1 2 SUBROUTINE MAXFIL 3 !*********************************************************************** 4 ! MAXFIL Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Update Maximum Value File (>Threshold) 7 ! 8 ! PROGRAMMER: Roger Brode, Jeff Wang 9 ! 10 ! DATE: March 2, 1992 11 ! 12 ! MODIFIED: Moved check for RSTSAV (SAVEFILE option) outside 13 ! the receptor loop, and replaced 'read to end' loop 14 ! with POSITION='APPEND' in OPEN statement for 15 ! Fortran 90 version. 16 ! R.W. Brode, PES, Inc., 6/23/98 17 ! 18 ! INPUTS: Maximum File Options 19 ! Array of CONC or DEPOS Averages 20 ! Averaging Period 21 ! 22 ! OUTPUTS: Updated Maximum Value File 23 ! 24 ! CALLED FROM: HRLOOP 25 !*********************************************************************** 26 27 ! Variable Declarations 28 USE MAIN1 29 IMPLICIT NONE 30 CHARACTER MODNAM*12 31 32 SAVE 33 34 ! Variable Initializations 35 MODNAM = 'MAXFIL' ! 0 36 37 ! Check for High/Max Value Options - Skip Update If KAVE=1, 38 ! And No CALCS Were Made for the Current Hour 39 IF ( CALCS .OR. KAVE(IAVE).NE.1 ) THEN 40 ! Begin Source Group LOOP 41 DO IGRP = 1 , NUMGRP ! 0 42 ! Check for MAXIFILE Option for This IGRP,IAVE Combination 43 IF ( MAXFLE(IGRP,IAVE).EQ.1 ) THEN ! 0 44 ! Begin Receptor LOOP 45 DO IREC = 1 , NUMREC ! 0 46 ! For the Values Over Threshold 47 IF ( AVEVAL(IREC,IGRP,IAVE,1).GE.THRESH(IGRP,IAVE) ) & 48 & WRITE (IMXUNT(IGRP,IAVE),THRFRM,ERR=99) & 49 & KAVE(IAVE) , GRPID(IGRP) , KURDAT , & 50 & AXR(IREC) , AYR(IREC) , AZELEV(IREC) , & 51 & AZHILL(IREC) , AZFLAG(IREC) , & 52 & AVEVAL(IREC,IGRP,IAVE,1) 53 ENDDO 54 ! End Receptor LOOP 55 IF ( RSTSAV ) THEN ! 0 56 ! Saving Intermediate Results to File for Later Re-start 57 ! Close MAXIFILE and Reposition to End 58 CLOSE (IMXUNT(IGRP,IAVE)) ! 0 59 OPEN (IMXUNT(IGRP,IAVE),FILE=THRFIL(IGRP,IAVE), & 60 & POSITION='APPEND') 61 ENDIF 62 ENDIF 63 ENDDO 64 ! End Source Group LOOP 65 ENDIF 66 67 GOTO 999 ! 0 68 69 ! WRITE Error Message for Problem Writing to Maximum Value File 70 99 WRITE (DUMMY,'("MAXFL",I3.3)') IMXUNT(IGRP,IAVE) ! 0 71 CALL ERRHDL(PATH,MODNAM,'E','520',DUMMY) 72 RUNERR = .TRUE. 73 74 999 CONTINUE ! 0 75 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