1 2 SUBROUTINE TOXXFL 3 !*********************************************************************** 4 ! TOXXFL Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Update TOXXFILE Buffers, and Write Out if Full 7 ! 8 ! PROGRAMMER: Roger Brode 9 ! 10 ! DATE: September 29, 1992 11 ! 12 ! INPUTS: TOXXFILE Options 13 ! Array of CONC or DEPOS Averages 14 ! Averaging Period 15 ! 16 ! OUTPUTS: Updated TOXXFILE Buffers and File 17 ! 18 ! CALLED FROM: HRLOOP 19 !*********************************************************************** 20 21 ! Variable Declarations 22 USE MAIN1 23 IMPLICIT NONE 24 CHARACTER MODNAM*12 25 26 SAVE 27 INTEGER :: I , IG , ICODE 28 REAL :: CUTOFF 29 30 ! Variable Initializations 31 MODNAM = 'TOXXFL' ! 0 32 33 ! Check for TOXXFILE Option - Skip Update If KAVE=1, 34 ! And No CALCS Were Made for the Current Hour 35 IF ( ITOXFL(IAVE).EQ.1 .AND. (CALCS .OR. KAVE(IAVE).NE.1) ) THEN 36 ! Convert TOXXFILE Threshold to User Units 37 CUTOFF = TOXTHR(IAVE)*EMIFAC(1) ! 0 38 39 ! Begin Receptor LOOP 40 DO IREC = 1 , NUMREC 41 42 ! Begin Source Group LOOP 43 DO IGRP = 1 , NUMGRP ! 0 44 45 ! For the Values Over Threshold (in user units), Fill Buffers 46 IF ( AVEVAL(IREC,IGRP,IAVE,1).GE.CUTOFF ) THEN ! 0 47 DO IG = 1 , NUMGRP ! 0 48 ! Loop Through Groups and Write Values to Buffer 49 IPAIR = IPAIR + 1 ! 0 50 ICODE = 100000*ILINE + 1000*IG + IREC 51 IDCONC(IAVE,IPAIR) = ICODE 52 ! Convert CONC Values Back to Units of g/s 53 TXCONC(IAVE,IPAIR) = AVEVAL(IREC,IG,IAVE,1) & 54 & /EMIFAC(1) 55 IF ( IPAIR.EQ.NPAIR ) THEN 56 ! Write Out Full Buffers and Reset Counter 57 WRITE (ITXUNT(IAVE),ERR=99) & 58 & (IDCONC(IAVE,I),I=1,NPAIR) 59 WRITE (ITXUNT(IAVE),ERR=99) & 60 & (TXCONC(IAVE,I),I=1,NPAIR) 61 IPAIR = 0 ! 0 62 ENDIF 63 ENDDO 64 ! Exit Source Group LOOP 65 GOTO 50 ! 0 66 ENDIF 67 68 ENDDO 69 ! End Source Group LOOP 70 71 50 ENDDO 72 ! End Receptor LOOP 73 ENDIF 74 75 GOTO 999 ! 0 76 77 ! WRITE Error Message for Problem Writing to TOXXFILE 78 99 WRITE (DUMMY,'("TOXFL",I3.3)') ITXUNT(IAVE) ! 0 79 CALL ERRHDL(PATH,MODNAM,'E','520',DUMMY) 80 RUNERR = .TRUE. 81 82 999 CONTINUE ! 0 83 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