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 trunk/NEMO/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/restart.F90 @ 709

Last change on this file since 709 was 709, checked in by smasson, 17 years ago

continue changeset:704, see ticket:5
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 18.3 KB
Line 
1MODULE restart
2   !!======================================================================
3   !!                     ***  MODULE  restart  ***
4   !! Ocean restart :  write the ocean restart file
5   !!======================================================================
6   !! History :        !  99-11  (M. Imbard)  Original code
7   !!             8.5  !  02-08  (G. Madec)  F90: Free form
8   !!             9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
9   !!             9.0  !  06-07  (S. Masson)  use IOM for restart
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   rst_opn    : open the ocean restart file
14   !!   rst_write  : write the ocean restart file
15   !!   rst_read   : read the ocean restart file
16   !!----------------------------------------------------------------------
17   USE dom_oce         ! ocean space and time domain
18   USE oce             ! ocean dynamics and tracers
19   USE phycst          ! physical constants
20   USE daymod          ! calendar
21   USE ice_oce         ! ice variables
22   USE cpl_oce, ONLY : lk_cpl              !
23   USE in_out_manager  ! I/O manager
24   USE iom             ! I/O module
25   USE ini1d           ! re-initialization of u-v mask for the 1D configuration
26   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
27   USE eosbn2          ! equation of state            (eos bn2 routine)
28   USE trdmld_oce      ! ocean active mixed layer tracers trends variables
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   rst_opn    ! routine called by step module
34   PUBLIC   rst_write  ! routine called by step module
35   PUBLIC   rst_read   ! routine called by opa  module
36
37   LOGICAL, PUBLIC ::   lrst_oce                  !: logical to control the oce restart write
38   INTEGER, PUBLIC ::   numror, numrow            !: logical unit for cean restart (read and write)
39
40   !! * Substitutions
41#  include "vectopt_loop_substitute.h90"
42   !!----------------------------------------------------------------------
43   !!  OPA 9.0 , LOCEAN-IPSL (2006)
44   !! $Id$
45   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
46   !!----------------------------------------------------------------------
47
48CONTAINS
49
50   SUBROUTINE rst_opn( kt )
51      !!---------------------------------------------------------------------
52      !!                   ***  ROUTINE rst_opn  ***
53      !!                     
54      !! ** Purpose : + initialization (should be read in the namelist) of nitrst
55      !!              + open the restart when we are one time step before nitrst
56      !!                   - restart header is defined when kt = nitrst-1
57      !!                   - restart data  are written when kt = nitrst
58      !!              + define lrst_oce to .TRUE. when we need to define or write the restart
59      !!----------------------------------------------------------------------
60      INTEGER, INTENT(in) ::   kt     ! ocean time-step
61      !!
62      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
63      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
64      !!----------------------------------------------------------------------
65      !
66      IF( kt == nit000 ) THEN   ! default initialization, to do: should be read in the namelist...
67         nitrst = nitend        ! to do: should be read in the namelist in a cleaver way...
68         lrst_oce = .FALSE.
69      ENDIF
70
71      IF    ( kt == nitrst-1 .AND. lrst_oce         ) THEN
72         CALL ctl_stop( 'rst_opn: we cannot create an ocean restart at every time step',    &
73            &           'if the run has more than one time step!!!' )
74         numrow = 0
75      ELSEIF( kt == nitrst-1 .OR.  nitend == nit000 ) THEN   ! beware if model runs only one time step
76         ! beware of the format used to write kt (default is i8.8, that should be large enough)
77         IF( nitrst > 1.0e9 ) THEN   
78            WRITE(clkt,*) nitrst
79         ELSE
80            WRITE(clkt,'(i8.8)') nitrst
81         ENDIF
82         ! create the file
83         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_restart"
84         IF(lwp) THEN
85            WRITE(numout,*)
86            SELECT CASE ( jprstlib )
87            CASE ( jpnf90 )
88               WRITE(numout,*) '             open ocean restart.output NetCDF file: '//clname
89            CASE ( jprstdimg )
90               WRITE(numout,*) '             open ocean restart.output binary file: '//clname
91            END SELECT
92            IF( kt == nitrst-1 ) THEN
93               WRITE(numout,*) '             kt = nitrst - 1 = ', kt,' date= ', ndastp
94            ELSE
95               WRITE(numout,*) '             kt = ', kt,' date= ', ndastp
96            ENDIF
97         ENDIF
98
99         CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib )
100         lrst_oce = .TRUE.
101      ENDIF
102      !
103   END SUBROUTINE rst_opn
104
105
106   SUBROUTINE rst_write( kt )
107      !!---------------------------------------------------------------------
108      !!                   ***  ROUTINE rstwrite  ***
109      !!                     
110      !! ** Purpose :   Write restart fields in the format corresponding to jprstlib
111      !!
112      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
113      !!      file, save fields which are necessary for restart
114      !!----------------------------------------------------------------------
115      INTEGER, INTENT(in) ::   kt   ! ocean time-step
116      !!----------------------------------------------------------------------
117
118      ! calendar control
119      CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step
120      CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
121      CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
122      !                                                                     ! the begining of the run [s]
123      CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt               )   ! dynamics time step
124      CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1)         )   ! surface tracer time step
125
126      ! prognostic variables
127      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub      )   
128      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb      )
129      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tb      )
130      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , sb      )
131      CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb    )
132      CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb   )
133      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un      )
134      CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn      )
135      IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'wn'     , wn      )
136      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tn      )
137      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , sn      )
138      CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn    )
139      CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn   )
140
141#if defined key_ice_lim       
142      CALL iom_rstput( kt, nitrst, numrow, 'nfice'  , REAL( nfice, wp) )   !  ice computation frequency
143      CALL iom_rstput( kt, nitrst, numrow, 'sst_io' , sst_io  )
144      CALL iom_rstput( kt, nitrst, numrow, 'sss_io' , sss_io  )
145      CALL iom_rstput( kt, nitrst, numrow, 'u_io'   , u_io    )
146      CALL iom_rstput( kt, nitrst, numrow, 'v_io'   , v_io    )
147# if defined key_coupled
148      CALL iom_rstput( kt, nitrst, numrow, 'alb_ice', alb_ice )
149# endif
150#endif
151#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core 
152      CALL iom_rstput( kt, nitrst, numrow, 'nfbulk' , REAL( nfbulk, wp) )   !  bulk computation frequency
153      CALL iom_rstput( kt, nitrst, numrow, 'gsst'   , gsst    )
154#endif
155
156      IF( nn_dynhpg_rst == 1 .OR. lk_vvl ) THEN
157         CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd  )
158         CALL iom_rstput( kt, nitrst, numrow, 'rhop', rhop )
159         IF( ln_zps ) THEN
160            CALL iom_rstput( kt, nitrst, numrow, 'gtu' , gtu )
161            CALL iom_rstput( kt, nitrst, numrow, 'gsu' , gsu )
162            CALL iom_rstput( kt, nitrst, numrow, 'gru' , gru )
163            CALL iom_rstput( kt, nitrst, numrow, 'gtv' , gtv )
164            CALL iom_rstput( kt, nitrst, numrow, 'gsv' , gsv )
165            CALL iom_rstput( kt, nitrst, numrow, 'grv' , grv )
166         ENDIF
167      ENDIF
168
169      IF( kt == nitrst ) THEN
170         CALL iom_close( numrow )     ! close the restart file (only at last time step)
171         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
172      ENDIF
173      !
174   END SUBROUTINE rst_write
175
176
177   SUBROUTINE rst_read
178      !!----------------------------------------------------------------------
179      !!                   ***  ROUTINE rst_read  ***
180      !!
181      !! ** Purpose :   Read files for restart (format fixed by jprstlib )
182      !!
183      !! ** Method  :   Read the previous fields on the NetCDF/binary file
184      !!      the first record indicates previous characterics
185      !!      after control with the present run, we read :
186      !!      - prognostic variables on the second record
187      !!      - elliptic solver arrays
188      !!      - barotropic stream function arrays ("key_dynspg_rl" defined)
189      !!        or free surface arrays
190      !!      - tke arrays (lk_zdftke=T)
191      !!      for this last three records,  the previous characteristics
192      !!      could be different with those used in the present run.
193      !!
194      !!   According to namelist parameter nrstdt,
195      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
196      !!       nrstdt = 1  we verify that nit000 is equal to the last
197      !!                   time step of previous run + 1.
198      !!       In both those options, the  exact duration of the experiment
199      !!       since the beginning (cumulated duration of all previous restart runs)
200      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
201      !!       This is valid is the time step has remained constant.
202      !!
203      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
204      !!                    has been stored in the restart file.
205      !!----------------------------------------------------------------------
206      REAL(wp) ::   zcoef, zkt, zrdt, zrdttra1, zndastp, znfice, znfbulk
207#if defined key_ice_lim
208      INTEGER  ::   ji, jj
209#endif
210      !!----------------------------------------------------------------------
211
212      IF(lwp) THEN                                             ! Contol prints
213         WRITE(numout,*)
214         SELECT CASE ( jprstlib )
215         CASE ( jpnf90 )
216            WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
217         CASE ( jprstdimg )
218            WRITE(numout,*) 'rst_read : read oce binary restart file'
219         END SELECT
220         WRITE(numout,*) '~~~~~~~~'
221
222         WRITE(numout,*) ' *** Info on the present job : '
223         WRITE(numout,*) '   time-step           : ', nit000
224         WRITE(numout,*) '   date ndastp         : ', ndastp
225         WRITE(numout,*)
226         WRITE(numout,*) ' *** restart option'
227         SELECT CASE ( nrstdt )
228         CASE ( 0 ) 
229            WRITE(numout,*) ' nrstdt = 0 no control of nit000'
230         CASE ( 1 ) 
231            WRITE(numout,*) ' nrstdt = 1 we control the date of nit000'
232         CASE ( 2 )
233            WRITE(numout,*) ' nrstdt = 2 the date adatrj is read in restart file'
234         CASE DEFAULT
235            WRITE(numout,*) '  ===>>>> nrstdt not equal 0, 1 or 2 : no control of the date'
236            WRITE(numout,*) '  =======                  ========='
237         END SELECT
238         WRITE(numout,*)
239      ENDIF
240
241      CALL iom_open( 'restart', numror, kiolib = jprstlib )
242
243      ! Calendar informations
244      CALL iom_get( numror, 'kt'     , zkt      )   ! time-step
245      CALL iom_get( numror, 'ndastp' , zndastp  )   ! date
246      IF(lwp) THEN
247         WRITE(numout,*)
248         WRITE(numout,*) ' *** Info on the restart file read : '
249         WRITE(numout,*) '   time-step           : ', NINT( zkt )
250         WRITE(numout,*) '   date ndastp         : ', NINT( zndastp )
251         WRITE(numout,*)
252      ENDIF
253      ! Control of date
254      IF( nit000 - NINT( zkt )  /= 1 .AND. nrstdt /= 0 ) &
255           & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', &
256           & ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
257      ! re-initialisation of  adatrj0
258      adatrj0 = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
259      IF ( nrstdt == 2 ) THEN
260         ! by default ndatsp has been set to ndate0 in dom_nam
261         ! ndate0 has been read in the namelist (standard OPA 8)
262         ! here when nrstdt=2 we keep the  final date of previous run
263         ndastp = NINT( zndastp )
264         CALL iom_get( numror, 'adatrj', adatrj )   ! number of elapsed days since the begining of last run
265      ENDIF
266      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
267      IF( iom_varid( numror, 'rdt' ) > 0 )   THEN
268         CALL iom_get( numror, 'rdt', zrdt )
269         IF( zrdt /= rdt )   neuler = 0
270      ENDIF
271      IF( iom_varid( numror, 'rdttra1' ) > 0 )   THEN
272         CALL iom_get( numror, 'rdttra1', zrdttra1 )
273         IF( zrdttra1 /= rdttra(1) )   neuler = 0
274      ENDIF
275      !
276      !                                                       ! Read prognostic variables
277      CALL iom_get( numror, jpdom_autoglo, 'ub'   , ub    )        ! before i-component velocity
278      CALL iom_get( numror, jpdom_autoglo, 'vb'   , vb    )        ! before j-component velocity
279      CALL iom_get( numror, jpdom_autoglo, 'tb'   , tb    )        ! before temperature
280      CALL iom_get( numror, jpdom_autoglo, 'sb'   , sb    )        ! before salinity
281      CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb  )        ! before curl
282      CALL iom_get( numror, jpdom_autoglo, 'hdivb', hdivb )        ! before horizontal divergence
283      CALL iom_get( numror, jpdom_autoglo, 'un'   , un    )        ! now    i-component velocity
284      CALL iom_get( numror, jpdom_autoglo, 'vn'   , vn    )        ! now    j-component velocity
285      IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'wn'   , wn    )        ! now    k-component velocity
286      CALL iom_get( numror, jpdom_autoglo, 'tn'   , tn    )        ! now    temperature
287      CALL iom_get( numror, jpdom_autoglo, 'sn'   , sn    )        ! now    salinity
288      CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn  )        ! now    curl
289      CALL iom_get( numror, jpdom_autoglo, 'hdivn', hdivn )        ! now    horizontal divergence
290
291
292      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
293         tb   (:,:,:) = tn   (:,:,:)                             ! all before fields set to now field values
294         sb   (:,:,:) = sn   (:,:,:)
295         ub   (:,:,:) = un   (:,:,:)
296         vb   (:,:,:) = vn   (:,:,:)
297         rotb (:,:,:) = rotn (:,:,:)
298         hdivb(:,:,:) = hdivn(:,:,:)
299      ENDIF
300
301      !!sm: TO BE MOVED IN NEW SURFACE MODULE...
302
303#if defined key_ice_lim
304      ! Louvain La Neuve Sea Ice Model
305      IF( iom_varid( numror, 'nfice' ) > 0 ) then
306         CALL iom_get( numror             , 'nfice'  , znfice  )   ! ice computation frequency
307         CALL iom_get( numror, jpdom_autoglo, 'sst_io' , sst_io  )
308         CALL iom_get( numror, jpdom_autoglo, 'sss_io' , sss_io  )
309         CALL iom_get( numror, jpdom_autoglo, 'u_io'   , u_io    )
310         CALL iom_get( numror, jpdom_autoglo, 'v_io'   , v_io    )
311# if defined key_coupled
312         CALL iom_get( numror, jpdom_autoglo, 'alb_ice', alb_ice )
313# endif
314         IF( znfice /= REAL( nfice, wp ) ) THEN      ! if nfice changed between 2 runs
315            zcoef = REAL( nfice-1, wp ) / znfice
316            sst_io(:,:) = zcoef * sst_io(:,:)
317            sss_io(:,:) = zcoef * sss_io(:,:)
318            u_io  (:,:) = zcoef * u_io  (:,:)
319            v_io  (:,:) = zcoef * v_io  (:,:)
320         ENDIF
321      ELSE
322         IF(lwp) WRITE(numout,*)
323         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
324         IF(lwp) WRITE(numout,*)
325         zcoef = REAL( nfice-1, wp )
326         sst_io(:,:) = zcoef *( tn(:,:,1) + rt0 )          !!bug a explanation is needed here!
327         sss_io(:,:) = zcoef *  sn(:,:,1)
328         zcoef = 0.5 * REAL( nfice-1, wp )
329         DO jj = 2, jpj
330            DO ji = fs_2, jpi   ! vector opt.
331               u_io(ji,jj) = zcoef * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) )
332               v_io(ji,jj) = zcoef * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) )
333            END DO
334         END DO
335# if defined key_coupled
336         alb_ice(:,:) = 0.8 * tmask(:,:,1)
337# endif
338      ENDIF
339#endif
340#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core 
341      ! Louvain La Neuve Sea Ice Model
342      IF( iom_varid( numror, 'nfbulk' ) > 0 ) THEN
343         CALL iom_get( numror             , 'nfbulk', znfbulk )   ! bulk computation frequency
344         CALL iom_get( numror, jpdom_autoglo, 'gsst'  , gsst    )
345         IF( znfbulk /= REAL(nfbulk, wp) ) THEN      ! if you change nfbulk between 2 runs
346            zcoef = REAL( nfbulk-1, wp ) / znfbulk
347            gsst(:,:) = zcoef * gsst(:,:)
348         ENDIF
349      ELSE
350         IF(lwp) WRITE(numout,*)
351         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
352         IF(lwp) WRITE(numout,*)
353         gsst(:,:) = REAL( nfbulk - 1, wp )*( tn(:,:,1) + rt0 )
354      ENDIF
355#endif
356
357      !!sm: end of TO BE MOVED IN NEW SURFACE MODULE...
358
359      IF( iom_varid( numror, 'rhd' ) > 0 ) THEN
360         CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd  )
361         CALL iom_get( numror, jpdom_autoglo, 'rhop', rhop )
362      ELSE
363         CALL eos( tb, sb, rhd, rhop )        ! before potential and in situ densities
364      ENDIF
365      IF( ln_zps .AND. .NOT. lk_cfg_1d ) THEN
366         IF( iom_varid( numror, 'gtu' ) > 0 ) THEN
367            CALL iom_get( numror, jpdom_autoglo, 'gtu' , gtu )
368            CALL iom_get( numror, jpdom_autoglo, 'gsu' , gsu )
369            CALL iom_get( numror, jpdom_autoglo, 'gru' , gru )
370            CALL iom_get( numror, jpdom_autoglo, 'gtv' , gtv )
371            CALL iom_get( numror, jpdom_autoglo, 'gsv' , gsv )
372            CALL iom_get( numror, jpdom_autoglo, 'grv' , grv )
373         ELSE
374            CALL zps_hde( nit000, tb , sb , rhd,   &  ! Partial steps: before Horizontal DErivative
375               &                  gtu, gsu, gru,   &  ! of t, s, rd at the bottom ocean level
376               &                  gtv, gsv, grv )
377         ENDIF
378      ENDIF
379      !
380   END SUBROUTINE rst_read
381
382
383   !!=====================================================================
384END MODULE restart
Note: See TracBrowser for help on using the repository browser.