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

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

Initial revision

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