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