C	functions to read text and numbers from a character string




	SUBROUTINE SKIPCOMMA (TEXT,IPOS)
C	skip blanks and also a comma if it is the next non-blank character
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position
C	                   !  output: the next position

	ILAST=LEN(TEXT)

	DO WHILE (IPOS.LE.ILAST)
	 IF (TEXT(IPOS:IPOS).EQ.' ') THEN
	  IPOS=IPOS+1
	 ELSE
	  GOTO 11
	 END IF
	END DO

11	IF (IPOS.LE.ILAST) THEN
	  IF (TEXT(IPOS:IPOS).EQ.',') IPOS=IPOS+1
	END IF

	RETURN
	END





	CHARACTER*(*) FUNCTION GETSTRING (TEXT,IPOS)
C	get next string without blanks
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position
C	                   !  output: the next position

	CHARACTER*1 CH

	ILAST=LEN(TEXT)

	DO WHILE (IPOS.LE.ILAST)
	 IF (TEXT(IPOS:IPOS).EQ.' ') THEN
	  IPOS=IPOS+1
	 ELSE
	  GOTO 11
	 END IF
	END DO

11	IF (IPOS.GT.ILAST) THEN
	 GETSTRING=' '
	ELSE
	 GETSTRING=' '
	 J=0
	 DO WHILE (IPOS.LE.ILAST)
	  CH=TEXT(IPOS:IPOS)
	  IF (CH.NE.' ') THEN
	   J=J+1
	   IF (J.LE.LEN(GETSTRING)) THEN
	    GETSTRING(J:J)=CH
	    IPOS=IPOS+1
	   ELSE
	    STOP 5561
	   END IF
	  ELSE
	   GOTO 21
	  END IF
	 END DO
	END IF

21	RETURN
	END





	CHARACTER*(*) FUNCTION GETCHNB (TEXT,IPOS)
C	get next CHaracter that is Non-Blank
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position
C	                   !  output: the next position

	ILAST=LEN(TEXT)

	DO WHILE (IPOS.LE.ILAST)
	 IF (TEXT(IPOS:IPOS).EQ.' ') THEN
	  IPOS=IPOS+1
	 ELSE
	  GOTO 11
	 END IF
	END DO

11	IF (IPOS.GT.ILAST) THEN
	 GETCHNB=' '
	ELSE
	 GETCHNB=' '
	 IF (1.LE.LEN(GETCHNB)) THEN
	  GETCHNB(1:1)=TEXT(IPOS:IPOS)
	  IPOS=IPOS+1
	 ELSE
	  STOP 5561
	 END IF
	END IF

	RETURN
	END





	INTEGER FUNCTION IGETINTP (TEXT,IPOS)
C	get positive integer without introductory blanks and sign
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position
C	                   !  output: the next position

	INTEGER IREAD(40)
	CHARACTER*1 CH

	CH='0'
	ICH0=ICHAR(CH)
	CH='9'
	ICH9=ICHAR(CH)

	ILAST=LEN(TEXT)

	IF (IPOS.GT.ILAST) THEN
	 IGETINTP=0
	ELSE
	 J=0
	 DO WHILE (IPOS.LE.ILAST)
	  CH=TEXT(IPOS:IPOS)
	  ICH=ICHAR(CH)
	  IF (ICH.GE.ICH0 .AND. ICH.LE.ICH9) THEN
	   J=J+1
	   IF (J.GT.40) STOP 1566
	   IREAD(J)=ICH-ICH0
	   IPOS=IPOS+1
	  ELSE
	   GOTO 21
	  END IF
	 END DO
21	 IGETINTP=0
	 DO K=1,J
	  IGETINTP=IGETINTP+IREAD(K)*(10**(J-K))
	 END DO
	END IF

	CALL SKIPCOMMA (TEXT,IPOS)

	RETURN
	END






	INTEGER FUNCTION IGETINT (TEXT,IPOS)
C	get integer
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position to search in
C	                   !  output: the next position

	INTEGER IREAD(40)
	CHARACTER*1 CH

	CH='0'
	ICH0=ICHAR(CH)
	CH='9'
	ICH9=ICHAR(CH)

	ILAST=LEN(TEXT)

	DO WHILE (IPOS.LE.ILAST)
	 IF (TEXT(IPOS:IPOS).EQ.' ') THEN
	  IPOS=IPOS+1
	 ELSE
	  GOTO 11
	 END IF
	END DO

