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 tags/start/NEMO/OPA_SRC/OBC – NEMO

source: tags/start/NEMO/OPA_SRC/OBC/obcrst.F90 @ 1388

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