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

Last change on this file since 239 was 239, checked in by opalod, 19 years ago

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