1 2 SUBROUTINE TERRST 3 !*********************************************************************** 4 ! TERRST Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: To Determine Total Error/Message Statistics 7 ! 8 ! PROGRAMMER: Jeff Wang, Roger Brode 9 ! 10 ! DATE: March 2, 1992 11 ! 12 ! INPUTS: Error Message Temporary File 13 ! 14 ! OUTPUTS: Total Number of Messages by Message Type 15 ! 16 ! CALLED FROM: This is A Utility Program 17 !*********************************************************************** 18 19 ! Variable Declarations 20 USE MAIN1 21 IMPLICIT NONE 22 CHARACTER MODNAM*12 23 24 SAVE 25 INTEGER :: IERRLN 26 CHARACTER ERRTP*1 , ERRCD*3 , ERRMG1*50 , ERRMG2*8 , INPFLD*3 27 28 ! Variable Initialization 29 MODNAM = 'TERRST' ! 6 30 IFTL = 0 31 IWRN = 0 32 INFO = 0 33 ICLM = 0 34 IMSG = 0 35 IHEZ = 0 36 EOF = .FALSE. 37 38 ! Rewind the Temporary Error/Message File 39 REWIND IERUNT 40 41 DO WHILE ( .NOT.EOF ) 42 READ (IERUNT,1116,END=99,ERR=9999) PATH , ERRTP , ERRCD , & 43 & IERRLN , MODNAM , ERRMG1 , ERRMG2 44 45 1116 FORMAT (A2,1X,A1,A3,I6,1X,A6,1X,A50,1X,A8) 46 47 ! Sort Error Group And Find The Index 48 INPFLD = ERRCD ! 1280 49 CALL STONUM(INPFLD,3,FNUM,IMIT) 50 51 IF ( ERRTP.EQ.'E' ) THEN 52 IFTL = IFTL + 1 ! 4 53 ELSEIF ( ERRTP.EQ.'W' ) THEN 54 IWRN = IWRN + 1 ! 0 55 ELSEIF ( ERRTP.EQ.'I' ) THEN 56 INFO = INFO + 1 ! 1276 57 ! Message for Calm Hour, Increment Calm Counter 58 IF ( NINT(FNUM).EQ.440 ) ICLM = ICLM + 1 59 ! Message for Missing Hour, Increment Missing Hour Counter 60 IF ( NINT(FNUM).EQ.460 ) IMSG = IMSG + 1 61 ! Message for HE > ZI, Increment Counter 62 IF ( NINT(FNUM).EQ.283 ) IHEZ = IHEZ + 1 63 ENDIF 64 65 GOTO 11 ! 1280 66 99 EOF = .TRUE. ! 6 67 11 CONTINUE ! 1286 68 ENDDO 69 70 ! Use BACKSPACE To Reposition Temporary Error Message File Ahead of EOF; 71 ! This Is Needed in Order To Allow For Additional Message Writes 72 BACKSPACE IERUNT ! 6 73 74 GOTO 1000 75 76 ! WRITE Error Message: Error Reading Temp Error Message File 77 9999 CALL ERRHDL(PATH,MODNAM,'E','510','ERRORMSG') ! 0 78 79 1000 CONTINUE ! 6 80 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