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.
obcrst.F90 in trunk/NEMO/OPA_SRC/OBC – NEMO

source: trunk/NEMO/OPA_SRC/OBC/obcrst.F90 @ 78

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

CT : UPDATE052 : change logical lpXXXobc to lp_obc_XXX for Open Boundaries case
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 30.6 KB
Line 
1MODULE obcrst
2#if defined key_obc
3   !!=================================================================================
4   !!                       ***  MODULE  obcrst  ***
5   !! Ocean dynamic :  Input/Output files for restart on OBC
6   !!=================================================================================
7
8   !!---------------------------------------------------------------------------------
9   !! * Modules used
10   USE oce             ! ocean dynamics and tracers variables
11   USE dom_oce         ! ocean space and time domain variables
12   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
13   USE phycst          ! physical constants
14   USE obc_oce         ! ocean open boundary conditions
15   USE daymod          ! calendar
16   USE lib_mpp         ! for mppobc
17   USE in_out_manager  ! I/O manager
18
19   IMPLICIT NONE
20   PRIVATE
21
22   !! * Accessibility
23   PUBLIC obc_rst_lec        ! routine called by iniobc.F90
24   PUBLIC obc_rst_wri        ! routine called by step.F90
25
26   !!---------------------------------------------------------------------------------
27   !!   OPA 9.0 , LODYC-IPSL   (2003)
28   !!---------------------------------------------------------------------------------
29
30CONTAINS
31
32   SUBROUTINE obc_rst_wri ( kt )
33      !!--------------------------------------------------------------------------------
34      !!                  ***  SUBROUTINE obc_rst_wri  ***
35      !!               
36      !! ** Purpose :   Write open boundary restart fields in restart.obc.output file
37      !!
38      !! ** Method  :   restart.obc.output file: Direct access non formatted file.
39      !!      Each nstock time step , save fields which are necessary for restart.
40      !!      - This routine is called if at least the key_obc is defined. It is called
41      !!        at the same time step than rstwri.
42      !!      - First record holds OBC parameters nbobc,jpieob,jpiwob,jpjnob,jpjsob and
43      !!        the OBC layout jpjed, jpjef ... for checking purposes.
44      !!      - Following records hold the boundary arrays, in the order east west north
45      !!        south, if they exist.
46      !!      - The writing is realised by vertical slab across the boundary, for bsf, u,
47      !!        v, t, and s boundary arrays. Each record hold a vertical slab.
48      !!      - For mpp, this allows each processor to write only the correct informations
49      !!        it hold. If a processor has no valid informations on boundary, it just
50      !!        skip the writing part (automatically).
51      !!      - Special care is taken for dumping the starting point of a boundary (jpjed,
52      !!        jpjwd, jpind, jpisd) because of the general definition of nje0 njw0,nin0,
53      !!        nis0. This is done to avoid records to be written by 2 adjacent processors.
54      !!
55      !!  History :
56      !!         ! 97-11 (J.M. Molines) Original code
57      !!         ! 98-11 (J.M. Molines) Bug fix for adjacent processors
58      !!   8.5   ! 02-10 (C. Talandier, A-M. Treguier) F90
59      !!         ! 03-06 (J.M. Molines) Bug fix for adjacent processors
60      !!   9.0   ! 04-02 (G. Madec)  suppression of numwob, use inum
61      !!-----------------------------------------------------------------------------------
62      !! * Arguments
63      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
64
65      !! * Local declarations
66      INTEGER ::   ji, jj, jk, ios
67      INTEGER ::   inum = 11          ! temporary logical unit
68      INTEGER ::   ibloc, nreclo, jrec, jt, jb 
69      INTEGER ::   jfoe, jfow, ifon, ifos
70      INTEGER ::   ino0, it0
71      !!-----------------------------------------------------------------------------
72
73      ! 1. Output of restart fields (inum)
74      ! ------------------------------------
75 
76      IF( ( mod(kt,nstock) == 0 ) .OR. ( kt == nitend ) ) THEN
77
78         ! 1.0 Initializations
79         ! -------------------
80         IF(lwp) THEN
81              WRITE(numout,*) ' '
82              WRITE(numout,*) 'obcrst: OBC output for restart with obc_rst_wri routine'
83              WRITE(numout,*) '~~~~~~'
84              WRITE(numout,*) '        output done in restart.obc.output file at it= ', kt, ' date= ', ndastp
85         END IF
86
87         ino0 = no
88         it0  = kt
89         ibloc  = 4096*4
90         nreclo = ibloc*( ( ( 26 *jpk + 9 )*jpbyt -1)/ibloc + 1)
91         IF(lwp) WRITE(numout,*) '             '
92         IF(lwp) WRITE(numout,*) '        OBC restart file opened with nreclo = ',nreclo
93
94         ! 1.1 Open file
95         ! -------------
96         OPEN( UNIT   = inum,                 &
97               IOSTAT = ios,                  &
98               FILE   = 'restart.obc.output', &
99               ACCESS = 'DIRECT',             &
100               RECL   =  nreclo,              &
101               FORM   = 'UNFORMATTED' )
102         IF( ios > 0 ) THEN
103            IF(lwp) WRITE(numout,*) '      '
104            IF(lwp) WRITE(numout,*) '        Pbm to OPEN the restart.obc.output file ' 
105            IF(lwp) WRITE(numout,*) '      '
106            nstop = nstop + 1   
107         END IF
108
109         ! 1.2 Write header
110         ! ----------------
111         WRITE (inum,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob,     &
112                              jpjed,jpjef,jpjwd,jpjwf,jpind,jpinf,jpisd,jpisf
113
114         ! 1.3 Write east boundary array if any.
115         ! -------------------------------------
116         IF( lp_obc_east ) THEN
117            IF( lfbceast ) THEN
118               IF(lwp) THEN
119                  WRITE(numout,*) ' '
120                  WRITE(numout,*) '        No restart file for the fixed east OBC'
121               END IF
122            ELSE
123               IF( jpieob /= 0 ) THEN
124                  IF( nje0+njmpp-1  == jpjed .AND. nie1 >= nie0 ) THEN
125            ! ... dump of jpjed if it is on this proc.
126                     jrec = 2
127                     jfoe = jpjed - njmpp + 1
128                     PRINT *,'Narea =',narea,' write jrec =2 east'
129                     WRITE(inum,REC=jrec)                                    &
130# if ! defined key_dynspg_fsc
131                           ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), &
132# endif
133                           ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
134                           ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
135                           ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
136                           ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
137                  ENDIF
138                  DO ji = nie0, nie1
139                     DO jj = nje0, nje1
140            ! ... only interested processors go through the following lines
141            !           jfoe = jj + njmpp -1
142                        jfoe = jj 
143                        jrec = 2 + jj + njmpp -1 -jpjed
144                        WRITE (inum,REC=jrec)                                   &
145# if ! defined key_dynspg_fsc
146                              ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), &
147# endif
148                              ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
149                              ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
150                              ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
151                              ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
152                     END DO
153                  END DO
154               END IF
155            END IF
156         END IF
157 
158         ! 1.4 Write west boundary arrays if any
159         ! -------------------------------------
160         IF( lp_obc_west ) THEN
161            IF( lfbcwest ) THEN
162               IF(lwp) THEN
163                  WRITE(numout,*) ' '
164                  WRITE(numout,*) '        No restart file for the fixed west OBC'
165               END IF
166            ELSE
167               IF( jpiwob /= 0 ) THEN
168                  IF( njw0+njmpp+1 == jpjwd .AND. niw1 >= niw0 ) THEN
169            ! ... dump of jpjwd if it is on this proc.
170                     jrec = 3 + jpjef - jpjed
171            !        jfow = jpjwd
172                     jfow = jpjwd -njmpp + 1
173                     PRINT *,'Narea =',narea,' write jrec =',jrec,' west'
174                     WRITE (inum,REC=jrec)                                   &
175# if ! defined key_dynspg_fsc
176                           ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), &
177# endif
178                           ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
179                           ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
180                           ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
181                           ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
182                  END IF
183                  DO ji = niw0, niw1
184                     DO jj = njw0, njw1
185            ! ... only interested processors go through the following lines
186            !           jfow = jj + njmpp -1
187                        jfow = jj 
188                        jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd
189                        WRITE (inum,REC=jrec)                                   &
190# if ! defined key_dynspg_fsc
191                              ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), &
192# endif
193                              ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
194                              ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
195                              ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
196                              ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
197                     END DO
198                  END DO
199               END IF
200            END IF
201         END IF
202 
203         ! 1.5 Write north boundary arrays if any
204         ! --------------------------------------
205         IF( lp_obc_north ) THEN
206            IF( lfbcnorth ) THEN
207               IF(lwp) THEN
208                  WRITE(numout,*) ' '
209                  WRITE(numout,*) '        No restart file for the fixed north OBC'
210               END IF
211            ELSE
212               IF( jpjnob /= 0) THEN
213                  IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN
214            ! ... dump of jpind if it is on this proc.
215                     jrec = 4 + jpjef -jpjed + jpjwf -jpjwd
216            !        ifon = jpind
217                     ifon = jpind -nimpp +1
218                     WRITE (inum,REC=jrec)                                   &
219# if ! defined key_dynspg_fsc
220                           ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), &
221# endif
222                           ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
223                           ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
224                           ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
225                           ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
226                  END IF
227                  DO jj = njn0, njn1
228                     DO ji = nin0, nin1
229            ! ... only interested processors go through the following lines
230            !           ifon = ji + nimpp -1
231                        ifon = ji 
232                        jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1  -jpind
233                        WRITE (inum,REC=jrec)                                   &
234# if ! defined key_dynspg_fsc
235                              ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), &
236# endif
237                              ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
238                              ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
239                              ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
240                              ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
241                     END DO
242                  END DO
243               END IF
244            END IF
245         END IF
246 
247         ! 1.6 Write south boundary arrays if any
248         ! --------------------------------------
249         IF( lp_obc_south ) THEN
250            IF( lfbcsouth ) THEN
251               IF(lwp) THEN
252                  WRITE(numout,*) ' '
253                  WRITE(numout,*) '        No restart file for the fixed south OBC'
254                  WRITE(numout,*) ' '
255               END IF
256            ELSE
257               IF( jpjsob /= 0 ) THEN
258                  IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN
259            ! ... dump of jpisd if it is on this proc.
260                     jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind
261            !        ifos = jpisd
262                     ifos = jpisd -nimpp + 1
263                     WRITE (inum,REC=jrec)                                   &
264# if ! defined key_dynspg_fsc
265                           ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), &
266# endif
267                           ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
268                           ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
269                           ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
270                           ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
271                  END IF
272                  DO jj = njs0, njs1
273                     DO ji = nis0, nis1
274            ! ... only interested processors go through the following lines
275            !           ifos = ji + nimpp -1
276                        ifos = ji 
277                        jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + &
278                              ji + nimpp -1 -jpisd
279                        WRITE (inum,REC=jrec) &
280# if ! defined key_dynspg_fsc
281                              ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), &
282# endif 
283                              ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
284                              ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
285                              ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
286                              ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
287                     END DO
288                  END DO
289               END IF
290            END IF
291         END IF
292      END IF
293      CLOSE(inum)
294
295   END SUBROUTINE obc_rst_wri
296
297
298   SUBROUTINE obc_rst_lec
299      !!----------------------------------------------------------------------------
300      !!                   ***  SUBROUTINE obc_rst_lec  ***
301      !!                   
302      !! ** Purpose :   Read files for restart at open boundaries
303      !!
304      !! ** Method  :   Read the previous boundary arrays on unit inum
305      !!      The first record indicates previous characterics
306      !!
307      !! History :
308      !!        ! 97-11 (J.M. Molines) Original code
309      !!   8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
310      !!----------------------------------------------------------------------------
311      !! * Local declarations
312      INTEGER ::   inum = 11            ! temporary logical unit
313      INTEGER ::   ji,jj,jk,ios
314      INTEGER ::   ino0,it0,nbobc0,jpieob0,jpiwob0,jpjnob0,jpjsob0
315      INTEGER ::   ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,jpjsob1
316      INTEGER ::   ied0,ief0,iwd0,iwf0,ind0,inf0,isd0,isf0
317      INTEGER ::   ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1
318      INTEGER ::   ibloc, nreclo, jrec, jt, jb
319      INTEGER ::   jfoe, jfow, ifon, ifos
320      !!-----------------------------------------------------------------------------
321
322      ! 0. Initialisations
323      ! ------------------
324 
325      ino0    = no
326      it0     = nit000
327      nbobc0  = nbobc
328      jpieob0 = jpieob
329      jpiwob0 = jpiwob
330      jpjnob0 = jpjnob
331      jpjsob0 = jpjsob
332 
333      ied0   = jpjed
334      ief0   = jpjef
335      iwd0   = jpjwd
336      iwf0   = jpjwf
337      ind0   = jpind
338      inf0   = jpinf
339      isd0   = jpisd
340      isf0   = jpisf
341 
342      ibloc  = 4096*4
343      nreclo = ibloc *( ( ( 26 *jpk + 9 )*jpbyt -1)/ibloc + 1)
344 
345      IF(lwp) THEN
346         WRITE(numout,*) 'obcrst: beginning of restart with obc_rst_lec routine'
347         WRITE(numout,*) '~~~~~~'
348         WRITE(numout,*) ' '
349         WRITE(numout,*) '        The present run :'
350         WRITE(numout,*) '        number job is  : ',no 
351         WRITE(numout,*) '        with the time nit000 : ',nit000
352         WRITE(numout,*) '        OBC restart file opened with nreclo = ',nreclo 
353      END IF
354 
355      ! 0.1 Open files
356      ! ---------------
357      OPEN( UNIT   =  inum,       &
358            IOSTAT =  ios,          &
359            FILE   = 'restart.obc', &
360            ACCESS = 'DIRECT',      &
361            RECL   =  nreclo,       &
362            FORM   = 'UNFORMATTED' )
363      IF( ios > 0 ) THEN
364         IF(lwp) WRITE(numout,*) '        Pbm to OPEN the restart.obc file ' 
365         nstop = nstop + 1   
366      END IF
367
368      ! 1. Read
369      ! -------
370 
371      ! 1.1 First record
372      ! -----------------
373      READ(inum,REC=1) ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,     &
374                         jpjsob1,ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1
375 
376      IF(lwp) THEN
377         WRITE(numout,*) ' '
378         WRITE(numout,*) '        READ inum with number job : ',ino1,' with the time it: ',it1
379         WRITE(numout,*) ' '
380      END IF
381 
382      ! 1.2 Control of date
383      ! --------------------
384      IF( ( it0-it1 ) /= 1 .AND. abs(nrstdt) == 1 ) THEN
385          IF(lwp) THEN
386             WRITE(numout,*) '        ===>>>> : problem with nit000 for the restart'
387             WRITE(numout,*) '        =============='
388             WRITE(numout,*) '        we stop in obc_rst_lec routine. Verify the file or rerun with the value'
389             WRITE(numout,*) '        0 for the control of time parameter nrstdt'
390             WRITE(numout,*) ' ' 
391          END IF
392          nstop = nstop + 1
393      END IF
394 
395      ! 1.3 Control of number of open boundaries
396      ! ----------------------------------------
397      IF( nbobc1 /= nbobc0 ) THEN
398         IF(lwp) THEN
399            WRITE(numout,*) '        ===> W A R N I N G: The number of OBC have changed:'
400            WRITE(numout,*) '        Last run : ',nbobc0,' obcs'
401            WRITE(numout,*) '        This run : ',nbobc1,' obcs'
402         END IF
403      END IF
404 
405      ! 1.4 Control of which boundary is open
406      ! -------------------------------------
407      IF( lp_obc_east .AND. ( jpieob1 /= 0 ) ) THEN
408         IF(lwp) THEN
409            WRITE(numout,*) '         '
410            WRITE(numout,*) '        East open boundary'
411            IF( jpieob0 /= jpieob1 ) THEN
412               WRITE(numout,*) '         ==>>>> : Problem in obc_rst_lec, jpieob have changed'
413               nstop = nstop + 1
414            END IF
415         END IF
416      END IF
417 
418      IF( lp_obc_west .AND. ( jpiwob1 /= 0 ) ) THEN
419         IF(lwp) THEN
420            WRITE(numout,*) '         '
421            WRITE(numout,*) '        West open boundary'
422            IF( jpiwob0 /= jpiwob1 ) THEN
423               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpiwob has changed'
424               nstop = nstop + 1
425            END IF
426         END IF
427      END IF
428 
429      IF( lp_obc_north .AND. ( jpjnob1 /= 0 ) ) THEN
430         IF(lwp) THEN
431            WRITE(numout,*) '         '
432            WRITE(numout,*) '        North open boundary'
433            IF( jpjnob0 /= jpjnob1 ) THEN
434               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjnob has changed'
435               nstop = nstop + 1
436            END IF
437         END IF
438      END IF
439 
440      IF( lp_obc_south .AND. ( jpjsob1 /= 0 ) ) THEN
441         IF(lwp) THEN
442            WRITE(numout,*) '         '
443            WRITE(numout,*) '        South open boundary'
444            IF( jpjsob0 /= jpjsob1) THEN
445               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjsob has changed'
446               nstop = nstop + 1
447            END IF
448         END IF
449      END IF
450 
451 
452      ! 1.5 Control of the limit of the boundaries
453      ! ------------------------------------------
454      IF( lp_obc_east .AND. ( jpieob1 /= 0 ) ) THEN
455         IF(lwp) THEN
456            IF( ied1 /= ied0 ) THEN
457               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjed has changed'
458               nstop = nstop + 1
459            END IF
460            IF( ief1 /= ief0 ) THEN
461               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjef has changed'
462               nstop = nstop + 1
463            END IF
464         END IF
465      END IF
466
467      IF( lp_obc_west .AND. ( jpiwob1 /= 0 ) ) THEN
468         IF(lwp) THEN
469            IF( iwd1 /= iwd0 ) THEN
470               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjwd has changed'
471               nstop = nstop + 1
472            END IF
473            IF( iwf1 /= iwf0 ) THEN
474               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjwf has changed'
475               nstop = nstop + 1
476            END IF
477         END IF
478      END IF
479 
480      IF( lp_obc_north .AND. ( jpjnob1 /= 0 ) ) THEN
481         IF(lwp) THEN
482            IF( ind1 /= ind0 ) THEN
483               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpind has changed'
484               nstop = nstop + 1
485            END IF
486            IF( inf1 /= inf0 ) THEN
487               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpinf has changed'
488               nstop = nstop + 1
489             END IF
490          END IF
491      END IF
492 
493      IF( lp_obc_south .AND. ( jpjsob1 /= 0 ) ) THEN
494         IF(lwp) THEN
495            IF( isd1 /= isd0 ) THEN
496               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpisd has changed'
497               nstop = nstop + 1
498            END IF
499            IF( isf1 /= isf0 ) THEN
500               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpisf has changed'
501               nstop = nstop + 1
502            END IF
503         END IF
504      END IF
505 
506 
507      ! 2. Now read the boundary arrays
508      ! -------------------------------
509 
510      ! 2.1 Read east boundary array if any.
511      ! ------------------------------------
512      IF( lp_obc_east ) THEN
513         IF( jpieob1 /= 0) THEN
514            IF( nje0+njmpp-1 == jpjed .AND. nie1 >= nie0 ) THEN
515      ! ... read of jpjed if it is on this proc.
516               jrec = 2
517      !        jfoe = jpjed
518               jfoe = jpjed -njmpp + 1
519               READ (inum,REC=jrec)                                   &
520# if ! defined key_dynspg_fsc
521                    ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), &
522# endif 
523                    ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
524                    ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
525                    ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
526                    ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
527            END IF
528            DO ji = nie0, nie1
529               DO jj = nje0, nje1
530      ! ... only interested processors go through the following lines
531      !           jfoe = jj + njmpp -1
532                  jfoe = jj 
533                  jrec = 2 + jj + njmpp -1 -jpjed
534                  READ (inum,REC=jrec)                                   &
535# if ! defined key_dynspg_fsc
536                       ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), &
537# endif
538                       ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
539                       ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
540                       ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
541                       ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
542               END DO
543            END DO
544
545         ELSE
546
547            !  lp_obc_east was not TRUE previously
548         END IF
549
550      END IF
551 
552      ! 2.2 Read west boundary arrays if any.
553      ! -------------------------------------
554      IF( lp_obc_west ) THEN
555         IF( jpiwob1 /= 0) THEN
556            IF( njw0+njmpp-1 == jpjwd .AND. niw1 >= niw0 ) THEN
557      ! ... read of jpjwd if it is on this proc.
558               jrec = 3 + jpjef - jpjed
559      !        jfow = jpjwd
560               jfow = jpjwd -njmpp + 1
561               READ (inum,REC=jrec)                                   &
562# if ! defined key_dynspg_fsc
563                    ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), &
564# endif
565                    ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
566                    ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
567                    ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
568                    ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
569            END IF
570            DO ji = niw0, niw1
571               DO jj = njw0, njw1
572      ! ... only interested processors go through the following lines
573      !           jfow = jj + njmpp -1
574                  jfow = jj 
575                  jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd
576                  READ (inum,REC=jrec)                                   &
577# if ! defined key_dynspg_fsc
578                       ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), &
579# endif
580                       ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
581                       ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
582                       ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
583                       ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
584               END DO
585            END DO
586
587         ELSE
588
589            !  lp_obc_west was not TRUE previously
590         END IF
591
592      END IF
593 
594      ! 2.3 Read north boundary arrays if any.
595      ! --------------------------------------
596      IF( lp_obc_north ) THEN
597         IF( jpjnob1 /= 0) THEN
598            IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN
599      ! ... read of jpind if it is on this proc.
600               jrec = 4 + jpjef -jpjed + jpjwf -jpjwd
601      !        ifon = jpind
602               ifon = jpind -nimpp +1
603               READ (inum,REC=jrec)                                   &
604# if ! defined key_dynspg_fsc
605                    ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), &
606# endif
607                    ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
608                    ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
609                    ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 
610                    ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
611            END IF
612            DO jj = njn0, njn1
613               DO ji = nin0, nin1
614      ! ... only interested processors go through the following lines
615      !           ifon = ji + nimpp -1
616                  ifon = ji 
617                  jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1  -jpind
618                  READ (inum,REC=jrec)                                   & 
619# if ! defined key_dynspg_fsc
620                       ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), &
621# endif 
622                       ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
623                       ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
624                       ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
625                       ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
626               END DO
627            END DO
628
629         ELSE
630
631           !  lp_obc_north was not TRUE previously
632         END IF
633
634      END IF
635 
636      ! 2.4 Read south boundary arrays if any.
637      ! -------------------------------------
638      IF( lp_obc_south ) THEN
639         IF( jpjsob1 /= 0) THEN
640            IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN
641      ! ... read of jpisd if it is on this proc.
642               jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind
643      !        ifos = jpisd
644               ifos = jpisd -nimpp + 1
645               READ (inum,REC=jrec)                                   &
646# if ! defined key_dynspg_fsc
647                    ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), &
648# endif
649                    ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
650                    ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
651                    ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
652                    ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
653            END IF
654            DO jj = njs0, njs1
655               DO ji = nis0, nis1
656      ! ... only interested processors go through the following lines
657      !           ifos = ji + nimpp -1
658                  ifos = ji 
659                  jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind +  &
660                        ji + nimpp -1 -jpisd
661                  READ (inum,REC=jrec)                                   & 
662# if ! defined key_dynspg_fsc
663                       ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), &
664# endif
665                       ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
666                       ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
667                       ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
668                       ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
669               END DO
670            END DO
671         ELSE
672            !  lp_obc_south was not TRUE previously
673         END IF
674
675      END IF
676      CLOSE(inum)
677
678      IF( lk_mpp ) THEN
679         IF( lp_obc_east ) THEN
680# if ! defined key_dynspg_fsc
681            CALL mppobc(bebnd,jpjed,jpjef,jpieob,3*3,2,jpj)
682# endif
683            CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj)
684            CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj)
685            CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj)
686            CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj)
687         ENDIF
688         IF( lp_obc_west ) THEN
689# if ! defined key_dynspg_fsc
690            CALL mppobc(bwbnd,jpjwd,jpjwf,jpiwob,3*3,2,jpj)
691# endif
692            CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj)
693            CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj)
694            CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj)
695            CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj)
696         ENDIF
697         IF( lp_obc_north ) THEN 
698# if ! defined key_dynspg_fsc
699            CALL mppobc(bnbnd,jpind,jpinf,jpjnob  ,3*3    ,1,jpi)
700# endif
701            CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi)
702            CALL mppobc(vnbnd,jpind,jpinf,jpjnob  ,jpk*3*3,1,jpi)
703            CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi)
704            CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi)
705         ENDIF
706         IF( lp_obc_south ) THEN
707# if ! defined key_dynspg_fsc
708            CALL mppobc(bsbnd,jpisd,jpisf,jpjsob,    3*3,1,jpi)
709# endif
710            CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi)
711            CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi)
712            CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi)
713            CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi)
714         ENDIF
715      ENDIF
716 
717   END SUBROUTINE obc_rst_lec
718#else
719   !!=================================================================================
720   !!                       ***  MODULE  obcrst  ***
721   !! Ocean dynamic :  Input/Output files for restart on OBC
722   !!=================================================================================
723CONTAINS
724   SUBROUTINE obc_rst_wri( kt )           !  No Open boundary ==> empty routine
725      INTEGER,INTENT(in) :: kt
726      WRITE(*,*) 'obc_rst_wri: You should not have seen this print! error?', kt
727   END SUBROUTINE obc_rst_wri
728   SUBROUTINE obc_rst_lec                 !  No Open boundary ==> empty routine
729   END SUBROUTINE obc_rst_lec
730#endif
731
732   !!=================================================================================
733END MODULE obcrst
Note: See TracBrowser for help on using the repository browser.