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

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

RB:nemo_v1_update_038: first integration of Agrif :

  • add agrif to dynspg_flt_jki.F90
  • cosmetic change of key_AGRIF in key_agrif
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 20.3 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#if defined key_agrif
91       Integer :: knum
92#endif
93      !!----------------------------------------------------------------------
94
95      IF( kt == nit000 ) THEN
96         IF(lwp) WRITE(numout,*)
97         IF(lwp) WRITE(numout,*) 'rst_wri : write restart.output NetCDF file'
98         IF(lwp) WRITE(numout,*) '~~~~~~~'
99         zfice(1) = 1.e0   ;   zfblk(1) = 1.e0
100      ENDIF
101
102
103      IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN
104         
105         ! 0. Initializations
106         ! ------------------
107
108         IF(lwp) WRITE(numout,*) ' '
109         IF(lwp) WRITE(numout,*) 'rst_write : write the restart file in NetCDF format ',   &
110                                              'at it= ',kt,' date= ',ndastp
111         IF(lwp) WRITE(numout,*) '~~~~~~~~~'
112
113         ! Job informations
114         zinfo(1) = FLOAT( no        )   ! job number
115         zinfo(2) = FLOAT( kt        )   ! time-step
116         zinfo(3) = FLOAT( 2 - nsolv )   ! pcg solver
117         zinfo(4) = FLOAT( nsolv - 1 )   ! sor solver
118         IF( lk_zdftke ) THEN
119            zinfo(5) = 1.e0              ! TKE
120         ELSE
121            zinfo(5) = 0.e0              ! no TKE
122         ENDIF
123         zinfo(6) = FLOAT( ndastp )      ! date
124         zinfo(7) = adatrj               ! ???
125
126         ! delete the restart file if it exists
127         INQUIRE( FILE=crestart, EXIST=llbon )
128         IF(llbon) THEN
129#if defined key_agrif
130       knum =Agrif_Get_Unit()
131            OPEN( UNIT=knum, FILE=crestart, STATUS='old' )
132            CLOSE( knum, STATUS='delete' )
133#else           
134            OPEN( UNIT=numwrs, FILE=crestart, STATUS='old' )
135            CLOSE( numwrs, STATUS='delete' )
136#endif
137         ENDIF
138
139         ! Name of the new restart file
140         ic     = 1
141         DO jc = 1, 16
142            IF( cexper(jc:jc) /= ' ' )   ic = jc
143         END DO
144         WRITE(cln,'("_",i4.4,i2.2,i2.2,"_restart")') nyear, nmonth, nday
145         clname = cexper(1:ic)//cln
146         ic = 1
147         DO jc = 1, 48
148            IF( clname(jc:jc) /= ' ' ) ic = jc
149         END DO
150         crestart = clname(1:ic)//".nc"
151         itime = 0
152         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 )
153         CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept, clname,   &
154                        itime, zdate0, rdt*nstock ,numwrs, domain_id=nidom )
155
156         CALL restput( numwrs, 'info'   , 1  , 1  , 10 , 0, zinfo   )   ! restart informations
157         
158         CALL restput( numwrs, 'ub'     , jpi, jpj, jpk, 0, ub      )   ! prognostic variables
159         CALL restput( numwrs, 'vb'     , jpi, jpj, jpk, 0, vb      )
160         CALL restput( numwrs, 'tb'     , jpi, jpj, jpk, 0, tb      )
161         CALL restput( numwrs, 'sb'     , jpi, jpj, jpk, 0, sb      )
162         CALL restput( numwrs, 'rotb'   , jpi, jpj, jpk, 0, rotb    )
163         CALL restput( numwrs, 'hdivb'  , jpi, jpj, jpk, 0, hdivb   )
164         CALL restput( numwrs, 'un'     , jpi, jpj, jpk, 0, un      )
165         CALL restput( numwrs, 'vn'     , jpi, jpj, jpk, 0, vn      )
166         CALL restput( numwrs, 'tn'     , jpi, jpj, jpk, 0, tn      )
167         CALL restput( numwrs, 'sn'     , jpi, jpj, jpk, 0, sn      )
168         CALL restput( numwrs, 'rotn'   , jpi, jpj, jpk, 0, rotn    )
169         CALL restput( numwrs, 'hdivn'  , jpi, jpj, jpk, 0, hdivn   )
170
171         ztab(:,:) = gcx(1:jpi,1:jpj)
172         CALL restput( numwrs, 'gcx'    , jpi, jpj, 1  , 0, ztab    )   ! Read elliptic solver arrays
173         ztab(:,:) = gcxb(1:jpi,1:jpj)
174         CALL restput( numwrs, 'gcxb'   , jpi, jpj, 1  , 0, ztab    )
175# if defined key_dynspg_rl
176         CALL restput( numwrs, 'bsfb'   , jpi, jpj, 1  , 0, bsfb    )   ! Rigid-lid formulation (bsf)
177         CALL restput( numwrs, 'bsfn'   , jpi, jpj, 1  , 0, bsfn    )
178         CALL restput( numwrs, 'bsfd'   , jpi, jpj, 1  , 0, bsfd    )
179# else
180         CALL restput( numwrs, 'sshb'   , jpi, jpj, 1  , 0, sshb    )   ! free surface formulation (ssh)
181         CALL restput( numwrs, 'sshn'   , jpi, jpj, 1  , 0, sshn    )
182#  if defined key_dynspg_ts
183         CALL restput( numwrs, 'sshb_b' , jpi, jpj, 1  , 0, sshb_b  )   ! free surface formulation (ssh)
184         CALL restput( numwrs, 'sshn_b' , jpi, jpj, 1  , 0, sshn_b  )   ! issued from barotropic loop
185         CALL restput( numwrs, 'un_b'   , jpi, jpj, 1  , 0, un_b    )   ! horizontal transports
186         CALL restput( numwrs, 'vn_b'   , jpi, jpj, 1  , 0, vn_b    )   ! issued from barotropic loop
187#  endif
188# endif
189# if defined key_zdftke   ||   defined key_esopa
190         IF( lk_zdftke ) THEN
191            CALL restput( numwrs, 'en'     , jpi, jpj, jpk, 0, en      )   ! TKE arrays
192         ENDIF
193# endif
194# if defined key_ice_lim
195         zfice(1) = FLOAT( nfice )                                      ! Louvain La Neuve Sea Ice Model
196         CALL restput( numwrs, 'nfice'  ,   1,   1, 1  , 0, zfice   )
197         CALL restput( numwrs, 'sst_io' , jpi, jpj, 1  , 0, sst_io  )
198         CALL restput( numwrs, 'sss_io' , jpi, jpj, 1  , 0, sss_io  )
199         CALL restput( numwrs, 'u_io'   , jpi, jpj, 1  , 0, u_io    )
200         CALL restput( numwrs, 'v_io'   , jpi, jpj, 1  , 0, v_io    )
201# if defined key_coupled
202         CALL restput( numwrs, 'alb_ice', jpi, jpj, 1  , 0, alb_ice )
203# endif
204# endif
205# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
206         zfblk(1) = FLOAT( nfbulk )                                 ! Bulk
207         CALL restput( numwrs, 'nfbulk' ,   1,   1, 1  , 0, zfblk   )
208         CALL restput( numwrs, 'gsst'   , jpi, jpj, 1  , 0, gsst    )
209# endif
210
211         CALL restclo( numwrs )                                         ! close the restart file
212         
213      ENDIF
214
215   END SUBROUTINE rst_write
216
217
218   SUBROUTINE rst_read
219      !!----------------------------------------------------------------------
220      !!                   ***  ROUTINE rst_read  ***
221      !!
222      !! ** Purpose :   Read files for restart
223      !!
224      !! ** Method  :   Read the previous fields on the NetCDF file
225      !!      the first record indicates previous characterics
226      !!      after control with the present run, we read :
227      !!      - prognostic variables on the second record
228      !!      - elliptic solver arrays
229      !!      - barotropic stream function arrays ("key_dynspg_rl" defined)
230      !!        or free surface arrays
231      !!      - tke arrays (lk_zdftke=T)
232      !!      for this last three records,  the previous characteristics
233      !!      could be different with those used in the present run.
234      !!
235      !!   According to namelist parameter nrstdt,
236      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
237      !!       nrstdt = 1  we verify that nit000 is equal to the last
238      !!                   time step of previous run + 1.
239      !!       In both those options, the  exact duration of the experiment
240      !!       since the beginning (cumulated duration of all previous restart runs)
241      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
242      !!       This is valid is the time step has remained constant.
243      !!
244      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
245      !!                    has been stored in the restart file.
246      !!
247      !! History :
248      !!        !  99-05  (M. Imbard)  Original code
249      !!   8.5  !  02-09  (G. Madec)  F90: Free form
250      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
251      !!----------------------------------------------------------------------
252      !! * Modules used
253      USE ioipsl
254
255      !! * Local declarations
256      LOGICAL ::   llog
257      CHARACTER (len=8 ) ::   clvnames(50)
258      CHARACTER (len=32) ::   clname
259      INTEGER  ::   &
260         itime, ibvar,     &  !
261         inum                 ! temporary logical unit
262      REAL(wp) ::   zdate0, zdt, zinfo(10)
263      REAL(wp) ::   zdept(jpk), zlamt(jpi,jpj), zphit(jpi,jpj)
264      REAL(wp), DIMENSION(jpi,jpj) :: ztab 
265#   if defined key_ice_lim
266      INTEGER  ::   ios1, ji, jj, jn
267      REAL(wp) ::   zfice(1)
268#   endif
269# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
270      INTEGER  ::   ios2, jk
271      REAL(wp) ::   zfblk(1)
272#   endif
273      !!----------------------------------------------------------------------
274      !!  OPA 8.5, LODYC-IPSL (2002)
275      !!----------------------------------------------------------------------
276      clname = 'restart'
277#if defined key_agrif       
278       inum = Agrif_Get_Unit()
279       If(.NOT. Agrif_root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
280#endif
281
282      IF(lwp) WRITE(numout,*)
283      IF(lwp) WRITE(numout,*) 'rst_read : read the NetCDF restart file'
284      IF(lwp) WRITE(numout,*) '~~~~~~~~'
285
286      IF(lwp) WRITE(numout,*) ' Info on the present job : '
287      IF(lwp) WRITE(numout,*) '   job number          : ', no
288      IF(lwp) WRITE(numout,*) '   time-step           : ', nit000
289      IF(lwp) WRITE(numout,*) '   solver type         : ', nsolv
290      IF( lk_zdftke ) THEN
291         IF(lwp) WRITE(numout,*) '   tke option          : 1 '
292      ELSE
293         IF(lwp) WRITE(numout,*) '   tke option          : 0 '
294      ENDIF
295      IF(lwp) WRITE(numout,*) '   date ndastp         : ', ndastp
296      IF(lwp) WRITE(numout,*)
297
298      ! Time domain : restart
299      ! -------------------------
300
301      IF(lwp) WRITE(numout,*)
302      IF(lwp) WRITE(numout,*)
303      IF(lwp) WRITE(numout,*) ' *** restart option'
304      SELECT CASE ( nrstdt )
305      CASE ( 0 ) 
306         IF(lwp) WRITE(numout,*) ' nrstdt = 0 no control of nit000'
307      CASE ( 1 ) 
308         IF(lwp) WRITE(numout,*) ' nrstdt = 1 we control the date of nit000'
309      CASE ( 2 )
310         IF(lwp) WRITE(numout,*) ' nrstdt = 2 the date adatrj is read in restart file'
311      CASE DEFAULT
312         IF(lwp) WRITE(numout,*) '  ===>>>> nrstdt not equal 0, 1 or 2 : no control of the date'
313         IF(lwp) WRITE(numout,*) ' =======                   ========='
314      END SELECT
315
316      itime = 0
317      llog  = .FALSE.
318      zlamt(:,:) = 0.e0
319      zphit(:,:) = 0.e0
320      zdept(:)   = 0.e0
321      CALL restini( clname, jpi, jpj, zlamt, zphit, jpk, zdept, 'NONE',   &
322         &          itime, zdate0, zdt, inum, domain_id=nidom )
323
324      CALL ioget_vname( inum, ibvar, clvnames)
325      CALL restget( inum, 'info', 1, 1, 10, 0, llog, zinfo )
326
327      IF(lwp) WRITE(numout,*)
328      IF(lwp) WRITE(numout,*) ' Info on the restart file read : '
329      IF(lwp) WRITE(numout,*) '   FILE name           : ', clname
330      IF(lwp) WRITE(numout,*) '   job number          : ', NINT( zinfo(1) )
331      IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zinfo(2) )
332      IF(lwp) WRITE(numout,*) '   solver type         : ', NINT( zinfo(4) ) + 1
333      IF(lwp) WRITE(numout,*) '   tke option          : ', NINT( zinfo(5) )
334      IF(lwp) WRITE(numout,*) '   date ndastp         : ', NINT( zinfo(6) )
335      IF(lwp) WRITE(numout,*) '   number of variables : ', ibvar
336      IF(lwp) WRITE(numout,*) '   NetCDF variables    : ', clvnames(1:ibvar)
337      IF(lwp) WRITE(numout,*)
338
339      ! Control of date
340      IF( nit000 - NINT( zinfo(2) )  /= 1 .AND. nrstdt /= 0 ) THEN
341         IF(lwp) WRITE(numout,cform_err)
342         IF(lwp) WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart'
343         IF(lwp) WRITE(numout,*) ' verify the restart file or rerun with nrstdt = 0 (namelist)'
344         nstop = nstop + 1
345      ENDIF
346
347      ! re-initialisation of  adatrj0
348      adatrj0 =  ( FLOAT( nit000-1 ) * rdttra(1) ) / rday
349
350      IF ( nrstdt == 2 ) THEN
351!                             by default ndatsp has been set to ndate0 in dom_nam
352!                             ndate0 has been read in the namelist (standard OPA 8)
353!                             here when nrstdt=2 we keep the  final date of previous run
354        ndastp = NINT( zinfo(6) )
355        adatrj0 =  zinfo(7)
356      ENDIF
357
358
359
360      CALL restget( inum, 'ub'     , jpi, jpj, jpk, 0, llog, ub      )    ! Read prognostic variables
361      CALL restget( inum, 'vb'     , jpi, jpj, jpk, 0, llog, vb      )
362      CALL restget( inum, 'tb'     , jpi, jpj, jpk, 0, llog, tb      )
363      CALL restget( inum, 'sb'     , jpi, jpj, jpk, 0, llog, sb      )
364      CALL restget( inum, 'rotb'   , jpi, jpj, jpk, 0, llog, rotb    )
365      CALL restget( inum, 'hdivb'  , jpi, jpj, jpk, 0, llog, hdivb   )
366      CALL restget( inum, 'un'     , jpi, jpj, jpk, 0, llog, un      )
367      CALL restget( inum, 'vn'     , jpi, jpj, jpk, 0, llog, vn      )
368      CALL restget( inum, 'tn'     , jpi, jpj, jpk, 0, llog, tn      )
369      CALL restget( inum, 'sn'     , jpi, jpj, jpk, 0, llog, sn      )
370      CALL restget( inum, 'rotn'   , jpi, jpj, jpk, 0, llog, rotn    )
371      CALL restget( inum, 'hdivn'  , jpi, jpj, jpk, 0, llog, hdivn   )
372
373      CALL restget( inum, 'gcxb'   , jpi, jpj, 1  , 0, llog, ztab    )   ! Read elliptic solver arrays
374      gcxb(1:jpi,1:jpj) = ztab(:,:) 
375      CALL restget( inum, 'gcx'    , jpi, jpj, 1  , 0, llog, ztab    )
376      gcx(1:jpi,1:jpj) = ztab(:,:) 
377# if defined key_dynspg_rl
378      CALL restget( inum, 'bsfb'   , jpi, jpj, 1  , 0, llog, bsfb    )   ! Rigid-lid formulation (bsf)
379      CALL restget( inum, 'bsfn'   , jpi, jpj, 1  , 0, llog, bsfn    )
380      CALL restget( inum, 'bsfd'   , jpi, jpj, 1  , 0, llog, bsfd    )
381# else
382      CALL restget( inum, 'sshb'   , jpi, jpj, 1  , 0, llog, sshb    )   ! free surface formulation (ssh)
383      CALL restget( inum, 'sshn'   , jpi, jpj, 1  , 0, llog, sshn    )
384#  if defined key_dynspg_ts
385      CALL restget( inum, 'sshb_b' , jpi, jpj, 1  , 0, llog, sshb_b  )   ! free surface formulation (ssh)
386      CALL restget( inum, 'sshn_b' , jpi, jpj, 1  , 0, llog, sshn_b  )   ! issued from barotropic loop
387      CALL restget( inum, 'un_b'   , jpi, jpj, 1  , 0, llog, un_b    )   ! horizontal transports
388      CALL restget( inum, 'vn_b'   , jpi, jpj, 1  , 0, llog, vn_b    )   ! issued from barotropic loop
389#  endif
390# endif
391# if defined key_zdftke   ||   defined key_esopa
392      IF( lk_zdftke ) THEN
393         IF( NINT( zinfo(5) ) == 1 ) THEN                                ! Read tke arrays
394            CALL restget( inum, 'en',jpi,jpj, jpk,0  , llog, en )
395            ln_rstke = .FALSE.
396         ELSE
397            IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file didnot used  tke scheme'
398            IF(lwp) WRITE(numout,*) ' =======                ======='
399            nrstdt = 2
400            ln_rstke = .TRUE.
401         ENDIF
402      ENDIF
403# endif
404# if defined key_ice_lim
405      ! Louvain La Neuve Sea Ice Model
406      ios1 = 0
407      DO jn = 1, 30
408         IF( clvnames(jn) == 'nfice' )  ios1 = 1
409      END DO
410      IF( ios1 == 1 ) THEN
411         CALL restget( inum, 'nfice' ,   1,   1, 1 , 0, llog, zfice  )
412         CALL restget( inum, 'sst_io', jpi, jpj, 1 , 0, llog, sst_io )
413         CALL restget( inum, 'sss_io', jpi, jpj, 1 , 0, llog, sss_io )
414         CALL restget( inum, 'u_io'  , jpi, jpj, 1 , 0, llog, u_io   )
415         CALL restget( inum, 'v_io'  , jpi, jpj, 1 , 0, llog, v_io   )
416#if defined key_coupled
417         CALL restget( inum, 'alb_ice', jpi, jpj, 1 , 0, llog, alb_ice )
418#endif
419      ENDIF
420      IF( zfice(1) /= FLOAT(nfice) .OR. ios1 == 0 ) THEN
421         IF(lwp) WRITE(numout,*)
422         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
423         IF(lwp) WRITE(numout,*)
424         sst_io(:,:) = ( nfice-1 )*( tn(:,:,1) + rt0 )          !!bug a explanation is needed here!
425         sss_io(:,:) = ( nfice-1 )*  sn(:,:,1)
426         DO jj = 2, jpj
427            DO ji = 2, jpi
428               u_io(ji,jj) = ( nfice-1 ) * 0.5 * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) )
429               v_io(ji,jj) = ( nfice-1 ) * 0.5 * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) )
430            END DO
431         END DO
432#    if defined key_coupled
433         alb_ice(:,:) = 0.8 * tmask(:,:,1)
434#    endif
435      ENDIF
436# endif
437# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
438      ! Louvain La Neuve Sea Ice Model
439      ios2 = 0
440      DO jk = 1, 30
441         IF( clvnames(jk) == 'nfbulk' )  ios2 = 1
442      END DO
443      IF( ios2 == 1 ) THEN
444         CALL restget( inum, 'nfbulk',   1,   1, 1 , 0, llog, zfblk )
445         CALL restget( inum, 'gsst'  , jpi, jpj, 1 , 0, llog, gsst  )
446      ENDIF
447      IF( zfblk(1) /= FLOAT(nfbulk) .OR. ios2 == 0 ) THEN
448         IF(lwp) WRITE(numout,*)
449         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
450         IF(lwp) WRITE(numout,*)
451         gsst(:,:) = 0.
452         gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 )
453      ENDIF
454# endif
455     
456      CALL restclo( inum )
457  ! In case of restart with neuler = 0 then put all before fields = to now fields
458    IF ( neuler == 0 ) THEN
459      tb(:,:,:)=tn(:,:,:)
460      sb(:,:,:)=sn(:,:,:)
461      ub(:,:,:)=un(:,:,:)
462      vb(:,:,:)=vn(:,:,:)
463      rotb(:,:,:)=rotn(:,:,:)
464      hdivb(:,:,:)=hdivn(:,:,:)
465#if defined key_dynspg_rl
466    ! rigid lid
467      bsfb(:,:)=bsfn(:,:)
468#else
469    ! free surface formulation (eta)
470      sshb(:,:)=sshn(:,:)
471#endif
472    ENDIF
473
474   END SUBROUTINE rst_read
475
476#endif
477   !!=====================================================================
478END MODULE restart
Note: See TracBrowser for help on using the repository browser.