source: NEMO/branches/UKMO/2018_NEMO4_beta_mirror_10037_Benchmark/src/OCE/IOM/restart.F90 @ 10280

Last change on this file since 10280 was 10280, checked in by andmirek, 2 years ago

GMED 425 merge dev_r9950_GO8_package

File size: 16.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 ioipsl, ONLY : ju2ymds    ! for calendar
30   USE diurnal_bulk
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 licence     (./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             ::   iyear, imonth, iday
62      REAL (wp)           ::   zsec
63      REAL (wp)           ::   zfjulday
64      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
65      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
66      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file
67      CHARACTER(LEN=52)   ::   clpname   ! ocean output restart file name including prefix for AGRIF
68      CHARACTER(LEN=256)  ::   clinfo    ! info character
69      !!----------------------------------------------------------------------
70      !
71      IF( kt == nit000 ) THEN   ! default definitions
72         lrst_oce = .FALSE.   
73         IF( ln_rst_list ) THEN
74            nrst_lst = 1
75            nitrst = nstocklist( nrst_lst )
76         ELSE
77            nitrst = nitend
78         ENDIF
79      ENDIF
80
81      ! frequency-based restart dumping (nn_stock)
82      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN   
83         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
84         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
85         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
86      ENDIF
87      ! to get better performances with NetCDF format:
88      ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1)
89      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1
90      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
91         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
92            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
93            IF ( ln_rstdate ) THEN
94               zfjulday = fjulday + rdt / rday
95               IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
96               CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )           
97               WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
98            ELSE
99               IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
100               ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
101               ENDIF
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                  SELECT CASE ( jprstlib )
111                  CASE DEFAULT         ;   WRITE(numout,*)                            &
112                      '             open ocean restart NetCDF file: ',TRIM(clpath)//TRIM(clname)
113                  END SELECT
114                  IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression'
115                  IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt
116                  ELSE                          ;   WRITE(numout,*) '             kt = '             , kt
117                  ENDIF
118               ENDIF
119            ENDIF
120            !
121            IF(.NOT.lwxios) THEN
122               CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib )
123            ELSE
124#if defined key_iomput
125               cwxios_context = "rstw_"//TRIM(ADJUSTL(clkt))
126               IF( TRIM(Agrif_CFixed()) == '0' ) THEN
127                  clpname = clname
128               ELSE
129                  clpname = TRIM(Agrif_CFixed())//"_"//clname   
130               ENDIF
131               CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname), .false. )
132               CALL xios_update_calendar(nitrst)
133               CALL iom_swap(      cxios_context          )
134#else
135               clinfo = 'Can not use XIOS in rst_opn'
136               CALL ctl_stop(TRIM(clinfo))
137#endif
138            ENDIF
139            lrst_oce = .TRUE.
140         ENDIF
141      ENDIF
142      !
143   END SUBROUTINE rst_opn
144
145
146   SUBROUTINE rst_write( kt )
147      !!---------------------------------------------------------------------
148      !!                   ***  ROUTINE rstwrite  ***
149      !!                     
150      !! ** Purpose :   Write restart fields in the format corresponding to jprstlib
151      !!
152      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
153      !!              file, save fields which are necessary for restart
154      !!----------------------------------------------------------------------
155      INTEGER, INTENT(in) ::   kt   ! ocean time-step
156      !!----------------------------------------------------------------------
157                     IF(lwxios) CALL iom_swap(      cwxios_context          )
158                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       , ldxios = lwxios)   ! dynamics time step
159
160      IF ( .NOT. ln_diurnal_only ) THEN
161                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub, ldxios = lwxios        )     ! before fields
162                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb, ldxios = lwxios        )
163                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lwxios )
164                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lwxios )
165                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb, ldxios = lwxios      )
166                     !
167                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un, ldxios = lwxios        )     ! now fields
168                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn, ldxios = lwxios        )
169                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lwxios )
170                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lwxios )
171                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      )
172                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop, ldxios = lwxios      )
173                  ! extra variable needed for the ice sheet coupling
174                  IF ( ln_iscpl ) THEN
175                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask, ldxios = lwxios ) ! need to extrapolate T/S
176                     CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask, ldxios = lwxios ) ! need to correct barotropic velocity
177                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask, ldxios = lwxios ) ! need to correct barotropic velocity
178                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask, ldxios = lwxios) ! need to correct barotropic velocity
179                     CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios )   ! need to compute temperature correction
180                     CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation
181                     CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation
182                     CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl
183                  END IF
184      ENDIF
185     
186      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios ) 
187      IF(lwxios) CALL iom_swap(      cxios_context          )
188      IF( kt == nitrst ) THEN
189         IF(.NOT.lwxios) THEN
190            CALL iom_close( numrow )     ! close the restart file (only at last time step)
191         ELSE
192            CALL iom_context_finalize(      cwxios_context          )
193         ENDIF
194!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
195!!gm  not sure what to do here   ===>>>  ask to Sebastian
196         lrst_oce = .FALSE.
197            IF( ln_rst_list ) THEN
198               nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1))
199               nitrst = nstocklist( nrst_lst )
200            ENDIF
201      ENDIF
202      !
203   END SUBROUTINE rst_write
204
205
206   SUBROUTINE rst_read_open
207      !!----------------------------------------------------------------------
208      !!                   ***  ROUTINE rst_read_open  ***
209      !!
210      !! ** Purpose :   Open read files for restart (format fixed by jprstlib )
211      !!
212      !! ** Method  :   Use a non-zero, positive value of numror to assess whether or not
213      !!                the file has already been opened
214      !!----------------------------------------------------------------------
215      INTEGER        ::   jlibalt = jprstlib
216      LOGICAL        ::   llok
217      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file
218      !!----------------------------------------------------------------------
219      !
220      IF( numror <= 0 ) THEN
221         IF(lwp) THEN                                             ! Contol prints
222            WRITE(numout,*)
223            SELECT CASE ( jprstlib )
224            CASE ( jpnf90    )   ;   WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
225            END SELECT
226            IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
227            WRITE(numout,*) '~~~~~~~~'
228         ENDIF
229         lxios_sini = .FALSE.
230         clpath = TRIM(cn_ocerst_indir)
231         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
232         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt )
233! are we using XIOS to read the data? Part above will have to modified once XIOS
234! can handle checking if variable is in the restart file (there will be no need to open
235! restart)
236         IF(.NOT.lxios_set) lrxios = lrxios.AND.lxios_sini
237         IF( lrxios) THEN
238             crxios_context = 'nemo_rst'
239             IF( .NOT.lxios_set ) THEN
240                 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS'
241                 CALL iom_init( crxios_context, ld_tmppatch = .false. )
242                 lxios_set = .TRUE.
243             ENDIF
244         ENDIF
245         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN
246             CALL iom_init( crxios_context, ld_tmppatch = .false. )
247             IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF'
248             lxios_set = .TRUE.
249         ENDIF
250      ENDIF
251
252   END SUBROUTINE rst_read_open
253
254
255   SUBROUTINE rst_read
256      !!----------------------------------------------------------------------
257      !!                   ***  ROUTINE rst_read  ***
258      !!
259      !! ** Purpose :   Read files for restart (format fixed by jprstlib )
260      !!
261      !! ** Method  :   Read in restart.nc file fields which are necessary for restart
262      !!----------------------------------------------------------------------
263      REAL(wp) ::   zrdt
264      INTEGER  ::   jk
265      REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d
266      !!----------------------------------------------------------------------
267
268      CALL rst_read_open           ! open restart for reading (if not already opened)
269
270      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
271      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN
272         CALL iom_get( numror, 'rdt', zrdt, ldxios = lrxios )
273         IF( zrdt /= rdt )   neuler = 0
274      ENDIF
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.