1 2 SUBROUTINE FLGHGT 3 !*********************************************************************** 4 ! FLGHGT Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Processes Flagpole Receptor Heights 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: Flagpole Receptor Heights 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 33 REAL :: ROW 34 35 ! Variable Initializations 36 MODNAM = 'FLGHGT' ! 0 37 38 ! Check for the Location of the Secondary Keyword, FLAG 39 DO I = 1 , IFC 40 IF ( FIELD(I).EQ.'FLAG' ) ISC = I + 1 ! 0 41 ENDDO 42 43 ! Determine Whether There Are Enough Parameter Fields 44 IF ( IFC.EQ.ISC-1 ) THEN ! 0 45 ! Error Message: Missing Parameter 46 CALL ERRHDL(PATH,MODNAM,'E','223',KTYPE) ! 0 47 RECERR = .TRUE. 48 GOTO 999 49 ELSEIF ( IFC.EQ.ISC ) THEN 50 ! Error Message: Missing Numerical Field 51 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 52 RECERR = .TRUE. 53 GOTO 999 54 ENDIF 55 56 CALL STONUM(FIELD(ISC),ILEN_FLD,FNUM,IMIT) ! 0 57 ! Check The Numerical Field 58 IF ( IMIT.EQ.-1 ) THEN 59 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 60 RECERR = .TRUE. 61 ENDIF 62 ROW = FNUM ! 0 63 64 ISET = IZF 65 66 DO I = ISC + 1 , IFC 67 CALL STONUM(FIELD(I),ILEN_FLD,FNUM,IMIT) ! 0 68 ! Check The Numerical Field 69 IF ( IMIT.EQ.-1 ) THEN 70 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 71 RECERR = .TRUE. 72 ENDIF 73 DO J = 1 , IMIT ! 0 74 ISET = ISET + 1 ! 0 75 IF ( ISET.LE.NREC ) THEN 76 ZFTMP1(ISET) = ROW ! 0 77 ZFTMP2(ISET) = FNUM 78 ENDIF 79 ENDDO 80 ENDDO 81 82 IZF = ISET ! 0 83 84 999 CONTINUE ! 0 85 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