INTEGER FUNCTION ICVTS (STRING, IPOS, IRET) C***************************************************************************** C C Description : Routine to read an integer number from a string C C Arguments : STRING = string to be checked, terminated by zero-byte C IPOS = optional C input: C INTEGER position in STRING to start search C for number. C output: C INTEGER position plus 1 of first non-numeric C character in STRING, or C position of first non-numeric character if C this character is a sign-character or the C end-of-string character (=zero byte). C if not given input 1 assumed, no output C IRET = INTEGER return code: C -1 - numeric error C 0 - empty string C 1 - normal return C 2 - leading non-spaces C 4 - trailing non-spaces C ICVTS = INTEGER value of the number C C Author : F.A.Minkema C AKZO PHARMA, Oss Holland C dep. SDA C C Version : V1.1 Date : 03-jan-83 C C Module name : ICVTS.FTN C C Package : RSX-LIBRARY C C Compilation/Linking : FOR/F4P/TR:NONE ICVTS C C Updates : name version C H.A.M. Fikke V1.1 C description : IPOS optional C C***************************************************************************** BYTE STRING(1),CHAR C ICVTS=0 IRET=-1 C IRET1=0 ! switch: number found (yes/no: 1/0) IRET2=0 ! switch: leading non-spaces (yes/no: 2/0) IRET4=0 ! switch: trailing non-spaces (yes/no: 4/0) ISGN=1 ! sign of number (neg/pos: -1/1) VAL=0. ! value of number IPHASE=1 ! indicates where we are LS=LEN(STRING) ! length of string C C turn off INTEGER OVERFLOW (error # 70). C CALL ERRSET(70,.TRUE.,.FALSE.,.FALSE.,.FALSE.,) C C decode string, and compute number C IP=1 IF (LARG(2)) IP=IPOS I=IP 10 IF (I.GT.LS) GOTO 400 ! end of string CHAR=STRING(I) I=I+1 GOTO (100,200,300) IPHASE C C IPHASE=1 : search sign or first character of number C 100 IF ((CHAR.EQ.'+' .OR. CHAR.EQ.'-') .AND. 1 (STRING(I).GE.'0' .AND. STRING(I).LE.'9')) 110,120,120 C THEN 110 ISGN=44-CHAR IPHASE=2 GOTO 10 C ENDIF 120 IF (CHAR.GE.'0' .AND. CHAR.LE.'9') 130,140,140 C THEN 130 I=I-1 IPHASE=2 GOTO 10 C ENDIF 140 IF (CHAR.NE.' ') IRET2=2 GOTO 10 C C IPHASE=2 : determine number C 200 IF (CHAR.GE.'0' .AND. CHAR.LE.'9') 210,220,220 C THEN 210 VAL=10.*VAL + (CHAR-'0') IRET1=1 GOTO 10 C ENDIF 220 IPHASE=3 I=I-1 IP=I GOTO 10 C C IPHASE=3 : check trailing characters C 300 IF (CHAR.NE.' ') IRET4=4 GOTO 10 C C compute valid number and check occurance of error # 70 C 400 IVAL=ISGN*VAL CALL ERRTST(70,IRES) C C compute return parameters C IF (STRING(IP).NE.0) IP=IP+1 IF ((STRING(IP-1).EQ.'+' .OR. STRING(IP-1).EQ.'-') .AND. 1 (STRING(IP).GE.'0' .AND. STRING(IP).LE.'9')) IP=IP-1 IF (IPHASE.NE.3) IP=LS+1 C IF (IRES.EQ.2) 410,499,499 C THEN 410 ICVTS=IVAL IRET=IRET1+IRET2+IRET4 C ENDIF C C return to calling routine C 499 IF (LARG(2)) IPOS=IP RETURN END