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