SetupWeekDaysByMonth Subroutine

private subroutine SetupWeekDaysByMonth(StMon, StDay, StWeekDay, Weekdays)

Arguments

Type	Intent	Attributes		Name
integer,	intent(in)		::	StMon
integer,	intent(in)		::	StDay
integer,	intent(in)		::	StWeekDay
integer,	intent(inout),	DIMENSION(12)	::	Weekdays

Called By

Help

Source Code

SetupWeekDaysByMonth

Source Code

SUBROUTINE SetupWeekDaysByMonth(StMon,StDay,StWeekDay,WeekDays)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Linda Lawrie
          !       DATE WRITTEN   August 2000
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine calculates the weekday for each month based on the start date and
          ! weekday specified for that date.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
          ! na

  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT(IN) :: StMon
  INTEGER, INTENT(IN) :: StDay
  INTEGER, INTENT(IN) :: StWeekDay
  INTEGER, INTENT(INOUT), DIMENSION(12) :: Weekdays

          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na

          ! DERIVED TYPE DEFINITIONS:
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER Loop
  INTEGER CurWeekDay

  ! Set 1st day of Start Month
  CurWeekDay=StWeekDay
  DO Loop=1,StDay-1
    CurWeekDay=CurWeekDay-1
    IF (CurWeekDay == 0) CurWeekDay=7
  ENDDO

  WeekDays(StMon)=CurWeekDay
  DO Loop=StMon+1,12

    SELECT CASE(Loop)
    CASE(2)
      CurWeekDay=CurWeekDay+EndDayOfMonth(1)
      DO WHILE (CurWeekDay > 7)
        CurWeekDay=CurWeekDay-7
      ENDDO
      WeekDays(Loop)=CurWeekDay

    CASE(3)
      CurWeekDay=CurWeekDay+EndDayOfMonth(Loop-1)+LeapYearAdd
      DO WHILE (CurWeekDay > 7)
        CurWeekDay=CurWeekDay-7
      ENDDO
      WeekDays(Loop)=CurWeekDay

    CASE(4:12)
      CurWeekDay=CurWeekDay+EndDayOfMonth(Loop-1)
      DO WHILE (CurWeekDay > 7)
        CurWeekDay=CurWeekDay-7
      ENDDO
      WeekDays(Loop)=CurWeekDay

    END SELECT
  ENDDO

  IF (ANY(WeekDays == 0)) THEN
    ! need to start at StMon and go backwards.
    ! EndDayOfMonth is also "days" in month.  (without leapyear day in February)
    CurWeekDay=StWeekDay
    DO Loop=1,StDay-1
      CurWeekDay=CurWeekDay-1
      IF (CurWeekDay == 0) CurWeekDay=7
    ENDDO

    DO Loop=StMon-1,1,-1

      SELECT CASE(Loop)

      CASE(1)
        CurWeekDay=CurWeekDay-EndDayOfMonth(1)
        DO WHILE (CurWeekDay <= 0)
          CurWeekDay=CurWeekDay+7
        ENDDO
        WeekDays(Loop)=CurWeekDay

      CASE(2)
        CurWeekDay=CurWeekDay-EndDayOfMonth(2)+LeapYearAdd
        DO WHILE (CurWeekDay <= 0)
          CurWeekDay=CurWeekDay+7
        ENDDO
        WeekDays(Loop)=CurWeekDay

      CASE(3:12)
        CurWeekDay=CurWeekDay-EndDayOfMonth(Loop)
        DO WHILE (CurWeekDay <= 0)
          CurWeekDay=CurWeekDay+7
        ENDDO
        WeekDays(Loop)=CurWeekDay
      END SELECT

    ENDDO

  ENDIF

  RETURN

END SUBROUTINE SetupWeekDaysByMonth

All Procedures