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

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

nemo_v1_update_060: SM: IOM + 301 levels + CORE + begining of ctl_stop
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 18.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      INTEGER ::   inumwrs
87      REAL(wp) ::   zdate0
88      REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk
89      REAL(wp), DIMENSION(10) ::   zinfo(10)
90      REAL(wp), DIMENSION(jpi,jpj) :: ztab 
91#if defined key_agrif
92       Integer :: knum
93#endif
94      !!----------------------------------------------------------------------
95
96      IF( kt == nit000 ) THEN
97         IF(lwp) WRITE(numout,*)
98         IF(lwp) WRITE(numout,*) 'rst_wri : write restart.output NetCDF file'
99         IF(lwp) WRITE(numout,*) '~~~~~~~'
100         zfice(1) = 1.e0   ;   zfblk(1) = 1.e0
101      ENDIF
102
103
104      IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN
105         
106         ! 0. Initializations
107         ! ------------------
108
109         IF(lwp) WRITE(numout,*) ' '
110         IF(lwp) WRITE(numout,*) 'rst_write : write the restart file in NetCDF format ',   &
111                                              'at it= ',kt,' date= ',ndastp
112         IF(lwp) WRITE(numout,*) '~~~~~~~~~'
113
114         ! Job informations
115         zinfo(:) = 0.e0 
116         zinfo(1) = FLOAT( no        )   ! job number
117         zinfo(2) = FLOAT( kt        )   ! time-step
118         zinfo(3) = FLOAT( 2 - nsolv )   ! pcg solver
119         zinfo(4) = FLOAT( nsolv - 1 )   ! sor solver
120         IF( lk_zdftke ) THEN
121            zinfo(5) = 1.e0              ! TKE
122         ELSE
123            zinfo(5) = 0.e0              ! no TKE
124         ENDIF
125         zinfo(6) = FLOAT( ndastp )      ! date
126         zinfo(7) = adatrj               ! ???
127
128         ! delete the restart file if it exists
129         INQUIRE( FILE=crestart, EXIST=llbon )
130         IF(llbon) THEN
131#if defined key_agrif
132       knum =Agrif_Get_Unit()
133            OPEN( UNIT=knum, FILE=crestart, STATUS='old' )
134            CLOSE( knum, STATUS='delete' )
135#else           
136            OPEN( UNIT=inumwrs, FILE=crestart, STATUS='old' )
137            CLOSE( inumwrs, STATUS='delete' )
138#endif
139         ENDIF
140
141         ! Name of the new restart file
142         ic     = 1
143         DO jc = 1, 16
144            IF( cexper(jc:jc) /= ' ' )   ic = jc
145         END DO
146         WRITE(cln,'("_",i4.4,i2.2,i2.2,"_restart")') nyear, nmonth, nday
147         clname = cexper(1:ic)//cln
148         ic = 1
149         DO jc = 1, 48
150            IF( clname(jc:jc) /= ' ' ) ic = jc
151         END DO
152         crestart = clname(1:ic)//".nc"
153         itime = 0
154         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 )
155         CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept_0, clname,   &
156                        itime, zdate0, rdt*nstock ,inumwrs, domain_id=nidom )
157
158         CALL restput( inumwrs, 'info'   , 1  , 1  , 10 , 0, zinfo   )   ! restart informations
159         
160         CALL restput( inumwrs, 'ub'     , jpi, jpj, jpk, 0, ub      )   ! prognostic variables
161         CALL restput( inumwrs, 'vb'     , jpi, jpj, jpk, 0, vb      )
162         CALL restput( inumwrs, 'tb'     , jpi, jpj, jpk, 0, tb      )
163         CALL restput( inumwrs, 'sb'     , jpi, jpj, jpk, 0, sb      )
164         CALL restput( inumwrs, 'rotb'   , jpi, jpj, jpk, 0, rotb    )
165         CALL restput( inumwrs, 'hdivb'  , jpi, jpj, jpk, 0, hdivb   )
166         CALL restput( inumwrs, 'un'     , jpi, jpj, jpk, 0, un      )
167         CALL restput( inumwrs, 'vn'     , jpi, jpj, jpk, 0, vn      )
168         CALL restput( inumwrs, 'tn'     , jpi, jpj, jpk, 0, tn      )
169         CALL restput( inumwrs, 'sn'     , jpi, jpj, jpk, 0, sn      )
170         CALL restput( inumwrs, 'rotn'   , jpi, jpj, jpk, 0, rotn    )
171         CALL restput( inumwrs, 'hdivn'  , jpi, jpj, jpk, 0, hdivn   )
172
173         ztab(:,:) = gcx(1:jpi,1:jpj)
174         CALL restput( inumwrs, 'gcx'    , jpi, jpj, 1  , 0, ztab    )   ! Read elliptic solver arrays
175         ztab(:,:) = gcxb(1:jpi,1:jpj)
176         CALL restput( inumwrs, 'gcxb'   , jpi, jpj, 1  , 0, ztab    )
177# if defined key_dynspg_rl
178         CALL restput( inumwrs, 'bsfb'   , jpi, jpj, 1  , 0, bsfb    )   ! Rigid-lid formulation (bsf)
179         CALL restput( inumwrs, 'bsfn'   , jpi, jpj, 1  , 0, bsfn    )
180         CALL restput( inumwrs, 'bsfd'   , jpi, jpj, 1  , 0, bsfd    )
181# else
182         CALL restput( inumwrs, 'sshb'   , jpi, jpj, 1  , 0, sshb    )   ! free surface formulation (ssh)
183         CALL restput( inumwrs, 'sshn'   , jpi, jpj, 1  , 0, sshn    )
184#  if defined key_dynspg_ts
185         CALL restput( inumwrs, 'sshb_b' , jpi, jpj, 1  , 0, sshb_b  )   ! free surface formulation (ssh)
186         CALL restput( inumwrs, 'sshn_b' , jpi, jpj, 1  , 0, sshn_b  )   ! issued from barotropic loop
187         CALL restput( inumwrs, 'un_b'   , jpi, jpj, 1  , 0, un_b    )   ! horizontal transports
188         CALL restput( inumwrs, 'vn_b'   , jpi, jpj, 1  , 0, vn_b    )   ! issued from barotropic loop
189#  endif
190# endif
191# if defined key_zdftke   ||   defined key_esopa
192         IF( lk_zdftke ) THEN
193            CALL restput( inumwrs, 'en'     , jpi, jpj, jpk, 0, en      )   ! TKE arrays
194         ENDIF
195# endif
196# if defined key_ice_lim
197         zfice(1) = FLOAT( nfice )                                      ! Louvain La Neuve Sea Ice Model
198         CALL restput( inumwrs, 'nfice'  ,   1,   1, 1  , 0, zfice   )
199         CALL restput( inumwrs, 'sst_io' , jpi, jpj, 1  , 0, sst_io  )
200         CALL restput( inumwrs, 'sss_io' , jpi, jpj, 1  , 0, sss_io  )
201         CALL restput( inumwrs, 'u_io'   , jpi, jpj, 1  , 0, u_io    )
202         CALL restput( inumwrs, 'v_io'   , jpi, jpj, 1  , 0, v_io    )
203# if defined key_coupled
204         CALL restput( inumwrs, 'alb_ice', jpi, jpj, 1  , 0, alb_ice )
205# endif
206# endif
207# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
208         zfblk(1) = FLOAT( nfbulk )                                 ! Bulk
209         CALL restput( inumwrs, 'nfbulk' ,   1,   1, 1  , 0, zfblk   )
210         CALL restput( inumwrs, 'gsst'   , jpi, jpj, 1  , 0, gsst    )
211# endif
212
213         CALL restclo( inumwrs )                                         ! close the restart file
214         
215      ENDIF
216
217   END SUBROUTINE rst_write
218
219
220   SUBROUTINE rst_read
221      !!----------------------------------------------------------------------
222      !!                   ***  ROUTINE rst_read  ***
223      !!
224      !! ** Purpose :   Read files for restart
225      !!
226      !! ** Method  :   Read the previous fields on the NetCDF file
227      !!      the first record indicates previous characterics
228      !!      after control with the present run, we read :
229      !!      - prognostic variables on the second record
230      !!      - elliptic solver arrays
231      !!      - barotropic stream function arrays ("key_dynspg_rl" defined)
232      !!        or free surface arrays
233      !!      - tke arrays (lk_zdftke=T)
234      !!      for this last three records,  the previous characteristics
235      !!      could be different with those used in the present run.
236      !!
237      !!   According to namelist parameter nrstdt,
238      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
239      !!       nrstdt = 1  we verify that nit000 is equal to the last
240      !!                   time step of previous run + 1.
241      !!       In both those options, the  exact duration of the experiment
242      !!       since the beginning (cumulated duration of all previous restart runs)
243      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
244      !!       This is valid is the time step has remained constant.
245      !!
246      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
247      !!                    has been stored in the restart file.
248      !!
249      !! History :
250      !!        !  99-05  (M. Imbard)  Original code
251      !!   8.5  !  02-09  (G. Madec)  F90: Free form
252      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
253      !!----------------------------------------------------------------------
254      !! * Modules used
255      USE iom
256
257      !! * Local declarations
258      INTEGER  ::   &
259         inum                 ! temporary logical unit
260      REAL(wp), DIMENSION(1, 1, 10)  ::   zinfo
261      REAL(wp), DIMENSION(1, 1, 1)   ::   zzz 
262      INTEGER  ::   ios
263#   if defined key_ice_lim
264      INTEGER  ::   ji, jj
265#   endif
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      CALL iom_open ( 'restart', inum )
303     
304      CALL iom_get ( inum, jpdom_unknown, 'info', zinfo )
305     
306      IF(lwp) WRITE(numout,*)
307      IF(lwp) WRITE(numout,*) ' Info on the restart file read : '
308      IF(lwp) WRITE(numout,*) '   job number          : ', NINT( zinfo(1, 1, 1) )
309      IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zinfo(1, 1, 2) )
310      IF(lwp) WRITE(numout,*) '   solver type         : ', NINT( zinfo(1, 1, 4) ) + 1
311      IF(lwp) WRITE(numout,*) '   tke option          : ', NINT( zinfo(1, 1, 5) )
312      IF(lwp) WRITE(numout,*) '   date ndastp         : ', NINT( zinfo(1, 1, 6) )
313      IF(lwp) WRITE(numout,*)
314
315      ! Control of date
316      IF( nit000 - NINT( zinfo(1, 1, 2) )  /= 1 .AND. nrstdt /= 0 ) &
317           & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', &
318           & ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
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(1, 1, 6) )
328        adatrj0 =  zinfo(1, 1, 7)
329      ENDIF
330
331      CALL iom_get( inum, jpdom_local, 'ub'   , ub    )   ! Read prognostic variables
332      CALL iom_get( inum, jpdom_local, 'vb'   , vb    )
333      CALL iom_get( inum, jpdom_local, 'tb'   , tb    )
334      CALL iom_get( inum, jpdom_local, 'sb'   , sb    )
335      CALL iom_get( inum, jpdom_local, 'rotb' , rotb  )
336      CALL iom_get( inum, jpdom_local, 'hdivb', hdivb )
337      CALL iom_get( inum, jpdom_local, 'un'   , un    )
338      CALL iom_get( inum, jpdom_local, 'vn'   , vn    )
339      CALL iom_get( inum, jpdom_local, 'tn'   , tn    )
340      CALL iom_get( inum, jpdom_local, 'sn'   , sn    )
341      CALL iom_get( inum, jpdom_local, 'rotn' , rotn  )
342      CALL iom_get( inum, jpdom_local, 'hdivn', hdivn )
343! Caution : extrahallow
344! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
345      CALL iom_get( inum, jpdom_local, 'gcx' , gcx (1:jpi,1:jpj) )
346      CALL iom_get( inum, jpdom_local, 'gcxb', gcxb(1:jpi,1:jpj) )     ! Read elliptic solver arrays
347# if defined key_dynspg_rl
348      CALL iom_get( inum, jpdom_local, 'bsfb', bsfb )     ! Rigid-lid formulation (bsf)
349      CALL iom_get( inum, jpdom_local, 'bsfn', bsfn )
350      CALL iom_get( inum, jpdom_local, 'bsfd', bsfd )
351# else
352      CALL iom_get( inum, jpdom_local, 'sshb', sshb )     ! free surface formulation (ssh)
353      CALL iom_get( inum, jpdom_local, 'sshn', sshn )
354#  if defined key_dynspg_ts
355      CALL iom_get( inum, jpdom_local, 'sshb_b', sshb_b ) ! free surface formulation (ssh)
356      CALL iom_get( inum, jpdom_local, 'sshn_b', sshn_b ) ! issued from barotropic loop
357      CALL iom_get( inum, jpdom_local, 'un_b'  , un_b )   ! horizontal transports
358      CALL iom_get( inum, jpdom_local, 'vn_b'  , vn_b )   ! issued from barotropic loop
359#  endif
360# endif
361# if defined key_zdftke   ||   defined key_esopa
362      IF( lk_zdftke ) THEN
363         IF( NINT( zinfo(1, 1, 5) ) == 1 ) THEN                                ! Read tke arrays
364            CALL iom_get( inum, jpdom_local, 'en', en )
365            ln_rstke = .FALSE.
366         ELSE
367            IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file did not used  tke scheme'
368            IF(lwp) WRITE(numout,*) ' =======                ======='
369            nrstdt = 2
370            ln_rstke = .TRUE.
371         ENDIF
372      ENDIF
373# endif
374# if defined key_ice_lim
375      ! Louvain La Neuve Sea Ice Model
376      ios = iom_varid( inum, 'nfice' )
377      IF( ios > 0 ) then
378         CALL iom_get( inum, jpdom_unknown, 'nfice' , zzz )
379         zinfo(1, 1, 8) = zzz(1, 1, 1)
380         CALL iom_get( inum, jpdom_local, 'sst_io', sst_io )
381         CALL iom_get( inum, jpdom_local, 'sss_io', sss_io )
382         CALL iom_get( inum, jpdom_local, 'u_io'  , u_io )
383         CALL iom_get( inum, jpdom_local, 'v_io'  , v_io )
384#if defined key_coupled
385         CALL iom_get( inum, jpdom_local, 'alb_ice', alb_ice )
386#endif
387      ENDIF
388      IF( zinfo(1, 1, 8) /= FLOAT(nfice) .OR. ios == 0 ) THEN
389         IF(lwp) WRITE(numout,*)
390         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
391         IF(lwp) WRITE(numout,*)
392         sst_io(:,:) = ( nfice-1 )*( tn(:,:,1) + rt0 )          !!bug a explanation is needed here!
393         sss_io(:,:) = ( nfice-1 )*  sn(:,:,1)
394         DO jj = 2, jpj
395            DO ji = 2, jpi
396               u_io(ji,jj) = ( nfice-1 ) * 0.5 * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) )
397               v_io(ji,jj) = ( nfice-1 ) * 0.5 * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) )
398            END DO
399         END DO
400#    if defined key_coupled
401         alb_ice(:,:) = 0.8 * tmask(:,:,1)
402#    endif
403      ENDIF
404# endif
405# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
406      ! Louvain La Neuve Sea Ice Model
407      ios = iom_varid( inum, 'nfbulk' )
408      IF( ios > 0 ) then
409         CALL iom_get( inum, jpdom_unknown, 'nfbulk' , zzz )
410         CALL iom_get( inum, jpdom_local, 'gsst' , gsst )
411         zinfo(1, 1, 9) = zzz(1, 1, 1)
412      ENDIF
413      IF( zinfo(1, 1, 9) /= FLOAT(nfbulk) .OR. ios == 0 ) THEN
414         IF(lwp) WRITE(numout,*)
415         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
416         IF(lwp) WRITE(numout,*)
417         gsst(:,:) = 0.
418         gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 )
419      ENDIF
420# endif
421     
422      CALL iom_close( inum )
423
424  ! In case of restart with neuler = 0 then put all before fields = to now fields
425    IF ( neuler == 0 ) THEN
426      tb(:,:,:)=tn(:,:,:)
427      sb(:,:,:)=sn(:,:,:)
428      ub(:,:,:)=un(:,:,:)
429      vb(:,:,:)=vn(:,:,:)
430      rotb(:,:,:)=rotn(:,:,:)
431      hdivb(:,:,:)=hdivn(:,:,:)
432#if defined key_dynspg_rl
433    ! rigid lid
434      bsfb(:,:)=bsfn(:,:)
435#else
436    ! free surface formulation (eta)
437      sshb(:,:)=sshn(:,:)
438#endif
439    ENDIF
440
441   END SUBROUTINE rst_read
442
443#endif
444   !!=====================================================================
445END MODULE restart
Note: See TracBrowser for help on using the repository browser.