1 2 SUBROUTINE SHOUT 3 !*********************************************************************** 4 ! SHOUT Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Process Files of Season/Hour Results 7 ! 8 ! PROGRAMMER: Roger Brode 9 ! 10 ! DATE: June 5, 1997 11 ! 12 ! INPUTS: Array of Season/Hour Values 13 ! 14 ! OUTPUTS: File of Season/Hour Values 15 ! 16 ! CALLED FROM: OUTPUT 17 !*********************************************************************** 18 19 ! Variable Declarations 20 USE MAIN1 21 IMPLICIT NONE 22 CHARACTER MODNAM*12 23 24 SAVE 25 INTEGER :: I 26 CHARACTER HDRFRM*300 , SEAFRM*80 27 28 ! Variable Initializations 29 MODNAM = 'SHOUT' ! 0 30 31 ! Create Header Format for Columns Based on Number of Output Types 32 WRITE (HDRFRM,9020) NUMTYP , NUMTYP 33 9020 FORMAT ('(''*'',8X,''X'',13X,''Y'',4X,',I1, & 34 &'(2X,3A4),3X,''ZELEV'', 3X,''ZHILL'',3X,''ZFLAG'',4X,''GRP'',5X,& 35 &''NHRS'',2X,''SEAS'', 2X,''HOUR'',3X,''NET ID'',/,''*'',2(2X,'& 36 &'___________ ''),1X,',I1, & 37 &'(''____________''),1X,3('' ______ ''), '' & 38 &________ ____ ____ ____ ________'')') 39 40 WRITE (SEAFRM,1009) NUMTYP 41 1009 FORMAT ('(2(1X,F13.5),',I1,'(1X,F13.8),3(1X,F7.2),2X,A8,2X,', & 42 & '3(I4,2X),A8)') 43 44 ! Begin Source Group LOOP 45 DO IGRP = 1 , NUMGRP 46 ! Check for Selection of PERIOD PLOTFILE for This Group 47 IF ( ISEAHR(IGRP).EQ.1 ) THEN ! 0 48 ! Write Header Information 49 WRITE (ISHUNT(IGRP),9005) VERSN , TITLE1 ! 0 50 51 9005 FORMAT ('* AERMOD (',A5,'): ',A68) 52 WRITE (ISHUNT(IGRP),9007) (MODOPS(I),I=1,18) 53 9007 FORMAT ('* MODELING OPTIONS USED:',/'* ',18(1X,A6)) 54 WRITE (ISHUNT(IGRP),9010) GRPID(IGRP) , NUMREC , SEAFRM 55 9010 FORMAT ('*',9X,'FILE OF SEASON/HOUR VALUES FOR ', & 56 & 'SOURCE GROUP: ',A8,/'*',9X,'FOR A TOTAL OF ',I5, & 57 & ' RECEPTORS.',/'*',9X,'FORMAT: ',A60) 58 WRITE (ISHUNT(IGRP),HDRFRM) (CHIDEP(1,ITYP),CHIDEP(2,ITYP), & 59 & CHIDEP(3,ITYP),ITYP=1,NUMTYP) 60 DO ISEAS = 1 , 4 61 DO IHOUR = 1 , 24 ! 0 62 ! Begin Receptor LOOP 63 DO IREC = 1 , NUMREC ! 0 64 INUM = NSEAHR(ISEAS,IHOUR) - NSEACM(ISEAS,IHOUR) ! 0 65 WRITE (ISHUNT(IGRP),SEAFRM,ERR=99) AXR(IREC) , & 66 & AYR(IREC) , & 67 & (SHVALS(IREC,IGRP,ISEAS,IHOUR,ITYP),ITYP=1, & 68 & NUMTYP) , AZELEV(IREC) , AZHILL(IREC) , & 69 & AZFLAG(IREC) , GRPID(IGRP) , INUM , ISEAS , & 70 & IHOUR , NETID(IREC) 71 ENDDO 72 ! End Receptor LOOP 73 ENDDO 74 ENDDO 75 ENDIF 76 ENDDO 77 ! End Source Group LOOP 78 79 GOTO 999 ! 0 80 81 ! WRITE Error Message for Problem Writing to Plot File 82 99 WRITE (DUMMY,'("SHFIL",I3.3)') ISHUNT(IGRP) ! 0 83 CALL ERRHDL(PATH,MODNAM,'E','520',DUMMY) 84 85 999 CONTINUE ! 0 86 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