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 branches/UKMO/dev_r5518_GO6_package_fix_rnf_MOCI_TEST_SUITE/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

source: branches/UKMO/dev_r5518_GO6_package_fix_rnf_MOCI_TEST_SUITE/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90 @ 8191

Last change on this file since 8191 was 8191, checked in by andmirek, 7 years ago

merge with XIOS restart read branch

File size: 17.1 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   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   rst_opn    : open the ocean restart file
15   !!   rst_write  : write the ocean restart file
16   !!   rst_read   : read the ocean restart file
17   !!----------------------------------------------------------------------
18   USE oce             ! ocean dynamics and tracers
19   USE dom_oce         ! ocean space and time domain
20   USE phycst          ! physical constants
21   USE in_out_manager  ! I/O manager
22   USE iom             ! I/O module
23   USE ioipsl, ONLY : ju2ymds    ! for calendar
24   USE eosbn2          ! equation of state            (eos bn2 routine)
25   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
26   USE divcur          ! hor. divergence and curl      (div & cur routines)
27   USE sbc_oce         ! for icesheet freshwater input variables
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   rst_opn         ! routine called by step module
33   PUBLIC   rst_write       ! routine called by step module
34   PUBLIC   rst_read        ! routine called by istate module
35   PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39#  include "vectopt_loop_substitute.h90"
40   !!----------------------------------------------------------------------
41   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
42   !! $Id$
43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
44   !!----------------------------------------------------------------------
45CONTAINS
46
47   SUBROUTINE rst_opn( kt )
48      !!---------------------------------------------------------------------
49      !!                   ***  ROUTINE rst_opn  ***
50      !!                     
51      !! ** Purpose : + initialization (should be read in the namelist) of nitrst
52      !!              + open the restart when we are one time step before nitrst
53      !!                   - restart header is defined when kt = nitrst-1
54      !!                   - restart data  are written when kt = nitrst
55      !!              + define lrst_oce to .TRUE. when we need to define or write the restart
56      !!----------------------------------------------------------------------
57      INTEGER, INTENT(in) ::   kt     ! ocean time-step
58      INTEGER             ::   iyear, imonth, iday
59      REAL (wp)           ::   zsec
60      REAL (wp)           ::   zfjulday
61      !!
62      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
63      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
64      CHARACTER(LEN=150)  ::   clpath   ! full path to ocean output restart file
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            IF ( ln_rstdate ) THEN
89               zfjulday = fjulday + rdttra(1) / rday
90               IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
91               CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )           
92               WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
93            ELSE
94               ! beware of the format used to write kt (default is i8.8, that should be large enough...)
95               IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
96               ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
97               ENDIF
98            ENDIF
99            ! create the file
100            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
101            clpath = TRIM(cn_ocerst_outdir)
102            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
103            IF(lwp) THEN
104               WRITE(numout,*)
105               SELECT CASE ( jprstlib )
106               CASE ( jprstdimg )   ;   WRITE(numout,*)                            &
107                   '             open ocean restart binary file: ',TRIM(clpath)//clname
108               CASE DEFAULT         ;   WRITE(numout,*)                            &
109                   '             open ocean restart NetCDF file: ',TRIM(clpath)//clname
110               END SELECT
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            !
117            CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib )
118            lrst_oce = .TRUE.
119         ENDIF
120      ENDIF
121      !
122   END SUBROUTINE rst_opn
123
124
125   SUBROUTINE rst_write( kt )
126      !!---------------------------------------------------------------------
127      !!                   ***  ROUTINE rstwrite  ***
128      !!                     
129      !! ** Purpose :   Write restart fields in the format corresponding to jprstlib
130      !!
131      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
132      !!              file, save fields which are necessary for restart
133      !!----------------------------------------------------------------------
134      INTEGER, INTENT(in) ::   kt   ! ocean time-step
135      !!----------------------------------------------------------------------
136
137                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics time step
138                     CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) )   ! surface tracer time step
139
140                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields
141                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        )
142                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) )
143                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) )
144                     CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      )
145                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     )
146                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      )
147                     !
148                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields
149                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        )
150                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) )
151                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) )
152                     CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      )
153                     CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     )
154                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      )
155                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      )
156#if defined key_zdfkpp
157                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       )
158#endif
159                     IF( lk_oasis) THEN
160                     ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true
161                     IF( ln_coupled_iceshelf_fluxes ) THEN
162                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass', greenland_icesheet_mass )
163                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed )
164                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change )
165                        CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass', antarctica_icesheet_mass )
166                        CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed )
167                        CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change )
168                     ENDIF
169                     ENDIF
170
171      IF( kt == nitrst ) THEN
172         CALL iom_close( numrow )     ! close the restart file (only at last time step)
173!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
174!!gm  not sure what to do here   ===>>>  ask to Sebastian
175         lrst_oce = .FALSE.
176            IF( ln_rst_list ) THEN
177               nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1))
178               nitrst = nstocklist( nrst_lst )
179            ENDIF
180            lrst_oce = .FALSE.
181      ENDIF
182      !
183   END SUBROUTINE rst_write
184
185
186   SUBROUTINE rst_read_open
187      !!----------------------------------------------------------------------
188      !!                   ***  ROUTINE rst_read_open  ***
189      !!
190      !! ** Purpose :   Open read files for restart (format fixed by jprstlib )
191      !!
192      !! ** Method  :   Use a non-zero, positive value of numror to assess whether or not
193      !!                the file has already been opened
194      !!----------------------------------------------------------------------
195      INTEGER        ::   jlibalt = jprstlib
196      LOGICAL        ::   llok
197      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file
198      !!----------------------------------------------------------------------
199      !
200      IF( numror <= 0 ) THEN
201         IF(lwp) THEN                                             ! Contol prints
202            WRITE(numout,*)
203            SELECT CASE ( jprstlib )
204            CASE ( jpnf90    )   ;   WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
205            CASE ( jprstdimg )   ;   WRITE(numout,*) 'rst_read : read oce binary restart file'
206            END SELECT
207            IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
208            WRITE(numout,*) '~~~~~~~~'
209         ENDIF
210
211         clpath = TRIM(cn_ocerst_indir)
212         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
213         IF ( jprstlib == jprstdimg ) THEN
214           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
215           ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90
216           INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok )
217           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
218         ENDIF
219         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt )
220! are we using XIOS to read the data? Part above will have to modified once XIOS
221! can handle checking if variable is in the restart file (there will be no need to open
222! restart)
223         IF(.NOT.lxios_set) lxios_read = lxios_read.AND.lxios_sini
224         IF( lxios_read) THEN
225         if(.NOT.lxios_set) then
226             rxios_context = 'nemo_rst'
227             call iom_init( rxios_context )
228             lxios_set = .TRUE.
229         endif
230         ENDIF
231         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lxios_read) THEN
232            rxios_context = 'nemo_rst'
233            call iom_init( rxios_context )
234         ENDIF
235      ENDIF
236   END SUBROUTINE rst_read_open
237
238   SUBROUTINE rst_read
239      !!----------------------------------------------------------------------
240      !!                   ***  ROUTINE rst_read  ***
241      !!
242      !! ** Purpose :   Read files for restart (format fixed by jprstlib )
243      !!
244      !! ** Method  :   Read in restart.nc file fields which are necessary for restart
245      !!----------------------------------------------------------------------
246      REAL(wp) ::   zrdt, zrdttra1
247      INTEGER  ::   jk
248      LOGICAL  ::   llok
249      !!----------------------------------------------------------------------
250
251      CALL rst_read_open           ! open restart for reading (if not already opened)
252
253      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
254      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN
255         CALL iom_get( numror, 'rdt', zrdt )
256         IF( zrdt /= rdt )   neuler = 0
257      ENDIF
258      IF( iom_varid( numror, 'rdttra1', ldstop = .FALSE. ) > 0 )   THEN
259         CALL iom_get( numror, 'rdttra1', zrdttra1 )
260         IF( zrdttra1 /= rdttra(1) )   neuler = 0
261      ENDIF
262      !
263      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
264         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
265         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      )
266         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
267         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
268         CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    )
269         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   )
270         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
271      ELSE
272         neuler = 0
273      ENDIF
274      !
275      CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields
276      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      )
277      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) )
278      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
279      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
280      IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN
281         CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    )
282         CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   )
283      ELSE
284         CALL div_cur( 0 )                              ! Horizontal divergence & Relative vorticity
285      ENDIF
286      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
287         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
288      ELSE
289         CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )   
290      ENDIF
291#if defined key_zdfkpp
292      IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN
293         CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly
294      ELSE
295         CALL eos( tsn, rhd, fsdept_n(:,:,:) )   ! compute rhd
296      ENDIF
297#endif
298      !
299      IF( iom_varid( numror, 'greenland_icesheet_mass', ldstop = .FALSE. ) > 0 )   THEN
300         CALL iom_get( numror, 'greenland_icesheet_mass', greenland_icesheet_mass )
301         CALL iom_get( numror, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed )
302         CALL iom_get( numror, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change )
303      ELSE
304         greenland_icesheet_mass = 0.0 
305         greenland_icesheet_mass_rate_of_change = 0.0 
306         greenland_icesheet_timelapsed = 0.0
307      ENDIF
308      IF( iom_varid( numror, 'antarctica_icesheet_mass', ldstop = .FALSE. ) > 0 )   THEN
309         CALL iom_get( numror, 'antarctica_icesheet_mass', antarctica_icesheet_mass )
310         CALL iom_get( numror, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed )
311         CALL iom_get( numror, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change )
312      ELSE
313         antarctica_icesheet_mass = 0.0 
314         antarctica_icesheet_mass_rate_of_change = 0.0 
315         antarctica_icesheet_timelapsed = 0.0
316      ENDIF
317
318      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
319         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values
320         ub   (:,:,:)   = un   (:,:,:)
321         vb   (:,:,:)   = vn   (:,:,:)
322         rotb (:,:,:)   = rotn (:,:,:)
323         hdivb(:,:,:)   = hdivn(:,:,:)
324         sshb (:,:)     = sshn (:,:)
325
326         IF( lk_vvl ) THEN
327            DO jk = 1, jpk
328               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
329            END DO
330         ENDIF
331
332      ENDIF
333      !
334   END SUBROUTINE rst_read
335
336   !!=====================================================================
337END MODULE restart
Note: See TracBrowser for help on using the repository browser.