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_mpp.h90 in trunk/NEMO/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/restart_mpp.h90 @ 247

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

CL : Add CVS Header and CeCILL licence information

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.8 KB
Line 
1   !!---------------------------------------------------------------------
2   !!                     ***  restart_mpp.h90  ***
3   !!---------------------------------------------------------------------
4
5   SUBROUTINE rst_write(kt)
6     !!---------------------------------------------------------------------
7     !!                  ***  ROUTINE rst_write  ***
8     !!
9     !! ** Purpose :   Write restart fields in direct access format in mpp.
10     !!      one per process
11     !!
12     !! ** Method  :   each nstock time step , save fields which are necessary
13     !!      for restart
14     !!      Record #1 hold general information on the state of the run
15     !!      Data fields (either 3D or 2D ) starts ar record #2
16     !!
17     !! History :
18     !!        !  91-03  ()  original code
19     !!        !  91-11  (G. Madec)
20     !!        !  92-06  (M. Imbard)  correction restart file
21     !!        !  92-07  (M. Imbard)  split into diawri and rstwri
22     !!        !  98-02  (M. Guyon)  FETI method
23     !!        !  98-05  (G. Roullet)  free surface
24     !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
25     !!   8.5  !  03-06  (J.M. Molines)  F90: Free form, mpp support
26     !!----------------------------------------------------------------------
27     !! * Arguments
28     INTEGER, INTENT( in ) ::   kt         ! ocean time-step
29
30     !! * Local declarations
31     INTEGER :: ino0, it0, ipcg0, isor0, itke0
32     INTEGER :: irecl8, irec
33     INTEGER :: jk               ! dummy loop indices
34     INTEGER :: inum = 11        ! temporary logical unit
35     INTEGER :: ios1 , ios2      ! flag for ice and bulk in the current run
36     INTEGER :: ios3             ! flag for free surface.  0 = none 1 = yes.  0 = none 1 = yes
37     INTEGER :: ios4             ! flag for coupled (1) or not (0)
38
39     CHARACTER(LEN=80)  :: clres
40
41     REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk
42     !!----------------------------------------------------------------------
43     !!  OPA 9.0 , LOCEAN-IPSL (2005)
44     !! $Header$
45     !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
46     !!----------------------------------------------------------------------
47
48    IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN
49
50       ! 0. Initializations
51       ! ------------------
52
53       IF(lwp) THEN
54          WRITE(numout,*) ' '
55          WRITE(numout,*) ' rst_write: output done in inum = ',   &
56               inum,' at it= ',kt,' date= ',ndastp
57          WRITE(numout,*) ' -------'
58       ENDIF
59
60       ! Open direct access file, with reclength for 2D wp fields
61       irecl8= jpi * jpj * wp
62       WRITE(clres,'(a,i3.3)') 'restart.output.',narea
63       OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl8 )
64
65
66       ino0  = no
67       it0   = kt
68       ipcg0 = 0
69       isor0 = 0
70       itke0 = 0
71       isor0 = nsolv - 1
72       ipcg0 = 2 - nsolv
73       IF ( lk_zdftke ) itke0=1
74       ! FETI method
75       IF (nsolv == 3) THEN
76          isor0 = 2
77          ipcg0 = 2
78       ENDIF
79
80       ! 1. Write in inum
81       ! ------------------
82
83       ! first record
84       ios1 = 0
85       ios2 = 0
86       ios3 = 0
87       ios4 = 0
88       IF ( lk_ice_lim                           )   ios1 = 1
89       IF ( l_bulk                               )   ios2 = 1
90       IF ( lk_dynspg_fsc .OR. lk_dynspg_fsc_tsk )   ios3 = 1
91       IF ( lk_cpl                               )   ios4 = 1
92
93       WRITE(inum,REC=1) irecl8, ino0, it0, isor0, ipcg0, itke0, &
94          &              nfice, nfbulk , ios1, ios2, ios3, ios4, &
95          &              ndastp, adatrj, jpi, jpj, jpk,  &
96          &              jpni, jpnj, jpnij, narea, jpiglo, jpjglo, &
97          &              nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
98
99       ! prognostic variables
100
101       irec=2
102
103       ! 'before' fields
104
105       DO jk = 1, jpk
106          WRITE(inum,REC=irec) ub(:,:,jk)
107          irec = irec +1
108       END DO
109
110       DO jk = 1, jpk
111          WRITE(inum,REC=irec) vb(:,:,jk)
112          irec = irec +1
113       END DO
114
115       DO jk = 1, jpk
116          WRITE(inum,REC=irec) tb(:,:,jk)
117          irec = irec +1
118       END DO
119
120       DO jk = 1, jpk
121          WRITE(inum,REC=irec) sb(:,:,jk)
122          irec = irec +1
123       END DO
124
125       DO jk = 1, jpk
126          WRITE(inum,REC=irec) rotb(:,:,jk)
127          irec = irec +1
128       END DO
129
130       DO jk = 1, jpk
131          WRITE(inum,REC=irec) hdivb(:,:,jk)
132          irec = irec +1
133       END DO
134
135       ! 'now' fields
136
137       DO jk = 1, jpk
138          WRITE(inum,REC=irec) un(:,:,jk)
139          irec = irec +1
140       END DO
141
142       DO jk = 1, jpk
143          WRITE(inum,REC=irec) vn(:,:,jk)
144          irec = irec +1
145       END DO
146
147       DO jk = 1, jpk
148          WRITE(inum,REC=irec) tn(:,:,jk)
149          irec = irec +1
150       END DO
151
152       DO jk = 1, jpk
153          WRITE(inum,REC=irec) sn(:,:,jk)
154          irec = irec +1
155       END DO
156
157       DO jk = 1, jpk
158          WRITE(inum,REC=irec) rotn(:,:,jk)
159          irec = irec +1
160       END DO
161
162       DO jk = 1, jpk
163          WRITE(inum,REC=irec) hdivn(:,:,jk)
164          irec = irec +1
165       END DO
166
167       ! elliptic solver arrays
168       WRITE(inum,REC=irec ) gcx(:,:)
169       irec = irec +1
170
171       WRITE(inum,REC=irec ) gcxb(:,:)
172       irec = irec +1
173
174#if defined key_dynspg_fsc
175
176       ! free surface formulation (ssh)
177
178       WRITE(inum,REC=irec ) sshb(:,:)
179       irec = irec +1
180
181       WRITE(inum,REC=irec ) sshn(:,:)
182       irec = irec +1
183#else
184
185       ! Rigid-lid formulation (bsf)
186
187       WRITE(inum,REC=irec ) bsfb(:,:)
188       irec = irec +1
189
190       WRITE(inum,REC=irec ) bsfn(:,:)
191       irec = irec +1
192
193       WRITE(inum,REC=irec ) bsfd(:,:)
194       irec = irec +1
195
196#endif
197
198       ! TKE arrays
199
200#if defined key_zdftke
201         DO jk = 1, jpk
202            WRITE(inum,REC=irec) en(:,:,jk) ; irec = irec + 1
203         END DO
204#endif
205
206#if defined key_ice_lim
207          zfice(1) = FLOAT( nfice )                                      ! Louvain La Neuve Sea Ice Model
208          WRITE(inum,REC=irec) zfice(:)     ; irec = irec + 1
209          WRITE(inum,REC=irec) sst_io(:,:)  ; irec = irec + 1
210          WRITE(inum,REC=irec) sss_io(:,:)  ; irec = irec + 1
211          WRITE(inum,REC=irec) u_io  (:,:)  ; irec = irec + 1
212          WRITE(inum,REC=irec) v_io  (:,:)  ; irec = irec + 1
213#    if defined key_coupled
214          WRITE(inum,REC=irec) alb_ice(:,:)  ; irec = irec + 1
215#    endif
216#endif
217# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
218          zfblk(1) = FLOAT( nfbulk )                                 ! Bulk
219          WRITE(inum,REC=irec) zfblk(:)   ; irec = irec + 1
220          WRITE(inum,REC=irec) gsst(:,:)  ; irec = irec + 1
221# endif
222
223       CLOSE(inum)
224    ENDIF
225
226  END SUBROUTINE rst_write
227
228  SUBROUTINE rst_read
229    !!---------------------------------------------------------------------
230    !!                       ROUTINE rst_read
231    !!                     ******************
232    !! ** Purpose :
233    !!        Read restart fields in direct access format, one per process
234    !!
235    !! ** Method :
236    !!        Just does the oposit than rst_wri
237    !!
238    !! History :
239    !!        !  91-03  ()  original code
240    !!        !  91-11  (G. Madec)
241    !!        !  92-06  (M. Imbard)  correction restart file
242    !!        !  92-07  (M. Imbard)  split into diawri and rstwri
243    !!        !  98-02  (M. Guyon)  FETI method
244    !!        !  98-05  (G. Roullet)  free surface
245    !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
246    !!   8.5  !  03-06  (J.M. Molines)  F90: Free form, mpp support
247    !!----------------------------------------------------------------------
248
249
250    !!----------------------------------------------------------------------
251    USE lib_mpp
252    !! * Local declarations
253    INTEGER :: ino0, it0, ipcg0, isor0, itke0
254    INTEGER :: ino1, it1, isor1, ipcg1, itke1, idast1
255    INTEGER :: iice1, ibulk1
256    INTEGER :: ipi,ipj,ipk, ipni,ipnj,ipnij,iarea
257    INTEGER :: irecl8, irec
258    INTEGER :: ji,jj,jk
259    INTEGER :: ick, inum
260    INTEGER :: ios1, ios2, ios3, ios4
261
262    CHARACTER(LEN=80)  :: clres
263
264    LOGICAL   :: lstop
265
266      REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk
267
268    !!----------------------------------------------------------------------
269    !!  OPA 8.5, LODYC-IPSL (2002)
270    !!----------------------------------------------------------------------
271
272
273    ! 0. Initialisations
274    ! ------------------
275
276    inum = 11
277    ino0  = no
278    it0   = nit000
279    ipcg0 = 0
280    isor0 = 0
281    itke0 = 0
282    isor0 = nsolv-1
283    ipcg0 = 2-nsolv
284    IF (lk_zdftke ) itke0 = 1
285    ! FETI method
286    IF( nsolv == 3 ) THEN
287       isor0=2
288       ipcg0=2
289    ENDIF
290
291    IF(lwp) THEN
292       WRITE(numout,*)
293       WRITE(numout,*) ' *** rst_read:  beginning of restart'
294       WRITE(numout,*) ' '
295       WRITE(numout,*) ' the present run :'
296       WRITE(numout,*) '   job number : ', no
297       WRITE(numout,*) '   with nit000 : ', nit000
298       WRITE(numout,*) '   with pcg option ipcg0 : ', ipcg0
299       WRITE(numout,*) '   with sor option isor0 : ', isor0
300       WRITE(numout,*) '   with FETI solver option ipcg0 & isor0 : ', ipcg0,' & ',isor0
301       WRITE(numout,*) '   with tke option itke0 : ', itke0
302       WRITE(numout,*) '   with nfice            : ', nfice
303       WRITE(numout,*) '   with nfbulk           : ', nfbulk
304    ENDIF
305
306    ! Open direct access file, with reclength for 2D wp fields
307    WRITE(clres,'(a,i3.3)') 'restart.',narea
308
309    OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=8 )
310    READ(inum,REC=1)irecl8
311    CLOSE(inum)
312
313    OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl8 )
314
315    ! 1. Read inum
316    ! --------------
317
318
319    READ(inum,REC=1) irecl8, ino1, it1, isor1, ipcg1, itke1, &
320     &  iice1, ibulk1, ios1, ios2, ios3, ios4, &
321     &  idast1, adatrj0,  ipi,ipj,ipk,ipni,ipnj,ipnij,iarea
322
323    ! Performs checks on the file
324
325    ! processor layout changed ? check only on lwp
326    lstop =.FALSE.
327    IF ( ipni /= jpni ) THEN
328       lstop=.TRUE.
329       IF (lwp)  WRITE(numout,*) ' E R R O R : Processor splitting change along I '
330       IF (lwp)  WRITE(numout,*) ' =========='
331    END IF
332
333    IF ( ipnj /= jpnj ) THEN
334       lstop=.TRUE.
335       IF (lwp)  WRITE(numout,*) ' E R R O R : Processor splitting change along J '
336       IF (lwp)  WRITE(numout,*) ' =========='
337    END IF
338
339    IF ( ipnij /= jpnij ) THEN
340       lstop=.TRUE.
341       IF (lwp)  WRITE(numout,*) ' E R R O R : Total number of processors changed '
342       IF (lwp)  WRITE(numout,*) ' =========='
343    END IF
344
345    ick = narea -iarea
346    CALL mpp_sum( ick )
347
348    IF (ick /= 0 ) THEN
349       lstop=.TRUE.
350       IF (lwp)  WRITE(numout,*) ' E R R O R : mismatch in area numbering ...'
351       IF (lwp)  WRITE(numout,*) ' =========='
352    END IF
353
354    IF(lwp) THEN
355       WRITE(numout,*)
356       WRITE(numout,*) ' READ inum with '
357       WRITE(numout,*) '   job number : ', ino1
358       WRITE(numout,*) '   with time step it : ', it1
359       WRITE(numout,*) '   with pcg option ipcg1 : ', ipcg1
360       WRITE(numout,*) '   with sor option isor1 : ', isor1
361       WRITE(numout,*) '   with tke option itke1 : ', itke1
362       WRITE(numout,*) '   with FETI solver option ipcg1 + isor1 : ', ipcg1 + isor1
363       WRITE(numout,*)
364    ENDIF
365
366    ! Control of date
367
368    IF( (it0-it1) /= 1 .AND. nrstdt /= 0 ) THEN
369       lstop=.TRUE.
370       IF(lwp) THEN
371          WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart'
372          WRITE(numout,*) ' =======                               ======='
373          WRITE(numout,*) ' we stop. verify the file'
374          WRITE(numout,*) ' or rerun with the value  0 for the'
375          WRITE(numout,*) ' control of time parameter  nrstdt'
376          WRITE(numout,*)
377       ENDIF
378    ENDIF
379
380    IF ( nrstdt /= 2 ) THEN  !  Compatibility with OPA8
381                             !  the beginning of the new run is ndate0 read in the namelist
382                             !  adatrj0 is recalculated assuming constant time step.
383
384       adatrj0 =  ( FLOAT( nit000-1 ) * rdttra(1) ) / rday
385    ELSE                 !  restart option nrstdt = 2
386                         !  both adatrj0 and ndastp are read in the restart file.
387       ndastp = idast1
388    ENDIF
389
390    IF (lstop ) STOP 'rst_read'
391
392    irec=2
393
394    ! 'before' fields
395
396    DO jk = 1, jpk
397       READ(inum,REC=irec) ub(:,:,jk)
398       irec = irec +1
399    END DO
400
401    DO jk = 1, jpk
402       READ(inum,REC=irec) vb(:,:,jk)
403       irec = irec +1
404    END DO
405
406    DO jk = 1, jpk
407       READ(inum,REC=irec) tb(:,:,jk)
408       irec = irec +1
409    END DO
410
411    DO jk = 1, jpk
412       READ(inum,REC=irec) sb(:,:,jk)
413       irec = irec +1
414    END DO
415
416    DO jk = 1, jpk
417       READ(inum,REC=irec) rotb(:,:,jk)
418       irec = irec +1
419    END DO
420
421    DO jk = 1, jpk
422       READ(inum,REC=irec) hdivb(:,:,jk)
423       irec = irec +1
424    END DO
425
426    ! 'now' fields
427
428    DO jk = 1, jpk
429       READ(inum,REC=irec) un(:,:,jk)
430       irec = irec +1
431    END DO
432
433    DO jk = 1, jpk
434       READ(inum,REC=irec) vn(:,:,jk)
435       irec = irec +1
436    END DO
437
438    DO jk = 1, jpk
439       READ(inum,REC=irec) tn(:,:,jk)
440       irec = irec +1
441    END DO
442
443    DO jk = 1, jpk
444       READ(inum,REC=irec) sn(:,:,jk)
445       irec = irec +1
446    END DO
447
448    DO jk = 1, jpk
449       READ(inum,REC=irec) rotn(:,:,jk)
450       irec = irec +1
451    END DO
452
453    DO jk = 1, jpk
454       READ(inum,REC=irec) hdivn(:,:,jk)
455       irec = irec +1
456    END DO
457
458    ! elliptic solver arrays
459    READ(inum,REC=irec ) gcx(:,:)
460    irec = irec +1
461
462    READ(inum,REC=irec ) gcxb(:,:)
463    irec = irec +1
464
465#if defined key_dynspg_fsc
466
467    ! free surface formulation (eta)
468
469    READ(inum,REC=irec ) sshb(:,:)
470    irec = irec +1
471
472    READ(inum,REC=irec ) sshn(:,:)
473    irec = irec +1
474#else
475
476    ! Rigid-lid formulation (bsf)
477
478    READ(inum,REC=irec ) bsfb(:,:)
479    irec = irec +1
480
481    READ(inum,REC=irec ) bsfn(:,:)
482    irec = irec +1
483
484    READ(inum,REC=irec ) bsfd(:,:)
485    irec = irec +1
486
487#endif
488
489    ! TKE arrays
490
491#if defined key_zdftke
492    IF ( itke1 == 1 ) THEN
493       DO jk = 1, jpk
494          READ(inum,REC=irec) en(:,:,jk)
495          irec = irec +1
496       END DO
497    ELSE
498       IF(lwp) THEN
499          WRITE(numout,*) ' ===>>>> : the previous restart file didnot used  tke scheme'
500          WRITE(numout,*) ' =======                ======='
501       ENDIF
502       nrstdt = 2
503    ENDIF
504#endif
505#if defined key_ice_lim
506    ! Louvain La Neuve Sea Ice Model
507    ! check if it was in the previous run
508    IF ( ios1 == 1 ) THEN
509       READ(inum,REC=irec) zfice(:)    ; irec = irec + 1
510       READ(inum,REC=irec) sst_io(:,:) ; irec = irec + 1
511       READ(inum,REC=irec) sss_io(:,:) ; irec = irec + 1
512       READ(inum,REC=irec) u_io  (:,:) ; irec = irec + 1
513       READ(inum,REC=irec) v_io  (:,:) ; irec = irec + 1
514#  if defined key_coupled
515       READ(inum,REC=irec) alb_ice(:,:) ; irec = irec + 1
516#  endif
517    ENDIF
518    IF ( zfice(1) /= FLOAT(nfice) .OR. ios1 == 0 ) THEN
519         IF(lwp) WRITE(numout,*)
520         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
521         IF(lwp) WRITE(numout,*)
522         sst_io(:,:) = sst_io(:,:) + ( nfice-1 )*( tn(:,:,1) + rt0 )
523         sss_io(:,:) = sss_io(:,:) + ( nfice-1 )*  sn(:,:,1)
524         DO jj = 2, jpj
525            DO ji = 2, jpi
526               u_io(ji,jj) = u_io(ji,jj) + (nfice-1)*0.5*( un(ji-1,jj,1)+un(ji-1,jj-1,1) )
527               v_io(ji,jj) = v_io(ji,jj) + (nfice-1)*0.5*( vn(ji,jj-1,1)+vn(ji-1,jj-1,1) )
528            END DO
529         END DO
530#    if defined key_coupled
531         alb_ice(:,:) = 0.8 * tmask(:,:,1)
532#    endif
533    ENDIF
534 
535#endif
536# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
537      ! bulk forcing
538      IF( ios2 == 1 ) THEN
539         READ(inum,REC=irec) zfblk(:)   ; irec = irec + 1
540         READ(inum,REC=irec) gsst (:,:) ; irec = irec + 1
541      ENDIF
542      IF( zfblk(1) /= FLOAT(nfbulk)  .OR. ios2 == 0 ) THEN
543         IF(lwp) WRITE(numout,*)
544         IF(lwp) WRITE(numout,*) 'rst_read :  Bulk forcing ==> Initialization '
545         IF(lwp) WRITE(numout,*)
546         gsst(:,:) = 0.e0
547         gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 )
548      ENDIF
549# endif
550    CLOSE(inum)
551
552  END SUBROUTINE rst_read
Note: See TracBrowser for help on using the repository browser.