subroutine dat_intprt(text, putval, userarg)

!
! Interprete TEXT containing name / value parameters.
! You must call DAT_DELIMITERS(SEP, ASS, QUOTE) before in order to define
!   the separator symbol SEP
!   the assignment symbol ASS and
!   the text quote character QUOTE.
!
! DAT_INTPRT calls the subroutine PUTVAL(NAME, VALUE, USERARG)
! for each name/value pair.
! For numeric values NAME and VALUE contain name and value.
! For textual values, the argument NAME contains a concatenation
! of name '=' and the text between the quotes. In that case, VALUE
! is guaranteed to be 0.0.
!
! There may be up to 32 numeric values per name in TEXT, separated by
! blanks or commas (comma not allowed when SEP=',').
! If more then one value per name is given, PUTVAL is called several times
!
! Example:
!
!     CALL DAT_DELIMITERS(';', ':=', '"')
!     TEXT='first:=3.3;second:="name";third:=10,10.5,11'
!     CALL DAT_INTPRT(TEXT, PUTVAL, 0)
!  
!  we are using ':=' as assignment symbol
!               ';' as separator
!               '"' as quote character
!
!  DAT_INTPRT will call PUTVAL(NAME, VALUE, 0) 5 times with the following arguments:
!
!  NAME         VALUE
!  ------------------
!  'first'        3.3
!  'second=name'  0.0
!  'third'       10.0
!  'third'       10.5
!  'third'       11.0
!

	character text*(*)  ! text to interprete. must not be longer than 160-len(ASS) characters
	external putval     ! procedure to call for each name/value pair
	external userarg    ! user argument

! arguments for dat_delimiters:
	character sep_symbol*(*)  ! separator between subsequent name/value pairs
	                          ! must not be blank
	character ass_symbol*(*)  ! assignment symbol separator between name and values
	                          ! must not be blank
	character quote_char*1    ! quote character (may be blank)

	integer l,p,m,j,ln,i,k,q

	character line*160 
	logical nodecpoint

	integer maxarr
	parameter (maxarr=32)
	real arr(maxarr)

	integer ls/0/, la/0/
	character sep*32, ass*32, quote*1
	save sep, ass, quote

	if (ls .eq. 0)
	1  stop 'DAT_INTPRT: DAT_DELIMITERS must be called first'
	if (len(text)+max(la,ls) .gt. len(line))
	1 stop 'DAT_INTPRT: text too long'

	call str_trim(line, text, l)

	line(l+1:l+1)='!'
	l=index(line,'!')-1
	if (l .le. 0) RETURN
	if (line(1:l) .eq. ' ') RETURN
	p=0
1	continue
	  line(l+1:l+la)=ass  ! set stopper

	  ! read blanks
	  if (p .lt. l) then
	    do while (line(p+1:p+1) .le. ' ')
	      p=p+1
	    enddo
	  endif

	  if (p .ge. l) RETURN

	  j=p
	  p=p+index(line(p+1:), ass(1:la))-1 ! position of assignment char.
