1 SUBROUTINE EVCARD 2 !*********************************************************************** 3 ! EVCARD Module of ISCEV2 Model 4 ! 5 ! PURPOSE: To process EVent Pathway card images 6 ! 7 ! PROGRAMMER: Roger Brode, Jeff Wang 8 ! 9 ! DATE: March 2, 1992 10 ! 11 ! MODIFIED: To incorporate modifications to date processing 12 ! for Y2K compliance, including use of date window 13 ! variables (ISTRT_WIND and ISTRT_CENT) and calculation 14 ! of 10-digit variables for start date (ISDATE) and 15 ! end date (IEDATE). 16 ! R.W. Brode, PES, Inc., 5/12/99 17 ! 18 ! MODIFIED: To remove reassignment of ISYEAR. 19 ! R.W. Brode, PES, 4/2/99 20 ! 21 ! MODIFIED: To remove mixed-mode math in calculation of 22 ! ISDATE and IEDATE - 4/19/93 23 ! 24 ! INPUTS: Pathway (EV) and Keyword 25 ! 26 ! OUTPUTS: Pass Two Event Setup 27 ! 28 ! CALLED FROM: SETUP 29 !*********************************************************************** 30 31 ! Variable Declarations 32 USE MAIN1 33 IMPLICIT NONE 34 CHARACTER MODNAM*12 35 36 SAVE 37 INTEGER :: I , ILSAVE , ITEMPDATE , ITEMPYEAR 38 39 ! Variable Initializations 40 MODNAM = 'EVCARD' ! 0 41 42 IF ( KEYWRD.EQ.'STARTING' ) THEN 43 ! Set Status Switch 44 IESTAT(1) = IESTAT(1) + 1 ! 0 45 IEVENT = 1 46 ! Error Message: Repeat Starting In Same Pathway 47 IF ( IESTAT(1).NE.1 ) CALL ERRHDL(PATH,MODNAM,'E','135',KEYWRD) 48 ELSEIF ( KEYWRD.EQ.'EVENTPER' ) THEN 49 ! Set Status Switch 50 IESTAT(2) = IESTAT(2) + 1 ! 0 51 ! Check for First Occurrence of EVENTPER Card, and 52 ! Reinitialize IPROC Array 53 IF ( IESTAT(2).EQ.1 ) THEN 54 DO I = 1 , 366 ! 0 55 IPROC(I) = 0 ! 0 56 ENDDO 57 ENDIF 58 ! Process Average Period, Date and Source Group --- CALL EVPER 59 CALL EVPER ! 0 60 ELSEIF ( KEYWRD.EQ.'EVENTLOC' ) THEN 61 ! Set Status Switch 62 IESTAT(3) = IESTAT(3) + 1 ! 0 63 ! Process Discrete Receptor Location --- CALL EVLOC 64 CALL EVLOC 65 ELSEIF ( KEYWRD.EQ.'INCLUDED' ) THEN 66 ! Set Status Switch 67 IESTAT(10) = IESTAT(10) + 1 ! 0 68 ! Save ILINE as ISAVE 69 ILSAVE = ILINE 70 ! Process the Included Receptor File --- CALL INCLUD 71 CALL INCLUD 72 ! Retrieve ILINE From ISAVE 73 ILINE = ILSAVE 74 ELSEIF ( KEYWRD.EQ.'FINISHED' ) THEN 75 ! Check for missing EVENTLOC cards 76 ! Write Error Message: Missing EVENTLOC 77 IF ( IESTAT(2).GT.IESTAT(3) ) & 78 & CALL ERRHDL(PATH,MODNAM,'E','130','EVENTLOC') 79 NUMEVE = IEVENT - 1 80 ! Set Status Switch 81 IESTAT(25) = IESTAT(25) + 1 82 IF ( IESTAT(25).NE.1 ) THEN 83 ! Error Message: Repeat Finished In Same Pathway 84 CALL ERRHDL(PATH,MODNAM,'E','135',KEYWRD) ! 0 85 GOTO 999 86 ENDIF 87 88 ! Get start date, ISDATE, and end date, IEDATE 89 ISDATE = EVDATE(1) ! 0 90 IEDATE = EVDATE(1) 91 ISYR = ISDATE/1000000 92 IEYR = IEDATE/1000000 93 ! Convert 8-digit EVDATE to 10-digit ISDATE and IEDATE 94 IF ( ISYR.GE.ISTRT_WIND .AND. ISYR.LE.99 ) THEN 95 ISYR = ISTRT_CENT*100 + ISYR ! 0 96 ISDATE = ISTRT_CENT*100000000 + ISDATE 97 ELSEIF ( ISYR.LT.ISTRT_WIND ) THEN 98 ISYR = (ISTRT_CENT+1)*100 + ISYR ! 0 99 ISDATE = (ISTRT_CENT+1)*100000000 + ISDATE 100 ENDIF 101 IF ( IEYR.GE.ISTRT_WIND .AND. IEYR.LE.99 ) THEN ! 0 102 IEYR = ISTRT_CENT*100 + IEYR ! 0 103 IEDATE = ISTRT_CENT*100000000 + IEDATE 104 ELSEIF ( IEYR.LT.ISTRT_WIND ) THEN 105 IEYR = (ISTRT_CENT+1)*100 + IEYR ! 0 106 IEDATE = (ISTRT_CENT+1)*100000000 + IEDATE 107 ENDIF 108 ! Loop through events to find start date and end date 109 DO I = 1 , NUMEVE ! 0 110 ITEMPDATE = EVDATE(I) ! 0 111 ITEMPYEAR = ITEMPDATE/1000000 112 IF ( ITEMPYEAR.GE.ISTRT_WIND .AND. ITEMPYEAR.LE.99 ) THEN 113 ITEMPDATE = ISTRT_CENT*100000000 + ITEMPDATE ! 0 114 ELSEIF ( ITEMPYEAR.LT.ISTRT_WIND ) THEN 115 ITEMPDATE = (ISTRT_CENT+1)*100000000 + ITEMPDATE ! 0 116 ENDIF 117 IF ( ITEMPDATE.LT.ISDATE ) ISDATE = ITEMPDATE ! 0 118 IF ( ITEMPDATE.GT.IEDATE ) IEDATE = ITEMPDATE 119 ENDDO 120 ! Set start hour to 00 and end hour to 24 121 ISDATE = (ISDATE/100)*100 ! 0 122 IEDATE = (IEDATE/100)*100 + 24 123 ISYR = ISDATE/1000000 124 IEYR = IEDATE/1000000 125 ISMN = (ISDATE/10000) - (ISDATE/1000000)*100 126 IEMN = (IEDATE/10000) - (IEDATE/1000000)*100 127 ISDY = (ISDATE/100) - (ISDATE/10000)*100 128 IEDY = (IEDATE/100) - (IEDATE/10000)*100 129 130 ! Write Out The Error Message: Mandatory Keyword Missing 131 IF ( IESTAT(1).EQ.0 ) & 132 & CALL ERRHDL(PATH,MODNAM,'E','130','STARTING') 133 IF ( IESTAT(2).EQ.0 ) & 134 & CALL ERRHDL(PATH,MODNAM,'E','130','EVENTPER') 135 IF ( IESTAT(3).EQ.0 ) & 136 & CALL ERRHDL(PATH,MODNAM,'E','130','EVENTLOC') 137 138 ELSE 139 ! Write Error Message: Invalid Keyword for This Pathway 140 CALL ERRHDL(PATH,MODNAM,'E','110',KEYWRD) ! 0 141 ENDIF 142 143 999 CONTINUE ! 0 144 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