11	IF (IPOS.GT.ILAST) THEN
	 IGETINT=0
	ELSE
	 CH=TEXT(IPOS:IPOS)
	 IF (CH.EQ.'+') THEN
	  IFAKT=1
	  IPOS=IPOS+1
	 ELSE IF (CH.EQ.'-') THEN
	  IFAKT=-1
	  IPOS=IPOS+1
	 ELSE
	  IFAKT=1
	 END IF
	 J=0
	 DO WHILE (IPOS.LE.ILAST)
	  CH=TEXT(IPOS:IPOS)
	  ICH=ICHAR(CH)
	  IF (ICH.GE.ICH0 .AND. ICH.LE.ICH9) THEN
	   J=J+1
	   IF (J.GT.40) STOP 1566
	   IREAD(J)=ICH-ICH0
	   IPOS=IPOS+1
	  ELSE
	   GOTO 21
	  END IF
	 END DO
21	 IGETINT=0
	 DO K=1,J
	  IGETINT=IGETINT+IREAD(K)*(10**(J-K))
	 END DO
	 IGETINT=IFAKT*IGETINT
	END IF

	CALL SKIPCOMMA (TEXT,IPOS)

	RETURN
	END





	REAL FUNCTION GETREAL (TEXT,IPOS)
C	get real number
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position to search in
C	                   !  output: the next position

	CHARACTER*1 CH

	ILAST=LEN(TEXT)

	DO WHILE (IPOS.LE.ILAST)
	 IF (TEXT(IPOS:IPOS).EQ.' ') THEN
	  IPOS=IPOS+1
	 ELSE
	  GOTO 11
	 END IF
	END DO

11	IF (IPOS.GT.ILAST) THEN
	 GETREAL=0.0
	ELSE
	 CH=TEXT(IPOS:IPOS)
	 IF (CH.EQ.'+') THEN
	  IFAKT=1
	  IPOS=IPOS+1
	 ELSE IF (CH.EQ.'-') THEN
	  IFAKT=-1
	  IPOS=IPOS+1
	 ELSE
	  IFAKT=1
	 END IF
	 GETREAL = IGETINTP (TEXT,IPOS)
	 IF (IPOS.LE.ILAST) THEN
	  CH=TEXT(IPOS:IPOS)
	  IF (CH.EQ.'.') THEN
	   IPOS = IPOS+1
	   I0 = IPOS
	   IF (IPOS.LE.ILAST) THEN
	    CH=TEXT(IPOS:IPOS)
	    DO WHILE (CH.EQ.'0')
	     IPOS = IPOS+1
	     IF (IPOS.LE.ILAST) THEN
	      CH=TEXT(IPOS:IPOS)
	     ELSE
	      CH='x'
	     END IF
	    END DO
	   END IF
	   I0 = IPOS-I0
	   JDEC = IGETINTP (TEXT,IPOS)
	   SLASK = FLOAT(JDEC)/(10**I0)
	   DO WHILE (JDEC.GE.1)
	    JDEC = JDEC/10
	    SLASK = 0.1*SLASK
	   END DO
	   GETREAL = GETREAL + SLASK
	  END IF
	 END IF
	 IF (IPOS.LE.ILAST) THEN
	  CH=TEXT(IPOS:IPOS)
	  IF ( CH.EQ.'E' .OR. CH.EQ.'D' ) THEN
	   IPOS=IPOS+1
	   IF (IPOS.LE.ILAST) THEN
	    CH=TEXT(IPOS:IPOS)
	    IF (CH.EQ.'+') THEN
	     IEFAKT=1
	     IPOS=IPOS+1
	    ELSE IF (CH.EQ.'-') THEN
	     IEFAKT=-1
	     IPOS=IPOS+1
	    ELSE
	     IEFAKT=1
	    END IF
	    JEXP = IGETINTP (TEXT,IPOS)
	    GETREAL = GETREAL * (10.0**FLOAT(IEFAKT*JEXP))
	   END IF
	  END IF
	 END IF
	 GETREAL = IFAKT * GETREAL
	END IF

	CALL SKIPCOMMA (TEXT,IPOS)

	RETURN
	END






	REAL FUNCTION GETREAL0 (TEXT,IPOS)
C	as getreal but no exponent is considered
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position to search in
C	                   !  output: the next position

	CHARACTER*1 CH

	ILAST=LEN(TEXT)

	DO WHILE (IPOS.LE.ILAST)
	 IF (TEXT(IPOS:IPOS).EQ.' ') THEN
	  IPOS=IPOS+1
	 ELSE
	  GOTO 11
	 END IF
	END DO

