trip_date.F90

Go to the documentation of this file.

SUBROUTINE trip_date(KYEAR,KMONTH,KDAY,PTIME)
!#######################################################
!
!!****  *TRIP_DATE* - current date and hour
!!
!-------------------------------------------------------------------------------
!
!*       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) :: PTIME  ! number of seconds since date at 00 UTC
!
!*       0.2   Declaration of local variables
!              ------------------------------
!
INTEGER :: IDAYS ! number of days in KMONTH
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
!*       1.    Return condition: less than one day to add
!              ------------------------------------------
!
IF (lhook) CALL dr_hook('TRIP_DATE',0,zhook_handle)
!
DO 
  IF (86400.-ptime > 1.e-6) EXIT
!
!-------------------------------------------------------------------------------
!
!*       2.    Adding one day
!              --------------
!
  ptime=ptime-86400.
!
!*       2.1   Number of days in a month
!              -------------------------
!
  SELECT CASE (kmonth)
    CASE(4,6,9,11)
      idays=30
    CASE(1,3,5,7:8,10,12)
      idays=31
    CASE(2)
      IF( ((mod(kyear,4)==0).AND.(mod(kyear,100)/=0)) .OR. (mod(kyear,400)==0))THEN
        idays=29
      ELSE
        idays=28
      ENDIF
  END SELECT
!
!*       2.2   Last day of the month
!              ---------------------
!
  IF (kday==idays) THEN
    IF (kmonth==12) THEN
      kday=1
      kmonth=1
      kyear=kyear+1
    ELSE
      kday=1   
      kmonth=kmonth+1
    ENDIF
! 
!*       2.3   Other days
!              ----------
  ELSE
    kday=kday+1
  ENDIF
!
ENDDO
!
IF (lhook) CALL dr_hook('TRIP_DATE',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE trip_date