C DAYWK.FTN 28-AUG-78 RDT C SUBROUTINE DAYWK(IMON,IDAY,IYR,IDOY,IDOW,LPYR) C C C+ C CALL DAYWK(IMON,IDAY,IYR,IDOY,IDOW,LPYR) C C ALL ARGUMENTS ARE INTEGER*2 VARIABLES. C C INPUT: C IMON - MONTH OF YEAR, OR 0 (IF DAY OF YEAR IS PASSED IN IDOY) C IDAY - DAY OF MONTH (USED ONLY IF IMON NOT 0) C IYR - YEAR (< 100 OR >= 1753); C IF < 100, YEAR IS ASSUMED TO BE 1900+IYR C IDOY - DAY OF YEAR (USED ONLY IF IMON = 0) C C OUTPUT: C IMON - MONTH (1-12); CHANGED ONLY IF 0 (FOR DAY OF YEAR PASSED) C IDAY - DAY OF MONTH (1-31); CHANGED ONLY IF DAY OF YEAR PASSED C IYR - (UNCHANGED) C IDOY - DAY OF YEAR (1-366) C IDOW - DAY OF WEEK (1-7; 1 FOR SUNDAY) C LPYR - 0 IF NOT A LEAP YEAR; 1 IF A LEAP YEAR C- C DIMENSION NDYCNT(12) C C FOR EACH MONTH, NUMBER OF DAYS IN NON-LEAP YEAR PRIOR TO MONTH DATA NDYCNT/0,31,59,90,120,151,181,212,243,273,304,334/ C C IF YEAR VALUE PASSED IS LESS THAN 100, ASSUME IN THE 1900'S JYR=IYR IF(JYR.LT.100) JYR=JYR+1900 C DETERMINE IF THIS IS A LEAP YEAR LPYR=0 IF(JYR-4*(JYR/4)) 84,81,84 81 IF(JYR-100*(JYR/100)) 83,82,83 82 IF(JYR-400*(JYR/400)) 84,83,84 83 LPYR=1 84 CONTINUE C C VALUE OF IMON (ZERO OR NON-ZERO) DETERMINES IF DAY OF YEAR C OR (MONTH AND DAY OF MONTH) PASSED IF(IMON.NE.0) GO TO 130 C DAY OF YEAR PASSED - DETERMINE MONTH AND DAY OF MONTH IMON=1 LFACT=0 C MONTH FOUND IF DAY OF YEAR NOT GREATER THAN NUMBER OF DAYS IN YEAR C BEFORE START OF THE NEXT MONTH 110 IF(IDOY.LE.(NDYCNT(IMON+1)+LFACT)) GO TO 120 IMON=IMON+1 C INCLUDE LEAP YEAR FACTOR WHEN CHECKING FOR SECOND MONTH AND BEYOND LFACT=LPYR IF(IMON.LT.12) GO TO 110 C SET DAY OF MONTH 120 IDAY=IDOY-NDYCNT(IMON) IF(IMON.GT.2) IDAY=IDAY-LPYR GO TO 140 C 130 CONTINUE C SET DAY OF YEAR WHEN MONTH AND DAY OF MONTH ARE PASSED IDOY=NDYCNT(IMON)+IDAY IF(IMON.GT.2) IDOY=IDOY+LPYR 140 CONTINUE C DETERMINE DAY OF WEEK NUMBER IDOW=(JYR-1751)+(JYR-1753)/4-(JYR-1701)/100+(JYR-1601)/400 1 +IDOY-1 IDOW=IDOW-7*((IDOW-1)/7) C RETURN END