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

Last change on this file since 475 was 474, checked in by opalod, 18 years ago

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