New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 8583 – NEMO

Changeset 8583


Ignore:
Timestamp:
2017-10-03T11:33:06+02:00 (6 years ago)
Author:
cbricaud
Message:

fix ticket #1944 in trunk ( SAS restartability)

Location:
trunk/NEMOGCM
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    r7761 r8583  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  daymod  *** 
    4    !! Ocean        :  calendar  
     4   !! Ocean :   management of the model calendar 
    55   !!===================================================================== 
    66   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code 
    77   !!                 ! 1997-03  (O. Marti) 
    8    !!                 ! 1997-05  (G. Madec)  
     8   !!                 ! 1997-05  (G. Madec) 
    99   !!                 ! 1997-08  (M. Imbard) 
    1010   !!   NEMO     1.0  ! 2003-09  (G. Madec)  F90 + nyear, nmonth, nday 
    1111   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj 
    1212   !!                 ! 2006-08  (G. Madec)  surface module major update 
    13    !!----------------------------------------------------------------------       
     13   !!                 ! 2015-11  (D. Lea) Allow non-zero initial time of day 
     14   !!---------------------------------------------------------------------- 
    1415 
    1516   !!---------------------------------------------------------------------- 
    1617   !!   day        : calendar 
    17    !!   
    18    !!           ------------------------------- 
    19    !!           ----------- WARNING ----------- 
    20    !! 
    21    !!   we suppose that the time step is deviding the number of second of in a day 
    22    !!             ---> MOD( rday, rdt ) == 0 
    23    !! 
    24    !!           ----------- WARNING ----------- 
    25    !!           ------------------------------- 
    26    !!   
    27    !!---------------------------------------------------------------------- 
    28    USE dom_oce         ! ocean space and time domain 
    29    USE phycst          ! physical constants 
    30    USE in_out_manager  ! I/O manager 
    31    USE iom             !  
    32    USE ioipsl, ONLY :   ymds2ju   ! for calendar 
    33    USE prtctl          ! Print control 
    34    USE restart         !  
    35    USE timing          ! Timing 
     18   !!---------------------------------------------------------------------- 
     19   !!                    ----------- WARNING ----------- 
     20   !!                    ------------------------------- 
     21   !!   sbcmod assume that the time step is dividing the number of second of  
     22   !!   in a day, i.e. ===> MOD( rday, rdt ) == 0  
     23   !!   except when user defined forcing is used (see sbcmod.F90) 
     24   !!---------------------------------------------------------------------- 
     25   USE dom_oce        ! ocean space and time domain 
     26   USE phycst         ! physical constants 
     27   USE ioipsl  , ONLY :   ymds2ju      ! for calendar 
     28   USE trc_oce , ONLY :   l_offline   ! offline flag 
     29   ! 
     30   USE in_out_manager ! I/O manager 
     31   USE prtctl         ! Print control 
     32   USE iom            ! 
     33   USE timing         ! Timing 
     34   USE restart        ! restart 
    3635 
    3736   IMPLICIT NONE 
     
    4039   PUBLIC   day        ! called by step.F90 
    4140   PUBLIC   day_init   ! called by istate.F90 
    42  
    43    INTEGER ::   nsecd, nsecd05, ndt, ndt05 
    44  
    45    !!---------------------------------------------------------------------- 
    46    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     41   PUBLIC   day_mth    ! Needed by TAM 
     42 
     43   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM) 
     44 
     45   !!---------------------------------------------------------------------- 
     46   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    4747   !! $Id$ 
    4848   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    5353      !!---------------------------------------------------------------------- 
    5454      !!                   ***  ROUTINE day_init  *** 
    55       !!  
    56       !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000  
     55      !! 
     56      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000 
    5757      !!                because day will be called at the beginning of step 
    5858      !! 
     
    6767      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 
    6868      !!---------------------------------------------------------------------- 
    69       INTEGER  ::   inbday, idweek 
    70       REAL(wp) ::   zjul 
     69      INTEGER  ::   inbday, idweek   ! local integers 
     70      REAL(wp) ::   zjul             ! local scalar 
    7171      !!---------------------------------------------------------------------- 
    7272      ! 
     
    7676            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 
    7777      ENDIF 
    78       ! all calendar staff is based on the fact that MOD( rday, rdt ) == 0 
    79       IF( MOD( rday , rdt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 
    80       IF( MOD( rday , 2.  ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    ) 
    81       IF( MOD( rdt  , 2.  ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           ) 
    82       nsecd   = NINT(rday       ) 
    83       nsecd05 = NINT(0.5 * rday ) 
    84       ndt     = NINT(      rdt  ) 
    85       ndt05   = NINT(0.5 * rdt  ) 
    86  
    87       ! ==> clem: here we read the ocean restart for the date (only if it exists) 
    88       !           It is not clean and another solution should be found 
    89       CALL day_rst( nit000, 'READ' ) 
    90       ! ==> 
    91  
    92       ! set the calendar from ndastp (read in restart file and namelist) 
    93  
     78      nsecd   = NINT( rday       ) 
     79      nsecd05 = NINT( 0.5 * rday ) 
     80      ndt     = NINT(       rdt  ) 
     81      ndt05   = NINT( 0.5 * rdt  ) 
     82 
     83      IF( .NOT. l_offline )   CALL day_rst( nit000, 'READ' ) 
     84 
     85      ! set the calandar from ndastp (read in restart file and namelist) 
    9486      nyear   =   ndastp / 10000 
    9587      nmonth  = ( ndastp - (nyear * 10000) ) / 100 
    96       nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )  
    97  
    98       CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday )  ! we assume that we start run at 00:00 
     88      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
     89 
     90      nhour   =   nn_time0 / 100 
     91      nminute = ( nn_time0 - nhour * 100 ) 
     92 
     93      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday )   
    9994      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error 
    100       fjulday = fjulday + 1.                             ! move back to the day at nit000 (and not at nit000 - 1) 
     95      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1) 
    10196 
    10297      nsec1jan000 = 0 
    10398      CALL day_mth 
    104        
     99 
    105100      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1 
    106          nmonth = nmonth - 1   
     101         nmonth = nmonth - 1 
    107102         nday = nmonth_len(nmonth) 
    108103      ENDIF 
     
    113108         IF( nleapy == 1 )   CALL day_mth 
    114109      ENDIF 
    115        
     110 
    116111      ! day since january 1st 
    117112      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 
    118113 
    119       !compute number of days between last monday and today       
     114      !compute number of days between last monday and today 
    120115      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday) 
    121       inbday = NINT(fjulday - zjul)            ! compute nb day between  01.01.1900 and current day   
    122       idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day   
     116      inbday = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day 
     117      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day 
     118      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900 
    123119 
    124120      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step 
    125       nsec_year  = nday_year * nsecd - ndt05   ! 1 time step before the middle of the first time step 
    126       nsec_month = nday      * nsecd - ndt05   ! because day will be called at the beginning of step 
    127       nsec_week  = idweek    * nsecd - ndt05 
    128       nsec_day   =             nsecd - ndt05 
     121      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN 
     122         ! 1 timestep before current middle of first time step is still the same day 
     123         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05  
     124         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05     
     125      ELSE 
     126         ! 1 time step before the middle of the first time step is the previous day  
     127         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05  
     128         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05    
     129      ENDIF 
     130      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05 
     131      nsec_day   =             nhour*3600+nminute*60 - ndt05  
     132      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd 
     133      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7 
    129134 
    130135      ! control print 
    131       IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
    132            &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week 
     136      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')   & 
     137           &                   ' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
     138           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  & 
     139           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year 
    133140 
    134141      ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 
     
    142149      !!---------------------------------------------------------------------- 
    143150      !!                   ***  ROUTINE day_init  *** 
    144       !!  
     151      !! 
    145152      !! ** Purpose :   calendar values related to the months 
    146153      !! 
     
    154161 
    155162      ! length of the month of the current year (from nleapy, read in namelist) 
    156       IF ( nleapy < 2 ) THEN  
     163      IF ( nleapy < 2 ) THEN 
    157164         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /) 
    158165         nyear_len(:) = 365 
     
    177184      ! time since Jan 1st   0     1     2    ...    11    12    13 
    178185      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|-------------------------------------- 
    179       !                 <---> <---> <--->  ...  <---> <---> <--->         
     186      !                 <---> <---> <--->  ...  <---> <---> <---> 
    180187      ! month number      0     1     2    ...    11    12    13 
    181188      ! 
     
    190197         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm) 
    191198      END DO 
    192       !            
    193    END SUBROUTINE  
     199      ! 
     200   END SUBROUTINE 
    194201 
    195202 
     
    197204      !!---------------------------------------------------------------------- 
    198205      !!                      ***  ROUTINE day  *** 
    199       !!  
     206      !! 
    200207      !! ** Purpose :   Compute the date with a day iteration IF necessary. 
    201208      !! 
     
    209216      !!              - adatrj    : date in days since the beginning of the run 
    210217      !!              - nsec_year : current time of the year (in second since 00h, jan 1st) 
    211       !!----------------------------------------------------------------------       
     218      !!---------------------------------------------------------------------- 
    212219      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices 
    213220      ! 
     
    220227      zprec = 0.1 / rday 
    221228      !                                                 ! New time-step 
    222       nsec_year  = nsec_year  + ndt  
    223       nsec_month = nsec_month + ndt                  
     229      nsec_year  = nsec_year  + ndt 
     230      nsec_month = nsec_month + ndt 
    224231      nsec_week  = nsec_week  + ndt 
    225       nsec_day   = nsec_day   + ndt                 
     232      nsec_day   = nsec_day   + ndt 
    226233      adatrj  = adatrj  + rdt / rday 
    227234      fjulday = fjulday + rdt / rday 
    228235      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error 
    229236      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error 
    230        
     237 
    231238      IF( nsec_day > nsecd ) THEN                       ! New day 
    232239         ! 
     
    261268 
    262269      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week 
    263        
     270 
    264271      IF(ln_ctl) THEN 
    265272         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
     
    267274      ENDIF 
    268275 
    269       ! since we no longer call rst_opn, need to define nitrst here, used by ice restart routine 
    270       IF( kt == nit000 )  THEN 
    271          nitrst = nitend 
    272          lrst_oce = .FALSE.  ! init restart ocean (done in rst_opn when not SAS) 
    273       ENDIF 
    274  
    275       IF( MOD( kt - 1, nstock ) == 0 ) THEN 
    276          ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
    277          nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    278          IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
    279       ENDIF 
    280  
     276      IF( .NOT. l_offline ) CALL rst_opn( kt )               ! Open the restart file if needed and control lrst_oce 
     277      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information 
     278      ! 
    281279      IF( nn_timing == 1 )  CALL timing_stop('day') 
    282280      ! 
     
    312310      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    313311      ! 
    314       REAL(wp) ::   zkt, zndastp 
     312      REAL(wp) ::   zkt, zndastp, zdayfrac, ksecs, ktime 
     313      INTEGER  ::   ihour, iminute 
    315314      !!---------------------------------------------------------------------- 
    316315 
     
    337336            ! define ndastp and adatrj 
    338337            IF ( nrstdt == 2 ) THEN 
    339                ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 
     338               ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 
    340339               CALL iom_get( numror, 'ndastp', zndastp ) 
    341340               ndastp = NINT( zndastp ) 
    342341               CALL iom_get( numror, 'adatrj', adatrj  ) 
     342          CALL iom_get( numror, 'ntime', ktime ) 
     343          nn_time0=INT(ktime) 
     344               ! calculate start time in hours and minutes 
     345          zdayfrac=adatrj-INT(adatrj) 
     346          ksecs = NINT(zdayfrac*86400)        ! Nearest second to catch rounding errors in adatrj          
     347          ihour = INT(ksecs/3600) 
     348          iminute = ksecs/60-ihour*60 
     349            
     350               ! Add to nn_time0 
     351               nhour   =   nn_time0 / 100 
     352               nminute = ( nn_time0 - nhour * 100 ) 
     353          nminute=nminute+iminute 
     354           
     355          IF( nminute >= 60 ) THEN 
     356             nminute=nminute-60 
     357        nhour=nhour+1 
     358          ENDIF 
     359          nhour=nhour+ihour 
     360          IF( nhour >= 24 ) THEN 
     361        nhour=nhour-24 
     362             adatrj=adatrj+1 
     363          ENDIF           
     364          nn_time0 = nhour * 100 + nminute 
     365          adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated           
    343366            ELSE 
    344                ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
    345                ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     367               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 
     368               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam 
     369               nhour   =   nn_time0 / 100 
     370               nminute = ( nn_time0 - nhour * 100 ) 
     371               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    346372               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
    347373               ! note this is wrong if time step has changed during run 
    348374            ENDIF 
    349375         ELSE 
    350             ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
    351             ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     376            ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 
     377            ndastp = ndate0           ! ndate0 read in the namelist in dom_nam 
     378            nhour   =   nn_time0 / 100 
     379       nminute = ( nn_time0 - nhour * 100 ) 
     380            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    352381            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
    353382         ENDIF 
     
    358387            WRITE(numout,*) '   date ndastp                                      : ', ndastp 
    359388            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
     389       WRITE(numout,*) '   nn_time0                                         : ',nn_time0 
    360390            WRITE(numout,*) 
    361391         ENDIF 
     
    373403         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since 
    374404         !                                                                     ! the begining of the run [s] 
     405    CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
    375406      ENDIF 
    376407      ! 
    377408   END SUBROUTINE day_rst 
     409 
    378410   !!====================================================================== 
    379411END MODULE daymod 
  • trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r8528 r8583  
    2525   USE usrdef_nam     ! user defined configuration 
    2626   USE daymod         ! calendar 
     27   USE restart        ! open  restart file 
    2728   USE step           ! NEMO time-stepping                 (stp     routine) 
    2829   USE cpl_oasis3     ! 
     
    364365      IF( ln_ctl      )     CALL prt_ctl_init   ! Print control 
    365366                            CALL day_init   ! model calendar (using both namelist and restart infos) 
     367      IF( ln_rstart )       CALL rst_read_open 
    366368 
    367369                            CALL sbc_init   ! Forcings : surface module  
  • trunk/NEMOGCM/SETTE/sette.sh

    r8284 r8583  
    144144 
    145145for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 
    146  
    147146do 
    148147 
     
    800799    set_namelist namelist_cfg cn_exp \"SAS\" 
    801800    set_namelist namelist_cfg nn_it000 1 
    802     set_namelist namelist_cfg nn_itend 100 
    803     set_namelist namelist_cfg nn_stock 50 
     801    set_namelist namelist_cfg nn_itend 240 
     802    set_namelist namelist_cfg nn_stock 120 
    804803    set_namelist namelist_cfg ln_ctl .false. 
    805804    set_namelist namelist_cfg ln_clobber .true. 
     
    823822    cd ${EXE_DIR} 
    824823    set_namelist namelist_cfg cn_exp \"SAS\" 
    825     set_namelist namelist_cfg nn_it000 51 
    826     set_namelist namelist_cfg nn_itend 100 
     824    set_namelist namelist_cfg nn_it000 121 
     825    set_namelist namelist_cfg nn_itend 240 
    827826    set_namelist namelist_cfg ln_ctl .false. 
    828827    set_namelist namelist_cfg ln_clobber .true. 
     
    835834    set_namelist namelist_cfg ln_rstart .true. 
    836835    set_namelist namelist_cfg nn_rstctl 2 
    837     set_namelist namelist_ice_cfg cn_icerst_in \"SAS_00000050_restart_ice\" 
     836    set_namelist namelist_cfg nn_date0 010106 
     837    set_namelist namelist_cfg cn_ocerst_in \"SAS_00000120_restart\" 
     838    set_namelist namelist_ice_cfg cn_icerst_in \"SAS_00000120_restart_ice\" 
    838839    if [ ${USING_MPMD} == "yes" ] ; then 
    839840       set_xio_using_server iodef.xml true 
     
    844845        L_NPROC=$(( $i - 1 )) 
    845846        L_NPROC=`printf "%04d\n" ${L_NPROC}` 
    846         ln -sf ../LONG/SAS_00000050_restart_ice_${L_NPROC}.nc . 
     847        ln -sf ../LONG/SAS_00000120_restart_${L_NPROC}.nc . 
     848        ln -sf ../LONG/SAS_00000120_restart_ice_${L_NPROC}.nc . 
    847849    done 
    848850    cd ${SETTE_DIR} 
Note: See TracChangeset for help on using the changeset viewer.