1 2 SUBROUTINE HILHGT 3 !*********************************************************************** 4 ! HILHGT Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Processes Hill Height Scale Inputs for Receptor Network 7 ! 8 ! PROGRAMMER: Roger Brode 9 ! 10 ! DATE: May 31, 1995 11 ! 12 ! INPUTS: Input Runstream Image Parameters 13 ! 14 ! OUTPUTS: Hill Height Scale Input for a Receptor Network 15 ! 16 ! CALLED FROM: RECART 17 ! REPOLR 18 !*********************************************************************** 19 20 ! Variable Declarations 21 USE MAIN1 22 IMPLICIT NONE 23 CHARACTER MODNAM*12 24 25 SAVE 26 INTEGER :: I , J , IZH1 27 REAL :: ROW 28 29 ! Variable Initializations 30 MODNAM = 'HILHGT' ! 0 31 IZH1 = IZH + 1 32 33 ! Check for the Location of the Secondary Keyword, ELEV 34 DO I = 1 , IFC 35 IF ( FIELD(I).EQ.'HILL' ) ISC = I + 1 ! 0 36 ENDDO 37 38 ! Determine Whether There Are Enough Parameter Fields 39 IF ( IFC.EQ.ISC-1 ) THEN ! 0 40 ! Error Message: Missing Parameter 41 CALL ERRHDL(PATH,MODNAM,'E','223',KTYPE) ! 0 42 RECERR = .TRUE. 43 GOTO 999 44 ELSEIF ( IFC.EQ.ISC ) THEN 45 ! Error Message: Missing Numerical Field 46 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 47 RECERR = .TRUE. 48 GOTO 999 49 ENDIF 50 51 CALL STONUM(FIELD(ISC),ILEN_FLD,FNUM,IMIT) ! 0 52 ! Check The Numerical Field 53 IF ( IMIT.EQ.-1 ) THEN 54 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 55 RECERR = .TRUE. 56 ENDIF 57 ROW = FNUM ! 0 58 59 ISET = IZH 60 61 DO I = ISC + 1 , IFC 62 CALL STONUM(FIELD(I),ILEN_FLD,FNUM,IMIT) ! 0 63 ! Check The Numerical Field 64 IF ( IMIT.EQ.-1 ) THEN 65 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 66 RECERR = .TRUE. 67 ENDIF 68 DO J = 1 , IMIT ! 0 69 ISET = ISET + 1 ! 0 70 IF ( ISET.LE.NREC ) THEN 71 ZHTMP1(ISET) = ROW ! 0 72 ZHTMP2(ISET) = FNUM 73 ENDIF 74 ENDDO 75 ENDDO 76 77 IZH = ISET ! 0 78 79 IF ( ELTYPE.EQ.'FEET' .OR. REELEV.EQ.'FEET' ) THEN 80 ! Convert ZHILL to Metric System 81 DO I = IZH1 , IZH ! 0 82 ZHTMP2(I) = 0.3048*ZHTMP2(I) ! 0 83 ENDDO 84 ENDIF 85 86 999 CONTINUE ! 0 87 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