1 2 SUBROUTINE HIPER 3 !*********************************************************************** 4 ! HIPER Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Selects Highest PERIOD Average Values 7 ! 8 ! PROGRAMMER: Roger Brode, Jeff Wang 9 ! 10 ! DATE: March 2, 1992 11 ! 12 ! MODIFIED: Changed parameter for specifying the number of 13 ! high annual/period averages from NVAL to NHIANN. 14 ! R.W. Brode, PES, Inc., 4/3/98 15 ! 16 ! INPUTS: Array of Period Averages 17 ! 18 ! OUTPUTS: Array of Highest Period Averages By Source Group 19 ! 20 ! CALLED FROM: MAIN 21 !*********************************************************************** 22 23 ! Variable Declarations 24 USE MAIN1 25 IMPLICIT NONE 26 CHARACTER MODNAM*12 27 28 SAVE 29 INTEGER :: J 30 31 ! Variable Initializations 32 MODNAM = 'HIPER' ! 2 33 34 ! Begin Source Group LOOP 35 DO IGRP = 1 , NUMGRP 36 ! Begin Receptor LOOP 37 RECEPTOR_LOOP:DO IREC = 1 , NUMREC ! 2 38 IF ( NHIANN.GT.1 ) THEN ! 288 39 IF ( ANNVAL(IREC,IGRP,ITYP).GT.AMXVAL(NHIANN,IGRP,ITYP) )& 40 & THEN 41 DO J = NHIANN - 1 , 1 , -1 ! 38 42 IF ( ANNVAL(IREC,IGRP,ITYP).LE.AMXVAL(J,IGRP,ITYP) & 43 & ) THEN 44 AMXVAL(J+1,IGRP,ITYP) = ANNVAL(IREC,IGRP,ITYP) ! 26 45 IMXLOC(J+1,IGRP,ITYP) = IREC 46 ! Exit Block 47 GOTO 50 48 ELSE 49 AMXVAL(J+1,IGRP,ITYP) = AMXVAL(J,IGRP,ITYP) ! 240 50 IMXLOC(J+1,IGRP,ITYP) = IMXLOC(J,IGRP,ITYP) 51 IF ( J.EQ.1 ) THEN 52 AMXVAL(1,IGRP,ITYP) = ANNVAL(IREC,IGRP,ITYP) ! 12 53 IMXLOC(1,IGRP,ITYP) = IREC 54 ENDIF 55 ENDIF 56 ENDDO 57 ENDIF 58 ELSEIF ( NHIANN.EQ.1 ) THEN 59 IF ( ANNVAL(IREC,IGRP,ITYP).GT.AMXVAL(1,IGRP,ITYP) ) THEN! 0 60 AMXVAL(1,IGRP,ITYP) = ANNVAL(IREC,IGRP,ITYP) ! 0 61 IMXLOC(1,IGRP,ITYP) = IREC 62 ENDIF 63 ENDIF 64 50 ENDDO RECEPTOR_LOOP 65 ! End Receptor LOOP 66 ENDDO 67 ! End Source Group LOOP 68 69 ! Dump Results Arrays to SAVFIL --- CALL RSDUMP 70 IF ( MULTYR ) CALL RSDUMP ! 2 71 72 CONTINUE 73 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