ecearth3/sources/tm5mp/base/datetime.F90

!#################################################################
!
!* module contains all routines that deal with date/time calculation   *
!
! subroutine  chardate(idate6,cdate)
! subroutine  inctime
! subroutine  tau2date(itaux,idatex)
! subroutine  date2tau(idatex,itaux)
! subroutine  calc_sm( mlen, sec_day, sec_month, sec_year )
! subroutine  dayl(day,daylen,jdim,lat_start,dlat)
! subroutine  caldat(julian,mm,id,iyyy)
! integer function  julday(mm,id,iy)
! integer function get_day(mm,dd,mlen)
! subroutine  tstamp(kunit,itaux,msg)
!
!### macro's #####################################################
!
#define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
#define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
#define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
!
#include "tm5.inc"
!
!#################################################################

module datetime

  use GO, only : gol, goErr, goPr
  
  implicit none

  ! --- in/out -------------------------------------
  
  private

  public :: inctime, tau2date, date2tau, dayl, idate2ddate
  public :: get_day, julday, calc_sm, new_valid_timestep
  public :: tstamp, wrtgol_tstamp, chardate

contains

  
  ! ==============================================================
  
  
  !-----------------------------------------------------------------------
  !
  !     put date/time in character string
  !
  !     on input:  idate6 contains date/time
  !     on output: cdata contains date/time string
  !
  !-----------------------------------------------------------------------

  subroutine chardate(idate6,cdate)

    integer,dimension(6),intent(in) :: idate6  ! "chardate" input date
    character(24)                   :: cdate   ! "chardate" output string
    !
    integer :: k
    character(3),dimension(12),parameter :: mon= &
         (/'jan','feb','mar','apr','may','jun', &
         'jul','aug','sep','oct','nov','dec'/)
    !
    ! put date/time in string
    !
    write(cdate,'(i4,"-",a3,"-",i2,"  ",i2,":",i2,":",i2,"   ")') &
         idate6(1),mon(idate6(2)),(idate6(k),k=3,6)
    !
  end subroutine chardate


  !-----------------------------------------------------------------------
  !**** inctime
  !
  !     purpose
  !     -------
  !     increment time and set newday/newmonth/newyr switches
  ! 
  !     influences
  !     ----------
  !     nstep,itau,idate,newyr,newmonth,newday,newsrun
  !
  !     externals
  !     ---------
  !     subroutines: tau2date
  !                  tstamp
  !-----------------------------------------------------------------------

  subroutine inctime

    use dims, only : ndyn,tref,idate,itau,nstep,revert,nregions
    use dims, only : newyr,newmonth,newday,newsrun, newhour

    ! local
    integer              :: ninc, k
    integer,dimension(6) :: idtmp
    !
    ! add time step of ninc seconds

    ninc=ndyn/(2*tref(1))  !cmk   !region = 1 is master
    !
    nstep=nstep+1
    itau=itau+revert*ninc
    do  k=1,6
       idtmp(k)=idate(k)
    end do
    call tau2date(itau,idate)
    !
    ! set switches
    !
    newyr = ( idate(1) /= idtmp(1) )
    newmonth = ( idate(2) /= idtmp(2) )
    newday = ( idate(3) /= idtmp(3) )
    newhour(:)  = ( idate(4) /= idtmp(4) )
    newsrun = .false.


  end subroutine inctime




  subroutine tau2date(itaux,idatex)
    !-----------------------------------------------------------------------
    !**** tau2date
    !
    !     purpose
    !     -------
    !     calculate date from given time in seconds
    !
    !     parameters
    !     ----------
    !     on input : itaux contains date/time in seconds
    !     on output: idatex contains date in year,month,day,hour,min,sec
    !
    !     dependencies
    !     ------------
    !     icalendo determines the type calendar used for the conversion
    !     iyear0 is the reference year for the calculation
    !     julday0 is the reference julian day for the calculation
    !
    !     externals
    !     ---------
    !     subroutines: caldat
    !     funtions:    julday
    !-----------------------------------------------------------------------
    use dims, only : icalendo, iyear0, julday0

    implicit none

    ! input/output
    integer(kind=8),     intent(in)  :: itaux
    integer,dimension(6),intent(out) :: idatex

    ! local
    integer :: julian
    integer :: idayy,iyeary,idummy
    !
    ! compute time (hour,min,sec) and number of days
    !
    idatex(6)=mod(itaux,60)
    idatex(5)=mod(itaux/60,60)
    idatex(4)=mod(itaux/3600,24)
    idayy=itaux/86400
    !
    ! permanent 360 year calendar with 30 days in each month
    !
    if ( icalendo == 1 ) then
       idatex(3)=mod(idayy,30)+1
       idatex(2)=mod(idayy/30,12)+1
       idatex(1)=iyear0+idayy/360
       !
       ! real calendar
       !
    else if ( icalendo == 2 ) then
       julian=julday0+idayy
       call caldat(julian,idatex(2),idatex(3),idatex(1))
       !
       ! permanent 365 day year calendar
       !
    else if ( icalendo == 3 ) then
       iyeary=idayy/365
       idatex(1)=iyear0+iyeary
       ! use Jan 1, 1981 as a year containing 365 days and add doy
       julian=julday(1,1,1981)+idayy-iyeary*365
       call caldat(julian,idatex(2),idatex(3),idummy)
       !
       ! permanent leap year calendar
       !
    else if ( icalendo == 4 ) then
       iyeary=idayy/366
       idatex(1)=iyear0+iyeary
       ! use Jan 1, 1980 as a year containing 366 days and add doy
       julian=julday(1,1,1980)+idayy-iyeary*366
       call caldat(julian,idatex(2),idatex(3),idummy)
       !
       ! illegal option icalendo
       !
    else
       write(*,*) ' tau2date: ERROR while computing date' 
       write(*,*) ' tau2date: Illegal calendar type'
       write(*,*) '           icalendo = ',icalendo
       stop 
    end if

  end subroutine tau2date



  subroutine date2tau(idatex,itaux)
    !-----------------------------------------------------------------------
    !**** date2tau
    !
    !     purpose
    !     -------
    !     calculate time in seconds from given date
    !
    !     parameters
    !     ----------
    !     on input : idatex contains date in year,month,day,hour,min,sec
    !     on output: itaux contains date/time in seconds
    !
    !     dependencies
    !     ------------
    !     icalendo determines the type calendar used for the conversion
    !     iyear0 is the reference year for the calculation
    !     julday0 is the reference julian day for the calculation
    !
    !     externals
    !     ---------
    !     funtions: julday
    !-----------------------------------------------------------------------
    use dims, only : icalendo, iyear0, julday0, kmain

    implicit none

    ! input/output
    integer,dimension(6), intent(in)  :: idatex
    integer(kind=8),      intent(out) :: itaux

    ! local
    integer :: idaysec
    !
    ! compute the seconds the day is old
    ! 
    idaysec=idatex(6)+idatex(5)*60+idatex(4)*3600
    !
    ! permanent 360 year calendar with 30 days in each month
    !
    if ( icalendo == 1 ) then
       itaux=idaysec+(idatex(3)-1)*86400+(idatex(2)-1)*2592000 &
            +(idatex(1)-iyear0)*31104000
       !
       ! real calendar
       !
    else if ( icalendo == 2 ) then
       itaux=86400*(julday(idatex(2),idatex(3),idatex(1))-julday0)+idaysec
       !
       ! permanent 365 day year calendar
       !
    else if ( icalendo == 3 ) then
       itaux=86400*(julday(idatex(2),idatex(3),1981)-julday(1,1,1981))  &
            +(idatex(1)-iyear0)*365*86400+idaysec
       !
       ! permanent leap year calendar
       !
    else if ( icalendo == 4 ) then
       itaux=86400*(julday(idatex(2),idatex(3),1980)-julday(1,1,1980))  &
            +(idatex(1)-iyear0)*366*86400+idaysec
       !
       ! illegal option icalendo
       !
    else
       write(kmain,*) ' date2tau: ERROR while computing time'
       write(kmain,*) ' date2tau: Illegal calendar type'
       write(kmain,*) '           icalendo = ',icalendo
       stop 
    end if

  end subroutine date2tau



  integer function get_day(mm,dd,mlen)
    !
    ! returns day number (from 1 January)
    !
    implicit none
    ! input/output
    integer,intent(in) :: mm   ! month in year
    integer,intent(in) :: dd   ! day in month, year
    integer,intent(in),dimension(12)  :: mlen  !lengt of months (days)
    ! local
    integer    :: m

    get_day = 0
    do m=1,mm-1
       get_day = get_day + mlen(m)
    enddo
    get_day = get_day + dd

  end function get_day



  integer function julday(mm,id,iy)
    !-----------------------------------------------------------------------
    !**** julday
    !
    !    purpose
    !    -------
    !    calculate julian day from given date
    !
    !    parameters
    !    ----------
    !    on input : mm, id, iyyy contain month, day and year
    !    on output: julday contains the julian day
    !
    !    dependencies
    !    ------------
    !    julday0 is the reference julian day for the calculation
    !
    !    reference
    !    ---------
    !    J. Meeuws, "Astronomical formulea for calculators" 19xx
    !-----------------------------------------------------------------------
    implicit none

    ! input, output
    integer,intent(in) :: mm  ! month
    integer,intent(in) :: id  ! day
    integer,intent(in) :: iy  ! year

    ! local
    integer,parameter  :: igreg=15+31*(10+12*1582)
    integer            :: julday0, jy, jm, ja, iyyy

    ! handle dates before 0 AD
    !
    iyyy=iy
    if ( iy == 0 ) then
       stop 'julday:  ERROR invalid year 0 AD'
    end if
    if ( iy < 0 ) then
       iyyy=iy+1
    end if
    !
    !calculate julian day from date in gregorian calendar
    !
    if ( mm > 2 ) then
       jy=iyyy
       jm=mm+1
    else
       jy=iyyy-1
       jm=mm+13
    end if
    julday=int(365.25*jy)+int(30.6001*jm)+id+1720995
    !
    !handle julian calender
    !
    if ( id+31*(mm+12*iyyy) >= igreg ) then
       ja=int(0.01*jy)
       julday=julday+2-ja+int(0.25*ja)
    end if

  end function julday



  subroutine caldat(julian,mm,id,iyyy)
    !-----------------------------------------------------------------------
    !**** caldat
    !
    !     purpose
    !     -------
    !     calculate date from given julian day
    !
    !     parameters
    !     ----------
    !     on input : julday contains the julian day
    !     on output: mm, id, iyyy contain month, day and year
    !
    !     dependencies
    !     ------------
    !     julday0 is the reference julian day for the calculation
    !
    !     reference
    !     ---------
    !     J. Meeuws, "Astronomical formulea for calculators" 19xx
    !-----------------------------------------------------------------------
    implicit none

    ! input/output
    integer,intent(in)  :: julian
    integer,intent(out) :: mm
    integer,intent(out) :: id
    integer,intent(out) :: iyyy

    ! local
    integer,parameter   :: igreg=2299161
    integer             :: jalpha, ja, jb, jc, jd, je
    !
    ! handle gregorian and julian date
    !
    if ( julian >= igreg )then
       jalpha=int(((julian-1867216)-0.25)/36524.25)
       ja=julian+1+jalpha-int(0.25*jalpha)
    else
       ja=julian
    end if
    jb=ja+1524
    jc=int(6680.+((jb-2439870)-122.1)/365.25)
    jd=365*jc+int(0.25*jc)
    je=int((jb-jd)/30.6001)
    id=jb-jd-int(30.6001*je)
    mm=je-1
    if ( mm > 12 ) mm=mm-12
    iyyy=jc-4715
    if ( mm > 2 ) iyyy=iyyy-1
    !
    ! handle dates before 0 AD
    !
    if ( iyyy <= 0 ) iyyy=iyyy-1

  end subroutine caldat



  subroutine calc_sm( mlen, sec_day, sec_month, sec_year )
    !
    !
    !
    use dims, only : icalendo, idate

    implicit none

    ! input/output
    real,intent(out) :: sec_day     ! # seconds in day
    real,intent(out) :: sec_month   ! # seconds in current month
    real,intent(out) :: sec_year    ! # seconds in current year
    integer,intent(out),dimension(12):: mlen ! days per month (current year)

    ! start

    sec_day=86400.
    mlen(1)=31
    mlen(2)=28
    mlen(3)=31
    mlen(4)=30
    mlen(5)=31
    mlen(6)=30
    mlen(7)=31
    mlen(8)=31
    mlen(9)=30
    mlen(10)=31
    mlen(11)=30
    mlen(12)=31 ! only for regular year

    !
    ! calender option
    !
    sec_year=365.*sec_day
    if ( icalendo == 1 ) then
       mlen(:)=30
       sec_year=360.*sec_day
    end if
    if ( icalendo == 4 ) then
       mlen(2)=29
       sec_year=366.*sec_day
    end if
    if ( icalendo == 2 .and. (mod(idate(1),4) == 0) .and.   &
         (mod(idate(1),100) /= 0) .or. (mod(idate(1),400) == 0) ) then
       mlen(2)=29
       sec_year=366.*sec_day
    end if
    sec_month=sec_day*mlen(idate(2))

    !write(*,*) 'calc_sm: sec_month',sec_month

  end subroutine calc_sm



  subroutine dayl(day,daylen,jdim,lat_start,dlat)
    !
    !***  calculates daylength (hours) depending on 
    !***  latitude (phi) and day of year (day)
    !
    !     programmed by:		
    !     implemented by: fd IMAU Tue Feb 27 17:51:57 MET 1997
    !     modified by MK for zoom version may 2001

    !     purpose
    !     -------
    !     calculates daylength	
    !
    !     interface
    !     ---------
    !     call dayl(day,daylen,jdim,lat_start,dlat)
    !
    !       day          : the day of the year based on 365 days a year
    !       daylen(jdim) : length of day at jdim latitudes
    !       lat_start    : first latitude (degrees from -90 to +90) 
    !                      at the southernmost edge
    !       dlat         : increment
    !
    !     method
    !     ------
    !     none
    !
    !     external
    !     ---------
    !     none
    !
    !     reference
    !     ---------	
    !     
    !-------------------------------
    implicit none

    ! input/output
    integer,intent(in)               :: day    ! the day of the year 
    integer,intent(in)               :: jdim   ! dimension of daylen
    real,intent(out),dimension(jdim) :: daylen ! length of day at jdim lats
    real,intent(in)                  :: lat_start ! first latitude
    real,intent(in)                  :: dlat   ! latitude increment

    ! local
    real                             :: nj,dj,phi,td,a,phix,xh,pi
    integer                          :: j,idayy=365

    ! start
    pi = acos(-1.0)
    dj= dlat

    do j=1,jdim
       phix = (lat_start+(j-0.5)*dj)*pi/180.
       td = -float(mod(day+10,idayy))*2.*pi/idayy
       a = cos(td)*pi/180.*23.45
       xh = tan(a)*tan(phix)
       if ( abs(xh) <= 1. ) then
          ! CMK BUG: N-S reversal removed dec2004
          daylen(j) = 24*(1-acos(-xh)/pi)
       else
          if ( xh <= -1 ) daylen(j) = 24.0
          if ( xh >=  1 ) daylen(j) = 0.0
       end if
    end do ! j

  end subroutine dayl



  !----------------------------------------------------------------------
  ! write time stamp and msg on unit kunit
  !----------------------------------------------------------------------
  
  subroutine tstamp( kunit, itaux, msg )
  
    use GO, only : gol, goPr

    ! --- in/out -----------------------
    
    integer,          intent(in) :: kunit  ! unit to write "tstamp" to  <--- ignored
    integer(kind=8),  intent(in) :: itaux  ! "tstamp" time
    character(len=*), intent(in) :: msg    ! "tstamp" message
    
    ! --- begin ---------------------
    
    call wrtgol_tstamp( itaux, msg ); call goPr

  end subroutine tstamp
  
  
  ! ***


  subroutine wrtgol_tstamp( itaux, msg )
  
    use GO, only : gol, goPr

    ! --- in/out -----------------------
    
    integer(kind=8),  intent(in) :: itaux  ! "tstamp" time
    character(len=*), intent(in) :: msg    ! "tstamp" message
    
    ! --- local ----------------------

    integer,dimension(6) :: idatex
    character(len=24)    :: cdate
    
    ! --- begin ---------------------

    ! convert from seconds to year/month/etc:
    call tau2date(itaux,idatex)
    
    ! write in characters:
    call chardate(idatex,cdate)
    
    ! depricated ...
    !write (kunit,'(a1,a24,a1,a)') ' ',cdate,' ',msg
    
    ! display:
    write (gol,'(a24," ",a)') cdate, trim(msg)

  end subroutine wrtgol_tstamp
  
  
  ! ***


  subroutine new_valid_timestep( dtime, nread, cfl_outputstep)

    use dims, only        : nregions, tref
    
    ! --- in/out -------------------------

    integer, intent(inout)  :: dtime   ! current timestep
                                       ! to be replaced with a valid new timestep
    integer, intent(in)     :: nread   ! nread (e.g. 3hr) should be a 
                                       ! multiple of the new 'valid' timestep
                                       
    integer, intent(in)     :: cfl_outputstep   ! choose times

    ! --- begin -----------------------------

    ! loop until time is largest multiple of nread, clf_outputstep, and 2*tref
    do
      dtime = dtime-1
      if (mod(nread,dtime) == 0 .and. mod(cfl_outputstep,dtime) == 0 .and.&
          mod(dtime,maxval(2*tref(1:nregions))) == 0) exit
      if (dtime < maxval(2*tref(1:nregions))) then
        write (gol,'("no valid timestep found:")'); call goPr
        write (gol,'("  dtime (s)          : ",i8)') dtime; call goErr
        write (gol,'("  nread (s)          : ",i8)') nread; call goErr
        write (gol,'("  cfl_outputstep (s) : ",i8)') cfl_outputstep; call goErr
        write (gol,'("STOP in ",a)') 'datetime/new_valid_timestep'; call goErr; stop
      end if
    enddo

  end subroutine new_valid_timestep

  real*8 function idate2ddate ( idate )
    
    ! computes the decimal date given a calendar date
    ! 21 Oct 2011, M. Trudeau
    
    implicit none
    
    integer, dimension(6), intent(in) :: idate
    integer                           :: siy
    integer(kind=8)                   :: itau, itau_ref, itau_bgn, itau_end
    logical                           :: is_leap
    
    call date2tau((/idate(1), 1, 1, 0, 0, 0/), itau_ref)
    call date2tau(idate, itau)
    
    is_leap = (mod(idate(1), 4) == 0 .and. .not. mod(idate(1), 100) == 0) .or. (mod(idate(1), 400) == 0)
    
    if ( is_leap ) then
       siy = 31622400 
    else
       siy = 31536000
    endif
    
    idate2ddate = dble(idate(1)) + dble(itau - itau_ref) / dble(siy)
    
  end function idate2ddate

end module datetime