11	IF (IPOS.GT.ILAST) THEN
	 GETREAL0=0.0
	ELSE
	 CH=TEXT(IPOS:IPOS)
	 IF (CH.EQ.'+') THEN
	  IFAKT=1
	  IPOS=IPOS+1
	 ELSE IF (CH.EQ.'-') THEN
	  IFAKT=-1
	  IPOS=IPOS+1
	 ELSE
	  IFAKT=1
	 END IF
	 GETREAL0 = IGETINTP (TEXT,IPOS)
	 IF (IPOS.LE.ILAST) THEN
	  CH=TEXT(IPOS:IPOS)
	  IF (CH.EQ.'.') THEN
	   IPOS = IPOS+1
	   I0 = IPOS
	   IF (IPOS.LE.ILAST) THEN
	    CH=TEXT(IPOS:IPOS)
	    DO WHILE (CH.EQ.'0')
	     IPOS = IPOS+1
	     IF (IPOS.LE.ILAST) THEN
	      CH=TEXT(IPOS:IPOS)
	     ELSE
	      CH='x'
	     END IF
	    END DO
	   END IF
	   I0 = IPOS-I0
	   JDEC = IGETINTP (TEXT,IPOS)
	   SLASK = FLOAT(JDEC)/(10**I0)
	   DO WHILE (JDEC.GE.1)
	    JDEC = JDEC/10
	    SLASK = 0.1*SLASK
	   END DO
	   GETREAL0 = GETREAL0 + SLASK
	  END IF
	 END IF
	 GETREAL0 = IFAKT * GETREAL0
	END IF

	CALL SKIPCOMMA (TEXT,IPOS)

	RETURN
	END






	REAL*8 FUNCTION GETREALD (TEXT,IPOS)
C	get double-precision real number
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position to search in
C	                   !  output: the next position

	CHARACTER*1 CH

	ILAST=LEN(TEXT)

	DO WHILE (IPOS.LE.ILAST)
	 IF (TEXT(IPOS:IPOS).EQ.' ') THEN
	  IPOS=IPOS+1
	 ELSE
	  GOTO 11
	 END IF
	END DO

11	IF (IPOS.GT.ILAST) THEN
	 GETREALD=0.0D0
	ELSE
	 CH=TEXT(IPOS:IPOS)
	 IF (CH.EQ.'+') THEN
	  IFAKT=1
	  IPOS=IPOS+1
	 ELSE IF (CH.EQ.'-') THEN
	  IFAKT=-1
	  IPOS=IPOS+1
	 ELSE
	  IFAKT=1
	 END IF
	 GETREALD = IGETINTP (TEXT,IPOS)
	 IF (IPOS.LE.ILAST) THEN
	  CH=TEXT(IPOS:IPOS)
	  IF (CH.EQ.'.') THEN
	   IPOS = IPOS+1
	   I0 = IPOS
	   IF (IPOS.LE.ILAST) THEN
	    CH=TEXT(IPOS:IPOS)
	    DO WHILE (CH.EQ.'0')
	     IPOS = IPOS+1
	     IF (IPOS.LE.ILAST) THEN
	      CH=TEXT(IPOS:IPOS)
	     ELSE
	      CH='x'
	     END IF
	    END DO
	   END IF
	   I0 = IPOS-I0
	   JDEC = IGETINTP (TEXT,IPOS)
	   SLASK = FLOAT(JDEC)/(10**I0)
	   DO WHILE (JDEC.GE.1)
	    JDEC = JDEC/10
	    SLASK = 0.1*SLASK
	   END DO
	   GETREALD = GETREALD + SLASK
	  END IF
	 END IF
	 IF (IPOS.LE.ILAST) THEN
	  CH=TEXT(IPOS:IPOS)
	  IF ( CH.EQ.'D' .OR. CH.EQ.'E' ) THEN
	   IPOS=IPOS+1
	   IF (IPOS.LE.ILAST) THEN
	    CH=TEXT(IPOS:IPOS)
	    IF (CH.EQ.'+') THEN
	     IEFAKT=1
	     IPOS=IPOS+1
	    ELSE IF (CH.EQ.'-') THEN
	     IEFAKT=-1
	     IPOS=IPOS+1
	    ELSE
	     IEFAKT=1
	    END IF
	    JEXP = IGETINTP (TEXT,IPOS)
	    GETREALD = GETREALD * (10.0**FLOAT(IEFAKT*JEXP))
	   END IF
	  END IF
	 END IF
	 GETREALD = IFAKT * GETREALD
	END IF

	CALL SKIPCOMMA (TEXT,IPOS)

	RETURN
	END







	COMPLEX*16 FUNCTION GETCD (TEXT,IPOS)
