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

Last change on this file since 2166 was 2166, checked in by rblod, 14 years ago

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