1
2
3      SUBROUTINE PRTREC
4!***********************************************************************
5!                 PRTREC Module of the AMS/EPA Regulatory Model - AERMOD
6!
7!        PURPOSE: Print Out The Receptor Network Values
8!
9!        PROGRAMMER: Jeff Wang, Roger Brode
10!
11!        DATE:    March 2, 1992
12!
13!        MODIFIED:   To remove reference to Boundary
14!                    Receptors - 4/1/2004
15!
16!        MODIFIED:   To Adjust Format Statement 9082 for Boundary
17!                    Receptors - 9/29/92
18!
19!        INPUTS:  Arrays of Source Parameters
20!                 Arrays of Receptor Locations
21!                 Arrays of Model Results
22!
23!        OUTPUTS: Printed Model Outputs
24!
25!        CALLED FROM:   INPSUM
26!***********************************************************************
27
28!     Variable Declarations
29      USE MAIN1
30      IMPLICIT NONE
31      CHARACTER MODNAM*12
32
33      SAVE
34      INTEGER :: I , J , K , INDZ , NX , NY , INDC , ISRF
35      REAL :: YCOVAL , XRMS , YRMS , RANGE , RADIAL
36      CHARACTER BUF132*132
37
38!     Variable Initializations
39      MODNAM = 'PRTREC'                                                 !      3
40
41      DO I = 1 , INNET
42         CALL HEADER                                                    !      3
43         WRITE (IOUNIT,9034)
44 9034    FORMAT (/40X,'*** GRIDDED RECEPTOR NETWORK SUMMARY ***')
45         WRITE (IOUNIT,9037) NTID(I) , NTTYP(I)
46         IF ( NTTYP(I).EQ.'GRIDCART' ) THEN
47            WRITE (IOUNIT,9038)                                         !      0
48 9038       FORMAT (/42X,'*** X-COORDINATES OF GRID ***'/52X,           &
49     &              '(METERS)'/)
50         ELSE
51            WRITE (IOUNIT,9036) XORIG(I) , YORIG(I)                     !      3
52 9036       FORMAT (/42X,'*** ORIGIN FOR POLAR NETWORK ***'/,32X,       &
53     &              'X-ORIG =',F10.2,' ;   Y-ORIG = ',F10.2,            &
54     &              '  (METERS)')
55            WRITE (IOUNIT,9039)
56 9039       FORMAT (/42X,'*** DISTANCE RANGES OF NETWORK ***'/52X,      &
57     &              '(METERS)'/)
58         ENDIF
59         WRITE (IOUNIT,9040) (XCOORD(J,I),J=1,NUMXPT(I))                !      3
60         IF ( NTTYP(I).EQ.'GRIDCART' ) THEN
61            WRITE (IOUNIT,9041)                                         !      0
62 9041       FORMAT (/42X,'*** Y-COORDINATES OF GRID *** ',/52X,         &
63     &              '(METERS)'/)
64         ELSE
65            WRITE (IOUNIT,9042)                                         !      3
66 9042       FORMAT (/42X,'*** DIRECTION RADIALS OF NETWORK *** ',/52X,  &
67     &              '(DEGREES)'/)
68         ENDIF
69         WRITE (IOUNIT,9040) (YCOORD(J,I),J=1,NUMYPT(I))                !      3
70         IF ( ELEV ) THEN
71!           Print Terrain Heights for Network
72!           Set Number of Columns Per Page, NCPP
73            NCPP = 9                                                    !      0
74!           Set Number of Rows Per Page, NRPP
75            NRPP = 40
76!           Begin LOOP Through Networks
77!           Calculate Number of Pages Per X-Group, NPPX, & Per Y-Group, NPPY
78            NPPX = 1 + INT((NUMXPT(I)-1)/NCPP)
79            NPPY = 1 + INT((NUMYPT(I)-1)/NRPP)
80            DO NX = 1 , NPPX
81               DO NY = 1 , NPPY                                         !      0
82                  CALL HEADER                                           !      0
83                  WRITE (IOUNIT,9037) NTID(I) , NTTYP(I)
84                  WRITE (IOUNIT,9011)
85
86 9011             FORMAT (/48X,'* ELEVATION HEIGHTS IN METERS *'/)
87                  IF ( NX.EQ.NPPX ) THEN
88                     IF ( NTTYP(I).EQ.'GRIDCART' ) THEN                 !      0
89                        WRITE (IOUNIT,9016)                             !      0
90                        WRITE (IOUNIT,9017)                             &
91     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NUMXPT(I))
92                     ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
93                        WRITE (IOUNIT,9018)                             !      0
94                        WRITE (IOUNIT,9019)                             &
95     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NUMXPT(I))
96                     ENDIF
97                  ELSE
98                     IF ( NTTYP(I).EQ.'GRIDCART' ) THEN                 !      0
99                        WRITE (IOUNIT,9016)                             !      0
100                        WRITE (IOUNIT,9017)                             &
101     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NCPP*NX)
102                     ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
103                        WRITE (IOUNIT,9018)                             !      0
104                        WRITE (IOUNIT,9019)                             &
105     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NCPP*NX)
106                     ENDIF
107                  ENDIF
108                  WRITE (IOUNIT,9010)                                   !      0
109                  IF ( NY.EQ.NPPY ) THEN
110                     DO K = 1 + NRPP*(NY-1) , NUMYPT(I)                 !      0
111                        IF ( NTTYP(I).EQ.'GRIDCART' ) THEN              !      0
112                           INDZ = NETEND(I) - K*NUMXPT(I) + 1           !      0
113                           YCOVAL = YCOORD(NUMYPT(I)-K+1,I)
114                        ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
115                           INDZ = NETSTA(I) + (K-1)*NUMXPT(I)           !      0
116                           YCOVAL = YCOORD(K,I)
117                        ENDIF
118                        IF ( NX.EQ.NPPX ) THEN                          !      0
119                           WRITE (IOUNIT,9013) YCOVAL ,                 &
120     &                            (AZELEV(INDZ+J-1),J=1+NCPP*(NX-1),    &
121     &                            NUMXPT(I))
122                        ELSE
123                           WRITE (IOUNIT,9013) YCOVAL ,                 &
124     &                            (AZELEV(INDZ+J-1),J=1+NCPP*(NX-1),    &
125     &                            NCPP*NX)
126                        ENDIF
127                     ENDDO
128                  ELSE
129                     DO K = 1 + NRPP*(NY-1) , NRPP*NY                   !      0
130                        IF ( NTTYP(I).EQ.'GRIDCART' ) THEN              !      0
131                           INDZ = NETEND(I) - K*NUMXPT(I) + 1           !      0
132                           YCOVAL = YCOORD(NUMYPT(I)-K+1,I)
133                        ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
134                           INDZ = NETSTA(I) + (K-1)*NUMXPT(I)           !      0
135                           YCOVAL = YCOORD(K,I)
136                        ENDIF
137                        IF ( NX.EQ.NPPX ) THEN                          !      0
138                           WRITE (IOUNIT,9013) YCOVAL ,                 &
139     &                            (AZELEV(INDZ+J-1),J=1+NCPP*(NX-1),    &
140     &                            NUMXPT(I))
141                        ELSE
142                           WRITE (IOUNIT,9013) YCOVAL ,                 &
143     &                            (AZELEV(INDZ+J-1),J=1+NCPP*(NX-1),    &
144     &                            NCPP*NX)
145                        ENDIF
146                     ENDDO
147                  ENDIF
148               ENDDO
149            ENDDO
150!           Print Hill Height Scales for Network
151!           Set Number of Columns Per Page, NCPP
152            NCPP = 9                                                    !      0
153!           Set Number of Rows Per Page, NRPP
154            NRPP = 40
155!           Begin LOOP Through Networks
156!           Calculate Number of Pages Per X-Group, NPPX, & Per Y-Group, NPPY
157            NPPX = 1 + INT((NUMXPT(I)-1)/NCPP)
158            NPPY = 1 + INT((NUMYPT(I)-1)/NRPP)
159            DO NX = 1 , NPPX
160               DO NY = 1 , NPPY                                         !      0
161                  CALL HEADER                                           !      0
162                  WRITE (IOUNIT,9037) NTID(I) , NTTYP(I)
163                  WRITE (IOUNIT,9012)
164 9012             FORMAT (/48X,'* HILL HEIGHT SCALES IN METERS *'/)
165                  IF ( NX.EQ.NPPX ) THEN
166                     IF ( NTTYP(I).EQ.'GRIDCART' ) THEN                 !      0
167                        WRITE (IOUNIT,9016)                             !      0
168                        WRITE (IOUNIT,9017)                             &
169     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NUMXPT(I))
170                     ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
171                        WRITE (IOUNIT,9018)                             !      0
172                        WRITE (IOUNIT,9019)                             &
173     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NUMXPT(I))
174                     ENDIF
175                  ELSE
176                     IF ( NTTYP(I).EQ.'GRIDCART' ) THEN                 !      0
177                        WRITE (IOUNIT,9016)                             !      0
178                        WRITE (IOUNIT,9017)                             &
179     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NCPP*NX)
180                     ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
181                        WRITE (IOUNIT,9018)                             !      0
182                        WRITE (IOUNIT,9019)                             &
183     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NCPP*NX)
184                     ENDIF
185                  ENDIF
186                  WRITE (IOUNIT,9010)                                   !      0
187                  IF ( NY.EQ.NPPY ) THEN
188                     DO K = 1 + NRPP*(NY-1) , NUMYPT(I)                 !      0
189                        IF ( NTTYP(I).EQ.'GRIDCART' ) THEN              !      0
190                           INDZ = NETEND(I) - K*NUMXPT(I) + 1           !      0
191                           YCOVAL = YCOORD(NUMYPT(I)-K+1,I)
192                        ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
193                           INDZ = NETSTA(I) + (K-1)*NUMXPT(I)           !      0
194                           YCOVAL = YCOORD(K,I)
195                        ENDIF
196                        IF ( NX.EQ.NPPX ) THEN                          !      0
197                           WRITE (IOUNIT,9013) YCOVAL ,                 &
198     &                            (AZHILL(INDZ+J-1),J=1+NCPP*(NX-1),    &
199     &                            NUMXPT(I))
200                        ELSE
201                           WRITE (IOUNIT,9013) YCOVAL ,                 &
202     &                            (AZHILL(INDZ+J-1),J=1+NCPP*(NX-1),    &
203     &                            NCPP*NX)
204                        ENDIF
205                     ENDDO
206                  ELSE
207                     DO K = 1 + NRPP*(NY-1) , NRPP*NY                   !      0
208                        IF ( NTTYP(I).EQ.'GRIDCART' ) THEN              !      0
209                           INDZ = NETEND(I) - K*NUMXPT(I) + 1           !      0
210                           YCOVAL = YCOORD(NUMYPT(I)-K+1,I)
211                        ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
212                           INDZ = NETSTA(I) + (K-1)*NUMXPT(I)           !      0
213                           YCOVAL = YCOORD(K,I)
214                        ENDIF
215                        IF ( NX.EQ.NPPX ) THEN                          !      0
216                           WRITE (IOUNIT,9013) YCOVAL ,                 &
217     &                            (AZHILL(INDZ+J-1),J=1+NCPP*(NX-1),    &
218     &                            NUMXPT(I))
219                        ELSE
220                           WRITE (IOUNIT,9013) YCOVAL ,                 &
221     &                            (AZHILL(INDZ+J-1),J=1+NCPP*(NX-1),    &
222     &                            NCPP*NX)
223                        ENDIF
224                     ENDDO
225                  ENDIF
226               ENDDO
227            ENDDO
228         ENDIF
229         IF ( FLGPOL ) THEN                                             !      3
230!           Print The Receptor Heights Above Ground for This Network
231!           Set Number of Columns Per Page, NCPP
232            NCPP = 9                                                    !      0
233!           Set Number of Rows Per Page, NRPP
234            NRPP = 40
235!           Begin LOOP Through Networks
236!           Calculate Number of Pages Per X-Group, NPPX, & Per Y-Group, NPPY
237            NPPX = 1 + INT((NUMXPT(I)-1)/NCPP)
238            NPPY = 1 + INT((NUMYPT(I)-1)/NRPP)
239            DO NX = 1 , NPPX
240               DO NY = 1 , NPPY                                         !      0
241                  CALL HEADER                                           !      0
242                  WRITE (IOUNIT,9037) NTID(I) , NTTYP(I)
243                  WRITE (IOUNIT,9035)
244 9035             FORMAT (/44X,'* RECEPTOR FLAGPOLE HEIGHTS IN METERS *'&
245     &                    /)
246                  IF ( NX.EQ.NPPX ) THEN
247                     IF ( NTTYP(I).EQ.'GRIDCART' ) THEN                 !      0
248                        WRITE (IOUNIT,9016)                             !      0
249                        WRITE (IOUNIT,9017)                             &
250     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NUMXPT(I))
251                     ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
252                        WRITE (IOUNIT,9018)                             !      0
253                        WRITE (IOUNIT,9019)                             &
254     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NUMXPT(I))
255                     ENDIF
256                  ELSE
257                     IF ( NTTYP(I).EQ.'GRIDCART' ) THEN                 !      0
258                        WRITE (IOUNIT,9016)                             !      0
259                        WRITE (IOUNIT,9017)                             &
260     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NCPP*NX)
261                     ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
262                        WRITE (IOUNIT,9018)                             !      0
263                        WRITE (IOUNIT,9019)                             &
264     &                         (XCOORD(J,I),J=1+NCPP*(NX-1),NCPP*NX)
265                     ENDIF
266                  ENDIF
267                  WRITE (IOUNIT,9010)                                   !      0
268                  IF ( NY.EQ.NPPY ) THEN
269                     DO K = 1 + NRPP*(NY-1) , NUMYPT(I)                 !      0
270                        IF ( NTTYP(I).EQ.'GRIDCART' ) THEN              !      0
271                           INDZ = NETEND(I) - K*NUMXPT(I) + 1           !      0
272                           YCOVAL = YCOORD(NUMYPT(I)-K+1,I)
273                        ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
274                           INDZ = NETSTA(I) + (K-1)*NUMXPT(I)           !      0
275                           YCOVAL = YCOORD(K,I)
276                        ENDIF
277                        IF ( NX.EQ.NPPX ) THEN                          !      0
278                           WRITE (IOUNIT,9013) YCOVAL ,                 &
279     &                            (AZFLAG(INDZ+J-1),J=1+NCPP*(NX-1),    &
280     &                            NUMXPT(I))
281                        ELSE
282                           WRITE (IOUNIT,9013) YCOVAL ,                 &
283     &                            (AZFLAG(INDZ+J-1),J=1+NCPP*(NX-1),    &
284     &                            NCPP*NX)
285                        ENDIF
286                     ENDDO
287                  ELSE
288                     DO K = 1 + NRPP*(NY-1) , NRPP*NY                   !      0
289                        IF ( NTTYP(I).EQ.'GRIDCART' ) THEN              !      0
290                           INDZ = NETEND(I) - K*NUMXPT(I) + 1           !      0
291                           YCOVAL = YCOORD(NUMYPT(I)-K+1,I)
292                        ELSEIF ( NTTYP(I).EQ.'GRIDPOLR' ) THEN
293                           INDZ = NETSTA(I) + (K-1)*NUMXPT(I)           !      0
294                           YCOVAL = YCOORD(K,I)
295                        ENDIF
296                        IF ( NX.EQ.NPPX ) THEN                          !      0
297                           WRITE (IOUNIT,9013) YCOVAL ,                 &
298     &                            (AZFLAG(INDZ+J-1),J=1+NCPP*(NX-1),    &
299     &                            NUMXPT(I))
300                        ELSE
301                           WRITE (IOUNIT,9013) YCOVAL ,                 &
302     &                            (AZFLAG(INDZ+J-1),J=1+NCPP*(NX-1),    &
303     &                            NCPP*NX)
304                        ENDIF
305                     ENDDO
306                  ENDIF
307               ENDDO
308            ENDDO
309         ENDIF
310      ENDDO
311
312      IF ( IRSTAT(4).NE.0 .OR. IRSTAT(8).NE.0 ) THEN                    !      3
313!RWB     Include EVALCART receptors with DISCCART receptors.  2/14/95
314!        Print Out The Coordinates, Height , Hill Height & Flags For
315!        Discrete Cart Receptors
316
317         INDC = 0                                                       !      0
318         DO I = 1 , NUMREC
319            IF ( RECTYP(I).EQ.'DC' ) THEN                               !      0
320               INDC = INDC + 1                                          !      0
321               IF ( MOD(INDC-1,90).EQ.0 ) THEN
322                  CALL HEADER                                           !      0
323                  WRITE (IOUNIT,9043)
324 9043             FORMAT (/45X,'*** DISCRETE CARTESIAN RECEPTORS ***',  &
325     &                    /43X,'(X-COORD, Y-COORD, ZELEV, ZHILL, ZFLAG)'&
326     &                    ,/45X,'              (METERS)'/)
327               ENDIF
328               IF ( MOD(INDC,2).NE.0 ) THEN                             !      0
329                  WRITE (BUF132(1:65),9045) AXR(I) , AYR(I) , AZELEV(I) &
330     &                   , AZHILL(I) , AZFLAG(I)
331               ELSE
332                  WRITE (BUF132(66:130),9045) AXR(I) , AYR(I) ,         &
333     &                   AZELEV(I) , AZHILL(I) , AZFLAG(I)
334                  WRITE (IOUNIT,9090) BUF132
335                  WRITE (BUF132,9095)
336               ENDIF
337            ENDIF
338         ENDDO
339         IF ( MOD(INDC,2).NE.0 ) THEN                                   !      0
340            WRITE (IOUNIT,9090) BUF132                                  !      0
341            WRITE (BUF132,9095)
342         ENDIF
343      ENDIF
344
345      IF ( IRSTAT(5).NE.0 ) THEN                                        !      3
346!        Print Out The Coordinates, Height & Flags For Discrete Polar Receptors
347         INDC = 0                                                       !      0
348         DO I = 1 , NUMREC
349            IF ( RECTYP(I).EQ.'DP' ) THEN                               !      0
350               INDC = INDC + 1                                          !      0
351               XRMS = AXR(I) - AXS(IREF(I))
352               YRMS = AYR(I) - AYS(IREF(I))
353               RANGE = SQRT(XRMS*XRMS+YRMS*YRMS)
354               RADIAL = ATAN2(XRMS,YRMS)*RTODEG
355               IF ( RADIAL.LE.0.0 ) RADIAL = RADIAL + 360.
356               IF ( MOD(INDC-1,90).EQ.0 ) THEN
357                  CALL HEADER                                           !      0
358                  WRITE (IOUNIT,9044)
359 9044             FORMAT (/43X,'    *** DISCRETE POLAR RECEPTORS ***',  &
360     &                    /43X,                                         &
361     &                    ' ORIGIN: (DIST, DIR, ZELEV, ZHILL, ZFLAG)',  &
362     &                    /43X,                                         &
363     &                    ' SRCID: (METERS,DEG,METERS,METERS,METERS)'/)
364               ENDIF
365               IF ( MOD(INDC,2).NE.0 ) THEN                             !      0
366                  WRITE (BUF132(1:65),9047) SRCID(IREF(I)) , RANGE ,    &
367     &                   RADIAL , AZELEV(I) , AZHILL(I) , AZFLAG(I)
368               ELSE
369                  WRITE (BUF132(66:130),9047) SRCID(IREF(I)) , RANGE ,  &
370     &                   RADIAL , AZELEV(I) , AZHILL(I) , AZFLAG(I)
371                  WRITE (IOUNIT,9090) BUF132
372                  WRITE (BUF132,9095)
373               ENDIF
374            ENDIF
375         ENDDO
376         IF ( MOD(INDC,2).NE.0 ) THEN                                   !      0
377            WRITE (IOUNIT,9090) BUF132                                  !      0
378            WRITE (BUF132,9095)
379         ENDIF
380      ENDIF
381
382      CONTINUE                                                          !      3
383 9037 FORMAT (/34X,'*** NETWORK ID: ',A8,' ;  NETWORK TYPE: ',A8,' ***')
384 9040 FORMAT (100(5X,10(F10.1,',')/))
385 9010 FORMAT (66(' -')/)
386 9013 FORMAT (2X,F10.2,1X,'|',1X,9(1X,F12.2,:))
387 9016 FORMAT (3X,' Y-COORD  |',48X,'X-COORD (METERS)')
388 9017 FORMAT (3X,' (METERS) |',1X,9(1X,F12.2,:))
389 9018 FORMAT (3X,'DIRECTION |',48X,'DISTANCE (METERS)')
390 9019 FORMAT (3X,'(DEGREES) |',1X,9(1X,F12.2,:))
391 9045 FORMAT (4X,' (',4(F9.1,', '),F9.1,'); ')
392 9047 FORMAT (3X,A8,': (',F9.1,', ',3(F7.1,', '),F7.1,'); ')
393 9090 FORMAT (A132)
394 9095 FORMAT (132(' '))
395      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