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/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/IOM – NEMO

source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/IOM/restart.F90 @ 10359

Last change on this file since 10359 was 10359, checked in by smasson, 6 years ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 4c: introduce a better version of the non-blocking mpp_max, see #2133

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