12	  i=index(line(j+1:p+1), sep(1:ls))
	  if (i .ne. 0) then
	    print *,'DAT_INTPRT: missing "',ass(1:la),'" : '
	1           , line(1:j+i+ls-1)
	    p=j+i+ls
	    goto 1
	  endif
	  if (j .eq. p) then
	    print *,'DAT_INTPRT: missing name: ', line
	    line(l+1:l+ls)=sep  ! set stopper
	    p=j+index(line(j+1:), sep(1:ls))+ls
	    goto 1
	  endif
	  m=p
	  do while (line(m:m) .le. ' ')
	    m=m-1
	  enddo
	  if (p .ge. l) then
	    print *,'DAT_INTPRT: missing "',ass(1:la),'" : ', line(1:p)
	    RETURN
	  endif
	  p=p+la

	  ! read blanks
	  line(l+1:l+1)=quote ! stopper
	  if (line(p+1:l+1) .eq. ' ') then
	    p=l
	  else
	    do while (line(p+1:p+1) .le. ' ')
	      p=p+1
	    enddo
	  endif

	  if (quote .gt. ' ' .and. line(p+1:p+1) .eq. quote) then ! --- quoted text

	    p=p+1
	    ln=index(line(p+1:), quote)-1
	    if (ln .eq. 0) then
	      call putval(line(j+1:m)//'= ', 0.0, userarg)
	    else
	      call putval(line(j+1:m)//'='//line(p+1:p+ln), 0.0, userarg)
	    endif
	    p=p+ln
	    ln=index(line(p+1:),sep(1:ls))-1
	    if (ln .lt. 0) ln=l-p
	    if (line(p+1:p+ln) .ne. quote) then
	      print *,'DAT_INTPRT: superflous characters: ',line(1:p+ln)
	    endif
	    p=p+ln+ls

	  elseif (index('-.0123456789',line(p+1:p+1)) .ne. 0) then ! --- numeric

	    i=0
	    line(l+1:l+ls)=sep(1:ls) ! stopper

	    k=p
	    do while (line(k+1:k+1) .eq. ' ') ! skip blanks
	      k=k+1
	    enddo
	    q=p
11	    continue
	      nodecpoint=.true.
	      do while (line(k+1:k+1) .ne. ' ' 
	1         .and. line(k+1:k+1) .ne. ',' 
	1         .and. line(k+1:k+ls) .ne. sep(1:ls))
	        k=k+1
	      enddo
	      do while (line(k+1:k+1) .eq. ' ') ! skip blanks
	        k=k+1
	      enddo
	      if (line(k+1:k+1) .eq. ',' .and.
	1         line(k+1:k+ls) .ne. sep(1:ls)) then ! skip one comma
	        k=k+1
	        do while (line(k+1:k+1) .eq. ' ') ! skip blanks
	          k=k+1
	        enddo
	      endif
	      if (i .lt. maxarr) then
	        if (index(line(p+1:k), '.') .ne. 0) nodecpoint=.false.
	        read(line(p+1:k), *, err=103) arr(i+1)
	      endif
	      i=i+1
	      if (line(k+1:k+ls) .ne. sep(1:ls)) then
	        p=k
	        goto 11
	      endif

	    p=k+ls

	    if (nodecpoint) call meta_format(5003) ! set to integer format
	    if (i .eq. 1) then
	      call putval(line(j+1:m), arr(1), userarg)
	    else
	      ln=i
	      if (ln .gt. maxarr) goto 103
	      do i=1,ln
	        call putval(line(j+1:m), arr(i), userarg)
	      enddo
	    endif
	    if (nodecpoint) call meta_format(0) ! reset format

	  else ! --- literal

	    ln=index(line(p+1:),sep(1:ls))-1
	    if (ln .lt. 0) ln=l-p
	    i=p+ln
	    do while (line(i:i) .le. ' ') ! truncate trailing blanks
	      i=i-1
	    enddo
	    if (i .le. p) then
	      call putval(line(j+1:m)//'= ', 0.0, userarg)
	    else
	      call putval(line(j+1:m)//'='//line(p+1:i), 0.0, userarg)
	    endif
	    p=p+ln+ls

	  endif
	  goto 1
	
103	  p=p+index(line(p+1:), sep(1:ls))-1
	  call str_trim(line(q+1:p), line(q+1:p), ln)
	  call putval(line(j+1:m)//'='//line(q+1:q+ln), 0.0, userarg)
	  p=p+ls
	  goto 1

	entry dat_delimiters(sep_symbol, ass_symbol, quote_char)

	quote=quote_char
	call str_trim(sep, sep_symbol, ls)
	call str_trim(ass, ass_symbol, la)
	if (sep(1:ls) .le. ' ')
	1 stop 'DAT_DELIMITERS: separator must not be blank'
	if (ass(1:la) .le. ' ')
	1 stop 'DAT_DELIMITERS: assignment symbol must not be blank'
	if (quote .eq. sep(1:1) .or. quote .eq. ass(1:1)) then
	  stop 'DAT_DELIMITERS: QUOTE must be different from SEP and ASS'
	endif
	end