1 2 3 SUBROUTINE EVCART 4 !*********************************************************************** 5 ! EVCART Module of the AMS/EPA Regulatory Model - AERMOD 6 ! 7 ! PURPOSE: Processes Discrete Cartesian Receptor Location Inputs 8 ! for Use with the EVALFILE Option 9 ! 10 ! PROGRAMMER: Roger Brode 11 ! 12 ! DATE: November 29, 1993 13 ! 14 ! INPUTS: Input Runstream Image Parameters 15 ! 16 ! OUTPUTS: Discrete Cartesian Receptor Location Inputs 17 ! With 'Arc' Grouping ID 18 ! 19 ! CALLED FROM: RECARD 20 !*********************************************************************** 21 22 ! Variable Declarations 23 USE MAIN1 24 IMPLICIT NONE 25 INTEGER :: I1 , I2 , I3 , I4 , I5 , J 26 CHARACTER MODNAM*12 27 28 SAVE 29 LOGICAL FOUND 30 31 ! Variable Initializations 32 MODNAM = 'EVCART' ! 0 33 I1 = IRXR 34 I2 = IRYR 35 I3 = IRZE 36 I4 = IRZF 37 I5 = IRZH 38 39 ! Determine Whether There Are Too Few Or Too Many Parameter Fields 40 IF ( IFC.LT.8 ) THEN 41 ! WRITE Error Message: Missing Parameters 42 CALL ERRHDL(PATH,MODNAM,'E','201',KEYWRD) ! 0 43 GOTO 999 44 ELSEIF ( IFC.GT.9 ) THEN 45 ! Error Message: Too Many Parameters 46 CALL ERRHDL(PATH,MODNAM,'E','202',KEYWRD) ! 0 47 GOTO 999 48 ENDIF 49 50 ! Check Whether The Maximum Number of Receptors is Exceeded 51 IF ( I1.EQ.NREC .OR. I2.EQ.NREC .OR. I3.EQ.NREC .OR. & 52 & I4.EQ.NREC .OR. I5.EQ.NREC ) THEN 53 ! Error Msg: Maximum Number Of Receptors Exceeded 54 WRITE (DUMMY,'(I8)') NREC ! 0 55 CALL ERRHDL(PATH,MODNAM,'E','219',DUMMY) 56 GOTO 999 57 ENDIF 58 59 ! READ XCOORD,YCOORD,ELEV,HILLZ,FLAG And Assign Them to Different 60 ! Arrays 61 62 CALL STONUM(FIELD(3),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 ELSE 67 AXR(I1+1) = FNUM ! 0 68 ENDIF 69 70 CALL STONUM(FIELD(4),ILEN_FLD,FNUM,IMIT) ! 0 71 ! Check The Numerical Field 72 IF ( IMIT.EQ.-1 ) THEN 73 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 74 ELSE 75 AYR(I2+1) = FNUM ! 0 76 ENDIF 77 78 CALL STONUM(FIELD(5),ILEN_FLD,FNUM,IMIT) ! 0 79 ! Check The Numerical Field 80 IF ( IMIT.EQ.-1 ) THEN 81 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 82 ELSE 83 AZELEV(I3+1) = FNUM ! 0 84 ENDIF 85 86 CALL STONUM(FIELD(6),ILEN_FLD,FNUM,IMIT) ! 0 87 ! Check The Numerical Field 88 IF ( IMIT.EQ.-1 ) THEN 89 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 90 ELSE 91 AZHILL(I5+1) = FNUM ! 0 92 ENDIF 93 94 CALL STONUM(FIELD(7),ILEN_FLD,FNUM,IMIT) ! 0 95 ! Check The Numerical Field 96 IF ( IMIT.EQ.-1 ) THEN 97 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 98 ELSE 99 AZFLAG(I4+1) = FNUM ! 0 100 ENDIF 101 102 ! Read ARCID Field, First Check for Previous Occurrence of This ARCID 103 FOUND = .FALSE. ! 0 104 J = 1 105 DO WHILE ( .NOT.FOUND .AND. J.LE.NUMARC ) 106 IF ( FIELD(8).EQ.ARCID(J) ) THEN ! 0 107 FOUND = .TRUE. ! 0 108 NDXARC(I1+1) = J 109 ENDIF 110 J = J + 1 ! 0 111 ENDDO 112 IF ( .NOT.FOUND ) THEN ! 0 113 NUMARC = NUMARC + 1 ! 0 114 IF ( NUMARC.GT.NARC ) THEN 115 ! Write Error Message: Too Many ARCs 116 WRITE (DUMMY,'(I8)') NARC ! 0 117 CALL ERRHDL(PATH,MODNAM,'E','254',DUMMY) 118 GOTO 999 119 ELSE 120 ARCID(NUMARC) = FIELD(8) ! 0 121 NDXARC(I1+1) = NUMARC 122 ENDIF 123 ENDIF 124 125 IF ( ELTYPE.EQ.'FEET' .OR. REELEV.EQ.'FEET' ) THEN ! 0 126 ! Convert ELEV AND ZHILL to Metric system 127 AZELEV(I3+1) = 0.3048*AZELEV(I3+1) ! 0 128 AZHILL(I5+1) = 0.3048*AZHILL(I5+1) 129 ENDIF 130 131 IRXR = I1 + 1 ! 0 132 IRYR = I2 + 1 133 IRZE = I3 + 1 134 IRZF = I4 + 1 135 IRZH = I5 + 1 136 NETID(IRXR) = ' ' 137 RECTYP(IRXR) = 'DC' 138 ! Reset ITAB Variable for TOXXFILE Option, 9/29/92 139 ITAB = 0 140 141 999 CONTINUE ! 0 142 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