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

Last change on this file since 55 was 55, checked in by opalod, 20 years ago

CT : BUGFIX029 : # Add of the key_zdftke everywhere the array en(:,:,jk) appears to avoid compilation error that happens only when key_mpp is active but not key_zdftke

# Correction of the control test on nrstdt for restart case

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