!! 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)
	  else
	    elem=str(start:pos-1)
	  endif
	  pos=pos+1
	  RETURN
	endif
	elem=str(start:pos-1)
	if (str(pos:) .eq. ' ') RETURN
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

!!
	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

!!
	subroutine STR_SUBSTITUTE(RESULT, STR, OLD, NEW) !!
!!
!! replace all occurences of substring OLD in STR by NEW
!! special case: if NEW=CHAR(0) then a null length string is replaced
!!
	character RESULT*(*), STR*(*) !! (out), (in) strings (must either be equal or not overlap)
	character OLD*(*), NEW*(*)    !! substrings (in)

	integer i,j,k

	i=0
	j=index(str, old)-1
	if (len(new) .eq. 1 .and. new(1:1) .eq. char(0)) then
	  k=0
	  do while (j .ge. 0)
	    if (j .gt. 0) result(k+1:k+j)=str(i+1:i+j)
	    i=i+j+len(old)
	    k=k+j
	    if (i .ge. len(str)) then
	      if (k .lt. len(result)) result(k+1:)=' '
	      RETURN
	    endif
	    j=index(str(i+1:), old)-1
	  enddo
	  if (k .lt. len(result)) result(k+1:)=str(i+1:)
	elseif (len(old) .ge. len(new)) then
	  k=0
	  do while (j .ge. 0)
	    if (j .gt. 0) result(k+1:k+j)=str(i+1:i+j)
	    i=i+j+len(old)
	    k=k+j
	    result(k+1:k+len(new))=new
	    k=k+len(new)
	    if (i .ge. len(str)) then
	      if (k .lt. len(result)) result(k+1:)=' '
	      RETURN
	    endif
	    j=index(str(i+1:), old)-1
	  enddo
	  if (k .lt. len(result)) result(k+1:)=str(i+1:)
	else
	  result=str
	  do while (j .ne. 0)
	    i=i+j
	    result(i+1:)=new//result(i+len(old)+1:)
	    i=i+len(new)
	    if (i .ge. len(str)) RETURN
	    j=index(str(i+1:), old)-1
	  enddo
	endif
	end

	subroutine STR_CRC(CRC,BUF) !!
!!
!! Computes a 16-bit Cyclic Redundancy Check for an character string BUF.
!! Before the first call CRC should be intitalized (i.e. to 0) -
!! between subsequent call it should left untouched.

	integer CRC        !! (in/out) CRC code
	character BUF*(*)  !! characters


	integer init,ireg,i,j,icrctb(0:255),ichr,ib1,ib2,ib3
	character*1 creg(4)
	save icrctb,init,ib1,ib2,ib3
	equivalence (creg,ireg) ! used to get at the 4 bytes in an integer.
	data init /0/

	integer crc1, crc2

	if (init.eq.0) then ! initialize tables?
	  init=1
	  ireg=256*(256*ichar('3')+ichar('2'))+ichar('1')
	  do j=1,4 ! figure out which component of creg addresses which byte of ireg.
	    if (creg(j).eq.'1') ib1=j
	    if (creg(j).eq.'2') ib2=j
	    if (creg(j).eq.'3') ib3=j
	  enddo
	  do j=0,255 ! create CRCs of all characters.
	    ireg=j*256

	    do i=1,8 ! Here is where 8 one-bit shifts, and some XORs with the generator polynomial, are done.
	      ichr=ichar(creg(ib2))
	      ireg=ireg+ireg
	      creg(ib3)=char(0)
	      if(ichr.gt.127)ireg=ieor(ireg,4129)
	    enddo

	    icrctb(j)=ireg
	  enddo
	endif
	ireg=crc
	crc1=ichar(creg(ib1))
	crc2=ichar(creg(ib2))

	do j=1,len(buf) ! Main loop over the characters
	  ireg=icrctb(ieor(ichar(buf(j:j)),crc2))
	  crc2=ieor(ichar(creg(ib2)),crc1)
	  crc1=ichar(creg(ib1))
	enddo
	creg(ib1)=char(crc1)
	creg(ib2)=char(crc2)
	crc=ireg
	return
	end

!!
	subroutine STR_CRC_COMP(CRC, CHR) !!
!!
!! encode CRC (16 bit) as 3 characters in CHR
!!
	integer CRC       !! (in)
	character CHR*3   !! (out)

	integer n,j
	character*41 cs/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ$+-&_'/

	if (crc .lt. 0 .or. crc .gt. 65535) stop 'STR_CRC_COMP: illegal CRC'
	n=crc
	j=mod(n,41)
	chr(1:1)=cs(j+1:j+1)
	n=n/41
	j=mod(n,41)
	chr(2:2)=cs(j+1:j+1)
	j=n/41
	chr(3:3)=cs(j+1:j+1)
	end