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/releases/r4.0/r4.0-HEAD/src/OCE/IOM – NEMO

source: NEMO/releases/r4.0/r4.0-HEAD/src/OCE/IOM/restart.F90

Last change on this file was 15810, checked in by smasson, 2 years ago

replace findloc by a do loop, see #2735

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