1 2 SUBROUTINE PRTNHI 3 !*********************************************************************** 4 ! PRTNHI Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Print Out The Specified Highest Value 7 ! 8 ! PROGRAMMER: Jeff Wang, Roger Brode 9 ! 10 ! DATE: March 2, 1992 11 ! 12 ! MODIFIED: To store high short term values in global arrays 13 ! rather than local arrays for later summary table 14 ! output. 15 ! R.W. Brode, PES, Inc. - August 15, 1995. 16 ! 17 ! MODIFIED: To add one more decimal place to receptor elevations 18 ! and flagpole heights for the temporary event file. 19 ! R.W. Brode, PES, Inc. - November 15, 1995. 20 ! 21 ! INPUTS: Arrays of Model Results 22 ! 23 ! OUTPUTS: Printed Model Outputs for Short Term Values 24 ! 25 ! CALLED FROM: MAIN 26 !*********************************************************************** 27 28 ! Variable Declarations 29 USE MAIN1 30 IMPLICIT NONE 31 CHARACTER MODNAM*12 32 33 SAVE 34 INTEGER :: IWHP(NVAL) , IHST , IVAL , K , IT1 , KWRT 35 REAL :: XR2 , YR2 , ZE2 , ZH2 , ZF2 36 CHARACTER NAMEEV*8 37 38 ! Variable Initialization 39 MODNAM = 'PRTNHI' ! 2 40 41 ! Write Out the 'EV STARTING' Card to the Temp-EVent File for 42 ! First Output Type Only (i.e., ITYP = 1) 43 IF ( ITYP.EQ.1 ) THEN 44 WRITE (ITEVUT,9000) ! 2 45 46 9000 FORMAT ('EV STARTING') 47 ENDIF 48 49 DO IAVE = 1 , NUMAVE ! 2 50 ! Decide if Print The Period 51 IHST = 0 ! 4 52 DO IVAL = 1 , NVAL 53 IF ( NHIAVE(IVAL,IAVE).EQ.1 ) THEN ! 8 54 IHST = IHST + 1 ! 8 55 IWHP(IHST) = IVAL 56 ENDIF 57 ENDDO 58 ! No High Values for This IAVE; Cycle to Next Averaging Period 59 IF ( IHST.EQ.0 ) GOTO 100 ! 4 60 ! Print The Data 61 DO IVAL = 1 , NVAL ! 4 62 ! Print Out High Value By Receptor Table --- CALL SPRTHT 63 IF ( NHIAVE(IVAL,IAVE).EQ.1 ) CALL SPRTHT(IVAL) ! 8 64 ENDDO 65 ! Print Out The Temporary File 66 DO IGRP = 1 , NUMGRP ! 4 67 ! Print Out the High Values 68 DO IREC = 1 , NUMREC ! 4 69 ! Get The Maximum in Nth Highest 70 DO K = 1 , IHST ! 576 71 IF ( HIVALU(IREC,IWHP(K),IGRP,IAVE,ITYP) & 72 & .GT.HMAX(K,IGRP,IAVE,ITYP) ) THEN 73 HMAX(K,IGRP,IAVE,ITYP) & 74 & = HIVALU(IREC,IWHP(K),IGRP,IAVE,ITYP) 75 HMDATE(K,IGRP,IAVE,ITYP) & 76 & = NHIDAT(IREC,IWHP(K),IGRP,IAVE,ITYP) 77 HMCLM(K,IGRP,IAVE,ITYP) & 78 & = HCLMSG(IREC,IWHP(K),IGRP,IAVE,ITYP) 79 HMLOC(K,IGRP,IAVE,ITYP) = IREC 80 ENDIF 81 ENDDO 82 ENDDO 83 ! 84 ! Output The Max-Upto-IHST to the TempEVent File for the 85 ! First Output Type Only (i.e., ITYP = 1) 86 IF ( ITYP.EQ.1 ) THEN ! 4 87 DO K = 1 , IHST ! 4 88 IT1 = MOD(IWHP(K),10) ! 8 89 IF ( HMLOC(K,IGRP,IAVE,ITYP).EQ.0 ) THEN 90 XR2 = 0.0 ! 0 91 YR2 = 0.0 92 ZE2 = 0.0 93 ZH2 = 0.0 94 ZF2 = 0.0 95 ELSE 96 XR2 = AXR(HMLOC(K,IGRP,IAVE,ITYP)) ! 8 97 YR2 = AYR(HMLOC(K,IGRP,IAVE,ITYP)) 98 ZE2 = AZELEV(HMLOC(K,IGRP,IAVE,ITYP)) 99 ZH2 = AZHILL(HMLOC(K,IGRP,IAVE,ITYP)) 100 ZF2 = AZFLAG(HMLOC(K,IGRP,IAVE,ITYP)) 101 ENDIF 102 IF ( KAVE(IAVE).LE.24 ) THEN ! 8 103 WRITE (NAMEEV,'(A1,I1,A1,I2.2,I3.3)') 'H' , IT1 , & 104 & 'H' , KAVE(IAVE) , IGRP 105 ELSE 106 ! KAVE > 24 Means MONTH Average; Write Out as 72 (=720/10) 107 KWRT = KAVE(IAVE)/10 ! 0 108 WRITE (NAMEEV,'(A1,I1,A1,I2.2,I3.3)') 'H' , IT1 , & 109 & 'H' , KWRT , IGRP 110 ENDIF 111 WRITE (ITEVUT,9001) NAMEEV , KAVE(IAVE) , GRPID(IGRP) & 112 & , HMDATE(K,IGRP,IAVE,ITYP) , & 113 & HMAX(K,IGRP,IAVE,ITYP) , & 114 & HMCLM(K,IGRP,IAVE,ITYP) , & 115 & HMLOC(K,IGRP,IAVE,ITYP) 116 9001 FORMAT (3X,'EVENTPER',1X,A8,1X,I3,2X,A8,3X,I8.8,3X, & 117 & F14.5,1X,A1,1X,I5) 118 WRITE (ITEVUT,9002) NAMEEV , XR2 , YR2 , ZE2 , ZH2 , & 119 & ZF2 120 9002 FORMAT (3X,'EVENTLOC',1X,A8,1X,'XR= ',F14.5,' YR= ', & 121 & F14.5,3(1X,F10.4)) 122 ENDDO 123 ENDIF 124 125 ENDDO 126 127 100 ENDDO 128 129 ! Write Out the 'EV FINISHED' Card to the Temp-EVent File for 130 ! First Output Type Only (i.e., ITYP = 1) 131 IF ( ITYP.EQ.1 ) THEN ! 2 132 WRITE (ITEVUT,9009) ! 2 133 9009 FORMAT ('EV FINISHED') 134 ENDIF 135 136 CONTINUE ! 2 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