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 @ 611

Last change on this file since 611 was 611, checked in by opalod, 17 years ago

nemo_v2_bugfix_015 : CT+SM : - correct dimg header record

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