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

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90 @ 4467

Last change on this file since 4467 was 3211, checked in by spickles2, 13 years ago

Stephen Pickles, 11 Dec 2011

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