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.
restart.F90 in NEMO/branches/UKMO/r12083_restart_datestamp/src/OCE/IOM – NEMO

source: NEMO/branches/UKMO/r12083_restart_datestamp/src/OCE/IOM/restart.F90 @ 12477

Last change on this file since 12477 was 12477, checked in by jcastill, 4 years ago

Changes as in the original branch, plus changes for bgc restart (in branch AMM15_v3_6_STABLE_package_collate)

File size: 16.7 KB
RevLine 
[3]1MODULE restart
2   !!======================================================================
3   !!                     ***  MODULE  restart  ***
4   !! Ocean restart :  write the ocean restart file
[508]5   !!======================================================================
[2528]6   !! History :  OPA  !  1999-11  (M. Imbard)  Original code
7   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form
8   !!            2.0  !  2006-07  (S. Masson)  use IOM for restart
9   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA
10   !!            - -  !  2010-10  (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D)
[5836]11   !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart
12   !!             -   !  2014-12  (G. Madec) remove KPP scheme
[508]13   !!----------------------------------------------------------------------
[3]14
15   !!----------------------------------------------------------------------
[508]16   !!   rst_opn    : open the ocean restart file
17   !!   rst_write  : write the ocean restart file
18   !!   rst_read   : read the ocean restart file
[3]19   !!----------------------------------------------------------------------
[2528]20   USE oce             ! ocean dynamics and tracers
[3]21   USE dom_oce         ! ocean space and time domain
[9654]22   USE sbc_ice         ! only lk_si3
[3]23   USE phycst          ! physical constants
[5836]24   USE eosbn2          ! equation of state            (eos bn2 routine)
25   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
26   !
[508]27   USE in_out_manager  ! I/O manager
28   USE iom             ! I/O module
[12477]29   USE ioipsl, ONLY : ju2ymds    ! for calendar
[6140]30   USE diurnal_bulk
[12477]31   USE sbc_oce         ! for icesheet freshwater input variables
[10425]32   USE lib_mpp         ! distribued memory computing library
[9367]33
[3]34   IMPLICIT NONE
35   PRIVATE
36
[4292]37   PUBLIC   rst_opn         ! routine called by step module
38   PUBLIC   rst_write       ! routine called by step module
39   PUBLIC   rst_read        ! routine called by istate module
40   PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init
[3]41
[508]42   !! * Substitutions
43#  include "vectopt_loop_substitute.h90"
[3]44   !!----------------------------------------------------------------------
[9598]45   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[888]46   !! $Id$
[10068]47   !! Software governed by the CeCILL license (see ./LICENSE)
[359]48   !!----------------------------------------------------------------------
[3]49CONTAINS
50
[12477]51   SUBROUTINE rst_opn( kt, ndastp )
[508]52      !!---------------------------------------------------------------------
53      !!                   ***  ROUTINE rst_opn  ***
54      !!                     
55      !! ** Purpose : + initialization (should be read in the namelist) of nitrst
56      !!              + open the restart when we are one time step before nitrst
57      !!                   - restart header is defined when kt = nitrst-1
58      !!                   - restart data  are written when kt = nitrst
59      !!              + define lrst_oce to .TRUE. when we need to define or write the restart
60      !!----------------------------------------------------------------------
61      INTEGER, INTENT(in) ::   kt     ! ocean time-step
[12477]62      INTEGER, INTENT(in) ::   ndastp ! ocean date
[508]63      !!
[12477]64      INTEGER             ::   iyear, imonth, iday 
65      REAL (wp)           ::   zsec 
66      REAL (wp)           ::   zfjulday      !!
[508]67      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
[5341]68      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
[12477]69      CHARACTER(LEN=150)  ::   clpath   ! full path to ocean output restart file
[9367]70      CHARACTER(LEN=52)   ::   clpname   ! ocean output restart file name including prefix for AGRIF
[9535]71      CHARACTER(LEN=256)  ::   clinfo    ! info character
[508]72      !!----------------------------------------------------------------------
73      !
[783]74      IF( kt == nit000 ) THEN   ! default definitions
75         lrst_oce = .FALSE.   
[5341]76         IF( ln_rst_list ) THEN
77            nrst_lst = 1
[11536]78            nitrst = nn_stocklist( nrst_lst )
[5341]79         ELSE
80            nitrst = nitend
81         ENDIF
[508]82      ENDIF
[11536]83     
84      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart
[5341]85
86      ! frequency-based restart dumping (nn_stock)
[11536]87      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN   
[783]88         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
[11536]89         nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing
[783]90         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
91      ENDIF
92      ! to get better performances with NetCDF format:
93      ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1)
94      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1
[11536]95      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
[5341]96         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
97            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
[12477]98            IF ( ln_rstdate ) THEN 
99               zfjulday = fjulday + rdt / rday 
100               IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error 
101               CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )             
102               WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday   
103            ELSE 
104               IF( nitrst > 999999999 ) THEN     
105                  WRITE(clkt, *       ) nitrst 
106               ELSE               
107                  WRITE(clkt, '(i8.8)') nitrst 
108               ENDIF
[611]109            ENDIF
[5341]110            ! create the file
111            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
112            clpath = TRIM(cn_ocerst_outdir)
113            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
114            IF(lwp) THEN
115               WRITE(numout,*)
[9367]116               IF(.NOT.lwxios) THEN
[10425]117                  WRITE(numout,*) '             open ocean restart NetCDF file: ',TRIM(clpath)//TRIM(clname)
[9367]118                  IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression'
119                  IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt
120                  ELSE                          ;   WRITE(numout,*) '             kt = '             , kt
121                  ENDIF
[5341]122               ENDIF
123            ENDIF
124            !
[9367]125            IF(.NOT.lwxios) THEN
[10425]126               CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE. )
[9367]127            ELSE
[9535]128#if defined key_iomput
[9367]129               cwxios_context = "rstw_"//TRIM(ADJUSTL(clkt))
130               IF( TRIM(Agrif_CFixed()) == '0' ) THEN
131                  clpname = clname
132               ELSE
133                  clpname = TRIM(Agrif_CFixed())//"_"//clname   
134               ENDIF
[9903]135               CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname), .false. )
[9367]136               CALL xios_update_calendar(nitrst)
137               CALL iom_swap(      cxios_context          )
[9535]138#else
139               clinfo = 'Can not use XIOS in rst_opn'
140               CALL ctl_stop(TRIM(clinfo))
141#endif
[9367]142            ENDIF
[5341]143            lrst_oce = .TRUE.
[611]144         ENDIF
[508]145      ENDIF
146      !
147   END SUBROUTINE rst_opn
148
149
[3]150   SUBROUTINE rst_write( kt )
151      !!---------------------------------------------------------------------
152      !!                   ***  ROUTINE rstwrite  ***
153      !!                     
[10425]154      !! ** Purpose :   Write restart fields in NetCDF format
[3]155      !!
[508]156      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
[2528]157      !!              file, save fields which are necessary for restart
[3]158      !!----------------------------------------------------------------------
[508]159      INTEGER, INTENT(in) ::   kt   ! ocean time-step
[3]160      !!----------------------------------------------------------------------
[9367]161                     IF(lwxios) CALL iom_swap(      cwxios_context          )
162                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       , ldxios = lwxios)   ! dynamics time step
[10425]163                     CALL iom_delay_rst( 'WRITE', 'OCE', numrow )   ! save only ocean delayed global communication variables
[1239]164
[6140]165      IF ( .NOT. ln_diurnal_only ) THEN
[9367]166                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub, ldxios = lwxios        )     ! before fields
167                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb, ldxios = lwxios        )
168                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lwxios )
169                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lwxios )
170                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb, ldxios = lwxios      )
[4990]171                     !
[9367]172                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un, ldxios = lwxios        )     ! now fields
173                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn, ldxios = lwxios        )
174                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lwxios )
175                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lwxios )
176                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      )
177                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop, ldxios = lwxios      )
[6140]178                  ! extra variable needed for the ice sheet coupling
179                  IF ( ln_iscpl ) THEN
[9367]180                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask, ldxios = lwxios ) ! need to extrapolate T/S
181                     CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask, ldxios = lwxios ) ! need to correct barotropic velocity
182                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask, ldxios = lwxios ) ! need to correct barotropic velocity
183                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask, ldxios = lwxios) ! need to correct barotropic velocity
184                     CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios )   ! need to compute temperature correction
185                     CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation
186                     CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation
187                     CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl
[6140]188                  END IF
189      ENDIF
190     
[9367]191      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios ) 
192      IF(lwxios) CALL iom_swap(      cxios_context          )
[508]193      IF( kt == nitrst ) THEN
[9367]194         IF(.NOT.lwxios) THEN
195            CALL iom_close( numrow )     ! close the restart file (only at last time step)
196         ELSE
197            CALL iom_context_finalize(      cwxios_context          )
198         ENDIF
[4990]199!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
200!!gm  not sure what to do here   ===>>>  ask to Sebastian
201         lrst_oce = .FALSE.
[5341]202            IF( ln_rst_list ) THEN
[11536]203               nrst_lst = MIN(nrst_lst + 1, SIZE(nn_stocklist,1))
204               nitrst = nn_stocklist( nrst_lst )
[5341]205            ENDIF
[3]206      ENDIF
[508]207      !
[3]208   END SUBROUTINE rst_write
209
[4990]210
[4292]211   SUBROUTINE rst_read_open
212      !!----------------------------------------------------------------------
213      !!                   ***  ROUTINE rst_read_open  ***
214      !!
[10425]215      !! ** Purpose :   Open read files for NetCDF restart
[4292]216      !!
217      !! ** Method  :   Use a non-zero, positive value of numror to assess whether or not
218      !!                the file has already been opened
219      !!----------------------------------------------------------------------
[5341]220      LOGICAL        ::   llok
221      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file
[4292]222      !!----------------------------------------------------------------------
[4990]223      !
224      IF( numror <= 0 ) THEN
[4292]225         IF(lwp) THEN                                             ! Contol prints
226            WRITE(numout,*)
[10425]227            WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
[4292]228            IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
229            WRITE(numout,*) '~~~~~~~~'
230         ENDIF
[9367]231         lxios_sini = .FALSE.
[5341]232         clpath = TRIM(cn_ocerst_indir)
233         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
[10425]234         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror )
[9367]235! are we using XIOS to read the data? Part above will have to modified once XIOS
236! can handle checking if variable is in the restart file (there will be no need to open
237! restart)
238         IF(.NOT.lxios_set) lrxios = lrxios.AND.lxios_sini
239         IF( lrxios) THEN
240             crxios_context = 'nemo_rst'
241             IF( .NOT.lxios_set ) THEN
242                 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS'
[9903]243                 CALL iom_init( crxios_context, ld_tmppatch = .false. )
[9367]244                 lxios_set = .TRUE.
245             ENDIF
246         ENDIF
247         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN
[9903]248             CALL iom_init( crxios_context, ld_tmppatch = .false. )
[9367]249             IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF'
250             lxios_set = .TRUE.
251         ENDIF
[4292]252      ENDIF
[9367]253
[4292]254   END SUBROUTINE rst_read_open
255
[5836]256
[3]257   SUBROUTINE rst_read
258      !!----------------------------------------------------------------------
259      !!                   ***  ROUTINE rst_read  ***
260      !!
[10425]261      !! ** Purpose :   Read files for NetCDF restart
[3]262      !!
[1531]263      !! ** Method  :   Read in restart.nc file fields which are necessary for restart
[3]264      !!----------------------------------------------------------------------
[6140]265      REAL(wp) ::   zrdt
[4292]266      INTEGER  ::   jk
[9367]267      REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d
[3]268      !!----------------------------------------------------------------------
269
[4292]270      CALL rst_read_open           ! open restart for reading (if not already opened)
[3]271
[544]272      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
[746]273      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN
[9367]274         CALL iom_get( numror, 'rdt', zrdt, ldxios = lrxios )
[544]275         IF( zrdt /= rdt )   neuler = 0
276      ENDIF
[6140]277
[10425]278      CALL iom_delay_rst( 'READ', 'OCE', numror )   ! read only ocean delayed global communication variables
279     
[6140]280      ! Diurnal DSST
[9367]281      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios ) 
[6140]282      IF ( ln_diurnal_only ) THEN
283         IF(lwp) WRITE( numout, * ) &
284         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0" 
285         rhop = rau0
[9367]286         CALL iom_get( numror, jpdom_autoglo, 'tn'     , w3d, ldxios = lrxios ) 
287         tsn(:,:,1,jp_tem) = w3d(:,:,1)
[6140]288         RETURN
289      ENDIF 
290     
[3680]291      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
[9367]292         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub, ldxios = lrxios                )   ! before fields
293         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb, ldxios = lrxios                )
294         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lrxios )
295         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lrxios )
296         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, ldxios = lrxios              )
[3680]297      ELSE
298         neuler = 0
299      ENDIF
300      !
[9367]301      CALL iom_get( numror, jpdom_autoglo, 'un'     , un, ldxios = lrxios )   ! now    fields
302      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn, ldxios = lrxios )
303      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lrxios )
304      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lrxios )
305      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios )
[3680]306      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
[9367]307         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density
[3680]308      ELSE
[6140]309         CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )   
[3680]310      ENDIF
[2528]311      !
[508]312      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
[3294]313         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values
314         ub   (:,:,:)   = un   (:,:,:)
315         vb   (:,:,:)   = vn   (:,:,:)
316         sshb (:,:)     = sshn (:,:)
[5836]317         !
[6140]318         IF( .NOT.ln_linssh ) THEN
[4689]319            DO jk = 1, jpk
[6140]320               e3t_b(:,:,jk) = e3t_n(:,:,jk)
[4689]321            END DO
322         ENDIF
[5836]323         !
[3]324      ENDIF
[508]325      !
326   END SUBROUTINE rst_read
[473]327
[3]328   !!=====================================================================
329END MODULE restart
Note: See TracBrowser for help on using the repository browser.