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

Last change on this file since 719 was 719, checked in by ctlod, 14 years ago

get back to the nemo_v2_3 version for trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 18.4 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: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/restart.F90,v 1.27 2007/06/05 10:35:19 opalod Exp $
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 has more than one time 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            SELECT CASE ( jprstlib )
88            CASE ( jpnf90 )
89               WRITE(numout,*) '             open ocean restart.output NetCDF file: '//clname
90            CASE ( jprstdimg )
91               WRITE(numout,*) '             open ocean restart.output binary file: '//clname
92            END SELECT
93            IF( kt == nitrst-1 ) THEN
94               WRITE(numout,*) '             kt = nitrst - 1 = ', kt,' date= ', ndastp
95            ELSE
96               WRITE(numout,*) '             kt = ', kt,' date= ', ndastp
97            ENDIF
98         ENDIF
99
100         CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib )
101         lrst_oce = .TRUE.
102      ENDIF
103      !
104   END SUBROUTINE rst_opn
105
106
107   SUBROUTINE rst_write( kt )
108      !!---------------------------------------------------------------------
109      !!                   ***  ROUTINE rstwrite  ***
110      !!                     
111      !! ** Purpose :   Write restart fields in the format corresponding to jprstlib
112      !!
113      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
114      !!      file, save fields which are necessary for restart
115      !!----------------------------------------------------------------------
116      INTEGER, INTENT(in) ::   kt   ! ocean time-step
117      !!----------------------------------------------------------------------
118
119      ! calendar control
120      CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step
121      CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
122      CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
123      !                                                                     ! the begining of the run [s]
124      CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt               )   ! dynamics time step
125      CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1)         )   ! surface tracer time step
126
127      ! prognostic variables
128      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub      )   
129      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb      )
130      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tb      )
131      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , sb      )
132      CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb    )
133      CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb   )
134      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un      )
135      CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn      )
136      IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'wn'     , wn      )
137      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tn      )
138      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , sn      )
139      CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn    )
140      CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn   )
141
142#if defined key_ice_lim       
143      CALL iom_rstput( kt, nitrst, numrow, 'nfice'  , REAL( nfice, wp) )   !  ice computation frequency
144      CALL iom_rstput( kt, nitrst, numrow, 'sst_io' , sst_io  )
145      CALL iom_rstput( kt, nitrst, numrow, 'sss_io' , sss_io  )
146      CALL iom_rstput( kt, nitrst, numrow, 'u_io'   , u_io    )
147      CALL iom_rstput( kt, nitrst, numrow, 'v_io'   , v_io    )
148# if defined key_coupled
149      CALL iom_rstput( kt, nitrst, numrow, 'alb_ice', alb_ice )
150# endif
151#endif
152#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core 
153      CALL iom_rstput( kt, nitrst, numrow, 'nfbulk' , REAL( nfbulk, wp) )   !  bulk computation frequency
154      CALL iom_rstput( kt, nitrst, numrow, 'gsst'   , gsst    )
155#endif
156
157      IF( nn_dynhpg_rst == 1 .OR. lk_vvl ) THEN
158         CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd  )
159         CALL iom_rstput( kt, nitrst, numrow, 'rhop', rhop )
160         IF( ln_zps ) THEN
161            CALL iom_rstput( kt, nitrst, numrow, 'gtu' , gtu )
162            CALL iom_rstput( kt, nitrst, numrow, 'gsu' , gsu )
163            CALL iom_rstput( kt, nitrst, numrow, 'gru' , gru )
164            CALL iom_rstput( kt, nitrst, numrow, 'gtv' , gtv )
165            CALL iom_rstput( kt, nitrst, numrow, 'gsv' , gsv )
166            CALL iom_rstput( kt, nitrst, numrow, 'grv' , grv )
167         ENDIF
168      ENDIF
169
170      IF( kt == nitrst ) THEN
171         CALL iom_close( numrow )     ! close the restart file (only at last time step)
172         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
173      ENDIF
174      !
175   END SUBROUTINE rst_write
176
177
178   SUBROUTINE rst_read
179      !!----------------------------------------------------------------------
180      !!                   ***  ROUTINE rst_read  ***
181      !!
182      !! ** Purpose :   Read files for restart (format fixed by jprstlib )
183      !!
184      !! ** Method  :   Read the previous fields on the NetCDF/binary file
185      !!      the first record indicates previous characterics
186      !!      after control with the present run, we read :
187      !!      - prognostic variables on the second record
188      !!      - elliptic solver arrays
189      !!      - barotropic stream function arrays ("key_dynspg_rl" defined)
190      !!        or free surface arrays
191      !!      - tke arrays (lk_zdftke=T)
192      !!      for this last three records,  the previous characteristics
193      !!      could be different with those used in the present run.
194      !!
195      !!   According to namelist parameter nrstdt,
196      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
197      !!       nrstdt = 1  we verify that nit000 is equal to the last
198      !!                   time step of previous run + 1.
199      !!       In both those options, the  exact duration of the experiment
200      !!       since the beginning (cumulated duration of all previous restart runs)
201      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
202      !!       This is valid is the time step has remained constant.
203      !!
204      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
205      !!                    has been stored in the restart file.
206      !!----------------------------------------------------------------------
207      REAL(wp) ::   zcoef, zkt, zrdt, zrdttra1, zndastp, znfice, znfbulk
208#if defined key_ice_lim
209      INTEGER  ::   ji, jj
210#endif
211      !!----------------------------------------------------------------------
212
213      IF(lwp) THEN                                             ! Contol prints
214         WRITE(numout,*)
215         SELECT CASE ( jprstlib )
216         CASE ( jpnf90 )
217            WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
218         CASE ( jprstdimg )
219            WRITE(numout,*) 'rst_read : read oce binary restart file'
220         END SELECT
221         WRITE(numout,*) '~~~~~~~~'
222
223         WRITE(numout,*) ' *** Info on the present job : '
224         WRITE(numout,*) '   time-step           : ', nit000
225         WRITE(numout,*) '   date ndastp         : ', ndastp
226         WRITE(numout,*)
227         WRITE(numout,*) ' *** restart option'
228         SELECT CASE ( nrstdt )
229         CASE ( 0 ) 
230            WRITE(numout,*) ' nrstdt = 0 no control of nit000'
231         CASE ( 1 ) 
232            WRITE(numout,*) ' nrstdt = 1 we control the date of nit000'
233         CASE ( 2 )
234            WRITE(numout,*) ' nrstdt = 2 the date adatrj is read in restart file'
235         CASE DEFAULT
236            WRITE(numout,*) '  ===>>>> nrstdt not equal 0, 1 or 2 : no control of the date'
237            WRITE(numout,*) '  =======                  ========='
238         END SELECT
239         WRITE(numout,*)
240      ENDIF
241
242      CALL iom_open( 'restart', numror, kiolib = jprstlib )
243
244      ! Calendar informations
245      CALL iom_get( numror, 'kt'     , zkt      )   ! time-step
246      CALL iom_get( numror, 'ndastp' , zndastp  )   ! date
247      IF(lwp) THEN
248         WRITE(numout,*)
249         WRITE(numout,*) ' *** Info on the restart file read : '
250         WRITE(numout,*) '   time-step           : ', NINT( zkt )
251         WRITE(numout,*) '   date ndastp         : ', NINT( zndastp )
252         WRITE(numout,*)
253      ENDIF
254      ! Control of date
255      IF( nit000 - NINT( zkt )  /= 1 .AND. nrstdt /= 0 ) &
256           & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', &
257           & ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
258      ! re-initialisation of  adatrj0
259      adatrj0 = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
260      IF ( nrstdt == 2 ) THEN
261         ! by default ndatsp has been set to ndate0 in dom_nam
262         ! ndate0 has been read in the namelist (standard OPA 8)
263         ! here when nrstdt=2 we keep the  final date of previous run
264         ndastp = NINT( zndastp )
265         CALL iom_get( numror, 'adatrj', adatrj )   ! number of elapsed days since the begining of last run
266      ENDIF
267      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
268      IF( iom_varid( numror, 'rdt' ) > 0 )   THEN
269         CALL iom_get( numror, 'rdt', zrdt )
270         IF( zrdt /= rdt )   neuler = 0
271      ENDIF
272      IF( iom_varid( numror, 'rdttra1' ) > 0 )   THEN
273         CALL iom_get( numror, 'rdttra1', zrdttra1 )
274         IF( zrdttra1 /= rdttra(1) )   neuler = 0
275      ENDIF
276      !
277      !                                                       ! Read prognostic variables
278      CALL iom_get( numror, jpdom_autoglo, 'ub'   , ub    )        ! before i-component velocity
279      CALL iom_get( numror, jpdom_autoglo, 'vb'   , vb    )        ! before j-component velocity
280      CALL iom_get( numror, jpdom_autoglo, 'tb'   , tb    )        ! before temperature
281      CALL iom_get( numror, jpdom_autoglo, 'sb'   , sb    )        ! before salinity
282      CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb  )        ! before curl
283      CALL iom_get( numror, jpdom_autoglo, 'hdivb', hdivb )        ! before horizontal divergence
284      CALL iom_get( numror, jpdom_autoglo, 'un'   , un    )        ! now    i-component velocity
285      CALL iom_get( numror, jpdom_autoglo, 'vn'   , vn    )        ! now    j-component velocity
286      IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'wn'   , wn    )        ! now    k-component velocity
287      CALL iom_get( numror, jpdom_autoglo, 'tn'   , tn    )        ! now    temperature
288      CALL iom_get( numror, jpdom_autoglo, 'sn'   , sn    )        ! now    salinity
289      CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn  )        ! now    curl
290      CALL iom_get( numror, jpdom_autoglo, 'hdivn', hdivn )        ! now    horizontal divergence
291
292
293      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
294         tb   (:,:,:) = tn   (:,:,:)                             ! all before fields set to now field values
295         sb   (:,:,:) = sn   (:,:,:)
296         ub   (:,:,:) = un   (:,:,:)
297         vb   (:,:,:) = vn   (:,:,:)
298         rotb (:,:,:) = rotn (:,:,:)
299         hdivb(:,:,:) = hdivn(:,:,:)
300      ENDIF
301
302      !!sm: TO BE MOVED IN NEW SURFACE MODULE...
303
304#if defined key_ice_lim
305      ! Louvain La Neuve Sea Ice Model
306      IF( iom_varid( numror, 'nfice' ) > 0 ) then
307         CALL iom_get( numror             , 'nfice'  , znfice  )   ! ice computation frequency
308         CALL iom_get( numror, jpdom_autoglo, 'sst_io' , sst_io  )
309         CALL iom_get( numror, jpdom_autoglo, 'sss_io' , sss_io  )
310         CALL iom_get( numror, jpdom_autoglo, 'u_io'   , u_io    )
311         CALL iom_get( numror, jpdom_autoglo, 'v_io'   , v_io    )
312# if defined key_coupled
313         CALL iom_get( numror, jpdom_autoglo, 'alb_ice', alb_ice )
314# endif
315         IF( znfice /= REAL( nfice, wp ) ) THEN      ! if nfice changed between 2 runs
316            zcoef = REAL( nfice-1, wp ) / znfice
317            sst_io(:,:) = zcoef * sst_io(:,:)
318            sss_io(:,:) = zcoef * sss_io(:,:)
319            u_io  (:,:) = zcoef * u_io  (:,:)
320            v_io  (:,:) = zcoef * v_io  (:,:)
321         ENDIF
322      ELSE
323         IF(lwp) WRITE(numout,*)
324         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
325         IF(lwp) WRITE(numout,*)
326         zcoef = REAL( nfice-1, wp )
327         sst_io(:,:) = zcoef *( tn(:,:,1) + rt0 )          !!bug a explanation is needed here!
328         sss_io(:,:) = zcoef *  sn(:,:,1)
329         zcoef = 0.5 * REAL( nfice-1, wp )
330         DO jj = 2, jpj
331            DO ji = fs_2, jpi   ! vector opt.
332               u_io(ji,jj) = zcoef * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) )
333               v_io(ji,jj) = zcoef * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) )
334            END DO
335         END DO
336# if defined key_coupled
337         alb_ice(:,:) = 0.8 * tmask(:,:,1)
338# endif
339      ENDIF
340#endif
341#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core 
342      ! Louvain La Neuve Sea Ice Model
343      IF( iom_varid( numror, 'nfbulk' ) > 0 ) THEN
344         CALL iom_get( numror             , 'nfbulk', znfbulk )   ! bulk computation frequency
345         CALL iom_get( numror, jpdom_autoglo, 'gsst'  , gsst    )
346         IF( znfbulk /= REAL(nfbulk, wp) ) THEN      ! if you change nfbulk between 2 runs
347            zcoef = REAL( nfbulk-1, wp ) / znfbulk
348            gsst(:,:) = zcoef * gsst(:,:)
349         ENDIF
350      ELSE
351         IF(lwp) WRITE(numout,*)
352         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
353         IF(lwp) WRITE(numout,*)
354         gsst(:,:) = REAL( nfbulk - 1, wp )*( tn(:,:,1) + rt0 )
355      ENDIF
356#endif
357
358      !!sm: end of TO BE MOVED IN NEW SURFACE MODULE...
359
360      IF( iom_varid( numror, 'rhd' ) > 0 ) THEN
361         CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd  )
362         CALL iom_get( numror, jpdom_autoglo, 'rhop', rhop )
363      ELSE
364         CALL eos( tb, sb, rhd, rhop )        ! before potential and in situ densities
365      ENDIF
366      IF( ln_zps .AND. .NOT. lk_cfg_1d ) THEN
367         IF( iom_varid( numror, 'gtu' ) > 0 ) THEN
368            CALL iom_get( numror, jpdom_autoglo, 'gtu' , gtu )
369            CALL iom_get( numror, jpdom_autoglo, 'gsu' , gsu )
370            CALL iom_get( numror, jpdom_autoglo, 'gru' , gru )
371            CALL iom_get( numror, jpdom_autoglo, 'gtv' , gtv )
372            CALL iom_get( numror, jpdom_autoglo, 'gsv' , gsv )
373            CALL iom_get( numror, jpdom_autoglo, 'grv' , grv )
374         ELSE
375            CALL zps_hde( nit000, tb , sb , rhd,   &  ! Partial steps: before Horizontal DErivative
376               &                  gtu, gsu, gru,   &  ! of t, s, rd at the bottom ocean level
377               &                  gtv, gsv, grv )
378         ENDIF
379      ENDIF
380      !
381   END SUBROUTINE rst_read
382
383
384   !!=====================================================================
385END MODULE restart
Note: See TracBrowser for help on using the repository browser.