MODULE daymod !!====================================================================== !! *** MODULE daymod *** !! Ocean : calendar !!===================================================================== !! History : ! 94-09 (M. Pontaud M. Imbard) Original code !! ! 97-03 (O. Marti) !! ! 97-05 (G. Madec) !! ! 97-08 (M. Imbard) !! 9.0 ! 03-09 (G. Madec) F90 + nyear, nmonth, nday !! ! 04-01 (A.M. Treguier) new calculation based on adatrj !! ! 06-08 (G. Madec) surface module major update !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! day : calendar !!---------------------------------------------------------------------- USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE in_out_manager ! I/O manager USE prtctl ! Print control IMPLICIT NONE PRIVATE PUBLIC day ! called by step.F90 INTEGER , PUBLIC :: nyear !: current year INTEGER , PUBLIC :: nmonth !: current month INTEGER , PUBLIC :: nday !: current day of the month INTEGER , PUBLIC :: nday_year !: current day counted from jan 1st of the current year REAL(wp), PUBLIC :: rsec_year !: current time step counted in second since 00h jan 1st of the current year REAL(wp), PUBLIC :: rsec_month !: current time step counted in second since 00h 1st day of the current month REAL(wp), PUBLIC :: rsec_day !: current time step counted in second since 00h of the current day INTEGER , PUBLIC :: ndastp !: time step date in year/month/day aammjj !!gm supprimer adatrj et adatrj0 ==> remplacer par rsecday..... REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the run REAL(wp), PUBLIC :: adatrj0 !: value of adatrj at nit000-1 (before the present run). ! ! it is the accumulated duration of previous runs ! ! that may have been run with different time steps. INTEGER , PUBLIC, DIMENSION(0:13) :: nmonth_len !: length of the current year INTEGER, PUBLIC, DIMENSION(12) :: nbiss = (/ 31, 29, 31, 30, 31, 30, & !: number of days per month & 31, 31, 30, 31, 30, 31 /) !: (leap-year) INTEGER, PUBLIC, DIMENSION(12) :: nobis = (/ 31, 28, 31, 30, 31, 30, & !: number of days per month & 31, 31, 30, 31, 30, 31 /) !: (365 days a year) REAL(wp), PUBLIC, DIMENSION(0:14) :: rmonth_half(0:14) !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE day( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE day *** !! !! ** Purpose : Compute the date with a day iteration IF necessary. !! !! ** Method : - ??? !! !! ** Action : - nyear : current year !! - nmonth : current month of the year nyear !! - nday : current day of the month nmonth !! - nday_year : current day of the year nyear !! - ndastp : =nyear*10000+nmonth*100+nday !! - adatrj : date in days since the beginning of the run !! - rsec_year : current time of the year (in second since 00h, jan 1st) !!---------------------------------------------------------------------- INTEGER, INTENT(in) :: kt ! ocean time-step indices ! INTEGER :: js, jm ! dummy loop indice CHARACTER (len=25) :: charout !!---------------------------------------------------------------------- ! 0. initialization of adatrj0 and nday, nmonth,nyear, nday_year. ! ndastp has been initialized in domain.F90 or restart.F90 !----------------------------------------------------------------- ! ! ---------------- ! IF( kt == -1 ) THEN ! Initialisation ! ! ! ---------------- ! ! IF( .NOT.ln_rstart ) adatrj0 = 0.e0 ! adatrj0 initialized in rst_read when restart ! set the calandar from adatrj0 and ndastp (read in restart file and namelist) adatrj = adatrj0 !???? bug.... toujours rest !!gm nyear = ndastp / 10000 nmonth = ( ndastp - (nyear * 10000) ) / 100 nday = ndastp - (nyear * 10000) - ( nmonth * 100 ) ! length of the month of the current year (from nleapy, read in namelist) nmonth_len(0) = nbiss(12) ; nmonth_len(13) = nbiss(1) SELECT CASE( nleapy ) CASE( 1 ) IF( MOD( nyear, 4 ) == 0 ) THEN ; nmonth_len(1:12) = nbiss(:) ! 366 days per year (leap year) ELSE ; nmonth_len(1:12) = nobis(:) ! 365 days per year ENDIF CASE( 0 ) ; nmonth_len(1:12) = nobis(:) ! 365 days per year CASE( 2: ) ; nmonth_len(1:13) = nleapy ! 12*nleapy days per year END SELECT ! half month in second since the bigining of the year rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len( 0 ) ) DO jm = 1, 12 rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm) ) END DO rmonth_half(13) = rmonth_half( 1 ) + 365. * rday rmonth_half(14) = rmonth_half( 2 ) + 365. * rday ! day since january 1st (useful to read daily forcing fields) nday_year = nday DO js = 1, nmonth - 1 ! accumulates days of previous months of this year nday_year = nday_year + nmonth_len(js) END DO ! number of seconds since... rsec_year = REAL( nday_year - 1 ) * rday - rdttra(1) ! 00h 1st day of the current year rsec_day = REAL( nday - 1 ) * rday - rdttra(1) ! 00h 1st day of the current month rsec_month = - rdttra(1) ! 00h of the current day ! control print IF(lwp) WRITE(numout,*)' ==============>> time-step =', kt, ' Initial DATE= ', & & nyear, '/', nmonth, '/', nday, ' rsec_day:', rsec_day ! ! ! -------------------------------- ! ELSE ! Model calendar at time-step kt ! ! ! -------------------------------- ! rsec_year = rsec_year + rdttra(1) ! New time-step rsec_month = rsec_month + rdttra(1) ! New time-step rsec_day = rsec_day + rdttra(1) ! New time-step adatrj = adatrj0 + ( kt - nit000 + 1 ) * rdttra(1) / rday IF( rsec_day >= rday ) THEN ! rsec_day = 0.e0 ! NEW day nday = nday + 1 nday_year = nday_year + 1 ! IF( nday == nmonth_len(nmonth) + 1 ) THEN ! NEW month nday = 1 rsec_month = 0.e0 nmonth = nmonth + 1 IF( nmonth == 13 ) THEN ! NEW year nyear = nyear + 1 nmonth = 1 nday_year = 1 rsec_year = 0.e0 ! ! update the length of the month IF( nleapy == 1 ) THEN ! of the current year (if necessary) IF( MOD( nyear, 4 ) == 0 ) THEN nmonth_len(1:12) = nbiss(:) ! 366 days per year (leap year) ELSE nmonth_len(1:12) = nobis(:) ! 365 days per year ENDIF ! half month in second since the bigining of the year rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len( 0 ) ) DO jm = 1, 12 rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm) ) END DO rmonth_half(13) = rmonth_half( 1 ) + 365. * rday rmonth_half(14) = rmonth_half( 2 ) + 365. * rday ENDIF ENDIF ENDIF ! ndastp = nyear * 10000 + nmonth * 100 + nday ! NEW date ! ! IF(lwp) WRITE(numout,'(a,i8,a,i4,a,i2,a,i2,a,i3)') '======>> time-step =', kt, & ! & ' New day, DATE= ', nyear, '/', nmonth, '/', nday, ' nday_year = ', nday_year ! IF(lwp) WRITE(numout,'(a,F9.0,a,F9.0,a,F9.0)') ' rsec_year = ', rsec_year, & ! & ' rsec_month = ', rsec_month, ' rsec_day = ', rsec_day ENDIF IF(ln_ctl) THEN WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear CALL prt_ctl_info(charout) ENDIF ! ENDIF END SUBROUTINE day !!====================================================================== END MODULE daymod