source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/daymod_tam.F90 @ 2587

MODULE daymod_tam
#ifdef key_tam
   !!======================================================================
   !!                       ***  MODULE  daymod_tam  ***
   !! Ocean        :  calendar, tangent and adjoint model version 
   !!=====================================================================
   !! History of the direct module :
   !!                  !  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
   !! History :
   !!             8.x  !  1998--2004 (A. Weaver, N. Daget) daytam
   !!             9.0  !  08-05  (A. Vidard) skeleton 
   !!                  !  08-08  (A. Vidard) 04-01 version, based on daytam
   !!                  !  02-09  (A. Vidard) 06-08 version 
   !!----------------------------------------------------------------------     
   !!----------------------------------------------------------------------
   !!   day_tam        : calendar
   !!  
   !!           -------------------------------
   !!           ----------- WARNING -----------
   !!
   !!   we assume that the time step is a divisor of the number of second of in a day
   !!             ---> MOD( rday, rdttra(1) ) == 0
   !!
   !!           ----------- WARNING -----------
   !!           -------------------------------
   !!  
   !!----------------------------------------------------------------------
   !! * Modules used
   USE par_kind,       ONLY: & ! Precision variables
      & wp
   USE phycst,         ONLY: &
      & rday
   USE dom_oce,        ONLY: & ! ocean space and time domain
      & rdttra
   USE in_out_manager, ONLY: & ! I/O manager
      & lwp,                 &
      & nleapy,              &
      & numout
   USE daymod,         ONLY: &
      & day       ,          &
      & day_mth   ,          &
      & nyear_len ,          &
      & nmonth_len,          &
      & nyear     ,          &  !: current year
      & nmonth    ,          &  !: current month
      & nday      ,          &  !: current day of the month
      & nday_year ,          &  !: curent day counted from jan 1st of the current year
      & ndastp    ,          &  !: time step date in year/month/day aammjj
      & rsec_year ,          &  !: current time step counted in second since 00h jan 1st of the current year
      & rsec_month,          &  !: current time step counted in second since 00h 1st day of the current month
      & rsec_day  ,          &  !: current time step counted in second since 00h of the current day
      & adatrj                  !: number of elapsed days since the begining of the run
   !                            !  it is the accumulated duration of previous runs
   !                            !  that may have been run with different time steps.
     
      
   IMPLICIT NONE
   PRIVATE

   !! * Routine accessibility
   PUBLIC day_tam        ! called by steptan.F90 and stepadj.F90

CONTAINS

   SUBROUTINE day_tam( kt, kindic )
      !!----------------------------------------------------------------------
      !!                      ***  ROUTINE day_tam  ***
      !! 
      !! ** Purpose :   Compute the date with a day iteration IF necessary.
      !!             forward for the tangent linear, backward for the adjoint
      !!
      !! * Arguments
      INTEGER, INTENT( in ) ::   kt      ! ocean time-step indices
      INTEGER, INTENT( in ) ::   kindic  ! forward (0) or backward (1)
      !!----------------------------------------------------------------------




      SELECT CASE ( kindic )
      CASE ( 0 )
         ! ----------------------------------------------
         ! Forward running Calendar for the tangent model
         ! ----------------------------------------------
         CALL day( kt )
      CASE ( 1 )
         ! ----------------------------------------------
         ! Backward running Calendar for the adjoint model
         ! ----------------------------------------------
         CALL day_adj( kt )
      CASE default
         IF (lwp) WRITE(numout,*) 'day_tam called with a wrong kindic: ',kindic
         CALL abort
      END SELECT
   END SUBROUTINE day_tam
   SUBROUTINE day_adj( kt )
      !!----------------------------------------------------------------------
      !!                      ***  ROUTINE day_adj  ***
      !! 
      !! ** Purpose :   Compute the date with a day iteration backward
      !!                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
      !
      CHARACTER (len=25) ::   charout
      !!----------------------------------------------------------------------

      !                                                 ! New time-step
      rsec_year  = rsec_year  - rdttra(1) 
      rsec_month = rsec_month - rdttra(1)                 
      rsec_day   = rsec_day   - rdttra(1)                 
      adatrj = adatrj + rdttra(1) / rday
      
      IF( rsec_day < 0 ) THEN                        ! NEW day
         !
         nday      = nday - 1
         nday_year = nday_year - 1
         rsec_day  = rday - 0.5 * rdttra(1)
         !
         IF( nday == 0 ) THEN      ! NEW month
            nmonth = nmonth - 1
            IF( nmonth == 0 ) THEN                     ! NEW year
               nyear     = nyear - 1
               nmonth    = 12
               nday_year = nyear_len(0)
               rsec_year = nday_year * rday - 0.5 * rdttra(1)
               IF( nleapy == 1 )   CALL day_mth
            ENDIF
            nday   = nmonth_len(nmonth)
            rsec_month = nmonth_len(nmonth) * rday - 0.5 * rdttra(1)
         ENDIF
         !
         ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date
         !
         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
              &   '      New day, DATE Y/M/D = ', 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
      
      !
   END SUBROUTINE day_adj

   !!======================================================================
#endif
END MODULE daymod_tam