1 2 SUBROUTINE TERHGT 3 !*********************************************************************** 4 ! TERHGT Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Processes Elevated Terrain Inputs for Receptor Network 7 ! 8 ! PROGRAMMER: Jeff Wang, Roger Brode 9 ! 10 ! DATE: March 2, 1992 11 ! 12 ! MODIFIED: To trap on array subscript out-of-bounds 13 ! when saving inputs to temporary arrays, 14 ! which can occur if there's an input error 15 ! in defining the receptor grid. 16 ! R.W. Brode, PES, 4/2/99 17 ! 18 ! INPUTS: Input Runstream Image Parameters 19 ! 20 ! OUTPUTS: Elevated Terrain Input for a Receptor Network 21 ! 22 ! CALLED FROM: RECART 23 ! REPOLR 24 !*********************************************************************** 25 26 ! Variable Declarations 27 USE MAIN1 28 IMPLICIT NONE 29 CHARACTER MODNAM*12 30 31 SAVE 32 INTEGER :: I , J , IZE1 33 REAL :: ROW 34 35 ! Variable Initializations 36 MODNAM = 'TERHGT' ! 0 37 IZE1 = IZE + 1 38 39 ! Check for the Location of the Secondary Keyword, ELEV 40 DO I = 1 , IFC 41 IF ( FIELD(I).EQ.'ELEV' ) ISC = I + 1 ! 0 42 ENDDO 43 44 ! Determine Whether There Are Enough Parameter Fields 45 IF ( IFC.EQ.ISC-1 ) THEN ! 0 46 ! Error Message: Missing Parameter 47 CALL ERRHDL(PATH,MODNAM,'E','223',KTYPE) ! 0 48 RECERR = .TRUE. 49 GOTO 999 50 ELSEIF ( IFC.EQ.ISC ) THEN 51 ! Error Message: Missing Numerical Field 52 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 53 RECERR = .TRUE. 54 GOTO 999 55 ENDIF 56 57 CALL STONUM(FIELD(ISC),ILEN_FLD,FNUM,IMIT) ! 0 58 ! Check The Numerical Field 59 IF ( IMIT.EQ.-1 ) THEN 60 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 61 RECERR = .TRUE. 62 ENDIF 63 ROW = FNUM ! 0 64 65 ISET = IZE 66 67 DO I = ISC + 1 , IFC 68 CALL STONUM(FIELD(I),ILEN_FLD,FNUM,IMIT) ! 0 69 ! Check The Numerical Field 70 IF ( IMIT.EQ.-1 ) THEN 71 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 72 RECERR = .TRUE. 73 ENDIF 74 DO J = 1 , IMIT ! 0 75 ISET = ISET + 1 ! 0 76 IF ( ISET.LE.NREC ) THEN 77 ZETMP1(ISET) = ROW ! 0 78 ZETMP2(ISET) = FNUM 79 ENDIF 80 ENDDO 81 ENDDO 82 83 IZE = ISET ! 0 84 85 IF ( ELTYPE.EQ.'FEET' .OR. REELEV.EQ.'FEET' ) THEN 86 ! Convert ELEV to Metric System 87 DO I = IZE1 , IZE ! 0 88 IF ( I.LE.NREC ) THEN ! 0 89 ZETMP2(I) = 0.3048*ZETMP2(I) ! 0 90 ZHTMP2(I) = 0.3048*ZHTMP2(I) 91 ENDIF 92 ENDDO 93 ENDIF 94 95 999 CONTINUE ! 0 96 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