1 2 SUBROUTINE STONUM(STRVAR,LENGTH,FNUM,IMUTI) 3 !*********************************************************************** 4 ! STONUM Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Gets Number From A String Variable 7 ! 8 ! PROGRAMMER: Jeff Wang, Roger Brode 9 ! 10 ! DATE: March 2, 1992 11 ! 12 ! INPUTS: Input String Variable 13 ! Length of Character String 14 ! 15 ! OUTPUTS: Numbers 16 ! 17 ! CALLED FROM: (This Is A Utility Program) 18 !*********************************************************************** 19 ! 20 ! Variable Declarations 21 IMPLICIT NONE 22 23 CHARACTER STRVAR*(*) , CHK , MODNAM*6 , NUMS*10 24 INTEGER :: I , IMUTI , LENGTH 25 REAL FNUM , CNUM , FDEC , FDC1 , HEAD 26 LOGICAL MEND , IN , NMARK , PMARK , DMARK , MMARK , EMARK 27 28 ! Variable Initialization 29 MODNAM = 'STONUM' ! 2879 30 NUMS = '0123456789' 31 I = 1 32 MEND = .FALSE. 33 IN = .FALSE. 34 NMARK = .FALSE. 35 PMARK = .FALSE. 36 DMARK = .FALSE. 37 MMARK = .FALSE. 38 EMARK = .FALSE. 39 CNUM = 0.0 40 IMUTI = 1 41 FDEC = 1. 42 43 ! Beginning the Processing 44 DO WHILE ( .NOT.MEND .AND. I.LE.LENGTH ) 45 CHK = STRVAR(I:I) ! 13521 46 IF ( CHK.NE.' ' ) THEN 47 IN = .TRUE. ! 11922 48 IF ( CHK.GE.'0' .AND. CHK.LE.'9' ) THEN 49 ! CHK is a Number, Assign a Value 50 IF ( .NOT.DMARK ) THEN ! 9897 51 CNUM = CNUM*10. + FLOAT(INDEX(NUMS,CHK)-1) ! 7014 52 ELSE 53 FDEC = FDEC/10. ! 2883 54 FDC1 = FDEC*FLOAT(INDEX(NUMS,CHK)-1) 55 CNUM = CNUM + FDC1 56 ENDIF 57 ELSE 58 ! Handle The E-Type Real Number 59 IF ( .NOT.EMARK .AND. CHK.EQ.'E' ) THEN ! 2025 60 EMARK = .TRUE. ! 18 61 IF ( .NOT.NMARK ) THEN 62 HEAD = CNUM ! 18 63 ELSE 64 HEAD = -CNUM ! 0 65 ENDIF 66 DMARK = .FALSE. ! 18 67 NMARK = .FALSE. 68 CNUM = 0.0 69 ELSEIF ( .NOT.PMARK .AND. CHK.EQ.'+' ) THEN 70 ! Set Positive Indicator 71 PMARK = .TRUE. ! 0 72 ELSEIF ( .NOT.NMARK .AND. CHK.EQ.'-' ) THEN 73 ! Set Negative Indicator 74 NMARK = .TRUE. ! 468 75 ELSEIF ( .NOT.DMARK .AND. CHK.EQ.'.' ) THEN 76 ! Set Decimal Indicator 77 DMARK = .TRUE. ! 1530 78 ELSEIF ( .NOT.MMARK .AND. CHK.EQ.'*' .AND. .NOT.NMARK ) & 79 & THEN 80 ! Set Repeat Number 81 MMARK = .TRUE. ! 9 82 IMUTI = NINT(CNUM) 83 CNUM = 0.0 84 ELSE 85 ! Error Occurs, Set Switch and Exit Out Of The Subroutine 86 GOTO 9999 ! 0 87 ENDIF 88 ENDIF 89 ELSEIF ( IN .AND. CHK.EQ.' ' ) THEN 90 MEND = .TRUE. ! 1599 91 ENDIF 92 I = I + 1 ! 13521 93 ENDDO 94 95 FNUM = CNUM ! 2879 96 97 ! In Case Of Negative Field, Value Set to Negative 98 IF ( NMARK ) FNUM = -FNUM 99 100 ! In Case of E-Format, Check for Exponents Out of Range 101 IF ( EMARK .AND. ABS(FNUM).LE.30. ) THEN 102 FNUM = HEAD*10**(FNUM) ! 18 103 ELSEIF ( EMARK .AND. ABS(FNUM).GT.30. ) THEN 104 IF ( FNUM.LT.0.0 ) THEN ! 0 105 FNUM = 0.0 ! 0 106 ELSEIF ( FNUM.GT.0.0 ) THEN 107 FNUM = HEAD*10**30. ! 0 108 ENDIF 109 GOTO 9999 ! 0 110 ENDIF 111 112 GOTO 1000 ! 2879 113 114 ! Set Error Switch for Illegal Numerical Field (WRITE Message and Handle 115 ! Error in Calling Routine) 116 9999 IMUTI = -1 ! 0 117 118 1000 CONTINUE ! 2879 119 END
HyperKWIC - Version 1.00DD executed at 20:00 on 1 Mar 2018 | Personal or Academic or Evaluation User | Free for Non-Commercial, Non-Government Use