1 2 3 SUBROUTINE PITEFF 4 !*********************************************************************** 5 !* PITEFF Module of the AMS/EPA Regulatory Model - AERMOD 6 !* 7 !* PURPOSE: To Determine the Coordinates of the OPENPIT Source 8 !* in Wind Direction Coordinate System 9 !* 10 !* PROGRAMMER: Jayant Hardikar, Roger Brode 11 !* 12 !* DATE: July 20, 1994 13 !* 14 !* INPUTS: 15 !* 16 !* OUTPUTS: Coordinates of the OPENPIT Source in Wind 17 !* Direction Coordinate System 18 !* 19 !* CALLED FROM: OCALC 20 !*********************************************************************** 21 22 !* Variable Declarations 23 USE MAIN1 24 IMPLICIT NONE 25 CHARACTER MODNAM*12 26 27 SAVE 28 INTEGER :: I , II , IUPWND 29 REAL :: SPAMIN , EFFANG , EFFWID , EFFLEN 30 REAL :: XTEMP(NVMAX) , YTEMP(NVMAX) 31 REAL , PARAMETER :: EPSLON = 0.00001 32 33 !* Variable Initializations 34 MODNAM = 'PITEFF' ! 0 35 36 !* Get Vertices of Actual Pit in WD-Coordinate System --- CALL AVERTS 37 CALL AVERTS(XVERT,YVERT,XTEMP,YTEMP,NVERT+1) 38 39 !* Find the Upwind Vertex of the Pit (one with minimum X) 40 SPAMIN = 1.0E+20 41 IUPWND = 0 42 DO IVERT = 1 , NVERT 43 IF ( XTEMP(IVERT).LT.SPAMIN ) THEN ! 0 44 IUPWND = IVERT ! 0 45 SPAMIN = XTEMP(IVERT) - EPSLON 46 ENDIF 47 ENDDO 48 49 !* If DEBUG Requested, Write Out Pit Info 50 IF ( DEBUG ) THEN ! 0 51 WRITE (IOUNIT,*) 'ACTUAL PIT COORDINATES:' ! 0 52 WRITE (IOUNIT,*) '----------------' 53 WRITE (IOUNIT,*) 'SYSTEM X1 Y1 X2 Y2' , & 54 & ' X3 Y3 X4 Y4' 55 WRITE (IOUNIT,*) '-------- -------- -------- -------- ' , & 56 & '-------- -------- -------- -------- ' , & 57 & '--------' 58 WRITE (IOUNIT,8000) (XVERT(II),YVERT(II),II=1,NVERT) 59 WRITE (IOUNIT,8100) (XTEMP(II),YTEMP(II),II=1,NVERT) 60 WRITE (IOUNIT,*) 61 WRITE (IOUNIT,*) ' UPWIND VERTEX OF THE PIT= ' , IUPWND 62 WRITE (IOUNIT,*) ' WIND DIRECTION W.R.T. PIT LONG AXIS= ' , & 63 & THETA 64 WRITE (IOUNIT,*) ' ALONGWIND LENGTH OF THE PIT= ' , PITL 65 WRITE (IOUNIT,*) ' RELATIVE DEPTH OF THE PIT= ' , PDREL 66 WRITE (IOUNIT,*) 67 ENDIF 68 69 !* Determine the Angle of the Effective Pit Relative to North 70 EFFANG = ANGLE + (90.*(IUPWND-1)) ! 0 71 72 !* Determine Length and Width Dimensions of the 73 !* Effective Pit Area 74 EFFWID = PITFRA**(1.0-(COS(THETA*DTORAD))**2)*PITWID 75 EFFLEN = PITFRA**((COS(THETA*DTORAD))**2)*PITLEN 76 77 !* Calculate the Coordinates of the Vertices of the Effective Pit Area 78 !* Set Coordinates of Vertices for Rectangular Area (in Kilometers). 79 !* Vertices Start with the "Southwest" Corner and Are Defined 80 !* Clockwise. The First Vertex is Repeated as the Last Vertex. 81 82 83 !* First determine proper 'x-dim' and 'y-dim' for effective area, 84 !* taking into account angle of orientation and relation to actual pit. 85 86 IF ( XINIT.LE.YINIT .AND. (IUPWND.EQ.1 .OR. IUPWND.EQ.3) ) THEN 87 XEFF = EFFWID ! 0 88 YEFF = EFFLEN 89 ELSEIF ( XINIT.LE.YINIT .AND. (IUPWND.EQ.2 .OR. IUPWND.EQ.4) ) & 90 & THEN 91 XEFF = EFFLEN ! 0 92 YEFF = EFFWID 93 ELSEIF ( XINIT.GT.YINIT .AND. (IUPWND.EQ.1 .OR. IUPWND.EQ.3) ) & 94 & THEN 95 XEFF = EFFLEN ! 0 96 YEFF = EFFWID 97 ELSEIF ( XINIT.GT.YINIT .AND. (IUPWND.EQ.2 .OR. IUPWND.EQ.4) ) & 98 & THEN 99 XEFF = EFFWID ! 0 100 YEFF = EFFLEN 101 ENDIF 102 103 XTEMP(1) = XVERT(IUPWND) ! 0 104 YTEMP(1) = YVERT(IUPWND) 105 106 XTEMP(2) = XTEMP(1) + (YEFF*SIN(EFFANG*DTORAD)) 107 YTEMP(2) = YTEMP(1) + (YEFF*COS(EFFANG*DTORAD)) 108 109 XTEMP(3) = XTEMP(2) + (XEFF*COS(EFFANG*DTORAD)) 110 YTEMP(3) = YTEMP(2) - (XEFF*SIN(EFFANG*DTORAD)) 111 112 XTEMP(4) = XTEMP(3) - (YEFF*SIN(EFFANG*DTORAD)) 113 YTEMP(4) = YTEMP(3) - (YEFF*COS(EFFANG*DTORAD)) 114 115 XTEMP(5) = XVERT(IUPWND) 116 YTEMP(5) = YVERT(IUPWND) 117 118 119 !* Calculate Coordinates of the Effective Pit Area in 120 !* Wind Direction Coordinate System --- CALL AVERTS 121 CALL AVERTS(XTEMP,YTEMP,XVERT,YVERT,NVERT+1) 122 123 !* If DEBUG Requested, Write Out Pit Info 124 IF ( DEBUG ) THEN 125 WRITE (IOUNIT,*) 'EFFECTIVE PIT COORDINATES:' ! 0 126 WRITE (IOUNIT,*) '----------------' 127 WRITE (IOUNIT,*) 'SYSTEM X1 Y1 X2 Y2' , & 128 & ' X3 Y3 X4 Y4' 129 WRITE (IOUNIT,*) '-------- -------- -------- -------- ' , & 130 & '-------- -------- -------- -------- ' , & 131 & '--------' 132 WRITE (IOUNIT,8000) (XTEMP(II),YTEMP(II),II=1,NVERT) 133 WRITE (IOUNIT,8100) (XVERT(II),YVERT(II),II=1,NVERT) 134 WRITE (IOUNIT,*) 135 WRITE (IOUNIT,*) 'EFFECTIVE PIT LENGTH = ' , EFFLEN 136 WRITE (IOUNIT,*) 'EFFECTIVE PIT WIDTH = ' , EFFWID 137 WRITE (IOUNIT,*) 'EFFECTIVE PIT ORIENTATION RELATIVE' , & 138 & ' TO NORTH= ' , EFFANG 139 WRITE (IOUNIT,*) 'FRACTIONAL SIZE OF THE EFFECTIVE PIT AREA= ' & 140 & , PITFRA 141 ENDIF 142 143 ! Reassign Effective Area Coordinates to Global Arrays for Subsequent Calcs. 144 DO I = 1 , 5 ! 0 145 XVERT(I) = XTEMP(I) ! 0 146 YVERT(I) = YTEMP(I) 147 ENDDO 148 149 CONTINUE ! 0 150 8000 FORMAT (1X,'User ',8(f11.3,1x)) 151 8100 FORMAT (1X,'Wind-Dir ',8(f11.3,1x)) 152 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