1 2 SUBROUTINE MAXPM10 3 !*********************************************************************** 4 ! MAXPM10 Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Update Overall Maximum Value Arrays 7 ! NMXPM = 10 Assigned in PARAMETER Statement in MAIN1 8 ! Note: For duplicate values, the earlier occurrence keeps 9 ! its rank within the array 10 ! 11 ! PROGRAMMER: Roger Brode 12 ! 13 ! DATE: June 19, 1998 14 ! 15 ! INPUTS: Maximum Value Table Options 16 ! Array of CONC or DEPOS Averages 17 ! Averaging Period 18 ! 19 ! OUTPUTS: Updated Maximum Value Array 20 ! Updated Maximum Date Array 21 ! Updated Maximum Receptor Array 22 ! 23 ! CALLED FROM: HIVALS 24 !*********************************************************************** 25 26 ! Variable Declarations 27 USE MAIN1 28 IMPLICIT NONE 29 CHARACTER MODNAM*12 30 31 SAVE 32 INTEGER :: J 33 34 ! Variable Initializations 35 MODNAM = 'MAXPM10' ! 0 36 37 ! Begin Source Group LOOP 38 DO IGRP = 1 , NUMGRP 39 ! Begin Receptor LOOP 40 RECEPTOR_LOOP:DO IREC = 1 , NUMREC ! 0 41 IF ( NMXPM.GT.1 ) THEN ! 0 42 IF ( SUMH4H(IREC,IGRP).GT.MXPMVAL(NMXPM,IGRP) ) THEN ! 0 43 DO J = NMXPM - 1 , 1 , -1 ! 0 44 IF ( SUMH4H(IREC,IGRP).LE.MXPMVAL(J,IGRP) ) THEN ! 0 45 MXPMVAL(J+1,IGRP) = SUMH4H(IREC,IGRP) ! 0 46 MXPMLOC(J+1,IGRP) = IREC 47 ! Exit Block 48 GOTO 50 49 ELSE 50 MXPMVAL(J+1,IGRP) = MXPMVAL(J,IGRP) ! 0 51 MXPMLOC(J+1,IGRP) = MXPMLOC(J,IGRP) 52 IF ( J.EQ.1 ) THEN 53 MXPMVAL(1,IGRP) = SUMH4H(IREC,IGRP) ! 0 54 MXPMLOC(1,IGRP) = IREC 55 ENDIF 56 ENDIF 57 ENDDO 58 ENDIF 59 ELSEIF ( NMXPM.EQ.1 ) THEN 60 IF ( SUMH4H(IREC,IGRP).GT.MXPMVAL(1,IGRP) ) THEN ! 0 61 MXPMVAL(1,IGRP) = SUMH4H(IREC,IGRP) ! 0 62 MXPMLOC(1,IGRP) = IREC 63 ENDIF 64 ENDIF 65 50 ENDDO RECEPTOR_LOOP 66 ! End Receptor LOOP 67 ENDDO 68 ! End Source Group LOOP 69 70 CONTINUE ! 0 71 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