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

source: tags/nemo_v3_2_beta/NEMO/OPA_SRC/OBC/obcrst.F90 @ 7795

Last change on this file since 7795 was 1581, checked in by smasson, 15 years ago

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