C	get double-precision complex number
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position to search in
C	                   !  output: the next position

	CHARACTER*1 CH
	REAL*8 X,Y, GETREALD

	ILAST=LEN(TEXT)

	DO WHILE (IPOS.LE.ILAST)
	 IF (TEXT(IPOS:IPOS).EQ.' ') THEN
	  IPOS=IPOS+1
	 ELSE
	  GOTO 11
	 END IF
	END DO

11	IF (IPOS.GT.ILAST) THEN
	 GETCD=(0.0D0,0.0D0)
	ELSE
	 CH=TEXT(IPOS:IPOS)
	 IF (CH.NE.'(') THEN
	  GETCD = DCMPLX ( GETREALD(TEXT,IPOS) , 0.0D0 )
	 ELSE
	  IPOS=IPOS+1
	  X = GETREALD (TEXT,IPOS)
	  IF (IPOS.GT.ILAST) THEN
	   STOP 3357
	  ELSE
	   IF (TEXT(IPOS:IPOS).NE.',') STOP 3357
	  END IF
	  IPOS=IPOS+1
	  Y = GETREALD (TEXT,IPOS)
	  IF (IPOS.GT.ILAST) THEN
	   STOP 3357
	  ELSE
	   IF (TEXT(IPOS:IPOS).NE.')') STOP 3357
	  END IF
	  GETCD=DCMPLX(X,Y)
	 END IF
	END IF

	CALL SKIPCOMMA (TEXT,IPOS)

	RETURN
	END






	SUBROUTINE TRIPD ( TEXT,IPOS, NVAL,AVAL,STEP,BVAL )
C	get nval,aval,step,bval from   (a:s:b)
	CHARACTER*(*) TEXT !  input:  the character string
	INTEGER IPOS       !  input:  the first position to search in
C	                   !  output: the next position
	INTEGER NVAL            ! output
	REAL*8 AVAL,STEP,BVAL   ! output

	CHARACTER*1 CH
	REAL*8 A,S,B, GETREALD

	ILAST=LEN(TEXT)

	DO WHILE (IPOS.LE.ILAST)
	 IF (TEXT(IPOS:IPOS).EQ.' ') THEN
	  IPOS=IPOS+1
	 ELSE
	  GOTO 11
	 END IF
	END DO

11	IF (IPOS.GT.ILAST) THEN
	 NVAL=0
	 AVAL=0.0D0
	 STEP=0.0D0
	 BVAL=0.0D0
	ELSE
	 CH=TEXT(IPOS:IPOS)
	 IF (CH.NE.'(') THEN
	  NVAL=1
	  AVAL = GETREALD (TEXT,IPOS)
	  STEP=0.0D0
	  BVAL=AVAL
	 ELSE
	  IPOS=IPOS+1
	  A = GETREALD (TEXT,IPOS)
	  IF (IPOS.GT.ILAST) THEN
	   STOP 3357
	  ELSE
	   IF (TEXT(IPOS:IPOS).NE.':') STOP 3357
	  END IF
	  IPOS=IPOS+1
	  S = GETREALD (TEXT,IPOS)
	  IF (IPOS.GT.ILAST) THEN
	   STOP 3357
	  ELSE
	   IF (TEXT(IPOS:IPOS).NE.':') STOP 3357
	  END IF
	  IPOS=IPOS+1
	  B = GETREALD (TEXT,IPOS)
	  IF (IPOS.GT.ILAST) THEN
	   STOP 3357
	  ELSE
	   IF (TEXT(IPOS:IPOS).NE.':') STOP 3357
	  END IF
	  IF (IPOS.GT.ILAST) THEN
	   STOP 3357
	  ELSE
	   IF (TEXT(IPOS:IPOS).NE.')') STOP 3357
	  END IF
	  IF (S.EQ.0.0D0) THEN
	   NVAL=1
	   AVAL=A
	   STEP=0.0D0
	   BVAL=AVAL
	  ELSE
	   NVAL = 1.5D0 + (B-A)/S
	   IF (NVAL.LE.1) THEN
	    NVAL=1
	    AVAL = A
	    STEP=0.0D0
	    BVAL=AVAL
	   ELSE
	    AVAL=A
	    STEP = (B-A) / (NVAL-1)
	    BVAL=B
	   END IF
	  END IF
	 END IF
	END IF

	CALL SKIPCOMMA (TEXT,IPOS)

	RETURN
	END
