INTEGER*4 FUNCTION JCVTS (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 = 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 IRET = INTEGER return code: C -1 - numeric error C 0 - no number found C 1 - normal return C 2 - leading non-spaces C 4 - trailing non-spaces C JCVTS = INTEGER*4 value of the number C C Author : T.Pijl C AKZO PHARMA, Oss Holland C dep. SDA C C Version : V1.0 Date : 4-jan-83 C C Module name : JCVTS.FOR C C Package : C C Compilation/Linking : C C Updates : name version C C description : C C***************************************************************************** BYTE STRING(1),ERB,CHAR INTEGER*4 IVAL DOUBLE PRECISION VAL DATA ERB/128/ C JCVTS=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 # 1). C CALL ERRSET(70,.TRUE.,.FALSE.,.FALSE.,.FALSE.,) CALL ERRSET(75,.TRUE.,.FALSE.,.FALSE.,.FALSE.,) C C decode string, and compute number C IPS=1 IF( LARG(2) ) IPS=IPOS I=IPS 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 IPS=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 # 1 C 400 IVAL=ISGN*VAL CALL ERRTST(75,IRES) C C compute return parameters C IF (STRING(IPS).NE.0) IPS=IPS+1 IF ((STRING(IPS-1).EQ.'+' .OR. STRING(IPS-1).EQ.'-') .AND. 1 (STRING(IPS).GE.'0' .AND. STRING(IPS).LE.'9')) IPS=IPS-1 IF (IPHASE.NE.3) IPS=LS+1 C IF (IRES.EQ.2) 410,499,499 C THEN 410 JCVTS=IVAL IRET=IRET1+IRET2+IRET4 C ENDIF C C return to calling routine C 499 IF( LARG(2) ) IPOS=IPS RETURN END