1 2 SUBROUTINE NHIGH 3 !*********************************************************************** 4 ! NHIGH Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Update Highest Value by Receptor Arrays 7 ! NVAL = 6 Assigned in PARAMETER Statement 8 ! Note: For duplicate values, the earlier occurrence keeps its 9 ! rank within the array 10 ! 11 ! PROGRAMMER: Roger Brode, Jeff Wang 12 ! 13 ! DATE: March 2, 1992 14 ! 15 ! INPUTS: High Value Options 16 ! Array of CONC or DEPOS Averages 17 ! Averaging Period 18 ! 19 ! OUTPUTS: Updated Highest Value Array 20 ! Updated Highest Date Array 21 ! 22 ! CALLED FROM: HIVALS 23 !*********************************************************************** 24 25 ! Variable Declarations 26 USE MAIN1 27 IMPLICIT NONE 28 CHARACTER MODNAM*12 29 30 SAVE 31 INTEGER :: J 32 33 ! Variable Initializations 34 MODNAM = 'NHIGH' ! 1620 35 36 ! Begin Source Group LOOP 37 DO IGRP = 1 , NUMGRP 38 ! Begin Receptor LOOP 39 RECEPTOR_LOOP:DO IREC = 1 , NUMREC ! 1620 40 IF ( NHIVAL.GT.1 ) THEN ! 233280 41 IF ( AVEVAL(IREC,IGRP,IAVE,ITYP) & 42 & .GT.HIVALU(IREC,NHIVAL,IGRP,IAVE,ITYP) ) THEN 43 DO J = NHIVAL - 1 , 1 , -1 ! 6872 44 IF ( AVEVAL(IREC,IGRP,IAVE,ITYP) & 45 & .LE.HIVALU(IREC,J,IGRP,IAVE,ITYP) ) THEN 46 HIVALU(IREC,J+1,IGRP,IAVE,ITYP) & 47 & = AVEVAL(IREC,IGRP,IAVE,ITYP) 48 IF ( NUMCLM(IAVE).EQ.0 .AND. NUMMSG(IAVE).EQ.0 )& 49 & THEN 50 HCLMSG(IREC,J+1,IGRP,IAVE,ITYP) = ' ' ! 1208 51 ELSE 52 ! Set Indicator Of Calm and Msg --- CALL HSETFG 53 CALL HSETFG(0,J) ! 1844 54 ENDIF 55 NHIDAT(IREC,J+1,IGRP,IAVE,ITYP) = KURDAT ! 3052 56 ! Exit Block 57 GOTO 50 58 ELSE 59 HIVALU(IREC,J+1,IGRP,IAVE,ITYP) & 60 & = HIVALU(IREC,J,IGRP,IAVE,ITYP) 61 HCLMSG(IREC,J+1,IGRP,IAVE,ITYP) & 62 & = HCLMSG(IREC,J,IGRP,IAVE,ITYP) 63 NHIDAT(IREC,J+1,IGRP,IAVE,ITYP) & 64 & = NHIDAT(IREC,J,IGRP,IAVE,ITYP) 65 IF ( J.EQ.1 ) THEN 66 HIVALU(IREC,1,IGRP,IAVE,ITYP) & 67 & = AVEVAL(IREC,IGRP,IAVE,ITYP) 68 IF ( NUMCLM(IAVE).EQ.0 .AND. NUMMSG(IAVE) & 69 & .EQ.0 ) THEN 70 HCLMSG(IREC,1,IGRP,IAVE,ITYP) = ' ' ! 1352 71 ELSE 72 ! Set Indicator Of Calm and Msg --- CALL HSETFG 73 CALL HSETFG(1,1) ! 2468 74 ENDIF 75 NHIDAT(IREC,1,IGRP,IAVE,ITYP) = KURDAT ! 3820 76 ENDIF 77 ENDIF 78 ENDDO 79 ENDIF 80 ELSEIF ( NHIVAL.EQ.1 ) THEN 81 IF ( AVEVAL(IREC,IGRP,IAVE,ITYP) & 82 & .GT.HIVALU(IREC,1,IGRP,IAVE,ITYP) ) THEN 83 HIVALU(IREC,1,IGRP,IAVE,ITYP) & 84 & = AVEVAL(IREC,IGRP,IAVE,ITYP) 85 IF ( NUMCLM(IAVE).EQ.0 .AND. NUMMSG(IAVE).EQ.0 ) THEN 86 HCLMSG(IREC,1,IGRP,IAVE,ITYP) = ' ' ! 0 87 ELSE 88 ! Set Indicator Of Calm and Missing --- CALL HSETFG 89 CALL HSETFG(1,1) ! 0 90 ENDIF 91 NHIDAT(IREC,1,IGRP,IAVE,ITYP) = KURDAT ! 0 92 ENDIF 93 ENDIF 94 50 ENDDO RECEPTOR_LOOP 95 ! End Receptor LOOP 96 ENDDO 97 ! End Source Group LOOP 98 99 CONTINUE ! 1620 100 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