Initial commit
This commit is contained in:
286
gen/str.f
Normal file
286
gen/str.f
Normal file
@ -0,0 +1,286 @@
|
||||
!! string handling
|
||||
!!
|
||||
subroutine STR_TRIM(RETSTR, STR, RETLEN) !!
|
||||
!!
|
||||
!! if RETSTR=STR then RETSTR is not touched
|
||||
!!
|
||||
!! Arguments:
|
||||
character*(*) STR, RETSTR !! in,out
|
||||
integer RETLEN !! out
|
||||
integer i
|
||||
|
||||
i=len(str)
|
||||
if (str(1:1) .gt. ' ') then
|
||||
10 if (str(i:i) .le. ' ') then
|
||||
i=i-1
|
||||
goto 10
|
||||
endif
|
||||
else
|
||||
20 if (str(i:i) .le. ' ') then
|
||||
if (i .gt. 1) then
|
||||
i=i-1
|
||||
goto 20
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
retlen=min(len(retstr),i)
|
||||
if (retstr .ne. str) then ! avoid copy to retstr if equal
|
||||
retstr=str(1:i)
|
||||
endif
|
||||
end
|
||||
|
||||
!!
|
||||
subroutine STR_UPCASE(RETSTR, STR) !!
|
||||
!!
|
||||
!! Arguments:
|
||||
character STR*(*), RETSTR*(*) !! in,out
|
||||
integer i, ch
|
||||
|
||||
retstr=str
|
||||
do i=1,len(retstr)
|
||||
ch=ichar(retstr(i:i))
|
||||
if (ch .ge. ichar('a') .and. ch .le. ichar('z')) then
|
||||
retstr(i:i)=char(ch-(ichar('a')-ichar('A')))
|
||||
endif
|
||||
enddo
|
||||
end
|
||||
|
||||
!!
|
||||
subroutine STR_LOWCASE(RETSTR, STR) !!
|
||||
!!
|
||||
!! Arguments:
|
||||
character STR*(*), RETSTR*(*) !! in,out
|
||||
integer i, ch
|
||||
|
||||
retstr=str
|
||||
do i=1,len(retstr)
|
||||
ch=ichar(retstr(i:i))
|
||||
if (ch .ge. ichar('A') .and. ch .le. ichar('Z')) then
|
||||
retstr(i:i)=char(ch+(ichar('a')-ichar('A')))
|
||||
endif
|
||||
enddo
|
||||
end
|
||||
|
||||
!!
|
||||
subroutine STR_APPEND(str, length, add) !!
|
||||
!!
|
||||
implicit none
|
||||
|
||||
character*(*) str, add !!
|
||||
integer length !!
|
||||
|
||||
if (len(add)+length .gt. len(str)) then
|
||||
if (length .lt. len(str)) then
|
||||
str(length+1:)=add
|
||||
length=len(str)
|
||||
endif
|
||||
else
|
||||
str(length+1:length+len(add))=add
|
||||
length=length+len(add)
|
||||
endif
|
||||
end
|
||||
|
||||
!!
|
||||
integer function STR_CMP(str1, str2) !!
|
||||
!!
|
||||
!! if strings are equal: return 0
|
||||
!! else return position of first different character
|
||||
|
||||
character str1*(*), str2*(*) !!
|
||||
|
||||
integer i
|
||||
|
||||
do i=0,min(len(str1),len(str2))-1
|
||||
if (str1(i+1:i+1) .ne. str2(i+1:i+1)) then
|
||||
str_cmp=i+1
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
do i=len(str1),len(str2)-1
|
||||
if (str2(i+1:i+1) .ne. ' ') then
|
||||
str_cmp=i+1
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
do i=len(str2),len(str1)-1
|
||||
if (str1(i+1:i+1) .ne. ' ') then
|
||||
str_cmp=i+1
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
str_cmp=0
|
||||
return
|
||||
end
|
||||
|
||||
!!
|
||||
subroutine STR_FIRST_NONBLANK(STR, POS) !!
|
||||
!!
|
||||
!! Arguments:
|
||||
character*(*) STR !! in
|
||||
integer POS !! out
|
||||
integer i
|
||||
|
||||
do i=1,len(str)
|
||||
if (str(i:i) .gt. ' ') then
|
||||
pos=i
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
pos=0
|
||||
end
|
||||
|
||||
!!
|
||||
subroutine STR_SPLIT(STR, DELIM, START, ENDE) !!
|
||||
!!
|
||||
!! split string into sequences separated by DELIM
|
||||
!! for the first sequence set ENDE=0 and START=0 (or START=n for other start position n+1)
|
||||
!! result: end of list: ENDE=-1
|
||||
!! empty sequence: START=ENDE+1
|
||||
!! normal sequence: STR(START:ENDE) without delimiter
|
||||
!!
|
||||
!! if ENDE has not a legal value, nothing happens
|
||||
|
||||
character STR*(*), DELIM*(*) !! (in) string, delimiter
|
||||
integer START, ENDE !! (in/out) start/end position
|
||||
|
||||
integer i
|
||||
|
||||
if (ende .lt. 0 .or. ende .ge. len(str) .or. start .lt. 0) then
|
||||
ende=-1
|
||||
RETURN
|
||||
endif
|
||||
if (ende .ne. 0) start=ende+len(delim)
|
||||
if (start .ge. len(str)) then
|
||||
if (start .gt. len(str)) then
|
||||
ende=-1
|
||||
RETURN
|
||||
endif
|
||||
i=0
|
||||
else
|
||||
i=index(str(start+1:), delim)
|
||||
endif
|
||||
if (i .eq. 0) then
|
||||
ende=len(str)
|
||||
else
|
||||
ende=start+i-1
|
||||
endif
|
||||
start=start+1
|
||||
end
|
||||
|
||||
!!
|
||||
subroutine STR_GET_ELEM(STR, POS, ELEM) !!
|
||||
!!
|
||||
!! reads next element ELEM from string STR(POS:). Elements are separated by
|
||||
!! spaces combined with one control-char (assume tab) or one comma.
|
||||
!! return ' ' when STR(POS:) contains only whitespace or when pos is to high
|
||||
!!
|
||||
character STR*(*) !! (in) input string
|
||||
character ELEM*(*) !! (out) element read
|
||||
integer POS !! (in/out) read position
|
||||
|
||||
integer start
|
||||
|
||||
|
||||
1 if (pos .gt. len(str)) then
|
||||
elem=' '
|
||||
RETURN
|
||||
endif
|
||||
if (str(pos:pos) .eq. ' ') then
|
||||
pos=pos+1
|
||||
goto 1
|
||||
endif
|
||||
start=pos
|
||||
2 if (str(pos:pos) .gt. ' ' .and. str(pos:pos) .ne. ',') then
|
||||
pos=pos+1
|
||||
if (pos .le. len(str)) then
|
||||
goto 2
|
||||
endif
|
||||
pos=pos-1
|
||||
endif
|
||||
if (str(pos:pos) .eq. ',' .or. str(pos:pos) .lt. ' ') then
|
||||
if (start .eq. pos) then
|
||||
elem=str(start:pos)
|
||||
if (elem(1:1) .lt. ' ') elem(1:1)=' '
|
||||
else
|
||||
elem=str(start:pos-1)
|
||||
endif
|
||||
pos=pos+1
|
||||
RETURN
|
||||
endif
|
||||
elem=str(start:pos-1)
|
||||
if (str(pos:) .eq. ' ') then
|
||||
RETURN
|
||||
endif
|
||||
3 if (str(pos:pos) .eq. ' ') then
|
||||
pos=pos+1
|
||||
if (pos .gt. len(str)) stop 'STR_GET_ELEM: assertion failed'
|
||||
goto 3
|
||||
endif
|
||||
if (str(pos:pos) .eq. ',' .or. str(pos:pos) .lt. ' ') then
|
||||
pos=pos+1
|
||||
endif
|
||||
end
|
||||
|
||||
!!
|
||||
subroutine STR_GET_WORD(STR, POS, WORD) !!
|
||||
!!
|
||||
!! reads next WORD from string STR(POS:). Words are separated by
|
||||
!! whitespace.
|
||||
!! return ' ' when STR(POS:) contains only whitespace or when pos is to high
|
||||
!!
|
||||
character STR*(*) !! (in) input string
|
||||
character WORD*(*) !! (out) element read
|
||||
integer POS !! (in/out) read position
|
||||
|
||||
integer start
|
||||
integer i
|
||||
|
||||
1 if (pos .gt. len(str)) then
|
||||
word=' '
|
||||
RETURN
|
||||
endif
|
||||
if (str(pos:pos) .le. ' ') then
|
||||
pos=pos+1
|
||||
goto 1
|
||||
endif
|
||||
start=pos
|
||||
do i=pos,len(str)
|
||||
if (str(i:i) .le. ' ') then
|
||||
pos=i
|
||||
word=str(start:i-1)
|
||||
RETURN
|
||||
endif
|
||||
enddo
|
||||
word=str(start:)
|
||||
pos=len(str)+1
|
||||
RETURN
|
||||
end
|
||||
|
||||
!!
|
||||
integer function STR_FIND_ELEM(STR, ELEM) !!
|
||||
!!
|
||||
!! find column index of element ELEM (case insensitive)
|
||||
!! only the first 64 chars of each element are checked
|
||||
!! 0 is returned when not found
|
||||
!!
|
||||
character STR*(*), ELEM*(*)
|
||||
character ups*64, upe*64
|
||||
integer pos, idx
|
||||
|
||||
pos=1
|
||||
call str_upcase(upe, elem)
|
||||
idx=0
|
||||
|
||||
call str_get_elem(str, pos, ups)
|
||||
do while (ups .ne. ' ')
|
||||
idx=idx+1
|
||||
call str_upcase(ups, ups)
|
||||
if (ups .eq. upe) then
|
||||
str_find_elem=idx
|
||||
RETURN
|
||||
endif
|
||||
call str_get_elem(str, pos, ups)
|
||||
enddo
|
||||
str_find_elem=0
|
||||
RETURN
|
||||
end
|
||||
Reference in New Issue
Block a user