Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | str | |||
integer, | intent(out), | optional | :: | ibegin | ||
integer, | intent(out), | optional | :: | inext | ||
logical, | intent(out), | optional | :: | error |
FUNCTION RealNum (str, ibegin, inext, error) RESULT (res) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Get real number from string - Format: [blanks][+|-][nnn][.nnn][e|E|d|D[+|-]nnn] !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(in) :: str ! String REAL :: res ! Real number INTEGER, OPTIONAL, INTENT(out) :: ibegin, & ! Start position of real number inext ! 1st character after real number LOGICAL, OPTIONAL, INTENT(out) :: error ! Error flag INTEGER :: ib,in,istat LOGICAL :: Bflag, & ! .T. at begin of number in str InMan, & ! .T. in mantissa of number Pflag, & ! .T. after 1st '.' encountered Eflag, & ! .T. at exponent identifier 'eEdD' InExp, & ! .T. in exponent of number DInMan, & ! .T. if at least 1 digit in mant. DInExp, & ! .T. if at least 1 digit in exp. err ! Local error flag !----- -------- --------- --------- --------- --------- --------- --------- ------- Bflag=.true.; InMan=.false.; Pflag=.false.; Eflag=.false.; InExp=.false. DInMan=.false.; DInExp=.false. ib = 1 in = 1 DO WHILE (in <= LEN_TRIM(str)) SELECT CASE (str(in:in)) CASE (' ') ! Only leading blanks permitted ib = ib+1 IF (InMan .OR. Eflag .OR. InExp) EXIT CASE ('+','-') ! Permitted only IF (Bflag) THEN InMan=.true.; Bflag=.false. ! - at beginning of mantissa ELSEIF (Eflag) THEN InExp=.true.; Eflag=.false. ! - at beginning of exponent ELSE EXIT ! - otherwise STOP ENDIF CASE ('0':'9') ! Mark IF (Bflag) THEN InMan=.true.; Bflag=.false. ! - beginning of mantissa ELSEIF (Eflag) THEN InExp=.true.; Eflag=.false. ! - beginning of exponent ENDIF IF (InMan) DInMan=.true. ! Mantissa contains digit IF (InExp) DInExp=.true. ! Exponent contains digit CASE ('.') IF (Bflag) THEN Pflag=.true. ! - mark 1st appearance of '.' InMan=.true.; Bflag=.false. ! mark beginning of mantissa ELSEIF (InMan .AND..NOT.Pflag) THEN Pflag=.true. ! - mark 1st appearance of '.' ELSE EXIT ! - otherwise STOP END IF CASE ('e','E','d','D') ! Permitted only IF (InMan) THEN Eflag=.true.; InMan=.false. ! - following mantissa ELSE EXIT ! - otherwise STOP ENDIF CASE DEFAULT EXIT ! STOP at all other characters END SELECT in = in+1 END DO err = (ib > in-1) .OR. (.NOT.DInMan) .OR. ((Eflag.OR.InExp).AND..NOT.DInExp) IF (err) THEN res = 0.0 ELSE READ(str(ib:in-1),*,IOSTAT=istat) res err = istat /= 0 END IF IF (PRESENT(ibegin)) ibegin = ib IF (PRESENT(inext)) inext = in IF (PRESENT(error)) error = err END FUNCTION RealNum