substract_to_date_surf.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 substract_to_date_surf(KYEAR,KMONTH,KDAY,PSEC)
!     #######################################################
!
!!****  *SUBSTRACT_TO_DATE_SURF* - finds the current date and hour from a date
!!
!!    PURPOSE
!!    -------
!!
!!                                WARNING
!!
!!      -----> Only correct for dates between 19900301 and 21000228   <-----
!!
!!  The correct test should be:
!! IF( ((MOD(KYEAR,4)==0).AND.(MOD(KYEAR,100)/=0)) .OR. (MOD(KYEAR,400)==0))THEN
!!
!!**  METHOD
!!    ------
!!
!!      A recursive method is used, removing one day ofter the other.
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    Book 2 (add_forecast_to_date)
!!
!!    AUTHOR
!!    ------
!!
!     G.Jaubert Meteo-France (from add_forecast_to_date)
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    23/07/01
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declaration of arguments
!              ------------------------
INTEGER, INTENT(INOUT) :: kyear  ! year of date
INTEGER, INTENT(INOUT) :: kmonth ! month of date
INTEGER, INTENT(INOUT) :: kday   ! day of date
REAL,    INTENT(INOUT) :: psec   ! number of seconds since date at 00 UTC
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('SUBSTRACT_TO_DATE_SURF',0,zhook_handle)
!
!*       1.    Return condition: PSEC >0
!              -------------------------
!
DO 
  IF (psec >= 0.) EXIT
!
!-------------------------------------------------------------------------------
!
!*       2.    remove one day
!              --------------
!
  psec=psec+86400.
!
!
!*       2.1   first day of the month
!              ---------------------
!
  IF (kday==1) THEN
    IF (kmonth==1) THEN
      kday=31
      kmonth=12
      kyear=kyear-1
    ELSE
      kmonth=kmonth-1
      SELECT CASE (kmonth)
        CASE(4,6,9,11)
          kday=30
        CASE(1,3,5,7:8,10,12)
          kday=31
        CASE(2)
          IF( ((mod(kyear,4)==0).AND.(mod(kyear,100)/=0)) .OR. (mod(kyear,400)==0))THEN
            kday=29
          ELSE
            kday=28
          ENDIF
      END SELECT
    ENDIF
! 
!*       2.2   Other days
!              ----------
  ELSE
    kday=kday-1
  ENDIF
!
!-------------------------------------------------------------------------------
!
!*       3.    Recursive call
!              --------------
!
ENDDO
!
IF (lhook) CALL dr_hook('SUBSTRACT_TO_DATE_SURF',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE substract_to_date_surf