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

source: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90 @ 3294

Last change on this file since 3294 was 3294, checked in by rblod, 12 years ago

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