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/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

source: branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90 @ 5417

Last change on this file since 5417 was 5417, checked in by deazer, 9 years ago

Rolling back previous commit to allow application of removal of svn keywords.
Changes will be brought back in afterward. This should then allwo fcm to merge
for rose build.
  • Property svn:keywords set to Id
File size: 13.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   !!----------------------------------------------------------------------
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 eosbn2          ! equation of state            (eos bn2 routine)
24   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
25   USE divcur          ! hor. divergence and curl      (div & cur routines)
26   USE sbc_ice, ONLY : lk_lim3
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   rst_opn         ! routine called by step module
32   PUBLIC   rst_write       ! routine called by step module
33   PUBLIC   rst_read        ! routine called by istate module
34   PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init
35
36   !! * Substitutions
37#  include "domzgr_substitute.h90"
38#  include "vectopt_loop_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
41   !! $Id$
42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE rst_opn( kt )
47      !!---------------------------------------------------------------------
48      !!                   ***  ROUTINE rst_opn  ***
49      !!                     
50      !! ** Purpose : + initialization (should be read in the namelist) of nitrst
51      !!              + open the restart when we are one time step before nitrst
52      !!                   - restart header is defined when kt = nitrst-1
53      !!                   - restart data  are written when kt = nitrst
54      !!              + define lrst_oce to .TRUE. when we need to define or write the restart
55      !!----------------------------------------------------------------------
56      INTEGER, INTENT(in) ::   kt     ! ocean time-step
57      !!
58      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
59      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
60      !!----------------------------------------------------------------------
61      !
62      IF( kt == nit000 ) THEN   ! default definitions
63         lrst_oce = .FALSE.   
64         nitrst = nitend
65      ENDIF
66      IF( MOD( kt - 1, nstock ) == 0 ) THEN   
67         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
68         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
69         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
70      ENDIF
71      ! to get better performances with NetCDF format:
72      ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1)
73      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1
74      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
75         ! beware of the format used to write kt (default is i8.8, that should be large enough...)
76         IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
77         ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
78         ENDIF
79         ! create the file
80         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
81         IF(lwp) THEN
82            WRITE(numout,*)
83            SELECT CASE ( jprstlib )
84            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart binary file: '//clname
85            CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart NetCDF file: '//clname
86            END SELECT
87            IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression'
88            IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt
89            ELSE                          ;   WRITE(numout,*) '             kt = '             , kt
90            ENDIF
91         ENDIF
92         !
93         CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib )
94         lrst_oce = .TRUE.
95      ENDIF
96      !
97   END SUBROUTINE rst_opn
98
99
100   SUBROUTINE rst_write( kt )
101      !!---------------------------------------------------------------------
102      !!                   ***  ROUTINE rstwrite  ***
103      !!                     
104      !! ** Purpose :   Write restart fields in the format corresponding to jprstlib
105      !!
106      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
107      !!              file, save fields which are necessary for restart
108      !!----------------------------------------------------------------------
109      INTEGER, INTENT(in) ::   kt   ! ocean time-step
110      !!----------------------------------------------------------------------
111
112                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics time step
113                     CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) )   ! surface tracer time step
114
115                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields
116                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        )
117                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) )
118                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) )
119                     CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      )
120                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     )
121                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      )
122                     !
123      IF( lk_lim3 )  CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )
124                     !
125                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields
126                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        )
127                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) )
128                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) )
129                     CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      )
130                     CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     )
131                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      )
132                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      )
133#if defined key_zdfkpp
134                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       )
135#endif
136                  IF( lk_lim3 ) THEN
137                     CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev'  , fraqsr_1lev     ) !clem modif
138                  ENDIF
139      IF( kt == nitrst ) THEN
140         CALL iom_close( numrow )     ! close the restart file (only at last time step)
141!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
142!!gm  not sure what to do here   ===>>>  ask to Sebastian
143         lrst_oce = .FALSE.
144      ENDIF
145      !
146   END SUBROUTINE rst_write
147
148
149   SUBROUTINE rst_read_open
150      !!----------------------------------------------------------------------
151      !!                   ***  ROUTINE rst_read_open  ***
152      !!
153      !! ** Purpose :   Open read files for restart (format fixed by jprstlib )
154      !!
155      !! ** Method  :   Use a non-zero, positive value of numror to assess whether or not
156      !!                the file has already been opened
157      !!----------------------------------------------------------------------
158      INTEGER  ::   jlibalt = jprstlib
159      LOGICAL  ::   llok
160      !!----------------------------------------------------------------------
161      !
162      IF( numror <= 0 ) THEN
163         IF(lwp) THEN                                             ! Contol prints
164            WRITE(numout,*)
165            SELECT CASE ( jprstlib )
166            CASE ( jpnf90    )   ;   WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
167            CASE ( jprstdimg )   ;   WRITE(numout,*) 'rst_read : read oce binary restart file'
168            END SELECT
169            IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
170            WRITE(numout,*) '~~~~~~~~'
171         ENDIF
172
173         IF ( jprstlib == jprstdimg ) THEN
174           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
175           ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90
176           INQUIRE( FILE = TRIM(cn_ocerst_in)//'.nc', EXIST = llok )
177           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
178         ENDIF
179         CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt )
180      ENDIF
181   END SUBROUTINE rst_read_open
182
183   SUBROUTINE rst_read
184      !!----------------------------------------------------------------------
185      !!                   ***  ROUTINE rst_read  ***
186      !!
187      !! ** Purpose :   Read files for restart (format fixed by jprstlib )
188      !!
189      !! ** Method  :   Read in restart.nc file fields which are necessary for restart
190      !!----------------------------------------------------------------------
191      REAL(wp) ::   zrdt, zrdttra1
192      INTEGER  ::   jk
193      LOGICAL  ::   llok
194      !!----------------------------------------------------------------------
195
196      CALL rst_read_open           ! open restart for reading (if not already opened)
197
198      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
199      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN
200         CALL iom_get( numror, 'rdt', zrdt )
201         IF( zrdt /= rdt )   neuler = 0
202      ENDIF
203      IF( iom_varid( numror, 'rdttra1', ldstop = .FALSE. ) > 0 )   THEN
204         CALL iom_get( numror, 'rdttra1', zrdttra1 )
205         IF( zrdttra1 /= rdttra(1) )   neuler = 0
206      ENDIF
207      !
208      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
209         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
210         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      )
211         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
212         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
213         CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    )
214         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   )
215         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
216         IF( lk_lim3 )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )
217      ELSE
218         neuler = 0
219      ENDIF
220      !
221      CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields
222      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      )
223      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) )
224      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
225      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
226      IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN
227         CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    )
228         CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   )
229      ELSE
230         CALL div_cur( 0 )                              ! Horizontal divergence & Relative vorticity
231      ENDIF
232      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
233         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
234      ELSE
235         CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )   
236      ENDIF
237#if defined key_zdfkpp
238      IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN
239         CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly
240      ELSE
241         CALL eos( tsn, rhd, fsdept_n(:,:,:) )   ! compute rhd
242      ENDIF
243#endif
244      !
245      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
246         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values
247         ub   (:,:,:)   = un   (:,:,:)
248         vb   (:,:,:)   = vn   (:,:,:)
249         rotb (:,:,:)   = rotn (:,:,:)
250         hdivb(:,:,:)   = hdivn(:,:,:)
251         sshb (:,:)     = sshn (:,:)
252
253         IF( lk_vvl ) THEN
254            DO jk = 1, jpk
255               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
256            END DO
257         ENDIF
258
259         IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN
260            DO jk = 1, jpk
261               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
262            END DO
263         ENDIF
264
265      ENDIF
266      !
267      IF( lk_lim3 ) THEN
268         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev )
269      ENDIF
270      !
271   END SUBROUTINE rst_read
272
273   !!=====================================================================
274END MODULE restart
Note: See TracBrowser for help on using the repository browser.