SUBROUTINE NUMBR(IN,INEXT,FNUM,TERM) C Version 01.14 C Written by: C Stephen R. Besch C Dept. of Physiology C School of Medicine C SUNY at Buffalo C Buffalo, N.Y. 14214 C July 9, 1980 C This routine accepts the next N characters from the array C IN and decodes them into a real number. The characters are C packed as 8-bit ascii, 3 characters per integer variable. C The absolute value of INEXT is stored as a pointer to the C next character to be fetched from IN, if INEXT is not 0. C The old value is used when INEXT is 0. INEXT is returned C returned bumped up to reflect the number of characters processed C whenever INEXT is positive, and not 0. C The result is returned in FNUM. C TERM is returned set to the value of the character C which terminated the input. C Input data may be any length, real or integer, with or C without an exponent specification, and ended with any non- C acceptable character. Leading spaces are ignored, while any C subsequent spaces act as number terminators. C Edit History: C 4/2/81 1. Modified terminating characteristics so that any C character other than a digit, +, -, E, e act as C number terminators. C 2. Terminating character now returned as argument C 3. Leading spaces now stripped off. C 8/12/81 1. No longer will bump INEXT past end of ITEXT array. C 3/27/82 1. Added initializing features for INEXT. DIMENSION IN(1) INTEGER CHAR,DPEXP,ESIGN,TERM COMMON /STRFUN/ IPTR C First initialize a few things. IF(INEXT.LT.0)IPTR=-INEXT !Initialize pointer if .NE.0 IF(INEXT.GT.0)IPTR=INEXT DPEXP=0 INEXP=0 ACUM=0 INEXP=0 SIGN=1 ESIGN=1 ASSIGN 310 TO MINUS ASSIGN 410 TO DP ASSIGN 610 TO DIGIT ASSIGN 700 TO EEXP ASSIGN 100 TO SPACE 90 ASSIGN 315 TO PLUS C The loop to fetch characters starts here. C GETWRD returns the decimal value of the character pointed to C by IPTR, masked with 177 octal to remove the parity bit. 100 CHAR=GETWRD(IN,IPTR,127) IF(CHAR.NE.13)IPTR=IPTR+1 !Point to next character IF(CHAR.EQ.32)GOTO SPACE !Ignore leading spaces ASSIGN 200 TO SPACE !Next space is a terminator C Check for E or e: IF(CHAR.EQ.69.OR.CHAR.EQ.101)GOTO EEXP C Check for non-acceptable character: IF(CHAR.LE.42.OR.CHAR.GT.57)GOTO 200 IF(CHAR.GE.48)GOTO DIGIT !Go process digits C Branch on:PLUS,COMMA,MINUS, DP,SLASH GOTO (330, 200, 300 ,400, 200),CHAR-42 C Come here to adjust result for exponont and decimal point C Also fix the sign of the answer 200 FNUM=SIGN*ACUM*10.**(DPEXP+ESIGN*INEXP) TERM=CHAR !Return terminating character IF(INEXT.GT.0)INEXT=IPTR RETURN C Here if you get a minus sign. Set a flag and C a bunch of GOTO's to cause an exit if another C minus sign is input. 300 GOTO MINUS 310 SIGN=-1. 315 ASSIGN 200 TO MINUS ASSIGN 200 TO PLUS GOTO 100 C Here on a sign in an exponent field. Set flags same as C in numeric field 320 ESIGN=-1 GOTO 315 C Here on plus sign. Set flags for exit on another sign, C but otherwise ignore character. 330 GOTO PLUS C Here if a decimal point is discovered. Set digit to C begin counting places to the right of the decimal point. C While you're here, forbid any more decimal points! 400 GOTO DP 410 ASSIGN 600 TO DIGIT ASSIGN 200 TO DP GOTO 315 !From now on, + or - terminates C Here on any digit. Initially just accumulate the C value of the numeric field (GOTO 610). After a DP, C count digits to the right of the decimal point.(GOTO 600) C When in an exponent field, accumulate that(GOTO 620). 610 ASSIGN 200 TO PLUS ASSIGN 200 TO MINUS ASSIGN 605 TO DIGIT GOTO 605 600 DPEXP=DPEXP-1 605 ACUM=ACUM*10.+CHAR-48 GOTO 100 620 INEXP=INEXP*10.+CHAR-48 GOTO 100 C Here if you find an E in the number field. First C allow signs again, but adjust to set the exponent sign C and accumulate exponent. Then forbid another E. 700 ASSIGN 320 TO MINUS ASSIGN 620 TO DIGIT ASSIGN 200 TO EEXP GOTO 90