1 2 SUBROUTINE OUSEAS 3 !*********************************************************************** 4 ! OUSEAS Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: To Process Season by Hour Output Selection 7 ! 8 ! PROGRAMMER: Roger Brode 9 ! 10 ! DATE: June 5, 1997 11 ! 12 ! INPUTS: Input Runstream Parameters 13 ! 14 ! OUTPUTS: Output Option Switches 15 ! 16 ! CALLED FROM: OUCARD 17 !*********************************************************************** 18 19 ! Variable Declarations 20 USE MAIN1 21 IMPLICIT NONE 22 CHARACTER MODNAM*12 23 24 SAVE 25 INTEGER :: I , J , K 26 CHARACTER INPGRP*8 27 LOGICAL FOUND 28 29 ! Variable Initializations 30 MODNAM = 'OUSEAS' ! 0 31 32 ! Check If Too Many Fields 33 IF ( IFC.GT.5 ) THEN 34 ! Error Message: Too Many Fields 35 CALL ERRHDL(PATH,MODNAM,'E','202',KEYWRD) ! 0 36 GOTO 999 37 ENDIF 38 39 ! Retrieve Source Group ID 40 INPGRP = FIELD(3) ! 0 41 ! Check Source Group ID 42 FOUND = .FALSE. 43 J = 1 44 DO WHILE ( .NOT.FOUND .AND. J.LE.NUMGRP ) 45 IF ( INPGRP.EQ.GRPID(J) ) THEN ! 0 46 FOUND = .TRUE. ! 0 47 INDGRP = J 48 ENDIF 49 J = J + 1 ! 0 50 ENDDO 51 IF ( .NOT.FOUND ) THEN ! 0 52 ! Error Message: E203 GRPID Not Match With Pre-Defined One 53 CALL ERRHDL(PATH,MODNAM,'E','203','GRPID') ! 0 54 GOTO 999 55 ENDIF 56 57 ! Set Switch and Check for Previous SEASONHR Card 58 ! for This Group ID 59 ISEAHR(INDGRP) = ISEAHR(INDGRP) + 1 ! 0 60 IF ( ISEAHR(INDGRP).GT.1 ) THEN 61 ! WRITE Error Message 62 CALL ERRHDL(PATH,MODNAM,'E','211',KEYWRD) ! 0 63 GOTO 999 64 ENDIF 65 66 IF ( (LOCE(4)-LOCB(4)).LE.ILEN_FLD-1 ) THEN ! 0 67 ! Retrieve Filename as Character Substring to Maintain Original Case 68 ! Also Check for Filename Larger Than 40 Characters 69 SEAHRS(INDGRP) = RUNST1(LOCB(4):LOCE(4)) ! 0 70 ELSE 71 ! WRITE Error Message: SEAHRS Field is Too Long 72 CALL ERRHDL(PATH,MODNAM,'E','203',' FILNAM ') ! 0 73 ENDIF 74 75 ! Retrieve File Unit If Input, or Assign File Unit and OPEN File 76 IF ( IFC.EQ.5 ) THEN ! 0 77 CALL STONUM(FIELD(5),ILEN_FLD,FNUM,IMIT) ! 0 78 ! Check for Valid Threshold Value 79 IF ( IMIT.NE.1 ) THEN 80 ! Write Error Message: Invalid Numerical Field 81 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 82 GOTO 999 83 ENDIF 84 ! Check for Conflict With System Files 85 IF ( FNUM.LE.25. ) THEN ! 0 86 ! WRITE Error Message: Invalid File Unit Specified 87 CALL ERRHDL(PATH,MODNAM,'E','560',KEYWRD) ! 0 88 GOTO 999 89 ELSEIF ( FNUM.GT.100 ) THEN 90 ! WRITE Warning Message: Suspect File Unit Specified 91 ! Unit May Conflict With Dynamically Allocated File Units 92 CALL ERRHDL(PATH,MODNAM,'W','565',KEYWRD) ! 0 93 ISHUNT(INDGRP) = NINT(FNUM) 94 ELSE 95 ISHUNT(INDGRP) = NINT(FNUM) ! 0 96 ENDIF 97 ELSE 98 ! Dynamically Allocate File Unit (300's) 99 ISHUNT(INDGRP) = 302 + INDGRP*10 ! 0 100 ! WRITE Warning Message: Dynamic FUnit Allocation May Have Conflict 101 IF ( INDGRP.GE.10 ) CALL ERRHDL(PATH,MODNAM,'W','565',KEYWRD) 102 ENDIF 103 104 ! Check for Earlier Use of This Filename and File Unit 105 FOUND = .FALSE. ! 0 106 DO I = 1 , NUMGRP 107 IF ( I.NE.INDGRP ) THEN ! 0 108 IF ( SEAHRS(INDGRP).EQ.SEAHRS(I) .AND. ISHUNT(INDGRP) & 109 & .EQ.ISHUNT(I) ) THEN 110 FOUND = .TRUE. ! 0 111 ELSEIF ( SEAHRS(INDGRP).EQ.SEAHRS(I) .AND. ISHUNT(INDGRP) & 112 & .NE.ISHUNT(I) ) THEN 113 ! Write Error Message: Conflicting Inputs 114 CALL ERRHDL(PATH,MODNAM,'E','550',KEYWRD) ! 0 115 GOTO 999 116 ELSEIF ( SEAHRS(INDGRP).NE.SEAHRS(I) .AND. ISHUNT(INDGRP) & 117 & .EQ.ISHUNT(I) ) THEN 118 ! Write Error Message: Conflicting Inputs 119 CALL ERRHDL(PATH,MODNAM,'E','550',KEYWRD) ! 0 120 GOTO 999 121 ENDIF 122 ENDIF 123 ENDDO 124 125 ! First Time File is Identified - OPEN File 126 IF ( .NOT.FOUND ) OPEN (ISHUNT(INDGRP),ERR=99,FILE=SEAHRS(INDGRP),& 127 & IOSTAT=IOERRN,STATUS='UNKNOWN') 128 129 ! Set Logical Switch Indicating That Plot File(s) Are Generated 130 SEASONHR = .TRUE. ! 0 131 132 GOTO 999 133 134 ! WRITE Error Message for Error Opening File 135 99 WRITE (DUMMY,'("SEAHR",I3.3)') ISHUNT(INDGRP) ! 0 136 CALL ERRHDL(PATH,MODNAM,'E','500',DUMMY) 137 138 999 CONTINUE ! 0 139 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