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

Last change on this file since 367 was 367, checked in by opalod, 18 years ago

nemo_v1_update_035 : CT : OBCs adapted to the new surface pressure gradient algorithms

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 19.9 KB
Line 
1MODULE restart
2   !!======================================================================
3   !!                     ***  MODULE  restart  ***
4   !! Ocean restart :  write the ocean restart file
5   !!=====================================================================
6
7   !!----------------------------------------------------------------------
8   !!   rst_write  : write of the restart file
9   !!   rst_read   : read the restart file
10   !!----------------------------------------------------------------------
11   !! * Modules used
12   USE dom_oce         ! ocean space and time domain
13   USE oce             ! ocean dynamics and tracers
14   USE phycst          ! physical constants
15   USE in_out_manager  ! I/O manager
16   USE daymod          ! calendar
17   USE sol_oce         ! ocean elliptic solver
18   USE zdf_oce         ! ???
19   USE zdftke          ! turbulent kinetic energy scheme
20   USE ice_oce         ! ice variables
21   USE blk_oce         ! bulk variables
22   USE flx_oce         ! sea-ice/ocean forcings variables
23   USE dynspg_oce      ! free surface time splitting scheme variables
24   USE cpl_oce,         ONLY : lk_cpl              !
25
26   IMPLICIT NONE
27   PRIVATE
28
29   !! * Routine accessibility
30   PUBLIC rst_write  ! routine called by step.F90
31   PUBLIC rst_read   ! routine called by inidtr.F90
32
33   !! * Module variables
34   CHARACTER (len=48) ::   &
35      crestart = 'initial.nc'   ! restart file name
36   !!----------------------------------------------------------------------
37   !!  OPA 9.0 , LOCEAN-IPSL (2005)
38   !! $Header$
39   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
40   !!----------------------------------------------------------------------
41
42
43CONTAINS
44
45#if  ( defined key_mpp_mpi   ||   defined key_mpp_shmem ) && defined key_dimgout
46   !!----------------------------------------------------------------------
47   !!   'key_mpp_mpi'     OR      MPI massively parallel processing library
48   !!   'key_mpp_shmem'         SHMEM massively parallel processing library
49   !!                     AND
50   !!   'key_dimgout'         
51   !!----------------------------------------------------------------------
52   !!                 direct acces file one per processor
53   !!          (merging/splitting is done off-line, eventually)
54   !!-----------------------------------------------------------------------
55#  include "restart_dimg.h90"
56
57#else
58   !!----------------------------------------------------------------------
59   !!   Default option                                          NetCDF file
60   !!----------------------------------------------------------------------
61
62   SUBROUTINE rst_write( kt )
63      !!---------------------------------------------------------------------
64      !!                   ***  ROUTINE rstwrite  ***
65      !!                     
66      !! ** Purpose :   Write restart fields in NetCDF format
67      !!
68      !! ** Method  :   Write in numwrs file each nstock time step in NetCDF
69      !!      file, save fields which are necessary for restart
70      !!
71      !! History :
72      !!        !  99-11  (M. Imbard)  Original code
73      !!   8.5  !  02-08  (G. Madec)  F90: Free form
74      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
75      !!----------------------------------------------------------------------
76      !! * Modules used
77      USE ioipsl
78
79      !! * Arguments
80      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
81
82      !! * Local declarations
83      LOGICAL ::   llbon
84      CHARACTER (len=50) ::   clname, cln
85      INTEGER ::   ic, jc, itime
86      REAL(wp) ::   zdate0
87      REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk
88      REAL(wp), DIMENSION(10) ::   zinfo(10)
89      REAL(wp), DIMENSION(jpi,jpj) :: ztab 
90      !!----------------------------------------------------------------------
91
92      IF( kt == nit000 ) THEN
93         IF(lwp) WRITE(numout,*)
94         IF(lwp) WRITE(numout,*) 'rst_wri : write restart.output NetCDF file'
95         IF(lwp) WRITE(numout,*) '~~~~~~~'
96         zfice(1) = 1.e0   ;   zfblk(1) = 1.e0
97      ENDIF
98
99
100      IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN
101         
102         ! 0. Initializations
103         ! ------------------
104
105         IF(lwp) WRITE(numout,*) ' '
106         IF(lwp) WRITE(numout,*) 'rst_write : write the restart file in NetCDF format ',   &
107                                              'at it= ',kt,' date= ',ndastp
108         IF(lwp) WRITE(numout,*) '~~~~~~~~~'
109
110         ! Job informations
111         zinfo(1) = FLOAT( no        )   ! job number
112         zinfo(2) = FLOAT( kt        )   ! time-step
113         zinfo(3) = FLOAT( 2 - nsolv )   ! pcg solver
114         zinfo(4) = FLOAT( nsolv - 1 )   ! sor solver
115         IF( lk_zdftke ) THEN
116            zinfo(5) = 1.e0              ! TKE
117         ELSE
118            zinfo(5) = 0.e0              ! no TKE
119         ENDIF
120         zinfo(6) = FLOAT( ndastp )      ! date
121         zinfo(7) = adatrj               ! ???
122
123         ! delete the restart file if it exists
124         INQUIRE( FILE=crestart, EXIST=llbon )
125         IF(llbon) THEN
126            OPEN( UNIT=numwrs, FILE=crestart, STATUS='old' )
127            CLOSE( numwrs, STATUS='delete' )
128         ENDIF
129
130         ! Name of the new restart file
131         ic     = 1
132         DO jc = 1, 16
133            IF( cexper(jc:jc) /= ' ' )   ic = jc
134         END DO
135         WRITE(cln,'("_",i4.4,i2.2,i2.2,"_restart")') nyear, nmonth, nday
136         clname = cexper(1:ic)//cln
137         ic = 1
138         DO jc = 1, 48
139            IF( clname(jc:jc) /= ' ' ) ic = jc
140         END DO
141         crestart = clname(1:ic)//".nc"
142         itime = 0
143         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 )
144         CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept, clname,   &
145                        itime, zdate0, rdt*nstock ,numwrs, domain_id=nidom )
146
147         CALL restput( numwrs, 'info'   , 1  , 1  , 10 , 0, zinfo   )   ! restart informations
148         
149         CALL restput( numwrs, 'ub'     , jpi, jpj, jpk, 0, ub      )   ! prognostic variables
150         CALL restput( numwrs, 'vb'     , jpi, jpj, jpk, 0, vb      )
151         CALL restput( numwrs, 'tb'     , jpi, jpj, jpk, 0, tb      )
152         CALL restput( numwrs, 'sb'     , jpi, jpj, jpk, 0, sb      )
153         CALL restput( numwrs, 'rotb'   , jpi, jpj, jpk, 0, rotb    )
154         CALL restput( numwrs, 'hdivb'  , jpi, jpj, jpk, 0, hdivb   )
155         CALL restput( numwrs, 'un'     , jpi, jpj, jpk, 0, un      )
156         CALL restput( numwrs, 'vn'     , jpi, jpj, jpk, 0, vn      )
157         CALL restput( numwrs, 'tn'     , jpi, jpj, jpk, 0, tn      )
158         CALL restput( numwrs, 'sn'     , jpi, jpj, jpk, 0, sn      )
159         CALL restput( numwrs, 'rotn'   , jpi, jpj, jpk, 0, rotn    )
160         CALL restput( numwrs, 'hdivn'  , jpi, jpj, jpk, 0, hdivn   )
161
162         ztab(:,:) = gcx(1:jpi,1:jpj)
163         CALL restput( numwrs, 'gcx'    , jpi, jpj, 1  , 0, ztab    )   ! Read elliptic solver arrays
164         ztab(:,:) = gcxb(1:jpi,1:jpj)
165         CALL restput( numwrs, 'gcxb'   , jpi, jpj, 1  , 0, ztab    )
166# if defined key_dynspg_rl
167         CALL restput( numwrs, 'bsfb'   , jpi, jpj, 1  , 0, bsfb    )   ! Rigid-lid formulation (bsf)
168         CALL restput( numwrs, 'bsfn'   , jpi, jpj, 1  , 0, bsfn    )
169         CALL restput( numwrs, 'bsfd'   , jpi, jpj, 1  , 0, bsfd    )
170# else
171         CALL restput( numwrs, 'sshb'   , jpi, jpj, 1  , 0, sshb    )   ! free surface formulation (ssh)
172         CALL restput( numwrs, 'sshn'   , jpi, jpj, 1  , 0, sshn    )
173#  if defined key_dynspg_ts
174         CALL restput( numwrs, 'sshb_b' , jpi, jpj, 1  , 0, sshb_b  )   ! free surface formulation (ssh)
175         CALL restput( numwrs, 'sshn_b' , jpi, jpj, 1  , 0, sshn_b  )   ! issued from barotropic loop
176         CALL restput( numwrs, 'un_b'   , jpi, jpj, 1  , 0, un_b    )   ! horizontal transports
177         CALL restput( numwrs, 'vn_b'   , jpi, jpj, 1  , 0, vn_b    )   ! issued from barotropic loop
178#  endif
179# endif
180# if defined key_zdftke   ||   defined key_esopa
181         IF( lk_zdftke ) THEN
182            CALL restput( numwrs, 'en'     , jpi, jpj, jpk, 0, en      )   ! TKE arrays
183         ENDIF
184# endif
185# if defined key_ice_lim
186         zfice(1) = FLOAT( nfice )                                      ! Louvain La Neuve Sea Ice Model
187         CALL restput( numwrs, 'nfice'  ,   1,   1, 1  , 0, zfice   )
188         CALL restput( numwrs, 'sst_io' , jpi, jpj, 1  , 0, sst_io  )
189         CALL restput( numwrs, 'sss_io' , jpi, jpj, 1  , 0, sss_io  )
190         CALL restput( numwrs, 'u_io'   , jpi, jpj, 1  , 0, u_io    )
191         CALL restput( numwrs, 'v_io'   , jpi, jpj, 1  , 0, v_io    )
192# if defined key_coupled
193         CALL restput( numwrs, 'alb_ice', jpi, jpj, 1  , 0, alb_ice )
194# endif
195# endif
196# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
197         zfblk(1) = FLOAT( nfbulk )                                 ! Bulk
198         CALL restput( numwrs, 'nfbulk' ,   1,   1, 1  , 0, zfblk   )
199         CALL restput( numwrs, 'gsst'   , jpi, jpj, 1  , 0, gsst    )
200# endif
201
202         CALL restclo( numwrs )                                         ! close the restart file
203         
204      ENDIF
205
206   END SUBROUTINE rst_write
207
208
209   SUBROUTINE rst_read
210      !!----------------------------------------------------------------------
211      !!                   ***  ROUTINE rst_read  ***
212      !!
213      !! ** Purpose :   Read files for restart
214      !!
215      !! ** Method  :   Read the previous fields on the NetCDF file
216      !!      the first record indicates previous characterics
217      !!      after control with the present run, we read :
218      !!      - prognostic variables on the second record
219      !!      - elliptic solver arrays
220      !!      - barotropic stream function arrays ("key_dynspg_rl" defined)
221      !!        or free surface arrays
222      !!      - tke arrays (lk_zdftke=T)
223      !!      for this last three records,  the previous characteristics
224      !!      could be different with those used in the present run.
225      !!
226      !!   According to namelist parameter nrstdt,
227      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
228      !!       nrstdt = 1  we verify that nit000 is equal to the last
229      !!                   time step of previous run + 1.
230      !!       In both those options, the  exact duration of the experiment
231      !!       since the beginning (cumulated duration of all previous restart runs)
232      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
233      !!       This is valid is the time step has remained constant.
234      !!
235      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
236      !!                    has been stored in the restart file.
237      !!
238      !! History :
239      !!        !  99-05  (M. Imbard)  Original code
240      !!   8.5  !  02-09  (G. Madec)  F90: Free form
241      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
242      !!----------------------------------------------------------------------
243      !! * Modules used
244      USE ioipsl
245
246      !! * Local declarations
247      LOGICAL ::   llog
248      CHARACTER (len=8 ) ::   clvnames(50)
249      CHARACTER (len=32) ::   clname = 'restart'
250      INTEGER  ::   &
251         itime, ibvar,     &  !
252         inum                 ! temporary logical unit
253      REAL(wp) ::   zdate0, zdt, zinfo(10)
254      REAL(wp) ::   zdept(jpk), zlamt(jpi,jpj), zphit(jpi,jpj)
255      REAL(wp), DIMENSION(jpi,jpj) :: ztab 
256#   if defined key_ice_lim
257      INTEGER  ::   ios1, ji, jj, jn
258      REAL(wp) ::   zfice(1)
259#   endif
260# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
261      INTEGER  ::   ios2, jk
262      REAL(wp) ::   zfblk(1)
263#   endif
264      !!----------------------------------------------------------------------
265      !!  OPA 8.5, LODYC-IPSL (2002)
266      !!----------------------------------------------------------------------
267
268      IF(lwp) WRITE(numout,*)
269      IF(lwp) WRITE(numout,*) 'rst_read : read the NetCDF restart file'
270      IF(lwp) WRITE(numout,*) '~~~~~~~~'
271
272      IF(lwp) WRITE(numout,*) ' Info on the present job : '
273      IF(lwp) WRITE(numout,*) '   job number          : ', no
274      IF(lwp) WRITE(numout,*) '   time-step           : ', nit000
275      IF(lwp) WRITE(numout,*) '   solver type         : ', nsolv
276      IF( lk_zdftke ) THEN
277         IF(lwp) WRITE(numout,*) '   tke option          : 1 '
278      ELSE
279         IF(lwp) WRITE(numout,*) '   tke option          : 0 '
280      ENDIF
281      IF(lwp) WRITE(numout,*) '   date ndastp         : ', ndastp
282      IF(lwp) WRITE(numout,*)
283
284      ! Time domain : restart
285      ! -------------------------
286
287      IF(lwp) WRITE(numout,*)
288      IF(lwp) WRITE(numout,*)
289      IF(lwp) WRITE(numout,*) ' *** restart option'
290      SELECT CASE ( nrstdt )
291      CASE ( 0 ) 
292         IF(lwp) WRITE(numout,*) ' nrstdt = 0 no control of nit000'
293      CASE ( 1 ) 
294         IF(lwp) WRITE(numout,*) ' nrstdt = 1 we control the date of nit000'
295      CASE ( 2 )
296         IF(lwp) WRITE(numout,*) ' nrstdt = 2 the date adatrj is read in restart file'
297      CASE DEFAULT
298         IF(lwp) WRITE(numout,*) '  ===>>>> nrstdt not equal 0, 1 or 2 : no control of the date'
299         IF(lwp) WRITE(numout,*) ' =======                   ========='
300      END SELECT
301
302      itime = 0
303      llog  = .FALSE.
304      zlamt(:,:) = 0.e0
305      zphit(:,:) = 0.e0
306      zdept(:)   = 0.e0
307      CALL restini( clname, jpi, jpj, zlamt, zphit, jpk, zdept, 'NONE',   &
308         &          itime, zdate0, zdt, inum, domain_id=nidom )
309
310      CALL ioget_vname( inum, ibvar, clvnames)
311      CALL restget( inum, 'info', 1, 1, 10, 0, llog, zinfo )
312
313      IF(lwp) WRITE(numout,*)
314      IF(lwp) WRITE(numout,*) ' Info on the restart file read : '
315      IF(lwp) WRITE(numout,*) '   FILE name           : ', clname
316      IF(lwp) WRITE(numout,*) '   job number          : ', NINT( zinfo(1) )
317      IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zinfo(2) )
318      IF(lwp) WRITE(numout,*) '   solver type         : ', NINT( zinfo(4) ) + 1
319      IF(lwp) WRITE(numout,*) '   tke option          : ', NINT( zinfo(5) )
320      IF(lwp) WRITE(numout,*) '   date ndastp         : ', NINT( zinfo(6) )
321      IF(lwp) WRITE(numout,*) '   number of variables : ', ibvar
322      IF(lwp) WRITE(numout,*) '   NetCDF variables    : ', clvnames(1:ibvar)
323      IF(lwp) WRITE(numout,*)
324
325      ! Control of date
326      IF( nit000 - NINT( zinfo(2) )  /= 1 .AND. nrstdt /= 0 ) THEN
327         IF(lwp) WRITE(numout,cform_err)
328         IF(lwp) WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart'
329         IF(lwp) WRITE(numout,*) ' verify the restart file or rerun with nrstdt = 0 (namelist)'
330         nstop = nstop + 1
331      ENDIF
332
333      ! re-initialisation of  adatrj0
334      adatrj0 =  ( FLOAT( nit000-1 ) * rdttra(1) ) / rday
335
336      IF ( nrstdt == 2 ) THEN
337!                             by default ndatsp has been set to ndate0 in dom_nam
338!                             ndate0 has been read in the namelist (standard OPA 8)
339!                             here when nrstdt=2 we keep the  final date of previous run
340        ndastp = NINT( zinfo(6) )
341        adatrj0 =  zinfo(7)
342      ENDIF
343
344
345
346      CALL restget( inum, 'ub'     , jpi, jpj, jpk, 0, llog, ub      )    ! Read prognostic variables
347      CALL restget( inum, 'vb'     , jpi, jpj, jpk, 0, llog, vb      )
348      CALL restget( inum, 'tb'     , jpi, jpj, jpk, 0, llog, tb      )
349      CALL restget( inum, 'sb'     , jpi, jpj, jpk, 0, llog, sb      )
350      CALL restget( inum, 'rotb'   , jpi, jpj, jpk, 0, llog, rotb    )
351      CALL restget( inum, 'hdivb'  , jpi, jpj, jpk, 0, llog, hdivb   )
352      CALL restget( inum, 'un'     , jpi, jpj, jpk, 0, llog, un      )
353      CALL restget( inum, 'vn'     , jpi, jpj, jpk, 0, llog, vn      )
354      CALL restget( inum, 'tn'     , jpi, jpj, jpk, 0, llog, tn      )
355      CALL restget( inum, 'sn'     , jpi, jpj, jpk, 0, llog, sn      )
356      CALL restget( inum, 'rotn'   , jpi, jpj, jpk, 0, llog, rotn    )
357      CALL restget( inum, 'hdivn'  , jpi, jpj, jpk, 0, llog, hdivn   )
358
359      CALL restget( inum, 'gcxb'   , jpi, jpj, 1  , 0, llog, ztab    )   ! Read elliptic solver arrays
360      gcxb(1:jpi,1:jpj) = ztab(:,:) 
361      CALL restget( inum, 'gcx'    , jpi, jpj, 1  , 0, llog, ztab    )
362      gcx(1:jpi,1:jpj) = ztab(:,:) 
363# if defined key_dynspg_rl
364      CALL restget( inum, 'bsfb'   , jpi, jpj, 1  , 0, llog, bsfb    )   ! Rigid-lid formulation (bsf)
365      CALL restget( inum, 'bsfn'   , jpi, jpj, 1  , 0, llog, bsfn    )
366      CALL restget( inum, 'bsfd'   , jpi, jpj, 1  , 0, llog, bsfd    )
367# else
368      CALL restget( inum, 'sshb'   , jpi, jpj, 1  , 0, llog, sshb    )   ! free surface formulation (ssh)
369      CALL restget( inum, 'sshn'   , jpi, jpj, 1  , 0, llog, sshn    )
370#  if defined key_dynspg_ts
371      CALL restget( inum, 'sshb_b' , jpi, jpj, 1  , 0, llog, sshb_b  )   ! free surface formulation (ssh)
372      CALL restget( inum, 'sshn_b' , jpi, jpj, 1  , 0, llog, sshn_b  )   ! issued from barotropic loop
373      CALL restget( inum, 'un_b'   , jpi, jpj, 1  , 0, llog, un_b    )   ! horizontal transports
374      CALL restget( inum, 'vn_b'   , jpi, jpj, 1  , 0, llog, vn_b    )   ! issued from barotropic loop
375#  endif
376# endif
377# if defined key_zdftke   ||   defined key_esopa
378      IF( lk_zdftke ) THEN
379         IF( NINT( zinfo(5) ) == 1 ) THEN                                ! Read tke arrays
380            CALL restget( inum, 'en',jpi,jpj, jpk,0  , llog, en )
381            ln_rstke = .FALSE.
382         ELSE
383            IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file didnot used  tke scheme'
384            IF(lwp) WRITE(numout,*) ' =======                ======='
385            nrstdt = 2
386            ln_rstke = .TRUE.
387         ENDIF
388      ENDIF
389# endif
390# if defined key_ice_lim
391      ! Louvain La Neuve Sea Ice Model
392      ios1 = 0
393      DO jn = 1, 30
394         IF( clvnames(jn) == 'nfice' )  ios1 = 1
395      END DO
396      IF( ios1 == 1 ) THEN
397         CALL restget( inum, 'nfice' ,   1,   1, 1 , 0, llog, zfice  )
398         CALL restget( inum, 'sst_io', jpi, jpj, 1 , 0, llog, sst_io )
399         CALL restget( inum, 'sss_io', jpi, jpj, 1 , 0, llog, sss_io )
400         CALL restget( inum, 'u_io'  , jpi, jpj, 1 , 0, llog, u_io   )
401         CALL restget( inum, 'v_io'  , jpi, jpj, 1 , 0, llog, v_io   )
402#if defined key_coupled
403         CALL restget( inum, 'alb_ice', jpi, jpj, 1 , 0, llog, alb_ice )
404#endif
405      ENDIF
406      IF( zfice(1) /= FLOAT(nfice) .OR. ios1 == 0 ) THEN
407         IF(lwp) WRITE(numout,*)
408         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
409         IF(lwp) WRITE(numout,*)
410         sst_io(:,:) = ( nfice-1 )*( tn(:,:,1) + rt0 )          !!bug a explanation is needed here!
411         sss_io(:,:) = ( nfice-1 )*  sn(:,:,1)
412         DO jj = 2, jpj
413            DO ji = 2, jpi
414               u_io(ji,jj) = ( nfice-1 ) * 0.5 * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) )
415               v_io(ji,jj) = ( nfice-1 ) * 0.5 * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) )
416            END DO
417         END DO
418#    if defined key_coupled
419         alb_ice(:,:) = 0.8 * tmask(:,:,1)
420#    endif
421      ENDIF
422# endif
423# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
424      ! Louvain La Neuve Sea Ice Model
425      ios2 = 0
426      DO jk = 1, 30
427         IF( clvnames(jk) == 'nfbulk' )  ios2 = 1
428      END DO
429      IF( ios2 == 1 ) THEN
430         CALL restget( inum, 'nfbulk',   1,   1, 1 , 0, llog, zfblk )
431         CALL restget( inum, 'gsst'  , jpi, jpj, 1 , 0, llog, gsst  )
432      ENDIF
433      IF( zfblk(1) /= FLOAT(nfbulk) .OR. ios2 == 0 ) THEN
434         IF(lwp) WRITE(numout,*)
435         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
436         IF(lwp) WRITE(numout,*)
437         gsst(:,:) = 0.
438         gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 )
439      ENDIF
440# endif
441     
442      CALL restclo( inum )
443  ! In case of restart with neuler = 0 then put all before fields = to now fields
444    IF ( neuler == 0 ) THEN
445      tb(:,:,:)=tn(:,:,:)
446      sb(:,:,:)=sn(:,:,:)
447      ub(:,:,:)=un(:,:,:)
448      vb(:,:,:)=vn(:,:,:)
449      rotb(:,:,:)=rotn(:,:,:)
450      hdivb(:,:,:)=hdivn(:,:,:)
451#if defined key_dynspg_rl
452    ! rigid lid
453      bsfb(:,:)=bsfn(:,:)
454#else
455    ! free surface formulation (eta)
456      sshb(:,:)=sshn(:,:)
457#endif
458    ENDIF
459
460   END SUBROUTINE rst_read
461
462#endif
463   !!=====================================================================
464END MODULE restart
Note: See TracBrowser for help on using the repository browser.