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.
obcini.F90 in trunk/NEMO/OPA_SRC/OBC – NEMO

source: trunk/NEMO/OPA_SRC/OBC/obcini.F90 @ 2065

Last change on this file since 2065 was 2065, checked in by rblod, 14 years ago

Set nbobc only one, see ticket #689

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 30.0 KB
Line 
1 MODULE obcini
2   !!======================================================================
3   !!                       ***  MODULE  obcini  ***
4   !! OBC initial state :  Open boundary initial state
5   !!======================================================================
6   !! History :  8.0  !  97-07  (J.M. Molines, G. Madec)  Original code
7   !!   NEMO     1.0  !  02-11  (C. Talandier, A-M. Treguier) Free surface, F90
8   !!            2.0  !  05-11  (V. Garnier) Surface pressure gradient organization
9   !!----------------------------------------------------------------------
10#if defined key_obc
11   !!----------------------------------------------------------------------
12   !!   'key_obc'                                  Open Boundary Conditions
13   !!----------------------------------------------------------------------
14   !!   obc_init       : initialization for the open boundary condition
15   !!----------------------------------------------------------------------
16   USE oce             ! ocean dynamics and tracers variables
17   USE dom_oce         ! ocean space and time domain variables
18   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
19   USE phycst          ! physical constants
20   USE obc_oce         ! ocean open boundary conditions
21   USE lib_mpp         ! for mpp_sum
22   USE in_out_manager  ! I/O units
23   USE dynspg_oce      ! flag lk_dynspg_flt
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   obc_init   ! routine called by opa.F90
29
30   !! * Substitutions
31#  include "obc_vectopt_loop_substitute.h90"
32   !!----------------------------------------------------------------------
33   !! NEMO/OPA 9.0 , LOCEAN-IPSL (2005)
34   !! $Id$
35   !! software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37
38CONTAINS
39   
40   SUBROUTINE obc_init
41      !!----------------------------------------------------------------------
42      !!                 ***  ROUTINE obc_init  ***
43      !!         
44      !! ** Purpose :   Initialization of the dynamics and tracer fields at
45      !!              the open boundaries.
46      !!
47      !! ** Method  :   initialization of open boundary variables
48      !!      (u, v) over 3 time step and 3 rows
49      !!      (t, s) over 2 time step and 2 rows
50      !!      if ln_rstart = .FALSE. : no restart, fields set to zero
51      !!      if ln_rstart = .TRUE.  : restart, fields are read in a file
52      !!      if rdpxxx = 0 then lfbc is set true for this boundary.
53      !!
54      !! ** Input   :   restart.obc file, restart file for open boundaries
55      !!----------------------------------------------------------------------
56      USE obcrst,   ONLY :   obc_rst_read   ! Make obc_rst_read routine available
57      !!
58      INTEGER  ::   ji, jj, istop , inumfbc
59      INTEGER, DIMENSION(4) ::   icorner
60      REAL(wp), DIMENSION(2) ::   ztestmask
61      !!
62      NAMELIST/namobc/ rn_dpein, rn_dpwin, rn_dpnin, rn_dpsin,       &
63         &             rn_dpeob, rn_dpwob, rn_dpnob, rn_dpsob,       &
64         &             rn_volemp, nn_obcdta, cn_obcdta,    &
65         &             ln_obc_clim, ln_vol_cst, ln_obc_fla
66      !!----------------------------------------------------------------------
67
68      REWIND( numnam )              ! Namelist namobc : open boundaries
69      READ  ( numnam, namobc )
70
71      ! convert DOCTOR namelist name into the OLD names
72      nobc_dta = nn_obcdta
73      cffile   = cn_obcdta
74      rdpein   = rn_dpein
75      rdpwin   = rn_dpwin
76      rdpsin   = rn_dpsin
77      rdpnin   = rn_dpnin
78      rdpeob   = rn_dpeob
79      rdpwob   = rn_dpwob
80      rdpsob   = rn_dpsob
81      rdpnob   = rn_dpnob
82      volemp   = rn_volemp
83     
84
85
86      ! By security we set rdpxin and rdpxob respectively to 1. and 15. if the corresponding OBC is not activated
87      IF( .NOT.lp_obc_east  ) THEN   ;   rdpein = 1.   ;   rdpeob = 15.   ;   END IF
88      IF( .NOT.lp_obc_west  ) THEN   ;   rdpwin = 1.   ;   rdpwob = 15.   ;   END IF
89      IF( .NOT.lp_obc_north ) THEN   ;   rdpnin = 1.   ;   rdpnob = 15.   ;   END IF
90      IF( .NOT.lp_obc_south ) THEN   ;   rdpsin = 1.   ;   rdpsob = 15.   ;   END IF
91
92      ! number of open boudaries and open boundary indicators
93      nbobc = 0
94      IF( lp_obc_east  )   nbobc = nbobc + 1
95      IF( lp_obc_west  )   nbobc = nbobc + 1
96      IF( lp_obc_north )   nbobc = nbobc + 1
97      IF( lp_obc_south )   nbobc = nbobc + 1
98
99      IF(lwp) WRITE(numout,*)
100      IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries'
101      IF(lwp) WRITE(numout,*) '~~~~~~~~'
102      IF(lwp) WRITE(numout,*) '   Number of open boundaries    nbobc = ', nbobc
103      IF(lwp) WRITE(numout,*)
104
105      ! control prints
106      IF(lwp) WRITE(numout,*) '   Namelist namobc'
107      IF(lwp) WRITE(numout,*) '      data in file (=1) or initial state used (=0)   nn_obcdta   = ', nn_obcdta
108      IF(lwp) WRITE(numout,*) '      climatology (true) or not                      ln_obc_clim = ', ln_obc_clim
109      IF(lwp) WRITE(numout,*) '      vol_cst (true) or not:                         ln_vol_cst  = ', ln_vol_cst
110      IF(lwp) WRITE(numout,*) ' '
111      IF(lwp) WRITE(numout,*) '   WARNING                                                  '
112      IF(lwp) WRITE(numout,*) '      Flather"s algorithm is applied with explicit free surface scheme                 '
113      IF(lwp) WRITE(numout,*) '      or with free surface time-splitting scheme                                       '
114      IF(lwp) WRITE(numout,*) '      Nor radiation neither relaxation is allowed with explicit free surface scheme:   '
115      IF(lwp) WRITE(numout,*) '      Radiation and/or relaxation is allowed with free surface time-splitting scheme '
116      IF(lwp) WRITE(numout,*) '      depending of the choice of rdpXin = rdpXob  = 0. for open boundaries             '
117      IF(lwp) WRITE(numout,*)
118      IF(lwp) WRITE(numout,*) '      For the filtered free surface case,                                              '
119      IF(lwp) WRITE(numout,*) '      radiation, relaxation or presciption of data can be applied                      '
120      IF(lwp) WRITE(numout,*)
121
122      IF( lwp.AND.lp_obc_east ) THEN
123         WRITE(numout,*) '      East open boundary :'
124         WRITE(numout,*) '         i index                    jpieob   = ', jpieob
125         WRITE(numout,*) '         damping time scale (days)  rn_dpeob = ', rn_dpeob
126         WRITE(numout,*) '         damping time scale (days)  rn_dpein = ', rn_dpein
127      ENDIF
128
129      IF( lwp.AND.lp_obc_west ) THEN
130         WRITE(numout,*) '      West open boundary :'
131         WRITE(numout,*) '         i index                    jpiwob   = ', jpiwob
132         WRITE(numout,*) '         damping time scale (days)  rn_dpwob = ', rn_dpwob
133         WRITE(numout,*) '         damping time scale (days)  rn_dpwin = ', rn_dpwin
134      ENDIF
135
136      IF( lwp.AND.lp_obc_north ) THEN
137         WRITE(numout,*) '      North open boundary :'
138         WRITE(numout,*) '         j index                    jpjnob   = ', jpjnob
139         WRITE(numout,*) '         damping time scale (days)  rn_dpnob = ', rn_dpnob
140         WRITE(numout,*) '         damping time scale (days)  rn_dpnin = ', rn_dpnin
141      ENDIF
142
143      IF( lwp.AND.lp_obc_south ) THEN
144         WRITE(numout,*) '      South open boundary :'
145         WRITE(numout,*) '         j index                    jpjsob   = ', jpjsob
146         WRITE(numout,*) '         damping time scale (days)  rn_dpsob = ', rn_dpsob
147         WRITE(numout,*) '         damping time scale (days)  rn_dpsin = ', rn_dpsin
148         WRITE(numout,*)
149      ENDIF
150
151      IF( nbobc >= 2 .AND. jperio /= 0 )   &
152         &   CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' )
153
154      ! 1. Initialisation of constants
155      ! ------------------------------
156      ! ...                          convert rdp$ob in seconds
157      ! Fixed Bdy flag              inbound                outbound
158      lfbceast  = .FALSE.   ;   rdpein = rdpein * rday    ;   rdpeob = rdpeob * rday
159      lfbcwest  = .FALSE.   ;   rdpwin = rdpwin * rday    ;   rdpwob = rdpwob * rday
160      lfbcnorth = .FALSE.   ;   rdpnin = rdpnin * rday    ;   rdpnob = rdpnob * rday
161      lfbcsouth = .FALSE.   ;   rdpsin = rdpsin * rday    ;   rdpsob = rdpsob * rday
162      inumfbc = 0
163      ! ... look for Fixed Boundaries (rdp = 0 )
164      ! ... When specified, lbcxxx flags are set to TRUE and rdpxxx are set to
165      ! ...  a small arbitrary value, (to avoid division by zero further on).
166      ! ...  rdpxxx is not used anymore.
167      IF( lp_obc_east )  THEN
168         IF( (rdpein+rdpeob) == 0 )  THEN
169            lfbceast = .TRUE.   ;   rdpein = 1e-3   ;   rdpeob = 1e-3
170            inumfbc = inumfbc+1
171         ELSEIF ( (rdpein*rdpeob) == 0 )  THEN
172            CALL ctl_stop( 'obc_init : rn_dpein & rn_dpeob must be both zero or non zero' )
173         END IF
174      END IF
175
176      IF( lp_obc_west )  THEN
177         IF( (rdpwin + rdpwob) == 0 )  THEN
178            lfbcwest = .TRUE.     ;     rdpwin = 1e-3     ;     rdpwob = 1e-3
179            inumfbc = inumfbc+1
180         ELSEIF ( (rdpwin*rdpwob) == 0 )  THEN
181            CALL ctl_stop( 'obc_init : rn_dpwin & rn_dpwob must be both zero or non zero' )
182         END IF
183      END IF
184      IF( lp_obc_north )  THEN
185         IF( (rdpnin + rdpnob) == 0 )  THEN
186            lfbcnorth = .TRUE.     ;     rdpnin = 1e-3     ;     rdpnob = 1e-3
187            inumfbc = inumfbc+1
188         ELSEIF ( (rdpnin*rdpnob) == 0 )  THEN
189            CALL ctl_stop( 'obc_init : rn_dpnin & rn_dpnob must be both zero or non zero' )
190         END IF
191      END IF
192      IF( lp_obc_south )  THEN
193         IF( (rdpsin + rdpsob) == 0 )  THEN
194            lfbcsouth = .TRUE.   ;   rdpsin = 1e-3   ;   rdpsob = 1e-3
195            inumfbc = inumfbc+1
196         ELSEIF ( (rdpsin*rdpsob) == 0 )  THEN
197            CALL ctl_stop( 'obc_init : rn_dpsin & rn_dpsob must be both zero or non zero' )
198         END IF
199      END IF
200
201      ! 2.  Clever mpp indices for loops on the open boundaries.
202      !     The loops will be performed only on the processors
203      !     that contain a given open boundary.
204      ! --------------------------------------------------------
205
206      IF( lp_obc_east ) THEN
207         ! ...   mpp initialization
208         nie0   = max( 1, min(jpieob   - nimpp+1, jpi     ) )
209         nie1   = max( 0, min(jpieob   - nimpp+1, jpi - 1 ) )
210         nie0p1 = max( 1, min(jpieob+1 - nimpp+1, jpi     ) )
211         nie1p1 = max( 0, min(jpieob+1 - nimpp+1, jpi - 1 ) )
212         nie0m1 = max( 1, min(jpieob-1 - nimpp+1, jpi     ) )
213         nie1m1 = max( 0, min(jpieob-1 - nimpp+1, jpi - 1 ) )
214         nje0   = max( 2, min(jpjed    - njmpp+1, jpj     ) )
215         nje1   = max( 0, min(jpjef    - njmpp+1, jpj - 1 ) )
216         nje0p1 = max( 1, min(jpjedp1  - njmpp+1, jpj     ) )
217         nje0m1 = max( 1, min(jpjed    - njmpp+1, jpj     ) )
218         nje1m1 = max( 0, min(jpjefm1  - njmpp+1, jpj - 1 ) )
219         nje1m2 = max( 0, min(jpjefm1-1- njmpp+1, jpj - 1 ) )
220         IF(lwp) THEN
221            IF( lfbceast ) THEN
222               WRITE(numout,*)'     '
223               WRITE(numout,*)'         Specified East Open Boundary'
224            ELSE
225               WRITE(numout,*)'     '
226               WRITE(numout,*)'         Radiative East Open Boundary'
227            END IF
228         END IF
229      END IF
230
231      IF( lp_obc_west ) THEN
232         ! ...   mpp initialization
233         niw0   = max( 1, min(jpiwob   - nimpp+1, jpi     ) )
234         niw1   = max( 0, min(jpiwob   - nimpp+1, jpi - 1 ) )
235         niw0p1 = max( 1, min(jpiwob+1 - nimpp+1, jpi     ) )
236         niw1p1 = max( 0, min(jpiwob+1 - nimpp+1, jpi - 1 ) )
237         njw0   = max( 2, min(jpjwd    - njmpp+1, jpj     ) )
238         njw1   = max( 0, min(jpjwf    - njmpp+1, jpj - 1 ) )
239         njw0p1 = max( 1, min(jpjwdp1  - njmpp+1, jpj     ) )
240         njw0m1 = max( 1, min(jpjwd    - njmpp+1, jpj     ) )
241         njw1m1 = max( 0, min(jpjwfm1  - njmpp+1, jpj - 1 ) )
242         njw1m2 = max( 0, min(jpjwfm1-1- njmpp+1, jpj - 1 ) )
243         IF(lwp) THEN
244            IF( lfbcwest ) THEN
245               WRITE(numout,*)'     '
246               WRITE(numout,*)'         Specified West Open Boundary'
247            ELSE
248               WRITE(numout,*)'     '
249               WRITE(numout,*)'         Radiative West Open Boundary'
250            END IF
251         END IF
252      END IF
253 
254      IF( lp_obc_north ) THEN
255         ! ...   mpp initialization
256         nin0   = max( 2, min(jpind    - nimpp+1, jpi     ) )
257         nin1   = max( 0, min(jpinf    - nimpp+1, jpi - 1 ) )
258         nin0p1 = max( 1, min(jpindp1  - nimpp+1, jpi     ) )
259         nin0m1 = max( 1, min(jpind    - nimpp+1, jpi     ) )
260         nin1m1 = max( 0, min(jpinfm1  - nimpp+1, jpi - 1 ) )
261         nin1m2 = max( 0, min(jpinfm1-1- nimpp+1, jpi - 1 ) )
262         njn0   = max( 1, min(jpjnob   - njmpp+1, jpj     ) )
263         njn1   = max( 0, min(jpjnob   - njmpp+1, jpj - 1 ) )
264         njn0p1 = max( 1, min(jpjnob+1 - njmpp+1, jpj     ) )
265         njn1p1 = max( 0, min(jpjnob+1 - njmpp+1, jpj - 1 ) )
266         njn0m1 = max( 1, min(jpjnob-1 - njmpp+1, jpj     ) )
267         njn1m1 = max( 0, min(jpjnob-1 - njmpp+1, jpj - 1 ) )
268         IF(lwp) THEN
269            IF( lfbcnorth ) THEN
270               WRITE(numout,*)'     '
271               WRITE(numout,*)'         Specified North Open Boundary'
272            ELSE
273               WRITE(numout,*)'     '
274               WRITE(numout,*)'         Radiative North Open Boundary'
275            END IF
276         END IF
277      END IF
278
279      IF( lp_obc_south ) THEN
280         ! ...   mpp initialization
281         nis0   = max( 2, min(jpisd    - nimpp+1, jpi     ) )
282         nis1   = max( 0, min(jpisf    - nimpp+1, jpi - 1 ) )
283         nis0p1 = max( 1, min(jpisdp1  - nimpp+1, jpi     ) )
284         nis0m1 = max( 1, min(jpisd    - nimpp+1, jpi     ) )
285         nis1m1 = max( 0, min(jpisfm1  - nimpp+1, jpi - 1 ) )
286         nis1m2 = max( 0, min(jpisfm1-1- nimpp+1, jpi - 1 ) )
287         njs0   = max( 1, min(jpjsob   - njmpp+1, jpj     ) )
288         njs1   = max( 0, min(jpjsob   - njmpp+1, jpj - 1 ) )
289         njs0p1 = max( 1, min(jpjsob+1 - njmpp+1, jpj     ) )
290         njs1p1 = max( 0, min(jpjsob+1 - njmpp+1, jpj - 1 ) )
291         IF(lwp) THEN
292            IF( lfbcsouth ) THEN
293               WRITE(numout,*)'     '
294               WRITE(numout,*)'         Specified South Open Boundary'
295            ELSE
296               WRITE(numout,*)'     '
297               WRITE(numout,*)'         Radiative South Open Boundary'
298            END IF
299         END IF
300      END IF
301
302      ! 3. mask correction for OBCs
303      ! ---------------------------
304
305      IF( lp_obc_east ) THEN
306         !... (jpjed,jpjefm1),jpieob
307         bmask(nie0p1:nie1p1,nje0:nje1m1) = 0.e0
308
309         ! ... initilization to zero
310         uemsk(:,:) = 0.e0   ;   vemsk(:,:) = 0.e0   ;   temsk(:,:) = 0.e0
311
312         ! ... set 2D mask on East OBC,  Vopt
313         DO ji = fs_nie0, fs_nie1
314            DO jj = nje0, nje1
315               uemsk(jj,:) = umask(ji,  jj,:) * tmask_i(ji,jj)   * tmask_i(ji+1,jj)
316               vemsk(jj,:) = vmask(ji+1,jj,:) * tmask_i(ji+1,jj) 
317               temsk(jj,:) = tmask(ji+1,jj,:) * tmask_i(ji+1,jj) 
318            END DO
319         END DO
320
321      END IF
322
323      IF( lp_obc_west ) THEN
324         ! ... (jpjwd,jpjwfm1),jpiwob
325         bmask(niw0:niw1,njw0:njw1m1) = 0.e0
326
327         ! ... initilization to zero
328         uwmsk(:,:) = 0.e0   ;   vwmsk(:,:) = 0.e0   ;   twmsk(:,:) = 0.e0 
329
330         ! ... set 2D mask on West OBC,  Vopt
331         DO ji = fs_niw0, fs_niw1
332            DO jj = njw0, njw1
333               uwmsk(jj,:) = umask(ji,jj,:) * tmask_i(ji,jj)   * tmask_i(ji+1,jj)
334               vwmsk(jj,:) = vmask(ji,jj,:) * tmask_i(ji,jj) 
335               twmsk(jj,:) = tmask(ji,jj,:) * tmask_i(ji,jj)
336            END DO
337         END DO
338
339      END IF
340
341      IF( lp_obc_north ) THEN
342         ! ... jpjnob,(jpind,jpisfm1)
343         bmask(nin0:nin1m1,njn0p1:njn1p1) = 0.e0
344
345         ! ... initilization to zero
346         unmsk(:,:) = 0.e0   ;   vnmsk(:,:) = 0.e0   ;   tnmsk(:,:) = 0.e0
347
348         ! ... set 2D mask on North OBC,  Vopt
349         DO jj = fs_njn0, fs_njn1
350            DO ji = nin0, nin1
351               unmsk(ji,:) = umask(ji,jj+1,:) * tmask_i(ji,jj+1) 
352               vnmsk(ji,:) = vmask(ji,jj  ,:) * tmask_i(ji,jj)   * tmask_i(ji,jj+1)
353               tnmsk(ji,:) = tmask(ji,jj+1,:) * tmask_i(ji,jj+1)
354            END DO
355         END DO
356
357      END IF
358
359      IF( lp_obc_south ) THEN 
360         ! ... jpjsob,(jpisd,jpisfm1)
361         bmask(nis0:nis1m1,njs0:njs1) = 0.e0
362
363         ! ... initilization to zero
364         usmsk(:,:) = 0.e0   ;   vsmsk(:,:) = 0.e0   ;   tsmsk(:,:) = 0.e0
365
366         ! ... set 2D mask on South OBC,  Vopt
367         DO jj = fs_njs0, fs_njs1 
368            DO ji = nis0, nis1
369               usmsk(ji,:) = umask(ji,jj,:) * tmask_i(ji,jj) 
370               vsmsk(ji,:) = vmask(ji,jj,:) * tmask_i(ji,jj) * tmask_i(ji,jj+1)
371               tsmsk(ji,:) = tmask(ji,jj,:) * tmask_i(ji,jj)
372            END DO
373         END DO
374
375      END IF
376
377      IF ( ln_vol_cst .OR. lk_dynspg_flt ) THEN
378        ! ... Initialize obcumask and obcvmask for the Force filtering
379        !     boundary condition in dynspg_flt
380        obcumask(:,:) = umask(:,:,1)
381        obcvmask(:,:) = vmask(:,:,1)
382
383        ! ... Initialize obctmsk on overlap region and obcs. This mask
384        !     is used in obcvol.F90 to calculate cumulate flux E-P.
385        !     obc Tracer point are outside the domain ( U/V obc points) ==> masked by obctmsk
386        !     - no flux E-P on obcs and overlap region (jpreci = jprecj = 1)
387        obctmsk(:,:) = tmask_i(:,:)     
388
389        IF( lp_obc_east ) THEN
390           ! ... East obc Force filtering mask for the grad D
391           obcumask(nie0  :nie1  ,nje0p1:nje1m1) = 0.e0
392           obcvmask(nie0p1:nie1p1,nje0p1:nje1m1) = 0.e0
393           ! ... set to 0 on East OBC
394           obctmsk(nie0p1:nie1p1,nje0:nje1) = 0.e0
395        END IF
396 
397        IF( lp_obc_west ) THEN
398           ! ... West obc Force filtering mask for the grad D
399           obcumask(niw0:niw1,njw0:njw1) = 0.e0
400           obcvmask(niw0:niw1,njw0:njw1) = 0.e0
401           ! ... set to 0 on West OBC
402           obctmsk(niw0:niw1,njw0:njw1) = 0.e0
403        END IF
404 
405        IF( lp_obc_north ) THEN
406           ! ... North obc Force filtering mask for the grad D
407           obcumask(nin0p1:nin1m1,njn0p1:njn1p1) = 0.e0
408           obcvmask(nin0p1:nin1m1,njn0  :njn1  ) = 0.e0
409           ! ... set to 0 on North OBC
410           obctmsk(nin0:nin1,njn0p1:njn1p1) = 0.e0
411        END IF
412 
413        IF( lp_obc_south ) THEN
414           ! ... South obc Force filtering mask for the grad D
415           obcumask(nis0p1:nis1m1,njs0:njs1) = 0.e0
416           obcvmask(nis0p1:nis1m1,njs0:njs1) = 0.e0
417           ! ... set to 0 on South OBC
418           obctmsk(nis0:nis1,njs0:njs1) = 0.e0
419        END IF
420      ENDIF
421
422      IF ( ln_vol_cst .OR. lk_dynspg_flt  ) THEN
423
424         ! 3.1 Total lateral surface
425         ! -------------------------
426         obcsurftot = 0.e0
427 
428         IF( lp_obc_east ) THEN ! ... East open boundary lateral surface
429            DO ji = nie0, nie1
430               DO jj = 1, jpj 
431                  obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
432               END DO
433            END DO
434         END IF
435 
436         IF( lp_obc_west ) THEN ! ... West open boundary lateral surface
437            DO ji = niw0, niw1
438               DO jj = 1, jpj 
439                  obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
440               END DO
441            END DO
442         END IF
443         IF( lp_obc_north ) THEN ! ... North open boundary lateral surface
444            DO jj = njn0, njn1
445               DO ji = 1, jpi
446                  obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
447               END DO
448            END DO
449         END IF
450 
451         IF( lp_obc_south ) THEN ! ... South open boundary lateral surface
452            DO jj = njs0, njs1
453               DO ji = 1, jpi
454                  obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
455               END DO
456            END DO
457         END IF
458 
459         IF( lk_mpp )   CALL mpp_sum( obcsurftot )   ! sum over the global domain
460      ENDIF
461
462      ! 5. Control print on mask
463      !    The extremities of the open boundaries must be in land
464      !    or else correspond to an "ocean corner" between two open boundaries.
465      !    corner 1 is southwest, 2 is south east, 3 is northeast, 4 is northwest.
466      ! --------------------------------------------------------------------------
467
468      icorner(:)=0
469
470      ! ... control of the west boundary
471      IF( lp_obc_west ) THEN
472         IF( jpiwob < 2 .OR.  jpiwob >= jpiglo-2 ) THEN
473            WRITE(ctmp1,*) ' jpiwob exceed ', jpiglo-2, 'or less than 2'
474            CALL ctl_stop( ctmp1 )
475         END IF
476         ztestmask(:)=0.
477         DO ji=niw0,niw1
478            IF( (njw0 + njmpp - 1) == jpjwd ) ztestmask(1)=ztestmask(1)+ tmask(ji,njw0,1)
479            IF( (njw1 + njmpp - 1) == jpjwf ) ztestmask(2)=ztestmask(2)+ tmask(ji,njw1,1)
480         END DO
481         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
482
483         IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1
484         IF( ztestmask(2) /= 0. ) icorner(4)=icorner(4)+1
485      END IF
486
487      ! ... control of the east boundary
488      IF( lp_obc_east ) THEN
489         IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN
490            WRITE(ctmp1,*) ' jpieob exceed ', jpiglo, ' or less than 4'
491            CALL ctl_stop( ctmp1 )
492         END IF
493         ztestmask(:)=0.
494         DO ji=nie0p1,nie1p1
495            IF( (nje0 + njmpp - 1) == jpjed ) ztestmask(1)=ztestmask(1)+ tmask(ji,nje0,1)
496            IF( (nje1 + njmpp - 1) == jpjef ) ztestmask(2)=ztestmask(2)+ tmask(ji,nje1,1)
497         END DO
498         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
499
500        IF( ztestmask(1) /= 0. ) icorner(2)=icorner(2)+1
501        IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1
502      END IF
503
504      ! ... control of the north boundary
505      IF( lp_obc_north ) THEN
506         IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN
507            WRITE(ctmp1,*) 'jpjnob exceed ', jpjglo, ' or less than 4'
508            CALL ctl_stop( ctmp1 )
509         END IF
510         ztestmask(:)=0.
511         DO jj=njn0p1,njn1p1
512            IF( (nin0 + nimpp - 1) == jpind ) ztestmask(1)=ztestmask(1)+ tmask(nin0,jj,1)
513            IF( (nin1 + nimpp - 1) == jpinf ) ztestmask(2)=ztestmask(2)+ tmask(nin1,jj,1)
514         END DO
515         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
516
517         IF( ztestmask(1) /= 0. ) icorner(4)=icorner(4)+1
518         IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1
519      END IF
520
521      ! ... control of the south boundary
522      IF( lp_obc_south ) THEN
523         IF( jpjsob < 2 .OR.  jpjsob >= jpjglo-2 ) THEN
524            WRITE(ctmp1,*) ' jpjsob exceed ', jpjglo-2, ' or less than 2'
525            CALL ctl_stop( ctmp1 )
526         END IF
527         ztestmask(:)=0.
528         DO jj=njs0,njs1
529            IF( (nis0 + nimpp - 1) == jpisd ) ztestmask(1)=ztestmask(1)+ tmask(nis0,jj,1)
530            IF( (nis1 + nimpp - 1) == jpisf ) ztestmask(2)=ztestmask(2)+ tmask(nis1,jj,1)
531         END DO
532         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
533
534         IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1
535         IF( ztestmask(2) /= 0. ) icorner(2)=icorner(2)+1
536      END IF
537
538      IF( icorner(1) == 2 ) THEN
539         IF(lwp) WRITE(numout,*)
540         IF(lwp) WRITE(numout,*) ' South West ocean corner, two open boudaries'
541         IF(lwp) WRITE(numout,*) ' ========== '
542         IF(lwp) WRITE(numout,*)
543         IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) &
544              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' )
545
546      ELSE IF( icorner(1) == 1 ) THEN
547         CALL ctl_stop( ' Open boundaries do not fit at SW corner, we stop' )
548      END IF
549
550      IF( icorner(2) == 2 ) THEN
551          IF(lwp) WRITE(numout,*)
552          IF(lwp) WRITE(numout,*) ' South East ocean corner, two open boudaries'
553          IF(lwp) WRITE(numout,*) ' ========== '
554          IF(lwp) WRITE(numout,*)
555          IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) &
556               &   CALL ctl_stop( ' Open boundaries do not fit, we stop' )
557      ELSE IF( icorner(2) == 1 ) THEN
558         CALL ctl_stop( ' Open boundaries do not fit at SE corner, we stop' )
559      END IF
560
561      IF( icorner(3) == 2 ) THEN
562         IF(lwp) WRITE(numout,*)
563         IF(lwp) WRITE(numout,*) ' North East ocean corner, two open boudaries'
564         IF(lwp) WRITE(numout,*) ' ========== '
565         IF(lwp) WRITE(numout,*)
566         IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) &
567              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' )
568       ELSE IF( icorner(3) == 1 ) THEN
569          CALL ctl_stop( ' Open boundaries do not fit at NE corner, we stop' )
570       END IF
571
572      IF( icorner(4) == 2 ) THEN
573         IF(lwp) WRITE(numout,*)
574         IF(lwp) WRITE(numout,*) ' North West ocean corner, two open boudaries'
575         IF(lwp) WRITE(numout,*) ' ========== '
576         IF(lwp) WRITE(numout,*)
577         IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) &
578              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' )
579       ELSE IF( icorner(4) == 1 ) THEN
580          CALL ctl_stop( ' Open boundaries do not fit at NW corner, we stop' )
581       END IF 
582
583      ! 6. Initialization of open boundary variables (u, v, t, s)
584      ! --------------------------------------------------------------
585      !   only if at least one boundary is  radiative
586      IF ( inumfbc < nbobc .AND.  ln_rstart ) THEN
587         !  Restart from restart.obc
588         CALL obc_rst_read
589      ELSE
590
591!         ! ... Initialization to zero of radiation arrays.
592!         !     Those have dimensions of local subdomains
593
594          uebnd(:,:,:,:) = 0.e0   ;   unbnd(:,:,:,:) = 0.e0
595          vebnd(:,:,:,:) = 0.e0   ;   vnbnd(:,:,:,:) = 0.e0
596          tebnd(:,:,:,:) = 0.e0   ;   tnbnd(:,:,:,:) = 0.e0
597          sebnd(:,:,:,:) = 0.e0   ;   snbnd(:,:,:,:) = 0.e0
598
599          uwbnd(:,:,:,:) = 0.e0   ;   usbnd(:,:,:,:) = 0.e0
600          vwbnd(:,:,:,:) = 0.e0   ;   vsbnd(:,:,:,:) = 0.e0
601          twbnd(:,:,:,:) = 0.e0   ;   tsbnd(:,:,:,:) = 0.e0
602          swbnd(:,:,:,:) = 0.e0   ;   ssbnd(:,:,:,:) = 0.e0
603
604      END IF
605
606      ! 7. Control print
607      ! -----------------------------------------------------------------
608
609      ! ... control of the east boundary
610      IF( lp_obc_east ) THEN
611         istop = 0
612         IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN
613            IF(lwp) WRITE(numout,cform_err)
614            IF(lwp) WRITE(numout,*) '            jpieob exceed ', jpim1, ' or less than 4'
615            istop = istop + 1
616         END IF
617
618         IF( lk_mpp ) THEN
619            ! ...
620            IF( nimpp > jpieob-5) THEN
621               IF(lwp) WRITE(numout,cform_err)
622               IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the East OBC'
623               IF(lwp) WRITE(numout,*) '        nimpp must be < jpieob-5'
624               istop = istop + 1
625            ENDIF
626         ELSE
627
628            ! ... stop if  e r r o r (s)   detected
629            IF( istop /= 0 ) THEN
630               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
631               CALL ctl_stop( ctmp1 )
632            ENDIF
633         ENDIF
634      ENDIF
635
636      ! ... control of the west boundary
637      IF( lp_obc_west ) THEN
638         istop = 0
639         IF( jpiwob < 2 .OR.  jpiwob >= jpiglo ) THEN
640            IF(lwp) WRITE(numout,cform_err)
641            IF(lwp) WRITE(numout,*) '            jpiwob exceed ', jpim1, ' or less than 2'
642            istop = istop + 1
643         END IF
644
645         IF( lk_mpp ) THEN
646            IF( (nimpp < jpiwob+5) .AND. (nimpp > 1) ) THEN
647               IF(lwp) WRITE(numout,cform_err)
648               IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the West OBC'
649               IF(lwp) WRITE(numout,*) '        nimpp must be > jpiwob-5 or =1'
650               istop = istop + 1
651            ENDIF
652         ELSE
653   
654            ! ... stop if  e r r o r (s)   detected
655            IF( istop /= 0 ) THEN
656               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
657               CALL ctl_stop( ctmp1 )
658            ENDIF
659         ENDIF
660      ENDIF
661
662      ! control of the north boundary
663      IF( lp_obc_north ) THEN
664         istop = 0
665         IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN
666            IF(lwp) WRITE(numout,cform_err)
667            IF(lwp) WRITE(numout,*) '          jpjnob exceed ', jpjm1,' or less than 4'
668            istop = istop + 1
669         END IF
670
671         IF( lk_mpp ) THEN
672            IF( njmpp > jpjnob-5) THEN
673               IF(lwp) WRITE(numout,cform_err)
674               IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the North OBC'
675               IF(lwp) WRITE(numout,*) '        njmpp must be < jpjnob-5'
676               istop = istop + 1
677            ENDIF
678         ELSE
679   
680            ! ... stop if  e r r o r (s)   detected
681            IF( istop /= 0 ) THEN
682                WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
683               CALL ctl_stop( ctmp1 )
684           ENDIF
685         ENDIF
686      ENDIF
687
688      ! control of the south boundary
689      IF( lp_obc_south ) THEN
690         istop = 0
691         IF( jpjsob < 2 .OR. jpjsob >= jpjglo ) THEN
692            IF(lwp) WRITE(numout,cform_err)
693            IF(lwp) WRITE(numout,*) '          jpjsob exceed ', jpjm1,' or less than 2'
694            istop = istop + 1
695         END IF
696
697         IF( lk_mpp ) THEN
698            IF( (njmpp < jpjsob+5) .AND. (njmpp > 1) ) THEN
699               IF(lwp) WRITE(numout,cform_err)
700               IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the South OBC'
701               IF(lwp) WRITE(numout,*) '        njmpp must be > jpjsob+5 or =1'
702               istop = istop + 1
703            ENDIF
704         ELSE
705   
706            ! ... stop if  e r r o r (s)   detected
707            IF( istop /= 0 ) THEN
708               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
709               CALL ctl_stop( ctmp1 )
710            ENDIF
711         ENDIF
712      ENDIF
713
714   END SUBROUTINE obc_init
715
716#else
717   !!---------------------------------------------------------------------------------
718   !!   Dummy module                                                NO open boundaries
719   !!---------------------------------------------------------------------------------
720CONTAINS
721   SUBROUTINE obc_init      ! Dummy routine
722   END SUBROUTINE obc_init
723#endif
724
725   !!=================================================================================
726END MODULE obcini
Note: See TracBrowser for help on using the repository browser.