1 2 SUBROUTINE GREGOR(INYR,INMN,JDY,IDY) 3 !*********************************************************************** 4 ! GREGOR Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: CONVERT JULIAN DAY (1-366) TO DAY OF MONTH, 7 ! INCLUDES TEST FOR 100 AND 400 YEAR CORRECTIONS TO 8 ! HANDLE 4 DIGIT YEARS BEYOND 2099 AND BEFORE 1901 9 ! (WILL WORK WITH 2 DIGIT YR FOR PERIOD 1901-2099) 10 ! 11 ! PROGRAMMER: Roger Brode, Jeff Wang 12 ! 13 ! DATE: March 2, 1992 14 ! 15 ! INPUTS: YEAR, INYR (2 OR 4 DIGIT) 16 ! MONTH, INMN 17 ! JULIAN DAY, JDY (1-366) 18 ! 19 ! OUTPUT: DAY OF MONTH, IDY 20 ! 21 ! CALLED FROM: METEXT 22 ! 23 ! ERROR HANDLING: Checks for Invalid Month or Day 24 !*********************************************************************** 25 26 ! Variable Declarations 27 USE MAIN1 28 IMPLICIT NONE 29 CHARACTER MODNAM*12 30 31 SAVE 32 INTEGER :: NDAY(12) 33 INTEGER :: INYR , INMN , IDY , JDY 34 35 ! Variable Initializations 36 DATA NDAY/0 , 31 , 59 , 90 , 120 , 151 , 181 , 212 , 243 , 273 , & 37 & 304 , 334/ 38 MODNAM = 'GREGOR' ! 0 39 40 ! Check for Invalid Month or Julian Day 41 IF ( INMN.LT.1 .OR. INMN.GT.12 ) THEN 42 ! WRITE Error Message ! Invalid Month 43 CALL ERRHDL(PATH,MODNAM,'E','203','MONTH') ! 0 44 GOTO 999 45 ELSEIF ( JDY.LT.1 .OR. JDY.GT.366 ) THEN 46 ! WRITE Error Message ! Invalid Julian Day 47 CALL ERRHDL(PATH,MODNAM,'E','203','Juli Day') ! 0 48 GOTO 999 49 ENDIF 50 51 ! Determine Day-of-Month Number; For Non-Leap Year First 52 IF ( (MOD(INYR,4).NE.0) .OR. & 53 & (MOD(INYR,100).EQ.0 .AND. MOD(INYR,400).NE.0) ) THEN 54 ! Not a Leap Year 55 IDY = JDY - NDAY(INMN) ! 0 56 ELSE 57 ! Leap Year 58 IDY = JDY - NDAY(INMN) ! 0 59 IF ( INMN.GT.2 ) IDY = IDY - 1 60 ENDIF 61 62 999 CONTINUE ! 0 63 64 CONTINUE 65 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