LCOV - code coverage report
Current view: top level - cicecore/shared - ice_calendar.F90 (source / functions) Hit Total Coverage
Test: 231018-211459:8916b9ff2c:1:quick Lines: 215 406 52.96 %
Date: 2023-10-18 15:30:36 Functions: 12 14 85.71 %

          Line data    Source code
       1             : !=======================================================================
       2             : 
       3             : ! Calendar routines for managing time
       4             : !
       5             : ! Authors: Elizabeth C. Hunke, LANL
       6             : !          Tony Craig, NCAR
       7             : !          Craig MacLachlan, UK Met Office
       8             : !
       9             : ! 2006 ECH: Removed 'w' option for history; added 'h' and histfreq_n.
      10             : !           Converted to free form source (F90).
      11             : ! 2010 CM : Fixed support for Gregorian calendar: subroutines
      12             : !           sec2time, time2sec and set_calendar added.
      13             : ! 2020 TC : Significant refactor to move away from time as prognostic
      14             : !           Note that the reference date is arbitrarily set to
      15             : !           0000-01-01-00000 and dates cannot be less than that.
      16             : !           The implementation is also limited by some integer
      17             : !           math to myear_max which is a parameter in this module.
      18             : 
      19             :       module ice_calendar
      20             : 
      21             :       use ice_kinds_mod
      22             :       use ice_communicate, only: my_task, master_task
      23             :       use ice_constants, only: c0, c1, c100, c30, c360, c365, c3600, &
      24             :           c4, c400
      25             :       use ice_domain_size, only: max_nstrm
      26             :       use ice_fileunits, only: nu_diag
      27             :       use ice_exit, only: abort_ice
      28             :       use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
      29             :       use icepack_intfc, only: icepack_query_parameters
      30             : 
      31             :       implicit none
      32             :       private
      33             : 
      34             :       ! INTERFACES
      35             : 
      36             :       public :: init_calendar     ! initialize calendar
      37             :       public :: calc_timesteps    ! initialize number of timesteps (after namelist and restart are read)
      38             :       public :: advance_timestep  ! advance model 1 timestep and update calendar
      39             :       public :: calendar ! update model internal calendar/time information
      40             :       public :: set_date_from_timesecs ! set model date from time in seconds
      41             :                                        ! (relative to init date)
      42             :                                        ! needed for binary restarts
      43             : 
      44             :       ! semi-private, only used directly by unit tester
      45             :       public :: compute_elapsed_days ! compute elapsed days since 0000-01-01
      46             :       public :: compute_days_between ! compute elapsed days between two dates
      47             :       public :: update_date          ! input date and delta date, compute new date
      48             :       public :: calendar_date2time   ! convert date to time relative to init date
      49             :       public :: calendar_time2date   ! convert time to date relative to init date
      50             :       public :: calendar_sec2hms     ! convert seconds to hour, minute, seconds
      51             :       public :: compute_calendar_data ! compute info about calendar for a given year
      52             : 
      53             :       ! private functions
      54             :       private :: set_calendar          ! sets model calendar type (noleap, etc)
      55             :       private :: compute_relative_elapsed ! compute relative elapsed years, months, days, hours
      56             : 
      57             :       ! PUBLIC
      58             : 
      59             :       character(len=*), public, parameter :: &
      60             :          ice_calendar_gregorian = 'Gregorian', &  ! calendar name, actually proleptic gregorian here   ! LCOV_EXCL_LINE
      61             :          ice_calendar_noleap    = 'NO_LEAP', &    ! 365 day per year calendar   ! LCOV_EXCL_LINE
      62             :          ice_calendar_360day    = '360day'        ! 360 day calendar with 30 days per month
      63             : 
      64             :       integer (kind=int_kind), public, parameter :: &
      65             :          months_per_year    = 12, &     ! months per year   ! LCOV_EXCL_LINE
      66             :          hours_per_day      = 24, &     ! hours per day   ! LCOV_EXCL_LINE
      67             :          minutes_per_hour   = 60, &     ! minutes per hour   ! LCOV_EXCL_LINE
      68             :          seconds_per_minute = 60        ! seconds per minute
      69             : 
      70             :       integer (kind=int_kind), public :: &
      71             :          seconds_per_day       , & ! seconds per day   ! LCOV_EXCL_LINE
      72             :          seconds_per_hour      , & ! seconds per hour   ! LCOV_EXCL_LINE
      73             :          days_per_year         , & ! number of days in one year   ! LCOV_EXCL_LINE
      74             :          daymo(months_per_year), & ! number of days in each month   ! LCOV_EXCL_LINE
      75             :          daycal(months_per_year+1) ! accumulated days in year to end of prior month
      76             : 
      77             :       integer (kind=int_kind), public :: &
      78             :          ! step counters
      79             :          istep    , & ! local step counter for current run in time loop
      80             :          istep0   , & ! counter, number of steps at start of run   ! LCOV_EXCL_LINE
      81             :          istep1   , & ! counter, number of steps at current timestep   ! LCOV_EXCL_LINE
      82             :          ! basic model time variables
      83             :          myear    , & ! year number
      84             :          mmonth   , & ! month number, 1 to months_per_year   ! LCOV_EXCL_LINE
      85             :          mday     , & ! day of the month   ! LCOV_EXCL_LINE
      86             :          msec     , & ! elapsed seconds into date   ! LCOV_EXCL_LINE
      87             :          ! initial time
      88             :          year_init, & ! initial year
      89             :          month_init,& ! initial month   ! LCOV_EXCL_LINE
      90             :          day_init, & ! initial day of month   ! LCOV_EXCL_LINE
      91             :          sec_init , & ! initial seconds   ! LCOV_EXCL_LINE
      92             :          ! other stuff
      93             :          hh_init  , & ! initial hour derived from sec_init
      94             :          mm_init  , & ! initial minute derived from sec_init   ! LCOV_EXCL_LINE
      95             :          ss_init  , & ! initial second derived from sec_init   ! LCOV_EXCL_LINE
      96             :          idate    , & ! date (yyyymmdd)   ! LCOV_EXCL_LINE
      97             :          idate0   , & ! initial date (yyyymmdd), associated with year_init, month_init, day_init   ! LCOV_EXCL_LINE
      98             :          dayyr    , & ! number of days in the current year   ! LCOV_EXCL_LINE
      99             :          npt      , & ! total number of time steps (dt)   ! LCOV_EXCL_LINE
     100             :          npt0     , & ! original npt value in npt0_unit   ! LCOV_EXCL_LINE
     101             :          ndtd = 1 , & ! number of dynamics subcycles: dt_dyn=dt/ndtd   ! LCOV_EXCL_LINE
     102             :          stop_now     , & ! if 1, end program execution   ! LCOV_EXCL_LINE
     103             :          write_restart, & ! if 1, write restart now   ! LCOV_EXCL_LINE
     104             :          diagfreq     , & ! diagnostic output frequency (10 = once per 10 dt)   ! LCOV_EXCL_LINE
     105             :          nstreams     , & ! number of history output streams   ! LCOV_EXCL_LINE
     106             :          dumpfreq_n(max_nstrm), & ! restart output frequency (10 = once per 10 d,m,y)   ! LCOV_EXCL_LINE
     107             :          histfreq_n(max_nstrm)    ! history output frequency
     108             : 
     109             :       logical (kind=log_kind), public :: &
     110             :          new_year       , & ! new year = .true.   ! LCOV_EXCL_LINE
     111             :          new_month      , & ! new month = .true.   ! LCOV_EXCL_LINE
     112             :          new_day        , & ! new day = .true.   ! LCOV_EXCL_LINE
     113             :          new_hour           ! new hour = .true.
     114             : 
     115             :       real (kind=dbl_kind), public :: &
     116             :          dt             , & ! thermodynamics timestep (s)   ! LCOV_EXCL_LINE
     117             :          dt_dyn         , & ! dynamics/transport/ridging timestep (s)   ! LCOV_EXCL_LINE
     118             :          timesecs       , & ! total elapsed time (s)   ! LCOV_EXCL_LINE
     119             :          yday           , & ! day of the year   ! LCOV_EXCL_LINE
     120             :          nextsw_cday        ! julian day of next shortwave calculation
     121             : 
     122             :       logical (kind=log_kind), public :: &
     123             :          use_leap_years , & ! use leap year functionality if true   ! LCOV_EXCL_LINE
     124             :          write_ic       , & ! write initial condition now   ! LCOV_EXCL_LINE
     125             :          dump_last      , & ! write restart file on last time step   ! LCOV_EXCL_LINE
     126             :          force_restart_now, & ! force a restart now   ! LCOV_EXCL_LINE
     127             :          write_history(max_nstrm) ! write history now
     128             : 
     129             :       character (len=2), public :: &
     130             :          npt_unit,            & ! run length unit, 'y', 'm', 'd', 'h', 's', '1'   ! LCOV_EXCL_LINE
     131             :          npt0_unit,           & ! original run length unit, 'y', 'm', 'd', 'h', 's', '1'   ! LCOV_EXCL_LINE
     132             :          histfreq(max_nstrm), & ! history output frequency, 'y','m','d','h','1','x'   ! LCOV_EXCL_LINE
     133             :          dumpfreq(max_nstrm)    ! restart frequency, 'y','m','d', h', '1', 'x' followed by optional 1
     134             : 
     135             :       character (len=char_len), public :: &
     136             :          dumpfreq_base(max_nstrm), & ! restart frequency basetime ('zero', 'init')   ! LCOV_EXCL_LINE
     137             :          histfreq_base(max_nstrm), & ! history frequency basetime ('zero', 'init')   ! LCOV_EXCL_LINE
     138             :          calendar_type               ! define calendar type
     139             :       data dumpfreq_base / 'init', 'init', 'init', 'init', 'init' /
     140             :       data histfreq_base / 'zero', 'zero', 'zero', 'zero', 'zero' /
     141             : 
     142             :       ! PRIVATE
     143             : 
     144             :       integer (kind=int_kind) :: &
     145             :          hour         ! hour of the day
     146             : 
     147             :       integer (kind=int_kind), parameter :: &
     148             :          myear_max = 200000           ! maximum year, limited by integer overflow in elapsed_hours
     149             : 
     150             :       ! 360-day year data
     151             :       integer (kind=int_kind) :: &
     152             :          daymo360(months_per_year)    ! number of days in each month
     153             :       data daymo360 /   30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30/
     154             : 
     155             :       ! 365-day year data
     156             :       integer (kind=int_kind) :: &
     157             :          daymo365(months_per_year)    ! number of days in each month
     158             :       data daymo365 /   31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
     159             : 
     160             :       ! 366-day year data (leap year)
     161             :       integer (kind=int_kind) :: &
     162             :          daymo366(months_per_year)    ! number of days in each month
     163             :       data daymo366 /   31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
     164             : 
     165             : 
     166             : !=======================================================================
     167             : 
     168             :       contains
     169             : 
     170             : !=======================================================================
     171             : ! Initialize calendar variables
     172             : 
     173          37 :       subroutine init_calendar
     174             : 
     175           8 :       real    (kind=dbl_kind) :: secday           ! seconds per day
     176             : 
     177             :       character(len=*),parameter :: subname='(init_calendar)'
     178             : 
     179          37 :       call icepack_query_parameters(secday_out=secday)
     180          37 :       call icepack_warnings_flush(nu_diag)
     181          37 :       if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
     182           0 :          file=__FILE__, line=__LINE__)
     183             : 
     184          37 :       seconds_per_day = nint(secday)
     185          37 :       if ((abs(real(seconds_per_day,kind=dbl_kind)/secday)-1.0_dbl_kind) > 1.0e-7) then
     186           0 :          write(nu_diag,*) trim(subname),' ERROR secday should basically be an integer',secday
     187           0 :          call abort_ice(subname//'ERROR: improper secday')
     188             :       endif
     189          37 :       seconds_per_hour = nint(secday/real(hours_per_day,kind=dbl_kind))
     190          37 :       if (abs(seconds_per_hour*hours_per_day - seconds_per_day) > 0) then
     191           0 :          write(nu_diag,*) trim(subname),' ERROR seconds per day and hours per day inconsistent'
     192           0 :          call abort_ice(subname//'ERROR: improper seconds_per_hour')
     193             :       endif
     194             : 
     195          37 :       istep = 0         ! local timestep number
     196          37 :       myear=year_init   ! year
     197          37 :       mmonth=month_init ! month
     198          37 :       mday=day_init     ! day of the month
     199          37 :       msec=sec_init     ! seconds into date
     200          37 :       call calendar_sec2hms(sec_init,hh_init,mm_init,ss_init)  ! initialize hh,mm,ss _init
     201          37 :       hour=0            ! computed in calendar, but needs some reasonable initial value
     202          37 :       istep1 = istep0   ! number of steps at current timestep
     203             :                         ! real (dumped) or imagined (use to set calendar)
     204          37 :       idate0 = (myear)*10000 + mmonth*100 + mday ! date (yyyymmdd)
     205          37 :       stop_now = 0      ! end program execution if stop_now=1
     206          37 :       dt_dyn = dt/real(ndtd,kind=dbl_kind) ! dynamics et al timestep
     207          37 :       force_restart_now = .false.
     208             : 
     209             :       ! initialize nstreams to zero (will be initialized from namelist in 'init_hist')
     210             :       ! this avoids using it uninitialzed in 'calendar' below
     211          37 :       nstreams = 0
     212             : 
     213             : #ifdef CESMCOUPLED
     214             :       ! calendar_type set by coupling
     215             : #else
     216          37 :       calendar_type = ''
     217          37 :       if (use_leap_years) then
     218          37 :          if (days_per_year == 365) then
     219          37 :             calendar_type = trim(ice_calendar_gregorian)
     220             :          else
     221           0 :             call abort_ice(subname//'ERROR: use_leap_years is true, must set days_per_year to 365')
     222             :          endif
     223             :       else
     224           0 :          if (days_per_year == 365) then
     225           0 :             calendar_type = trim(ice_calendar_noleap)
     226           0 :          elseif (days_per_year == 360) then
     227           0 :             calendar_type = trim(ice_calendar_360day)
     228             :          else
     229           0 :             call abort_ice(subname//'ERROR: days_per_year only 365 or 360 supported')
     230             :          endif
     231             :       endif
     232             : #endif
     233             : 
     234          37 :       call set_calendar(myear)
     235          37 :       call calendar()
     236             : 
     237          37 :       end subroutine init_calendar
     238             : 
     239             : !=======================================================================
     240             : ! Initialize timestep counter
     241             : ! This converts npt_unit and npt to a number of timesteps stored in npt
     242             : ! npt0 and npt0_unit remember the original values
     243             : ! It is safe to call this more than once, but it should be called only after
     244             : ! the initial model run date is known (from namelist or restart) and before
     245             : ! the first timestep
     246             : 
     247          37 :       subroutine calc_timesteps
     248             : 
     249           8 :       real    (kind=dbl_kind) :: secday           ! seconds per day
     250           8 :       real    (kind=dbl_kind) :: dtimesecs        ! time in seconds of run
     251             :       integer (kind=int_kind) :: yeare,monthe,daye,sece  ! time at end of run
     252             :       character(len=*),parameter :: subname='(calc_timesteps)'
     253             : 
     254          37 :       call icepack_query_parameters(secday_out=secday)
     255          37 :       call icepack_warnings_flush(nu_diag)
     256          37 :       if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
     257           0 :          file=__FILE__, line=__LINE__)
     258             : 
     259          37 :       yeare = myear
     260          37 :       monthe = mmonth
     261          37 :       daye = mday
     262          37 :       sece = msec
     263          37 :       npt0 = npt
     264          37 :       npt0_unit = npt_unit
     265             : 
     266          37 :       if (npt_unit == 'y') then
     267           0 :          call update_date(yeare,monthe,daye,sece,dyear=npt)
     268           0 :          call calendar_date2time(yeare,monthe,daye,sece,dtimesecs,myear,mmonth,mday,msec)
     269          37 :       elseif (npt_unit == 'm') then
     270           0 :          call update_date(yeare,monthe,daye,sece,dmon=npt)
     271           0 :          call calendar_date2time(yeare,monthe,daye,sece,dtimesecs,myear,mmonth,mday,msec)
     272          37 :       elseif (npt_unit == 'd') then
     273          37 :          dtimesecs = real(npt,kind=dbl_kind)*secday
     274          37 :          call update_date(yeare,monthe,daye,sece,dday=npt)
     275           0 :       elseif (npt_unit == 'h') then
     276           0 :          dtimesecs = real(npt,kind=dbl_kind)*secday/real(hours_per_day,kind=dbl_kind)
     277           0 :          call update_date(yeare,monthe,daye,sece,dsec=nint(dtimesecs))
     278           0 :       elseif (npt_unit == 's') then
     279           0 :          call update_date(yeare,monthe,daye,sece,dsec=npt)
     280           0 :          dtimesecs = real(npt,kind=dbl_kind)
     281           0 :       elseif (npt_unit == '1') then
     282           0 :          dtimesecs = dt*real(npt,kind=dbl_kind)
     283           0 :          call update_date(yeare,monthe,daye,sece,dsec=nint(dtimesecs))
     284             :       else
     285           0 :          write(nu_diag,*) trim(subname),' ERROR invalid npt_unit = ',trim(npt_unit)
     286           0 :          call abort_ice(subname//'ERROR: invalid npt_unit')
     287             :       endif
     288             : 
     289          37 :       npt = nint(dtimesecs/dt)
     290          37 :       npt_unit = '1'
     291             : 
     292          37 :       if (my_task == master_task) then
     293           7 :          write(nu_diag,*) ' '
     294           7 :          write(nu_diag,'(1x,2a,i9,a,f13.2)') subname,' modified npt from ',npt0,' '//trim(npt0_unit)//' with dt= ',dt
     295           7 :          write(nu_diag,'(1x,2a,i9,a,f13.2)') subname,'                to ',npt ,' '//trim(npt_unit )//' with dt= ',dt
     296           7 :          write(nu_diag,'(1x,2a,i6.4,a,i2.2,a,i2.2,a,i5.5)') subname,' start time is',myear,'-',mmonth,'-',mday,':',msec
     297           7 :          write(nu_diag,'(1x,2a,i6.4,a,i2.2,a,i2.2,a,i5.5)') subname,'   end time is',yeare,'-',monthe,'-',daye,':',sece
     298           7 :          write(nu_diag,*) ' '
     299             :       endif
     300             : 
     301             :       ! check that npt is very close to an integer
     302          37 :       if ((abs(real(npt,kind=dbl_kind)*dt/dtimesecs)-1.0_dbl_kind) > 1.0e-7) then
     303           0 :          write(nu_diag,*) trim(subname),' ERROR dt and npt not consistent',npt,dt
     304           0 :          call abort_ice(subname//'ERROR: improper npt')
     305             :       endif
     306             : 
     307          37 :       end subroutine calc_timesteps
     308             : 
     309             : !=======================================================================
     310             : ! Determine the date at the end of the time step
     311             : 
     312        5821 :       subroutine advance_timestep()
     313             : 
     314             :       ! local variables
     315             : 
     316             :       integer(kind=int_kind) :: &
     317             :          idt       ! integer dt
     318             :       character(len=*),parameter :: subname='(advance_timestep)'
     319             : 
     320        5821 :       if (trim(npt_unit) /= '1') then
     321           0 :          write(nu_diag,*) trim(subname),' ERROR npt_unit should be converted to timesteps by now ',trim(npt_unit)
     322           0 :          write(nu_diag,*) trim(subname),' ERROR you may need to call calc_timesteps to convert from other units'
     323           0 :          call abort_ice(subname//'ERROR: npt_unit incorrect')
     324             :       endif
     325             : 
     326        5821 :       istep = istep + 1
     327        5821 :       istep1 = istep1 + 1
     328        5821 :       idt = nint(dt)
     329             :       ! dt is historically a real but it should be an integer
     330             :       ! make sure dt is very close to an integer
     331        5821 :       if ((abs(real(idt,kind=dbl_kind)/dt)-1.0_dbl_kind) > 1.0e-7) then
     332           0 :          write(nu_diag,*) trim(subname),' ERROR dt error, needs to be integer number of seconds, dt=',dt
     333           0 :          call abort_ice(subname//'ERROR: improper dt')
     334             :       endif
     335        5821 :       msec = msec + idt
     336        5821 :       call calendar()
     337             : 
     338        5821 :       end subroutine advance_timestep
     339             : 
     340             : !=======================================================================
     341             : ! Update the calendar and time manager info
     342             : 
     343        5899 :       subroutine calendar()
     344             : 
     345             : ! This sets a bunch of internal calendar stuff including history and
     346             : ! restart frequencies.  These frequencies are relative to the start
     347             : ! of time which is arbitrarily set to year=0, month=1, day=1, sec=0
     348             : ! or to the model init time (year_init, month_init, day_init) depending
     349             : ! on histfreq_base or dumpfreq_base settings.
     350             : ! Using 'zero' means that the frequencies are repeatable between runs
     351             : ! regardless of the initial model date.
     352             : ! One thing to watch for is the size of elapsed hours.  This will
     353             : ! become a large integer and will overflow if the year is ever
     354             : ! greater than about 200,000 years.  A check has been added just
     355             : ! to make sure this doesn't happen.
     356             : ! The largest integer*4 is about 2^31 = 2*2^10^3 =~ 2*1000^3 = 2.e9
     357             : ! 2.e9 (hours) / (365*24 hours/year) =~ 228,000 years
     358             : ! The elapsed hours will overflow integers at some point after that.
     359             : 
     360             : 
     361             : !      real (kind=dbl_kind), intent(in), optional :: &
     362             : !         ttime                          ! time variable
     363             : 
     364             :       ! local variables
     365             : 
     366             :       integer (kind=int_kind) :: &
     367             :          ns                         , & ! loop index   ! LCOV_EXCL_LINE
     368             :          yearp,monthp,dayp,hourp    , & ! previous year, month, day, hour   ! LCOV_EXCL_LINE
     369             :          elapsed_years              , & ! relative elapsed years   ! LCOV_EXCL_LINE
     370             :          elapsed_months             , & ! relative elapsed months   ! LCOV_EXCL_LINE
     371             :          elapsed_days               , & ! relative elapsed days   ! LCOV_EXCL_LINE
     372             :          elapsed_hours                  ! relative elapsed hours
     373             :       character(len=*),parameter :: subname='(calendar)'
     374             : 
     375        5899 :       yearp=myear
     376        5899 :       monthp=mmonth
     377        5899 :       dayp=mday
     378        5899 :       hourp=hour
     379        5899 :       new_year=.false.
     380        5899 :       new_month=.false.
     381        5899 :       new_day=.false.
     382        5899 :       new_hour=.false.
     383        5899 :       write_history(:)=.false.
     384        5899 :       write_restart=0
     385             : 
     386        5899 :       call update_date(myear,mmonth,mday,msec)
     387        5899 :       call set_calendar(myear)
     388             : 
     389        5899 :       if (myear > myear_max) then
     390           0 :          write(nu_diag,*) trim(subname),' ERROR year too large, ',myear,myear_max
     391           0 :          call abort_ice(subname//'ERROR: model year too large')
     392             :       endif
     393             : 
     394        5899 :       idate = (myear)*10000 + mmonth*100 + mday ! date (yyyymmdd)
     395        5899 :       yday = daycal(mmonth) + mday            ! day of the year
     396        5899 :       hour = int(msec/seconds_per_hour)
     397             : 
     398        5899 :       call calendar_date2time(myear,mmonth,mday,msec,timesecs)
     399             : 
     400             :       !--- compute other stuff
     401             : 
     402             : #ifndef CESMCOUPLED
     403        5899 :       if (istep >= npt+1)  stop_now = 1
     404        5899 :       if (istep == npt .and. dump_last) write_restart = 1 ! last timestep
     405             : #endif
     406        5899 :       if (myear  /= yearp)  new_year = .true.
     407        5899 :       if (mmonth /= monthp) new_month = .true.
     408        5899 :       if (mday   /= dayp)   new_day = .true.
     409        5899 :       if (hour   /= hourp)  new_hour = .true.
     410             : 
     411             :       ! History writing flags
     412             : 
     413       11761 :       do ns = 1, nstreams
     414             : 
     415        5862 :          call compute_relative_elapsed(histfreq_base(ns), elapsed_years, elapsed_months, elapsed_days, elapsed_hours)
     416             : 
     417       11761 :          select case (histfreq(ns))
     418             :          case ("y", "Y")
     419           0 :             if (new_year  .and. histfreq_n(ns)/=0) then
     420           0 :                if (mod(elapsed_years, histfreq_n(ns))==0) &
     421           0 :                    write_history(ns) = .true.
     422             :             endif
     423             :          case ("m", "M")
     424        4372 :             if (new_month .and. histfreq_n(ns)/=0) then
     425           0 :                if (mod(elapsed_months,histfreq_n(ns))==0) &
     426           0 :                    write_history(ns) = .true.
     427             :             endif
     428             :          case ("d", "D")
     429        1490 :             if (new_day  .and. histfreq_n(ns)/=0) then
     430          61 :                if (mod(elapsed_days,histfreq_n(ns))==0) &
     431          61 :                    write_history(ns) = .true.
     432             :             endif
     433             :          case ("h", "H")
     434           0 :             if (new_hour  .and. histfreq_n(ns)/=0) then
     435           0 :                if (mod(elapsed_hours,histfreq_n(ns))==0) &
     436           0 :                    write_history(ns) = .true.
     437             :             endif
     438             :          case ("1")
     439        5862 :             if (histfreq_n(ns)/=0) then
     440           0 :                if (mod(istep1, histfreq_n(ns))==0) &
     441           0 :                   write_history(ns)=.true.
     442             :             endif
     443             :          end select
     444             : 
     445             :       enddo
     446             : 
     447             :       ! Restart writing flag, set dumpfreq to 'x" if stream is written once
     448             : 
     449       35394 :       do ns = 1, max_nstrm
     450             : 
     451       29495 :          call compute_relative_elapsed(dumpfreq_base(ns), elapsed_years, elapsed_months, elapsed_days, elapsed_hours)
     452             : 
     453       35394 :          select case (dumpfreq(ns)(1:1))
     454             :          case ("y", "Y")
     455           0 :             if (new_year  .and. mod(elapsed_years, dumpfreq_n(ns))==0) then
     456           0 :                write_restart = 1
     457           0 :                if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x'
     458             :             endif
     459             :          case ("m", "M")
     460           0 :             if (new_month .and. mod(elapsed_months,dumpfreq_n(ns))==0) then
     461           0 :                write_restart = 1
     462           0 :                if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x'
     463             :             endif
     464             :          case ("d", "D")
     465        5899 :             if (new_day   .and. mod(elapsed_days,  dumpfreq_n(ns))==0) then
     466          49 :                write_restart = 1
     467          49 :                if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x'
     468             :             endif
     469             :          case ("h", "H")
     470           0 :             if (new_hour  .and. mod(elapsed_hours, dumpfreq_n(ns))==0) then
     471           0 :                write_restart = 1
     472           0 :                if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x'
     473             :             endif
     474             :          case ("1")
     475       29495 :             if (mod(istep1, dumpfreq_n(ns))==0) then
     476           0 :                write_restart = 1
     477           0 :                if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x'
     478             :             endif
     479             :          end select
     480             :       enddo
     481             : 
     482        5899 :       if (force_restart_now) write_restart = 1
     483             : 
     484             :       if (my_task == master_task .and. mod(istep1,diagfreq) == 0 &
     485        5899 :                                  .and. stop_now /= 1) then
     486         999 :         write(nu_diag,*) ' '
     487             :         write(nu_diag,'(a7,i10,4x,a6,i10,4x,a4,i10)') &
     488         999 :              'istep1:', istep1, 'idate:', idate, 'sec:', msec
     489             :       endif
     490             : 
     491        5899 :       end subroutine calendar
     492             : 
     493             : !=======================================================================
     494             : ! Set the model calendar data for year
     495             : 
     496        5936 :       subroutine set_calendar(year)
     497             : 
     498             :       integer (kind=int_kind), intent(in) :: year   ! current year
     499             : 
     500             :       ! Internal variable
     501             :       character(len=*),parameter :: subname='(set_calendar)'
     502             : 
     503        5936 :       call compute_calendar_data(year,daymo,daycal,dayyr)
     504             : 
     505        5936 :       end subroutine set_calendar
     506             : 
     507             : !=======================================================================
     508             : ! Add and reconcile date
     509             : ! delta time arguments are optional
     510             : 
     511        5936 :       subroutine update_date(ayear,amon,aday,asec,dyear,dmon,dday,dsec)
     512             : 
     513             :       integer (kind=int_kind), intent(inout) :: ayear, amon, aday, asec  ! year, month, day, sec
     514             :       integer (kind=int_kind), intent(in), optional :: dyear, dmon, dday, dsec  ! delta year, month, day, sec
     515             : 
     516             :       ! local variables
     517             :       integer (kind=int_kind) :: tdaymo (months_per_year)   ! days per month
     518             :       integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month
     519             :       integer (kind=int_kind) :: tdayyr                     ! days in year
     520        1476 :       real    (kind=dbl_kind) :: secday ! seconds per day
     521             :       integer (kind=int_kind) :: isecday  ! seconds per day
     522             :       integer (kind=int_kind) :: delta
     523             :       character(len=*),parameter :: subname='(update_date)'
     524             : 
     525        5936 :       call icepack_query_parameters(secday_out=secday)
     526        5936 :       call icepack_warnings_flush(nu_diag)
     527        5936 :       if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
     528           0 :          file=__FILE__, line=__LINE__)
     529        5936 :       isecday = nint(secday)
     530             : 
     531             :       ! order matters.  think about adding 1 month and 10 days to the 25th of a month
     532             :       ! what is the right order?
     533             :       ! will add all deltas then reconcile years then months then days then seconds
     534             : 
     535        5936 :       if (present(dyear)) ayear = ayear + dyear
     536        5936 :       if (present(dmon)) amon = amon + dmon
     537        5936 :       if (present(dday)) aday = aday + dday
     538        5936 :       if (present(dsec)) asec = asec + dsec
     539             : 
     540             :       ! adjust negative data first
     541             :       ! reconcile months - years
     542        5936 :       do while (amon <= 0)
     543           0 :          delta = int((abs(amon))/months_per_year) + 1
     544           0 :          ayear = ayear - delta
     545           0 :          amon = amon + delta*months_per_year
     546             :       enddo
     547        5936 :       call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr)
     548             : 
     549             :       ! reconcile days - months - years
     550        5936 :       do while (aday <= 0)
     551           0 :          amon = amon - 1
     552           0 :          do while (amon <= 0)
     553           0 :             delta = int((abs(amon))/months_per_year) + 1
     554           0 :             ayear = ayear - delta
     555           0 :             amon = amon + delta*months_per_year
     556           0 :             call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr)
     557             :          enddo
     558           0 :          aday = aday + tdaymo(amon)
     559             :       enddo
     560             : 
     561             :       ! reconcile seconds - days - months - years
     562        5936 :       if (asec < 0) then
     563           0 :          delta = int(abs(asec)/isecday) + 1
     564           0 :          aday = aday - delta
     565           0 :          asec = asec + delta*isecday
     566             :       endif
     567        5936 :       do while (aday <= 0)
     568           0 :          amon = amon - 1
     569           0 :          do while (amon <= 0)
     570           0 :             delta = int((abs(amon))/months_per_year) + 1
     571           0 :             ayear = ayear - delta
     572           0 :             amon = amon + delta*months_per_year
     573           0 :             call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr)
     574             :          enddo
     575           0 :          aday = aday + tdaymo(amon)
     576             :       enddo
     577             : 
     578             :       ! check for negative data
     579        5936 :       if (ayear < 0 .or. amon <= 0 .or. aday <= 0 .or. asec < 0) then
     580           0 :          write(nu_diag,*) trim(subname),' ERROR in dateA, ',ayear,amon,aday,asec
     581           0 :          call abort_ice(subname//'ERROR: in date')
     582             :       endif
     583             : 
     584             :       ! reconcile months - years
     585        5936 :       do while (amon > months_per_year)
     586           0 :          delta = int((amon-1)/months_per_year)
     587           0 :          ayear = ayear + delta
     588           0 :          amon = amon - delta*months_per_year
     589             :       enddo
     590        5936 :       call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr)
     591             : 
     592             :       ! reconcile days - months - years
     593        5936 :       do while (aday > tdaymo(amon))
     594           0 :          aday = aday - tdaymo(amon)
     595           0 :          amon = amon + 1
     596           0 :          do while (amon > months_per_year)
     597           0 :             delta = int((amon-1)/months_per_year)
     598           0 :             ayear = ayear + delta
     599           0 :             amon = amon - delta*months_per_year
     600           0 :             call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr)
     601             :          enddo
     602             :       enddo
     603             : 
     604             :       ! reconcile seconds - days - months - years
     605        5936 :       if (asec >= isecday) then
     606         241 :          delta = int(asec/isecday)
     607         241 :          aday = aday + delta
     608         241 :          asec = asec - delta*isecday
     609             :       endif
     610        5936 :       do while (aday > tdaymo(amon))
     611           0 :          aday = aday - tdaymo(amon)
     612           0 :          amon = amon + 1
     613           0 :          do while (amon > months_per_year)
     614           0 :             delta = int((amon-1)/months_per_year)
     615           0 :             ayear = ayear + delta
     616           0 :             amon = amon - delta*months_per_year
     617           0 :             call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr)
     618             :          enddo
     619             :       enddo
     620             : 
     621             :       ! check for negative data, just in case
     622        5936 :       if (ayear < 0 .or. amon <= 0 .or. aday <= 0 .or. asec < 0) then
     623           0 :          write(nu_diag,*) trim(subname),' ERROR in dateB, ',ayear,amon,aday,asec
     624           0 :          call abort_ice(subname//'ERROR: in date')
     625             :       endif
     626             : 
     627        5936 :       end subroutine update_date
     628             : 
     629             : !=======================================================================
     630             : 
     631             : ! Set internal calendar date from timesecs input
     632             : ! Needed for binary restarts where only timesecs is on the restart file
     633             : 
     634           0 :       subroutine set_date_from_timesecs(ttimesecs)
     635             : 
     636             :       real (kind=dbl_kind), intent(in) :: ttimesecs   ! seconds since init date
     637             : 
     638             :       ! Internal variable
     639             :       character(len=*),parameter :: subname='(set_date_from_timesecs)'
     640             : 
     641           0 :       timesecs = ttimesecs
     642           0 :       call calendar_time2date(ttimesecs,myear,mmonth,mday,msec,year_init,month_init,day_init,sec_init)
     643             : 
     644           0 :       end subroutine set_date_from_timesecs
     645             : 
     646             : !=======================================================================
     647             : ! Compute elapsed days from year0,month0,day0 to year1,month1,day1
     648             : ! Same day results in 0 elapsed days
     649             : 
     650       41256 :       integer function compute_days_between(year0,month0,day0,year1,month1,day1)
     651             : 
     652             :       integer (kind=int_kind), intent(in) :: year0   ! start year
     653             :       integer (kind=int_kind), intent(in) :: month0  ! start month
     654             :       integer (kind=int_kind), intent(in) :: day0    ! start day
     655             :       integer (kind=int_kind), intent(in) :: year1   ! end year
     656             :       integer (kind=int_kind), intent(in) :: month1  ! end month
     657             :       integer (kind=int_kind), intent(in) :: day1    ! end day
     658             : 
     659             :       ! Internal variable
     660             :       integer (kind=int_kind) :: nday0, nday1
     661             :       character(len=*),parameter :: subname='(compute_days_between)'
     662             : 
     663       41256 :       nday0 = compute_elapsed_days(year0,month0,day0)
     664       41256 :       nday1 = compute_elapsed_days(year1,month1,day1)
     665             : 
     666       41256 :       compute_days_between = nday1 - nday0
     667             : 
     668       41256 :       end function compute_days_between
     669             : 
     670             : !=======================================================================
     671             : ! compute calendar data based on year
     672             : 
     673      100320 :       subroutine compute_calendar_data(ayear,adaymo,adaycal,adayyr)
     674             : 
     675             :       integer (kind=int_kind), intent(in)  :: ayear   ! year
     676             :       integer (kind=int_kind), intent(out) :: adaymo(:)  ! days per month
     677             :       integer (kind=int_kind), intent(out) :: adaycal(:) ! day count per month
     678             :       integer (kind=int_kind), intent(out) :: adayyr  ! days per year
     679             : 
     680             :       ! Internal variable
     681             :       logical (kind=log_kind) :: isleap   ! Leap year logical
     682             :       integer (kind=int_kind) :: n
     683             :       character(len=*),parameter :: subname='(compute_calendar_data)'
     684             : 
     685      100320 :       if (ayear < 0) then
     686           0 :          write(nu_diag,*) trim(subname),' ERROR in ayear = ',ayear
     687           0 :          call abort_ice(subname//'ERROR: in ayear')
     688             :       endif
     689             : 
     690      125284 :       if (size(adaymo)  /= months_per_year .or. &
     691       24964 :           size(adaycal) /= months_per_year+1 ) then
     692           0 :          call abort_ice(subname//'ERROR: in argument sizes')
     693             :       endif
     694             : 
     695      100320 :       if (trim(calendar_type) == trim(ice_calendar_gregorian)) then
     696             : 
     697      100320 :          isleap = .false. ! not a leap year
     698      100320 :          if (mod(ayear,  4) == 0) isleap = .true.
     699      100320 :          if (mod(ayear,100) == 0) isleap = .false.
     700      100320 :          if (mod(ayear,400) == 0) isleap = .true.
     701             : 
     702      100320 :          if (isleap) then
     703       76206 :             adaymo = daymo366
     704             :          else
     705     1227954 :             adaymo = daymo365
     706             :          endif
     707             : 
     708           0 :       elseif (trim(calendar_type) == trim(ice_calendar_360day)) then
     709           0 :          adaymo = daymo360
     710             :       else
     711           0 :          adaymo = daymo365
     712             :       endif
     713             : 
     714      100320 :       adaycal(1) = 0
     715     1304160 :       do n = 1, months_per_year
     716     1304160 :          adaycal(n+1) = adaycal(n) + adaymo(n)
     717             :       enddo
     718      100320 :       adayyr=adaycal(months_per_year+1)
     719             : 
     720      100320 :       end subroutine compute_calendar_data
     721             : 
     722             : !=======================================================================
     723             : ! Compute elapsed days from 0000-01-01 to year1,month1,day1
     724             : ! 0000-01-01 is 0 elapsed days
     725             : 
     726       82512 :       integer function compute_elapsed_days(ayear,amonth,aday)
     727             : 
     728             :       integer (kind=int_kind), intent(in) :: ayear   ! year
     729             :       integer (kind=int_kind), intent(in) :: amonth  ! month
     730             :       integer (kind=int_kind), intent(in) :: aday    ! day
     731             : 
     732             :       ! Internal variable
     733             :       integer (kind=int_kind) :: ced_nday, n
     734             :       integer (kind=int_kind) :: lyear,lmonth,lday,lsec
     735             :       integer (kind=int_kind) :: tdaymo (months_per_year)   ! days per month
     736             :       integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month
     737             :       integer (kind=int_kind) :: tdayyr                     ! days in year
     738             :       character(len=*),parameter :: subname='(compute_elapsed_days)'
     739             : 
     740             :       ! use 0000-01-01 as base, year 0 is a leap year
     741             :       ! this must be implemented consistent with set_calendar
     742             : 
     743       82512 :       lyear = ayear
     744       82512 :       lmonth = amonth
     745       82512 :       lday = aday
     746       82512 :       lsec = 0
     747             : 
     748       82512 :       if (lyear < 0 .or. lmonth <= 0 .or. lday <= 0) then
     749           0 :          write(nu_diag,*) trim(subname),' ERROR for year,month,day = ',lyear,lmonth,lday
     750           0 :          call abort_ice(subname//'ERROR: illegal date')
     751       82512 :       elseif (lmonth > months_per_year) then
     752           0 :          call update_date(lyear,lmonth,lday,lsec)
     753             :       endif
     754             : 
     755             :       ! compute days from year 0000-01-01 to year-01-01
     756             :       ! don't loop thru years for performance reasons
     757       82512 :       if (trim(calendar_type) == trim(ice_calendar_gregorian)) then
     758       82512 :          if (lyear == 0) then
     759        5862 :             ced_nday = 0
     760             :          else
     761       76650 :             ced_nday = lyear * 365 + 1 + (lyear-1)/4 - (lyear-1)/100 + (lyear-1)/400
     762             :          endif
     763             :       else
     764           0 :          ced_nday = lyear * daycal(months_per_year+1)
     765             :       endif
     766             : 
     767             :       ! now compute days in this year
     768       82512 :       call compute_calendar_data(lyear,tdaymo,tdaycal,tdayyr)
     769             : 
     770       82512 :       do n = 1, lmonth-1
     771       82512 :          ced_nday = ced_nday + tdaymo(n)
     772             :       enddo
     773             : 
     774       82512 :       if (lday <= tdaymo(lmonth)) then
     775       82512 :          ced_nday = ced_nday + lday - 1
     776             :       else
     777           0 :          write(nu_diag,*) trim(subname),' ERROR for year,month,day = ',ayear,amonth,aday
     778           0 :          call abort_ice(subname//'ERROR: illegal day in month')
     779             :       endif
     780             : 
     781       82512 :       compute_elapsed_days = ced_nday
     782             : 
     783       82512 :       end function compute_elapsed_days
     784             : 
     785             : !=======================================================================
     786             : ! Compute time in seconds from input calendar date
     787             : ! relative to year_init, month_init, day_init, sec_init unless _ref values passed in
     788             : ! For santity, must pass all four ref values or none
     789             : 
     790        5899 :       subroutine calendar_date2time(ayear,amon,aday,asec,atimesecs,year_ref,mon_ref,day_ref,sec_ref)
     791             : 
     792             :       integer(kind=int_kind), intent(in)  :: &
     793             :         ayear,amon,aday,asec                              ! year, month, day, sec of ttimesecs
     794             :       real   (kind=dbl_kind), intent(out) :: atimesecs   ! seconds since init date
     795             :       integer(kind=int_kind), intent(in), optional  :: &
     796             :         year_ref,mon_ref,day_ref,sec_ref                  ! year, month, day, sec reference time
     797             : 
     798             :       ! Internal variable
     799        1468 :       real    (kind=dbl_kind) :: secday
     800             :       integer (kind=int_kind) :: elapsed_days ! since beginning this run
     801             :       integer (kind=int_kind) :: lyear_ref,lmon_ref,lday_ref,lsec_ref  ! local reference year, month, day, sec
     802             :       integer (kind=int_kind) :: cnt
     803             :       character(len=*),parameter :: subname='(calendar_date2time)'
     804             : 
     805             :       ! set reference date and check that 0 or 4 optional arguments are passed
     806        5899 :       cnt = 0
     807        5899 :       if (present(year_ref)) then
     808           0 :          lyear_ref = year_ref
     809           0 :          cnt = cnt + 1
     810             :       else
     811        5899 :          lyear_ref = year_init
     812             :       endif
     813        5899 :       if (present(mon_ref)) then
     814           0 :          lmon_ref = mon_ref
     815           0 :          cnt = cnt + 1
     816             :       else
     817        5899 :          lmon_ref = month_init
     818             :       endif
     819        5899 :       if (present(day_ref)) then
     820           0 :          lday_ref = day_ref
     821           0 :          cnt = cnt + 1
     822             :       else
     823        5899 :          lday_ref = day_init
     824             :       endif
     825        5899 :       if (present(sec_ref)) then
     826           0 :          lsec_ref = sec_ref
     827           0 :          cnt = cnt + 1
     828             :       else
     829        5899 :          lsec_ref = sec_init
     830             :       endif
     831        5899 :       if (cnt /= 0 .and. cnt /= 4) then
     832           0 :          write(nu_diag,*) trim(subname),' ERROR in ref args, must pass 0 or 4 '
     833           0 :          call abort_ice(subname//'ERROR: in ref args, must pass 0 or 4')
     834             :       endif
     835             : 
     836        5899 :       call icepack_query_parameters(secday_out=secday)
     837        5899 :       call icepack_warnings_flush(nu_diag)
     838        5899 :       if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
     839           0 :          file=__FILE__, line=__LINE__)
     840             : 
     841        5899 :       elapsed_days = compute_days_between(lyear_ref,lmon_ref,lday_ref,ayear,amon,aday)
     842             :       atimesecs = real(elapsed_days,kind=dbl_kind)*secday + &
     843        5899 :                   real(asec,kind=dbl_kind) - real(lsec_ref,kind=dbl_kind)
     844             : 
     845        5899 :       end subroutine calendar_date2time
     846             : 
     847             : !=======================================================================
     848             : ! Compute calendar date from input time in seconds
     849             : ! relative to year_init, month_init, day_init, sec_init or ref data if passed.
     850             : ! For sanity, require all four or no ref values.
     851             : ! Implemented to minimize accumulating errors and avoid overflows
     852             : ! and perform well.
     853             : 
     854           0 :       subroutine calendar_time2date(atimesecs,ayear,amon,aday,asec,year_ref,mon_ref,day_ref,sec_ref)
     855             : 
     856             :       real   (kind=dbl_kind), intent(in)  :: atimesecs            ! seconds since init date
     857             :       integer(kind=int_kind), intent(out) :: &
     858             :         ayear,amon,aday,asec              ! year, month, day, sec of timesecs
     859             :       integer(kind=int_kind), intent(in), optional  :: &
     860             :         year_ref,mon_ref,day_ref,sec_ref  ! year, month, day, sec reference time
     861             : 
     862             :       ! Internal variable
     863             :       integer (kind=int_kind) :: ndays
     864             :       integer (kind=int_kind) :: tyear, tmon, tday, tsec     ! temporaries
     865             :       integer (kind=int_kind) :: tdaymo (months_per_year)   ! days per month
     866             :       integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month
     867             :       integer (kind=int_kind) :: tdayyr                     ! days in year
     868           0 :       real (kind=dbl_kind) :: secday, rdays, ltimesecs
     869             :       integer (kind=int_kind) :: lyear_ref,lmon_ref,lday_ref,lsec_ref  ! local reference year, month, day, sec
     870             :       integer (kind=int_kind) :: cnt
     871             :       character(len=*),parameter :: subname='(calendar_time2date)'
     872             : 
     873           0 :       call icepack_query_parameters(secday_out=secday)
     874           0 :       call icepack_warnings_flush(nu_diag)
     875           0 :       if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
     876           0 :          file=__FILE__, line=__LINE__)
     877             : 
     878             :       ! we could allow negative atimesecs, but this shouldn't be needed
     879           0 :       if (atimesecs < 0._dbl_kind) then
     880           0 :          write(nu_diag,*) trim(subname),' ERROR in atimesecs ',atimesecs
     881           0 :          call abort_ice(subname//'ERROR: in atimesecs')
     882             :       endif
     883             : 
     884             :       ! set reference date and check that 0 or 4 optional arguments are passed
     885           0 :       cnt = 0
     886           0 :       if (present(year_ref)) then
     887           0 :          lyear_ref = year_ref
     888           0 :          cnt = cnt + 1
     889             :       else
     890           0 :          lyear_ref = year_init
     891             :       endif
     892           0 :       if (present(mon_ref)) then
     893           0 :          lmon_ref = mon_ref
     894           0 :          cnt = cnt + 1
     895             :       else
     896           0 :          lmon_ref = month_init
     897             :       endif
     898           0 :       if (present(day_ref)) then
     899           0 :          lday_ref = day_ref
     900           0 :          cnt = cnt + 1
     901             :       else
     902           0 :          lday_ref = day_init
     903             :       endif
     904           0 :       if (present(sec_ref)) then
     905           0 :          lsec_ref = sec_ref
     906           0 :          cnt = cnt + 1
     907             :       else
     908           0 :          lsec_ref = sec_init
     909             :       endif
     910           0 :       if (cnt /= 0 .and. cnt /= 4) then
     911           0 :          write(nu_diag,*) trim(subname),' ERROR in ref args, must pass 0 or 4 '
     912           0 :          call abort_ice(subname//'ERROR: in ref args, must pass 0 or 4')
     913             :       endif
     914             : 
     915             : ! -------------------------------------------------------------------
     916             : ! tcraig, this is risky because atimesecs is real and could be very large
     917             : !      ayear = lyear_ref
     918             : !      amon = lmon_ref
     919             : !      aday = lday_ref
     920             : !      asec = lsec_ref
     921             : !
     922             : !      call update_date(ayear,amon,aday,asec,dsec=nint(atimesecs))
     923             : !      return
     924             : ! -------------------------------------------------------------------
     925             : 
     926             :       ! initial guess
     927           0 :       tyear = lyear_ref
     928           0 :       tmon = 1
     929           0 :       tday = 1
     930           0 :       tsec = 0
     931             : 
     932             :       ! add initial seconds to timesecs and treat lsec_ref as zero
     933           0 :       ltimesecs = atimesecs + real(lsec_ref,kind=dbl_kind)
     934             : 
     935             :       ! first estimate of tyear
     936           0 :       call compute_calendar_data(tyear,tdaymo,tdaycal,tdayyr)
     937           0 :       rdays = ltimesecs/secday
     938           0 :       tyear = tyear + int(rdays)/tdayyr
     939             : 
     940             :       ! reduce estimate of tyear if ndays > rdays
     941           0 :       ndays = compute_days_between(lyear_ref,lmon_ref,lday_ref,tyear,tmon,tday)
     942           0 :       if (ndays > int(rdays)) then
     943           0 :          tyear = tyear - (ndays - int(rdays))/tdayyr - 1
     944           0 :          ndays = compute_days_between(lyear_ref,lmon_ref,lday_ref,tyear,tmon,tday)
     945             :       endif
     946           0 :       call compute_calendar_data(tyear,tdaymo,tdaycal,tdayyr)
     947             : 
     948             :       ! compute residual days, switch to integers, compute date
     949           0 :       rdays = ltimesecs/secday
     950           0 :       tday = int(rdays) - ndays + 1
     951             : 
     952           0 :       do while (tday > tdaymo(tmon))
     953           0 :          tday = tday - tdaymo(tmon)
     954           0 :          tmon = tmon + 1
     955           0 :          do while (tmon > months_per_year)
     956           0 :             tmon = tmon - months_per_year
     957           0 :             tyear = tyear + 1
     958           0 :             call compute_calendar_data(tyear,tdaymo,tdaycal,tdayyr)
     959             :          enddo
     960             :       enddo
     961             : 
     962           0 :       ndays = compute_days_between(lyear_ref,lmon_ref,lday_ref,tyear,tmon,tday)
     963           0 :       tsec = int(ltimesecs - real(ndays,kind=dbl_kind)*secday)
     964           0 :       if (tsec > secday) then
     965           0 :          write(nu_diag,*) trim(subname),' ERROR in seconds, ',tyear,tmon,tday,tsec
     966           0 :          call abort_ice(subname//'ERROR: in seconds')
     967             :       endif
     968             : 
     969           0 :       ayear = tyear
     970           0 :       amon = tmon
     971           0 :       aday = tday
     972           0 :       asec = tsec
     973             : 
     974           0 :       end subroutine calendar_time2date
     975             : 
     976             : !=======================================================================
     977             : ! Compute hours, minutes, seconds from seconds
     978             : 
     979          37 :       subroutine calendar_sec2hms(seconds, hh, mm, ss)
     980             : 
     981             :       integer(kind=int_kind), intent(in)  :: &
     982             :          seconds                      ! calendar seconds in day
     983             :       integer(kind=int_kind), intent(out) :: &
     984             :          hh, mm, ss                   ! output hours, minutes, seconds
     985             : 
     986             :       character(len=*),parameter :: subname='(calendar_sec2hms)'
     987             : 
     988          37 :       if (seconds >= seconds_per_day) then
     989           0 :          write(nu_diag,*) trim(subname),' ERROR seconds >= seconds_per_day, ',seconds,seconds_per_day
     990           0 :          call abort_ice(subname//'ERROR: in seconds')
     991             :       endif
     992          37 :       hh = seconds/(seconds_per_hour)
     993          37 :       mm = (seconds - hh*seconds_per_hour)/seconds_per_minute
     994          37 :       ss = (seconds - hh*seconds_per_hour - mm*seconds_per_minute)
     995             : 
     996          37 :       end subroutine calendar_sec2hms
     997             : 
     998             : !=======================================================================
     999             : ! Compute relative elapsed years, months, days, hours from base time
    1000             : 
    1001       35357 :       subroutine compute_relative_elapsed(base, ey, em, ed, eh)
    1002             : 
    1003             :       character(len=*), intent(in) :: base
    1004             :       integer(kind=int_kind), intent(out) :: &
    1005             :         ey, em, ed, eh            ! relative elapsed year, month, day, hour
    1006             : 
    1007             :       character(len=*),parameter :: subname='(compute_relative_elapsed)'
    1008             : 
    1009       35357 :       if (base == 'zero') then
    1010        5862 :          ey = myear
    1011        5862 :          em = ey * months_per_year + mmonth - 1
    1012        5862 :          ed = compute_days_between(0,1,1,myear,mmonth,mday)
    1013        5862 :          eh = ed * hours_per_day + hour
    1014       29495 :       elseif (base == 'init') then
    1015       29495 :          ey = myear - year_init
    1016       29495 :          em = ey * months_per_year + (mmonth - month_init)
    1017       29495 :          ed = compute_days_between(year_init,month_init,day_init,myear,mmonth,mday)
    1018       29495 :          eh = ed * hours_per_day + hour
    1019             :       else
    1020           0 :          write(nu_diag,*) trim(subname),' ERROR base not recognized, ',trim(base)
    1021           0 :          call abort_ice(subname//'ERROR: base value invalid')
    1022             :       endif
    1023             : 
    1024             : !      if (my_task == master_task) then
    1025             : !         write(nu_diag,*) subname,' ey',ey
    1026             : !         write(nu_diag,*) subname,' em',em
    1027             : !         write(nu_diag,*) subname,' ed',ed
    1028             : !         write(nu_diag,*) subname,' eh',eh
    1029             : !      endif
    1030             : 
    1031       35357 :        end subroutine compute_relative_elapsed
    1032             : 
    1033             : !=======================================================================
    1034             : 
    1035             :       end module ice_calendar
    1036             : 
    1037             : !=======================================================================

Generated by: LCOV version 1.14-6-g40580cd