day_of_week.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!################################################
SUBROUTINE day_of_week(PYEAR, PMONTH, PDAY, PDOW)
!################################################
!! DAY_OF_WEEK
!!
!!  PURPOSE
!!  -------
!! DAY_OF_WEEK COMPUTES THE DAY OF THE WEEK BASED UPON THE GIVEN DATE,
!! MONTH AND YEAR.  IT USES THE ZELLER CONGRUENCE ALGORITHIM.
!! PDAY IS THE DAY OF THE MONTH, 1 - 31
!! PMONTH IS THE MONTH OF THE YEAR, 1 - 12
!! PYEAR IS THE YEAR, E.G., 1977
!! IT RETURNS 1 FOR SUNDAY, 2 FOR MONDAY, ETC.
!!
!! AUTHOR
!! ------
!! G. Pigeon *Météo-France*
!! 
!! MODIFICATIONS
!! -------------
!! Original  02/2010

USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
!! DECLARATION
IMPLICIT NONE
!! 1. declaraction of arguments
INTEGER,INTENT(IN) :: PYEAR !current year (UTC)
INTEGER,INTENT(IN) :: PMONTH!current month (UTC)
INTEGER,INTENT(IN) :: PDAY  !current day (UTC)
INTEGER,INTENT(OUT):: PDOW  !current day of the week
!!
!! 2. declaration of local variables
INTEGER :: DAY, YR, MN, N1, N2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DAY_OF_WEEK',0,zhook_handle)
!
yr = pyear
mn = pmonth
   
!   IF JANUARY OR FEBRUARY, ADJUST MONTH AND YEAR
   
IF (mn .LE. 2) THEN
   mn = mn + 12
   yr = yr - 1
END IF
n1 = (26 * (mn + 1)) / 10
n2 = (125 * yr) / 100
day = pday + n1 + n2 - (yr / 100) + (yr / 400) - 1
pdow = mod(day, 7) + 1
!
IF (lhook) CALL dr_hook('DAY_OF_WEEK',1,zhook_handle)
!
END SUBROUTINE day_of_week