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

source: branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90 @ 2888

Last change on this file since 2888 was 2888, checked in by davestorkey, 13 years ago

Move changes into updated BDY module and restore old OBC code.
(Full merge to take place next year).
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.