Files
piscal/dataassim/math/othersupmath/removerepeat.f
T
2016-02-03 18:52:05 +00:00

53 lines
1.4 KiB
FortranFixed

subroutine removerepeat(nin,stringin,nout,stringout,ncounter)
implicit none
integer nin,nout,ncounter(nin,nin+1)
character*100 stringin(nin),stringout(nin),term,
&chari,charj
character a*1
integer i,j,k,n
do i=1,nin
do j=1,nin+1
ncounter(i,j)=0
enddo
stringin(i)=trim(stringin(i))
enddo
nout=0
do i=1,nin
term=trim(stringin(i))
n=len(term)
chari=''
do k=1,n
a=term(k:k)
if((ichar(a).ge.65.and.ichar(a).le.90).or.
&(ichar(a).ge.97.and.ichar(a).le.122))then
if(ichar(a).ge.97)a=char(ichar(a)-32)
chari=trim(chari)//a
endif
enddo
do j=1,nout
term=trim(stringout(j))
n=len(term)
charj=''
do k=1,n
a=term(k:k)
if((ichar(a).ge.65.and.ichar(a).le.90).or.
&(ichar(a).ge.97.and.ichar(a).le.122))then
if(ichar(a).ge.97)a=char(ichar(a)-32)
charj=trim(charj)//a
endif
enddo
if(trim(chari).eq.trim(charj))then
ncounter(j,1)=ncounter(j,1)+1
ncounter(j,i+1)=1
goto 10
endif
enddo
nout=nout+1
stringout(nout)=trim(stringin(i))
ncounter(nout,1)=ncounter(nout,1)+1
ncounter(nout,i+1)=1
10 continue
enddo
return
end