SUBROUTINE DECODE (STR, A, MAXA, NA) C C Takes a given ASCIZ character string with a zero byte at C the end, and scans it for decimal numbers (integer or real). C Each number may have leading or trailing blanks, a sign (+/-), C a decimal point, and a signed or unsigned exponent, all C optional. Each number is terminated by a character different C from the above, such as a comma or space. C The variable number of such numbers is returned in C the real vector which is dimensioned to be at least C elements (MAXA is set by the caller). The actual C number used is returned as . Numbers which are defaulted C are returned as zero. C C David Villeneuve C Division of Physics M23A C National Research Council C Ottawa Ont. K1A 0R6 C 613-993-1288 C C REAL A(1) BYTE STR(1) C LEN = LENGTH(STR) NEXT = 1 NA = 0 10 NA = NA + 1 IF (NA .GT. MAXA) GO TO 20 A(NA) = FPCONV( STR, LEN, NEXT, LAST ) NEXT = LAST + 1 IF (NEXT .LE. LEN) GO TO 10 RETURN 20 NA = NA - 1 RETURN END FUNCTION FPCONV (STR, LEN, LFIRST, LAST) C C Takes a string of cahracters of length , starting at C character , and decodes the next real number there. C Real numbers must be of the form: C C 123 C 123. C 123E12 C 123.E12 C 123.456 C 123.456E-12 C -123 C ETC... C C Leading blankds are skipped, and the decoding stops at the first C character not part of the nubmer. is set to the position C of the next character following the nuber, after any trailing blanks. C BYTE STR(1) C C SKIP LEADING BLANKS C J = LFIRST 10 IF (.NOT. (J .LE. LEN .AND. STR(J) .EQ. ' ') ) GO TO 20 J = J+1 GO TO 10 20 LAST = J FPCONV = 0.0 IF (J .GT. LEN) RETURN C C FIND INTEGER PART OF NUMBER C FPCONV = XINTCV( STR, LEN, J, LAST, ISIGNI ) IF (LAST .GT. LEN) RETURN C C FIND FRACTIONAL PART OF NUMBER C J = LAST IF (STR(J) .NE. '.') GO TO 100 J = J+1 X = XINTCV( STR, LEN, J, LAST, ISIGNF ) K1 = LAST - J DO 60 K=1,K1 60 X = X/10.0 FPCONV = FPCONV + X*ISIGNI IF (LAST .GT. LEN) RETURN J = LAST C C FIND EXPONENT C 100 IF (STR(J) .NE. 'E' .AND. STR(J) .NE. 'e') GO TO 200 120 J = J+1 IF (STR(J) .EQ. ' ') GO TO 120 !SKIP BLANKS XINT = XINTCV( STR, LEN, J, LAST, ISIGNE) X = 10.0 IF (XINT .LT. 0.0) X = 0.1 IF (XINT .EQ. 0.0) GO TO 200 K1 = ABS(XINT) DO 150 K=1,K1 150 FPCONV = FPCONV * X C C SKIP PAST TRAILING BLANKS C 200 IF (LAST .GT. LEN .OR. STR(LAST) .NE. ' ') RETURN 250 LAST = LAST+1 IF (LAST .LE. LEN .AND. STR(LAST) .EQ. ' ') GO TO 250 IF (LAST .GT. LEN) RETURN IF (STR(LAST) .EQ. '+' .OR. STR(LAST) .EQ. '-' 1 .OR. (STR(LAST) .GE. '0' .AND. STR(LAST) .LE. '9') ) 2 LAST = LAST-1 !BACKUP ONE IF NUMBER FOLLOWING RETURN END FUNCTION XINTCV (STR, LEN, LFIRST, LAST, ISIGN) C C Inspects a string of characters of length , starting C at location , and returns the integer value represented C by the string contents as a real. The string may contain the digits 0-9 C and may begin with a +/- minus sign. The scan stops the first C non-digit encountered. Leading blanks are NOT skipped. C If the end of the string is rached, is set to LEN+1. C is set to plus or minus one depending on the presence C of a minus sign in the the number, so that -0 may be recognized. C BYTE STR(1) C J = LFIRST XNUM = 0.0 ISIGN = 1 !ASSUME POSITIVE IF (STR(J) .EQ. '-') ISIGN = -1 IF (STR(J) .EQ. '-' .OR. STR(J) .EQ. '+') J = J+1 C C CONVERT EACH DIGIT IN TURN C 50 IF (.NOT. ( J .LE. LEN .AND. 1 (STR(J) .GE. '0' .AND. STR(J) .LE. '9') ) ) GO TO 80 IDIGIT = STR(J) - '0' XNUM = XNUM*10.0 + FLOAT(IDIGIT) J = J+1 GO TO 50 C C FOUND NON-DIGIT C 80 LAST = J XINTCV = XNUM*ISIGN RETURN END