1 2 SUBROUTINE SETPOL 3 !*********************************************************************** 4 ! SETPOL Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Setup the Final Polar Receptor Network Inputs 7 ! 8 ! PROGRAMMER: Jeff Wang, Roger Brode 9 ! 10 ! DATE: March 2, 1992 11 ! 12 ! MODIFIED: To Include TOXXFILE Option - 9/29/92 13 ! 14 ! INPUTS: The GRIDPOLR Sub-pathway Input Parameters 15 ! 16 ! OUTPUTS: Polar Receptor Network Arrays 17 ! 18 ! CALLED FROM: REPOLR 19 !*********************************************************************** 20 21 ! Variable Declarations 22 USE MAIN1 23 IMPLICIT NONE 24 CHARACTER MODNAM*12 25 26 SAVE 27 INTEGER :: I , J , JSET 28 REAL :: YTEMP 29 30 ! Variable Initializations 31 MODNAM = 'SETPOL' ! 3 32 33 IF ( ICOUNT.NE.0 .AND. JCOUNT.NE.0 ) THEN 34 ! Setup The Coordinate Of The Receptors 35 NETSTA(INNET) = IRXR + 1 ! 3 36 ISET = IRXR 37 JSET = IRYR 38 DO J = 1 , JCOUNT 39 DO I = 1 , ICOUNT ! 108 40 ISET = ISET + 1 ! 432 41 JSET = JSET + 1 42 IF ( ISET.GT.NREC ) THEN 43 ! Error Msg: Maximum Number Of Receptor Exceeded 44 WRITE (DUMMY,'(I8)') NREC ! 0 45 CALL ERRHDL(PATH,MODNAM,'E','219',DUMMY) 46 GOTO 999 47 ENDIF 48 IF ( ICOUNT.GT.IXM ) THEN ! 432 49 ! WRITE Error Message: Too Many X-Coordinates for This Network 50 WRITE (DUMMY,'(I8)') IXM ! 0 51 CALL ERRHDL(PATH,MODNAM,'E','225',DUMMY) 52 GOTO 999 53 ENDIF 54 IF ( JCOUNT.GT.IYM ) THEN ! 432 55 ! WRITE Error Message: Too Many Y-Coordinates for This Network 56 WRITE (DUMMY,'(I8)') IYM ! 0 57 CALL ERRHDL(PATH,MODNAM,'E','226',DUMMY) 58 GOTO 999 59 ENDIF 60 YTEMP = YCOORD(J,INNET)*DTORAD ! 432 61 AXR(ISET) = XINT + XCOORD(I,INNET)*SIN(YTEMP) 62 AYR(JSET) = YINT + XCOORD(I,INNET)*COS(YTEMP) 63 ENDDO 64 ENDDO 65 IRXR = ISET ! 3 66 IRYR = JSET 67 XORIG(INNET) = XINT 68 YORIG(INNET) = YINT 69 NETEND(INNET) = IRXR 70 NUMXPT(INNET) = ICOUNT 71 NUMYPT(INNET) = JCOUNT 72 NTID(INNET) = NETIDT 73 NTTYP(INNET) = 'GRIDPOLR' 74 ! Define ITAB, NXTOX, NYTOX Variables for TOXXFILE Option, 9/29/92 75 IF ( ITAB.LT.0 ) THEN 76 ! First Receptor Network Defined - Set Variables 77 ITAB = 1 ! 3 78 NXTOX = ICOUNT 79 NYTOX = JCOUNT 80 ELSE 81 ! Previous Receptors Have Been Defined - Reset ITAB = 0 82 ITAB = 0 ! 0 83 ENDIF 84 ENDIF 85 86 ! Setup The AZELEV Array 87 CALL SBYVAL(ZETMP1,ZETMP2,IZE) ! 3 88 ISET = IRZE 89 DO I = 1 , IZE 90 ISET = ISET + 1 ! 0 91 IF ( ISET.GT.NREC ) THEN 92 ! Error Msg: Maximum Number Of Receptor Exceeded 93 WRITE (DUMMY,'(I8)') NREC ! 0 94 CALL ERRHDL(PATH,MODNAM,'E','219',DUMMY) 95 GOTO 999 96 ENDIF 97 AZELEV(ISET) = ZETMP2(I) ! 0 98 ENDDO 99 IRZE = ISET ! 3 100 101 ! Setup The AZHILL Array 102 CALL SBYVAL(ZHTMP1,ZHTMP2,IZH) 103 ISET = IRZH 104 DO I = 1 , IZH 105 ISET = ISET + 1 ! 0 106 IF ( ISET.GT.NREC ) THEN 107 ! Error Msg: Maximum Number Of Receptor Exceeded 108 WRITE (DUMMY,'(I8)') NREC ! 0 109 CALL ERRHDL(PATH,MODNAM,'E','219',DUMMY) 110 GOTO 999 111 ENDIF 112 AZHILL(ISET) = ZHTMP2(I) ! 0 113 ENDDO 114 IRZH = ISET ! 3 115 116 ! Setup The AZFLAG Array 117 CALL SBYVAL(ZFTMP1,ZFTMP2,IZF) 118 ISET = IRZF 119 DO I = 1 , IZF 120 ISET = ISET + 1 ! 0 121 IF ( ISET.GT.NREC ) THEN 122 ! Error Msg: Maximum Number Of Receptor Exceeded 123 WRITE (DUMMY,'(I8)') NREC ! 0 124 CALL ERRHDL(PATH,MODNAM,'E','219',DUMMY) 125 GOTO 999 126 ENDIF 127 AZFLAG(ISET) = ZFTMP2(I) ! 0 128 ENDDO 129 IRZF = ISET ! 3 130 131 DO I = IDC1 + 1 , IRXR 132 NETID(I) = NETIDT ! 432 133 RECTYP(I) = 'GP' 134 ENDDO 135 136 999 CONTINUE ! 3 137 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