1 2 3 SUBROUTINE SETSRC 4 !*********************************************************************** 5 ! SETSRC Module of the AMS/EPA Regulatory Model - AERMOD 6 ! ---------------------------------------------------------------------- 7 ! --- ISC-PRIME Version 1.0 Level 970812 Modified 8 ! --- D. Strimaitis 9 ! --- Earth Tech, Inc. 10 ! Prepared for EPRI under contract WO3527-01 11 ! ---------------------------------------------------------------------- 12 ! 13 ! PURPOSE: Sets the Source Parameters for a Particular Source 14 ! 15 ! PROGRAMMER: Roger Brode, Jeff Wang 16 ! 17 ! DATE: March 2, 1992 18 ! 19 ! MODIFIED: To incorporate inputs for numerical integration 20 ! algorithm for AREA source - 7/7/93 21 ! 22 ! INPUTS: Source Parameters Arrays 23 ! Source Index 24 ! 25 ! OUTPUTS: Source Parameters for a Particular Source 26 ! 27 ! CALLED FROM: PCALC 28 !*********************************************************************** 29 30 ! Variable Declarations 31 USE MAIN1 32 IMPLICIT NONE 33 CHARACTER MODNAM*12 34 35 SAVE 36 INTEGER :: J 37 38 ! Variable Initializations 39 MODNAM = 'SETSRC' ! 27396 40 41 ! Assign The Values From Array Elements To Variables 42 IF ( SRCTYP(ISRC).EQ.'POINT' ) THEN 43 XS = AXS(ISRC) ! 9132 44 YS = AYS(ISRC) 45 ZS = AZS(ISRC) 46 QS = AQS(ISRC) 47 HS = AHS(ISRC) 48 49 DS = ADS(ISRC) 50 VS = AVS(ISRC) 51 TS = ATS(ISRC) 52 53 ELSEIF ( SRCTYP(ISRC).EQ.'VOLUME' ) THEN 54 XS = AXS(ISRC) ! 9132 55 YS = AYS(ISRC) 56 ZS = AZS(ISRC) 57 QS = AQS(ISRC) 58 HS = AHS(ISRC) 59 60 SYINIT = ASYINI(ISRC) 61 SZINIT = ASZINI(ISRC) 62 63 ELSEIF ( SRCTYP(ISRC).EQ.'AREA' ) THEN 64 XS = AXS(ISRC) ! 9132 65 YS = AYS(ISRC) 66 ZS = AZS(ISRC) 67 QS = AQS(ISRC) 68 HS = AHS(ISRC) 69 70 XINIT = AXINIT(ISRC) 71 YINIT = AYINIT(ISRC) 72 ANGLE = AANGLE(ISRC) 73 74 SZINIT = ASZINI(ISRC) 75 NVERT = 4 76 77 ! Store Vertices in Temporary Arrays 78 DO IVERT = 1 , NVERT + 1 79 XVERT(IVERT) = AXVERT(IVERT,ISRC) ! 45660 80 YVERT(IVERT) = AYVERT(IVERT,ISRC) 81 ENDDO 82 83 XCNTR = AXCNTR(ISRC) ! 9132 84 YCNTR = AYCNTR(ISRC) 85 86 ELSEIF ( SRCTYP(ISRC).EQ.'AREAPOLY' ) THEN 87 XS = AXS(ISRC) ! 0 88 YS = AYS(ISRC) 89 ZS = AZS(ISRC) 90 QS = AQS(ISRC) 91 HS = AHS(ISRC) 92 93 SZINIT = ASZINI(ISRC) 94 NVERT = NVERTS(ISRC) 95 96 ! Store Vertices in Temporary Arrays 97 DO IVERT = 1 , NVERT + 1 98 XVERT(IVERT) = AXVERT(IVERT,ISRC) ! 0 99 YVERT(IVERT) = AYVERT(IVERT,ISRC) 100 ENDDO 101 102 ! Assign equivalent values of XINIT and YINIT for calculating area 103 XINIT = AXINIT(ISRC) ! 0 104 YINIT = AYINIT(ISRC) 105 106 ! Assign centroid of polygon 107 XCNTR = AXCNTR(ISRC) 108 YCNTR = AYCNTR(ISRC) 109 110 ELSEIF ( SRCTYP(ISRC).EQ.'AREACIRC' ) THEN 111 XS = AXS(ISRC) ! 0 112 YS = AYS(ISRC) 113 ZS = AZS(ISRC) 114 QS = AQS(ISRC) 115 HS = AHS(ISRC) 116 117 SZINIT = ASZINI(ISRC) 118 NVERT = NVERTS(ISRC) 119 120 ! Store Vertices in Temporary Arrays 121 DO IVERT = 1 , NVERT + 1 122 XVERT(IVERT) = AXVERT(IVERT,ISRC) ! 0 123 YVERT(IVERT) = AYVERT(IVERT,ISRC) 124 ENDDO 125 126 ! Assign equivalent values of XINIT and YINIT for calculating area 127 XINIT = AXINIT(ISRC) ! 0 128 YINIT = AYINIT(ISRC) 129 130 XCNTR = AXCNTR(ISRC) 131 YCNTR = AYCNTR(ISRC) 132 133 ELSEIF ( SRCTYP(ISRC).EQ.'OPENPIT' ) THEN 134 XS = AXS(ISRC) ! 0 135 YS = AYS(ISRC) 136 ZS = AZS(ISRC) 137 QS = AQS(ISRC) 138 ! Set Emission Height of Effective Area, HS = 0.0 139 HS = 0.0 140 ! Set Height of Emissions Above Base of Pit, EMIHGT 141 EMIHGT = AHS(ISRC) 142 NVERT = 4 143 144 XINIT = AXINIT(ISRC) 145 YINIT = AYINIT(ISRC) 146 ANGLE = AANGLE(ISRC) 147 PALPHA = AALPHA(ISRC) 148 PDEFF = APDEFF(ISRC) 149 SZINIT = ASZINI(ISRC) 150 PITLEN = MAX(XINIT,YINIT) 151 PITWID = MIN(XINIT,YINIT) 152 153 ! Store Vertices in Temporary Arrays 154 DO IVERT = 1 , NVERT + 1 155 XVERT(IVERT) = AXVERT(IVERT,ISRC) ! 0 156 YVERT(IVERT) = AYVERT(IVERT,ISRC) 157 ENDDO 158 159 XCNTR = AXCNTR(ISRC) ! 0 160 YCNTR = AYCNTR(ISRC) 161 162 ENDIF 163 164 NPD = INPD(ISRC) ! 27396 165 IF ( NPD.GT.0 ) THEN 166 DO J = 1 , NPD ! 0 167 PDIAM(J) = APDIAM(J,ISRC) ! 0 168 PHI(J) = APHI(J,ISRC) 169 PDENS(J) = APDENS(J,ISRC) 170 VGRAV(J) = AVGRAV(J,ISRC) 171 TSTOP(J) = ATSTOP(J,ISRC) 172 ENDDO 173 ENDIF 174 175 ! Initialize SURFAC variable 176 SURFAC = .FALSE. ! 27396 177 178 CONTINUE 179 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