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 2528 for trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 – NEMO

Ignore:
Timestamp:
2010-12-27T18:33:53+01:00 (13 years ago)
Author:
rblod
Message:

Update NEMOGCM from branch nemo_v3_3_beta

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    • Property svn:eol-style deleted
    r1836 r2528  
    2525   USE oce_trc 
    2626   USE trc 
    27    USE trctrp_lec 
     27   USE trcnam_trp 
    2828   USE lib_mpp 
     29   USE lib_fortran 
    2930   USE iom 
    3031   USE trcrst_cfc      ! CFC       
     
    3334   USE trcrst_c14b     ! C14 bomb restart 
    3435   USE trcrst_my_trc   ! MY_TRC   restart 
    35 #if defined key_off_tra 
    36     USE daymod 
    37 #endif 
     36   USE daymod 
    3837   IMPLICIT NONE 
    3938   PRIVATE 
     
    4746   !! * Substitutions 
    4847#  include "top_substitute.h90" 
    49    !!---------------------------------------------------------------------- 
    50    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    51    !! $Id$  
    52    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    53    !!---------------------------------------------------------------------- 
    5448    
    5549CONTAINS 
     
    6761      !!---------------------------------------------------------------------- 
    6862      ! 
    69 # if ! defined key_off_tra 
    70       IF( kt == nit000 ) lrst_trc = .FALSE.  
    71 # else 
    72       IF( kt == nit000 ) THEN 
    73         lrst_trc = .FALSE.  
    74         nitrst = nitend   
    75       ENDIF 
    76  
    77       IF( MOD( kt - 1, nstock ) == 0 ) THEN 
    78          ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
    79          nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    80          IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
    81       ENDIF 
    82 # endif 
    83      ! to get better performances with NetCDF format: 
    84      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*ndttrc + 1) 
    85      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*ndttrc + 1 
    86      IF( kt == nitrst - 2*ndttrc + 1 .OR. nstock == ndttrc .OR. ( kt == nitend - ndttrc + 1 .AND. .NOT. lrst_trc ) ) THEN 
     63      IF( lk_offline ) THEN 
     64         IF( kt == nit000 ) THEN 
     65            lrst_trc = .FALSE. 
     66            nitrst = nitend 
     67         ENDIF 
     68 
     69         IF( MOD( kt - 1, nstock ) == 0 ) THEN 
     70            ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
     71            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
     72            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
     73         ENDIF 
     74      ELSE 
     75         IF( kt == nit000 ) lrst_trc = .FALSE. 
     76      ENDIF 
     77 
     78      ! to get better performances with NetCDF format: 
     79      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
     80      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
     81      IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1 .AND. .NOT. lrst_trc ) ) THEN 
    8782         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    8883         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
     
    106101      !!---------------------------------------------------------------------- 
    107102      INTEGER  ::  jn      
    108       INTEGER  ::  iarak0  
    109       REAL(wp) ::  zarak0 
    110103      INTEGER  ::  jlibalt = jprstlib 
    111104      LOGICAL  ::  llok 
     
    128121      ! Time domain : restart 
    129122      ! --------------------- 
    130       CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar 
    131  
    132       IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   iarak0 = 1 
    133       ELSE                                           ;   iarak0 = 0 
    134       ENDIF 
    135       CALL iom_get( numrtr, 'arak0', zarak0 ) 
    136  
    137       IF( iarak0 /= NINT( zarak0 ) )   &                           ! Control of the scheme 
    138          & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 
    139          & ' it must be the same type for both restart and previous run', & 
    140          & ' centered or euler '  ) 
    141       IF(lwp) WRITE(numout,*) 
    142       IF(lwp) WRITE(numout,*) '    arakawa option      : ', NINT( zarak0 ) 
     123      CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    143124 
    144125      ! READ prognostic variables and computes diagnostic variable 
     
    175156 
    176157      CALL trc_rst_cal( kt, 'WRITE' )   ! calendar 
    177  
    178       IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   zarak0 = 1. 
    179       ELSE                                           ;   zarak0 = 0. 
    180       ENDIF 
    181       CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 ) 
    182  
     158      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step 
    183159      ! prognostic variables  
    184160      ! --------------------  
     
    222198      !! 
    223199      !!   According to namelist parameter nrstdt, 
    224       !!       nrsttr = 0  no control on the date (nittrc000 is  arbitrary). 
    225       !!       nrsttr = 1  we verify that nit000 is equal to the last 
     200      !!       nn_rsttr = 0  no control on the date (nit000 is  arbitrary). 
     201      !!       nn_rsttr = 1  we verify that nit000 is equal to the last 
    226202      !!                   time step of previous run + 1. 
    227203      !!       In both those options, the  exact duration of the experiment 
     
    230206      !!       This is valid is the time step has remained constant. 
    231207      !! 
    232       !!       nrsttr = 2  the duration of the experiment in days (adatrj) 
     208      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj) 
    233209      !!                    has been stored in the restart file. 
    234210      !!---------------------------------------------------------------------- 
     
    236212      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    237213      ! 
    238       REAL(wp) ::  zkt 
    239 #if defined key_off_tra 
     214      REAL(wp) ::  zkt, zrdttrc1 
    240215      REAL(wp) ::  zndastp 
    241 #endif 
    242216 
    243217      ! Time domain : restart 
     
    250224            WRITE(numout,*) '   previous time-step                               : ', NINT( zkt ) 
    251225            WRITE(numout,*) ' *** restart option' 
    252             SELECT CASE ( nrsttr ) 
    253             CASE ( 0 )   ;   WRITE(numout,*) ' nrsttr = 0 : no control of nittrc000' 
    254             CASE ( 1 )   ;   WRITE(numout,*) ' nrsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
    255             CASE ( 2 )   ;   WRITE(numout,*) ' nrsttr = 2 : calendar parameters read in restart' 
     226            SELECT CASE ( nn_rsttr ) 
     227            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000' 
     228            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
     229            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
    256230            END SELECT 
    257231            WRITE(numout,*) 
    258232         ENDIF 
    259233         ! Control of date  
    260          IF( nittrc000  - NINT( zkt ) /= 1 .AND.  nrsttr /= 0 )                                  & 
     234         IF( nit000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
    261235            &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
    262             &                  ' verify the restart file or rerun with nrsttr = 0 (namelist)' ) 
    263 #if defined key_off_tra 
    264          ! define ndastp and adatrj 
    265          IF ( nrsttr == 2 ) THEN 
    266             CALL iom_get( numrtr, 'ndastp', zndastp )  
    267             ndastp = NINT( zndastp ) 
    268             CALL iom_get( numrtr, 'adatrj', adatrj  ) 
    269          ELSE 
    270             ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    271             adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 
    272             ! note this is wrong if time step has changed during run 
     236            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
     237         IF( lk_offline ) THEN      ! set the date in offline mode 
     238            ! Check dynamics and tracer time-step consistency and force Euler restart if changed 
     239            IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN 
     240               CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 ) 
     241               IF( zrdttrc1 /= rdttrc(1) )   neuler = 0 
     242            ENDIF 
     243            !                          ! define ndastp and adatrj 
     244            IF ( nn_rsttr == 2 ) THEN 
     245               CALL iom_get( numrtr, 'ndastp', zndastp )  
     246               ndastp = NINT( zndastp ) 
     247               CALL iom_get( numrtr, 'adatrj', adatrj  ) 
     248            ELSE 
     249               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
     250               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     251               ! note this is wrong if time step has changed during run 
     252            ENDIF 
     253            ! 
     254            IF(lwp) THEN 
     255              WRITE(numout,*) ' *** Info used values : ' 
     256              WRITE(numout,*) '   date ndastp                                      : ', ndastp 
     257              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
     258              WRITE(numout,*) 
     259            ENDIF 
     260            ! 
     261            CALL day_init          ! compute calendar 
     262            ! 
    273263         ENDIF 
    274264         ! 
    275          IF(lwp) THEN 
    276            WRITE(numout,*) ' *** Info used values : ' 
    277            WRITE(numout,*) '   date ndastp                                      : ', ndastp 
    278            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
    279            WRITE(numout,*) 
    280          ENDIF 
    281          ! 
    282          CALL day_init          ! compute calendar 
    283          ! 
    284 #endif 
    285  
    286265      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
    287266         ! 
     
    291270            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    292271         ENDIF 
    293          ! calendar control 
    294272         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step 
    295273         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date 
     
    308286      !!---------------------------------------------------------------------- 
    309287 
    310       INTEGER  :: ji, jj, jk, jn 
     288      INTEGER  :: jn 
    311289      REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 
    312       REAL(wp) :: zder, zvol 
     290      REAL(wp) :: zder 
    313291      !!---------------------------------------------------------------------- 
    314292 
     
    322300      zdiag_tot = 0.e0 
    323301      DO jn = 1, jptra 
    324          zdiag_var    = 0.e0 
    325          zdiag_varmin = 0.e0 
    326          zdiag_varmax = 0.e0 
    327          DO jk = 1, jpk 
    328             DO jj = 1, jpj 
    329                DO ji = 1, jpi 
    330                   zvol = cvol(ji,jj,jk) 
    331 #  if defined key_off_degrad 
    332                   zvol = zvol * facvol(ji,jj,jk) 
     302#  if defined key_degrad 
     303         zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) ) 
     304#  else 
     305         zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:)  ) 
    333306#  endif 
    334                   zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * zvol 
    335                END DO 
    336             END DO 
    337          END DO 
    338           
    339307         zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    340308         zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     
    342310            CALL mpp_min( zdiag_varmin )      ! min over the global domain 
    343311            CALL mpp_max( zdiag_varmax )      ! max over the global domain 
    344             CALL mpp_sum( zdiag_var    )      ! sum over the global domain 
    345312         END IF 
    346313         zdiag_tot = zdiag_tot + zdiag_var 
     
    369336#endif 
    370337 
     338   !!---------------------------------------------------------------------- 
     339   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     340   !! $Id$  
     341   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    371342   !!====================================================================== 
    372343END MODULE trcrst 
Note: See TracChangeset for help on using the changeset viewer.