get_date_ol.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 get_date_ol(TPTIME,PTSTEP,HDATE)
!     #######################################################
!!****  *GET_DATE_OL* - gets the initial date of the simulation to write in
!                       netcdf file
!!
!!    PURPOSE
!!    -------
!!
      !!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      S. Faroux   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    06/2010 
!-------------------------------------------------------------------------------
!
USE modd_type_date_surf, ONLY: date_time
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
TYPE(date_time), INTENT(IN)      :: TPTIME      ! current date and time
REAL,            INTENT(IN)      :: PTSTEP
 CHARACTER(LEN=*), INTENT(OUT)    :: HDATE
!
INTEGER, DIMENSION(3)            :: ITIME, IDATE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!
IF (lhook) CALL dr_hook('GET_DATE_OL',0,zhook_handle)
itime(1)=floor(tptime%TIME/3600.)
itime(2)=floor((tptime%TIME-itime(1)*3600)/60.)
itime(3)=tptime%TIME-itime(1)*3600-itime(2)*60
!
IF (ptstep == floor(ptstep/86400.)*86400) THEN 
  hdate='days since '
ELSEIF (ptstep == floor(ptstep/3600.)*3600) THEN
  hdate='hours since '
ELSEIF (ptstep == floor(ptstep/60.)*60) THEN
  hdate='minutes since '
ELSE
  hdate='seconds since '
ENDIF
!
idate(1) = tptime%TDATE%YEAR
idate(2) = tptime%TDATE%MONTH
idate(3) = tptime%TDATE%DAY
!
 CALL write_time(idate(1),1,"-",hdate)
 CALL write_time(idate(2),0,"-",hdate)
 CALL write_time(idate(3),0,"",hdate)
 CALL write_time(itime(1),1,":",hdate)
 CALL write_time(itime(2),0,":",hdate)
 CALL write_time(itime(3),0,"",hdate)

IF (lhook) CALL dr_hook('GET_DATE_OL',1,zhook_handle)
CONTAINS


SUBROUTINE write_time(ITIME,ISPACE,HSEP,HTDATE)
!
INTEGER, INTENT(IN)             :: ITIME
INTEGER, INTENT(IN)             :: ISPACE
 CHARACTER(LEN=*), INTENT(IN)    :: HSEP
 CHARACTER(LEN=*), INTENT(INOUT) :: HTDATE
 CHARACTER(LEN=10)               :: YPAS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!      
!
IF (lhook) CALL dr_hook('GET_DATE_OL:WRITE_TIME',0,zhook_handle)
IF (itime.LT.10) THEN
  WRITE(ypas,'(i1)') itime
  IF (ispace==1) THEN
    htdate=trim(htdate)//" 0"//trim(ypas)//hsep
  ELSE
    htdate=trim(htdate)//"0"//trim(ypas)//hsep
  ENDIF
ELSE
  IF (itime.LT.100) THEN
    WRITE(ypas,'(i2)') itime
  ELSE
    WRITE(ypas,'(i4)') itime
  ENDIF
  IF (ispace==1) THEN
    htdate=trim(htdate)//" "//trim(ypas)//hsep
  ELSE
    htdate=trim(htdate)//trim(ypas)//hsep
  ENDIF  
ENDIF
IF (lhook) CALL dr_hook('GET_DATE_OL:WRITE_TIME',1,zhook_handle)
!
!
END SUBROUTINE write_time


END SUBROUTINE get_date_ol