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

source: trunk/NEMO/OPA_SRC/OBC/obcrst.F90 @ 719

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago

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