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/2019/dev_r11756_SI3restart_XIOS/src/OCE/IOM – NEMO

source: NEMO/branches/2019/dev_r11756_SI3restart_XIOS/src/OCE/IOM/restart.F90 @ 11870

Last change on this file since 11870 was 11870, checked in by andmirek, 4 years ago

Ticket #2323: open single restart write context for all restart files
  • Property svn:keywords set to Id
File size: 15.5 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      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
62      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
63      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file
64      CHARACTER(LEN=52)   ::   clpname   ! ocean output restart file name including prefix for AGRIF
65      CHARACTER(LEN=256)  ::   clinfo    ! info character
66      !!----------------------------------------------------------------------
67      !
68      IF( kt == nit000 ) THEN   ! default definitions
69         lrst_oce = .FALSE.   
70         IF( ln_rst_list ) THEN
71            nrst_lst = 1
72            nitrst = nn_stocklist( nrst_lst )
73         ELSE
74            nitrst = nitend
75         ENDIF
76      ENDIF
77     
78      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart
79
80      ! frequency-based restart dumping (nn_stock)
81      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN   
82         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
83         nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing
84         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
85      ENDIF
86      ! to get better performances with NetCDF format:
87      ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1)
88      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1
89      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
90         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
91            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
92            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
93            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
94            ENDIF
95            ! create the file
96            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
97            clpath = TRIM(cn_ocerst_outdir)
98            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
99            IF(lwp) THEN
100               WRITE(numout,*)
101               IF(.NOT.lwxios) THEN
102                  WRITE(numout,*) '             open ocean restart NetCDF file: ',TRIM(clpath)//TRIM(clname)
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(lwxios) THEN
111               CALL iom_setkt( nitrst, cwxios_context )
112            ELSE
113               CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE. )
114            ENDIF
115            lrst_oce = .TRUE.
116         ENDIF
117      ENDIF
118      !
119   END SUBROUTINE rst_opn
120
121
122   SUBROUTINE rst_write( kt )
123      !!---------------------------------------------------------------------
124      !!                   ***  ROUTINE rstwrite  ***
125      !!                     
126      !! ** Purpose :   Write restart fields in NetCDF format
127      !!
128      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
129      !!              file, save fields which are necessary for restart
130      !!----------------------------------------------------------------------
131      INTEGER, INTENT(in) ::   kt   ! ocean time-step
132      !!----------------------------------------------------------------------
133                     IF(lwxios) CALL iom_swap(      cwxios_context          )
134                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       , ldxios = lwxios)   ! dynamics time step
135                     CALL iom_delay_rst( 'WRITE', 'OCE', numrow )   ! save only ocean delayed global communication variables
136
137      IF ( .NOT. ln_diurnal_only ) THEN
138                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub, ldxios = lwxios        )     ! before fields
139                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb, ldxios = lwxios        )
140                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lwxios )
141                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lwxios )
142                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb, ldxios = lwxios      )
143                     !
144                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un, ldxios = lwxios        )     ! now fields
145                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn, ldxios = lwxios        )
146                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lwxios )
147                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lwxios )
148                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      )
149                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop, ldxios = lwxios      )
150                  ! extra variable needed for the ice sheet coupling
151                  IF ( ln_iscpl ) THEN
152                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask, ldxios = lwxios ) ! need to extrapolate T/S
153                     CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask, ldxios = lwxios ) ! need to correct barotropic velocity
154                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask, ldxios = lwxios ) ! need to correct barotropic velocity
155                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask, ldxios = lwxios) ! need to correct barotropic velocity
156                     CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios )   ! need to compute temperature correction
157                     CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation
158                     CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation
159                     CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl
160                  END IF
161      ENDIF
162     
163      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios ) 
164      IF(lwxios) CALL iom_swap(      cxios_context          )
165      IF( kt == nitrst ) THEN
166         IF(.NOT.lwxios) THEN
167            CALL iom_close( numrow )     ! close the restart file (only at last time step)
168         ENDIF
169!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
170!!gm  not sure what to do here   ===>>>  ask to Sebastian
171         lrst_oce = .FALSE.
172            IF( ln_rst_list ) THEN
173               nrst_lst = MIN(nrst_lst + 1, SIZE(nn_stocklist,1))
174               nitrst = nn_stocklist( nrst_lst )
175            ENDIF
176      ENDIF
177      !
178   END SUBROUTINE rst_write
179
180
181   SUBROUTINE rst_read_open
182      !!----------------------------------------------------------------------
183      !!                   ***  ROUTINE rst_read_open  ***
184      !!
185      !! ** Purpose :   Open read files for NetCDF restart
186      !!
187      !! ** Method  :   Use a non-zero, positive value of numror to assess whether or not
188      !!                the file has already been opened
189      !!----------------------------------------------------------------------
190      LOGICAL        ::   llok
191      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file
192      !!----------------------------------------------------------------------
193      !
194      IF( numror <= 0 ) THEN
195         IF(lwp) THEN                                             ! Contol prints
196            WRITE(numout,*)
197            WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
198            IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
199            WRITE(numout,*) '~~~~~~~~'
200         ENDIF
201         lxios_sini = .FALSE.
202         clpath = TRIM(cn_ocerst_indir)
203         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
204         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror )
205! are we using XIOS to read the data? Part above will have to modified once XIOS
206! can handle checking if variable is in the restart file (there will be no need to open
207! restart)
208         IF(.NOT.lxios_set) lrxios = lrxios.AND.lxios_sini
209         IF( lrxios) THEN
210             crxios_context = 'nemo_rst'
211             IF( .NOT. lxios_set ) THEN
212                 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS'
213                 CALL iom_init( crxios_context, TRIM(clpath)//cn_ocerst_in, ld_tmppatch = .false. )
214                 lxios_set = .TRUE.
215             ENDIF
216         ENDIF
217         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN
218             CALL iom_init( crxios_context, TRIM(clpath)//cn_ocerst_in, ld_tmppatch = .false. )
219             IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF'
220             lxios_set = .TRUE.
221         ENDIF
222      ENDIF
223
224   END SUBROUTINE rst_read_open
225
226
227   SUBROUTINE rst_read
228      !!----------------------------------------------------------------------
229      !!                   ***  ROUTINE rst_read  ***
230      !!
231      !! ** Purpose :   Read files for NetCDF restart
232      !!
233      !! ** Method  :   Read in restart.nc file fields which are necessary for restart
234      !!----------------------------------------------------------------------
235      REAL(wp) ::   zrdt
236      INTEGER  ::   jk
237      REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d
238      !!----------------------------------------------------------------------
239
240      CALL rst_read_open           ! open restart for reading (if not already opened)
241
242      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
243      IF(lrxios) CALL iom_swap(crxios_context)
244      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN
245         CALL iom_get( numror, 'rdt', zrdt, ldxios = lrxios )
246         IF( zrdt /= rdt )   neuler = 0
247      ENDIF
248
249      CALL iom_delay_rst( 'READ', 'OCE', numror )   ! read only ocean delayed global communication variables
250     
251      ! Diurnal DSST
252      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios ) 
253      IF ( ln_diurnal_only ) THEN
254         IF(lwp) WRITE( numout, * ) &
255         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0" 
256         rhop = rau0
257         CALL iom_get( numror, jpdom_autoglo, 'tn'     , w3d, ldxios = lrxios ) 
258         IF(lrxios) CALL iom_swap(cxios_context)
259         tsn(:,:,1,jp_tem) = w3d(:,:,1)
260         RETURN
261      ENDIF 
262     
263      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
264         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub, ldxios = lrxios                )   ! before fields
265         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb, ldxios = lrxios                )
266         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lrxios )
267         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lrxios )
268         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, ldxios = lrxios              )
269      ELSE
270         neuler = 0
271      ENDIF
272      !
273      CALL iom_get( numror, jpdom_autoglo, 'un'     , un, ldxios = lrxios )   ! now    fields
274      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn, ldxios = lrxios )
275      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lrxios )
276      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lrxios )
277      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios )
278      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
279         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density
280      ELSE
281         CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )   
282      ENDIF
283      !
284      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
285         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values
286         ub   (:,:,:)   = un   (:,:,:)
287         vb   (:,:,:)   = vn   (:,:,:)
288         sshb (:,:)     = sshn (:,:)
289         !
290         IF( .NOT.ln_linssh ) THEN
291            DO jk = 1, jpk
292               e3t_b(:,:,jk) = e3t_n(:,:,jk)
293            END DO
294         ENDIF
295         !
296      ENDIF
297      IF(lrxios) CALL iom_swap(cxios_context)
298      !
299   END SUBROUTINE rst_read
300
301   !!=====================================================================
302END MODULE restart
Note: See TracBrowser for help on using the repository browser.