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 branches/2012/dev_r3452_UKMO9_RESTART/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

source: branches/2012/dev_r3452_UKMO9_RESTART/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90 @ 3594

Last change on this file since 3594 was 3594, checked in by rfurner, 11 years ago

code not tested through SETTEE, builds and runs, but has not been thoroughly tested, so will not be included in 2012 merge, however submitted back to keep record of work done for 2013 developments

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