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 I1=IPOS JDEC = IGETINTP (TEXT,IPOS) GETREAL = GETREAL + FLOAT(JDEC)/(10**(IPOS-I1)) 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 I1=IPOS JDEC = IGETINTP (TEXT,IPOS) GETREAL0 = GETREAL0 + FLOAT(JDEC)/(10**(IPOS-I1)) 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 I1=IPOS JDEC = IGETINTP (TEXT,IPOS) GETREALD = GETREALD + FLOAT(JDEC)/(10**(IPOS-I1)) 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 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