1 2 SUBROUTINE PERPST 3 !*********************************************************************** 4 ! PERPST Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: To Process Postprocessor File Output Selection for PERIOD 7 ! Averages 8 ! 9 ! PROGRAMMER: Roger Brode, Jeff Wang 10 ! 11 ! DATE: March 2, 1992 12 ! 13 ! MODIFIED: To Change File Length Limit To 40 - 9/29/92 14 ! 15 ! INPUTS: Input Runstream Parameters 16 ! 17 ! OUTPUTS: Output Option Switches 18 ! 19 ! CALLED FROM: OUPLOT 20 !*********************************************************************** 21 22 ! Variable Declarations 23 USE MAIN1 24 IMPLICIT NONE 25 CHARACTER MODNAM*12 26 27 SAVE 28 INTEGER :: I , J 29 CHARACTER INPGRP*8 30 LOGICAL FOUND 31 32 ! Variable Initializations 33 MODNAM = 'PERPST' ! 0 34 35 ! Check If Too Many Fields 36 IF ( IFC.GT.7 ) THEN 37 ! Error Message: Too Many Fields 38 CALL ERRHDL(PATH,MODNAM,'E','202',KEYWRD) ! 0 39 GOTO 999 40 ENDIF 41 42 ! Retrieve Source Group ID 43 INPGRP = FIELD(4) ! 0 44 ! Check Source Group ID 45 FOUND = .FALSE. 46 J = 1 47 DO WHILE ( .NOT.FOUND .AND. J.LE.NUMGRP ) 48 IF ( INPGRP.EQ.GRPID(J) ) THEN ! 0 49 FOUND = .TRUE. ! 0 50 INDGRP = J 51 ENDIF 52 J = J + 1 ! 0 53 ENDDO 54 IF ( .NOT.FOUND ) THEN ! 0 55 ! Error Message: E203 GRPID Not Match With Pre-Defined One 56 CALL ERRHDL(PATH,MODNAM,'E','203','GRPID') ! 0 57 GOTO 999 58 ENDIF 59 60 ! Set Switch and Check for Previous POSTFILE Card 61 ! for This Averaging Period & Group ID 62 IANPST(INDGRP) = IANPST(INDGRP) + 1 ! 0 63 IF ( IANPST(INDGRP).GT.1 ) THEN 64 ! WRITE Error Message 65 CALL ERRHDL(PATH,MODNAM,'E','211',KEYWRD) ! 0 66 GOTO 999 67 ENDIF 68 69 ! Retrieve Format Secondary Keyword 70 IF ( FIELD(5).EQ.'UNFORM' ) THEN ! 0 71 IANFRM(INDGRP) = 0 ! 0 72 ELSEIF ( FIELD(5).EQ.'PLOT' ) THEN 73 IANFRM(INDGRP) = 1 ! 0 74 ELSE 75 ! Error Message: Invalid Format Specified for POSTFILE 76 CALL ERRHDL(PATH,MODNAM,'E','203','FORMAT') ! 0 77 GOTO 999 78 ENDIF 79 80 IF ( (LOCE(6)-LOCB(6)).LE.(ILEN_FLD-1) ) THEN ! 0 81 ! Retrieve Filename as Character Substring to Maintain Original Case 82 ! Also Check for Filename Larger Than 40 Characters 83 ANNPST(INDGRP) = RUNST1(LOCB(6):LOCE(6)) ! 0 84 ELSE 85 ! WRITE Error Message: ANNPST Field is Too Long 86 CALL ERRHDL(PATH,MODNAM,'E','203',' FILNAM ') ! 0 87 ENDIF 88 89 ! Retrieve File Unit If Input, or Assign File Unit and OPEN File 90 IF ( IFC.EQ.7 ) THEN ! 0 91 CALL STONUM(FIELD(7),ILEN_FLD,FNUM,IMIT) ! 0 92 ! Check for Valid Threshold Value 93 IF ( IMIT.NE.1 ) THEN 94 ! Write Error Message: Invalid Numerical Field 95 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 96 GOTO 999 97 ENDIF 98 ! Check for Conflict With System Files 99 IF ( FNUM.LE.25. ) THEN ! 0 100 ! WRITE Error Message: Invalid File Unit Specified 101 CALL ERRHDL(PATH,MODNAM,'E','560',KEYWRD) ! 0 102 GOTO 999 103 ELSEIF ( FNUM.GT.100 ) THEN 104 ! WRITE Warning Message: Suspect File Unit Specified 105 ! Unit May Conflict With Dynamically Allocated File Units 106 CALL ERRHDL(PATH,MODNAM,'W','565',KEYWRD) ! 0 107 IAPUNT(INDGRP) = NINT(FNUM) 108 ELSE 109 IAPUNT(INDGRP) = NINT(FNUM) ! 0 110 ENDIF 111 ELSE 112 ! Dynamically Allocate File Unit (300's) 113 IAPUNT(INDGRP) = 300 + INDGRP*10 - 5 ! 0 114 ! WRITE Warning Message: Dynamic FUnit Allocation May Have Conflict 115 IF ( INDGRP.GE.10 ) CALL ERRHDL(PATH,MODNAM,'W','565',KEYWRD) 116 ENDIF 117 118 ! Check for Earlier Use of This Filename and File Unit 119 FOUND = .FALSE. ! 0 120 DO I = 1 , NUMGRP 121 IF ( I.NE.INDGRP ) THEN ! 0 122 IF ( ANNPST(INDGRP).EQ.ANNPST(I) .AND. IAPUNT(INDGRP) & 123 & .EQ.IAPUNT(I) ) THEN 124 FOUND = .TRUE. ! 0 125 ELSEIF ( ANNPST(INDGRP).EQ.ANNPST(I) .AND. IAPUNT(INDGRP) & 126 & .NE.IAPUNT(I) ) THEN 127 ! Write Error Message: Conflicting Inputs 128 CALL ERRHDL(PATH,MODNAM,'E','550',KEYWRD) ! 0 129 GOTO 999 130 ELSEIF ( ANNPST(INDGRP).NE.ANNPST(I) .AND. IAPUNT(INDGRP) & 131 & .EQ.IAPUNT(I) ) THEN 132 ! Write Error Message: Conflicting Inputs 133 CALL ERRHDL(PATH,MODNAM,'E','550',KEYWRD) ! 0 134 GOTO 999 135 ENDIF 136 ENDIF 137 ENDDO 138 139 ! Check Against POSTFILEs for Short Term Averages 140 DO J = 1 , NUMAVE ! 0 141 DO I = 1 , NUMGRP ! 0 142 IF ( ANNPST(INDGRP).EQ.PSTFIL(I,J) .AND. IAPUNT(INDGRP) & 143 & .EQ.IPSUNT(I,J) ) THEN 144 FOUND = .TRUE. ! 0 145 ELSEIF ( ANNPST(INDGRP).EQ.PSTFIL(I,J) .AND. IAPUNT(INDGRP) & 146 & .NE.IPSUNT(I,J) ) THEN 147 ! Write Error Message: Conflicting Inputs 148 CALL ERRHDL(PATH,MODNAM,'E','550',KEYWRD) ! 0 149 GOTO 999 150 ELSEIF ( ANNPST(INDGRP).NE.PSTFIL(I,J) .AND. IAPUNT(INDGRP) & 151 & .EQ.IPSUNT(I,J) ) THEN 152 ! Write Error Message: Conflicting Inputs 153 CALL ERRHDL(PATH,MODNAM,'E','550',KEYWRD) ! 0 154 GOTO 999 155 ENDIF 156 ENDDO 157 ENDDO 158 159 IF ( .NOT.FOUND ) THEN ! 0 160 ! First Time File is Identified - OPEN File 161 IF ( FIELD(5).EQ.'UNFORM' ) THEN ! 0 162 OPEN (IAPUNT(INDGRP),ERR=99,FILE=ANNPST(INDGRP), & 163 & IOSTAT=IOERRN,FORM='UNFORMATTED',STATUS='UNKNOWN') 164 ELSEIF ( FIELD(5).EQ.'PLOT' ) THEN 165 OPEN (IAPUNT(INDGRP),ERR=99,FILE=ANNPST(INDGRP), & 166 & IOSTAT=IOERRN,FORM='FORMATTED',STATUS='UNKNOWN') 167 ENDIF 168 ENDIF 169 170 ! Set Logical Switch Indicating That Post File(s) Are Generated 171 ANPOST = .TRUE. ! 0 172 173 GOTO 999 174 175 ! WRITE Error Message for Error Opening File 176 99 WRITE (DUMMY,'("PSTFL",I3.3)') IAPUNT(INDGRP) ! 0 177 CALL ERRHDL(PATH,MODNAM,'E','500',DUMMY) 178 179 999 CONTINUE ! 0 180 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