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

Context Navigation

source: tags/nemo_v3_2/NEMO/OPA_SRC/OBC/obcini.F90 @ 1813

Last change on this file since 1813 was 1813, checked in by rblod, 15 years ago
Fixes for OBC, see ticket #648
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
38	CONTAINS
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, rn_volemp, &
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 /= 0 .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
444	IF( lp_obc_north ) THEN ! ... North open boundary lateral surface
445	DO jj = njn0, njn1
446	DO ji = 1, jpi
447	obcsurftot = obcsurftot+hv(ji,jj)e1v(ji,jj)vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
448	END DO
449	END DO
450	END IF
451
452	IF( lp_obc_south ) THEN ! ... South open boundary lateral surface
453	DO jj = njs0, njs1
454	DO ji = 1, jpi
455	obcsurftot = obcsurftot+hv(ji,jj)e1v(ji,jj)vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
456	END DO
457	END DO
458	END IF
459
460	IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain
461	ENDIF
462
463	! 5. Control print on mask
464	! The extremities of the open boundaries must be in land
465	! or else correspond to an "ocean corner" between two open boundaries.
466	! corner 1 is southwest, 2 is south east, 3 is northeast, 4 is northwest.
467	! --------------------------------------------------------------------------
468
469	icorner(:)=0
470
471	! ... control of the west boundary
472	IF( lp_obc_west ) THEN
473	IF( jpiwob < 2 .OR. jpiwob >= jpiglo-2 ) THEN
474	WRITE(ctmp1,*) ' jpiwob exceed ', jpiglo-2, 'or less than 2'
475	CALL ctl_stop( ctmp1 )
476	END IF
477	ztestmask(:)=0.
478	DO ji=niw0,niw1
479	IF( (njw0 + njmpp - 1) == jpjwd ) ztestmask(1)=ztestmask(1)+ tmask(ji,njw0,1)
480	IF( (njw1 + njmpp - 1) == jpjwf ) ztestmask(2)=ztestmask(2)+ tmask(ji,njw1,1)
481	END DO
482	IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain
483
484	IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1
485	IF( ztestmask(2) /= 0. ) icorner(4)=icorner(4)+1
486	END IF
487
488	! ... control of the east boundary
489	IF( lp_obc_east ) THEN
490	IF( jpieob < 4 .OR. jpieob >= jpiglo ) THEN
491	WRITE(ctmp1,*) ' jpieob exceed ', jpiglo, ' or less than 4'
492	CALL ctl_stop( ctmp1 )
493	END IF
494	ztestmask(:)=0.
495	DO ji=nie0p1,nie1p1
496	IF( (nje0 + njmpp - 1) == jpjed ) ztestmask(1)=ztestmask(1)+ tmask(ji,nje0,1)
497	IF( (nje1 + njmpp - 1) == jpjef ) ztestmask(2)=ztestmask(2)+ tmask(ji,nje1,1)
498	END DO
499	IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain
500
501	IF( ztestmask(1) /= 0. ) icorner(2)=icorner(2)+1
502	IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1
503	END IF
504
505	! ... control of the north boundary
506	IF( lp_obc_north ) THEN
507	IF( jpjnob < 4 .OR. jpjnob >= jpjglo ) THEN
508	WRITE(ctmp1,*) 'jpjnob exceed ', jpjglo, ' or less than 4'
509	CALL ctl_stop( ctmp1 )
510	END IF
511	ztestmask(:)=0.
512	DO jj=njn0p1,njn1p1
513	IF( (nin0 + nimpp - 1) == jpind ) ztestmask(1)=ztestmask(1)+ tmask(nin0,jj,1)
514	IF( (nin1 + nimpp - 1) == jpinf ) ztestmask(2)=ztestmask(2)+ tmask(nin1,jj,1)
515	END DO
516	IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain
517
518	IF( ztestmask(1) /= 0. ) icorner(4)=icorner(4)+1
519	IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1
520	END IF
521
522	! ... control of the south boundary
523	IF( lp_obc_south ) THEN
524	IF( jpjsob < 2 .OR. jpjsob >= jpjglo-2 ) THEN
525	WRITE(ctmp1,*) ' jpjsob exceed ', jpjglo-2, ' or less than 2'
526	CALL ctl_stop( ctmp1 )
527	END IF
528	ztestmask(:)=0.
529	DO jj=njs0,njs1
530	IF( (nis0 + nimpp - 1) == jpisd ) ztestmask(1)=ztestmask(1)+ tmask(nis0,jj,1)
531	IF( (nis1 + nimpp - 1) == jpisf ) ztestmask(2)=ztestmask(2)+ tmask(nis1,jj,1)
532	END DO
533	IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain
534
535	IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1
536	IF( ztestmask(2) /= 0. ) icorner(2)=icorner(2)+1
537	END IF
538
539	IF( icorner(1) == 2 ) THEN
540	IF(lwp) WRITE(numout,*)
541	IF(lwp) WRITE(numout,*) ' South West ocean corner, two open boudaries'
542	IF(lwp) WRITE(numout,*) ' ========== '
543	IF(lwp) WRITE(numout,*)
544	IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) &
545	& CALL ctl_stop( ' Open boundaries do not fit, we stop' )
546
547	ELSE IF( icorner(1) == 1 ) THEN
548	CALL ctl_stop( ' Open boundaries do not fit at SW corner, we stop' )
549	END IF
550
551	IF( icorner(2) == 2 ) THEN
552	IF(lwp) WRITE(numout,*)
553	IF(lwp) WRITE(numout,*) ' South East ocean corner, two open boudaries'
554	IF(lwp) WRITE(numout,*) ' ========== '
555	IF(lwp) WRITE(numout,*)
556	IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) &
557	& CALL ctl_stop( ' Open boundaries do not fit, we stop' )
558	ELSE IF( icorner(2) == 1 ) THEN
559	CALL ctl_stop( ' Open boundaries do not fit at SE corner, we stop' )
560	END IF
561
562	IF( icorner(3) == 2 ) THEN
563	IF(lwp) WRITE(numout,*)
564	IF(lwp) WRITE(numout,*) ' North East ocean corner, two open boudaries'
565	IF(lwp) WRITE(numout,*) ' ========== '
566	IF(lwp) WRITE(numout,*)
567	IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) &
568	& CALL ctl_stop( ' Open boundaries do not fit, we stop' )
569	ELSE IF( icorner(3) == 1 ) THEN
570	CALL ctl_stop( ' Open boundaries do not fit at NE corner, we stop' )
571	END IF
572
573	IF( icorner(4) == 2 ) THEN
574	IF(lwp) WRITE(numout,*)
575	IF(lwp) WRITE(numout,*) ' North West ocean corner, two open boudaries'
576	IF(lwp) WRITE(numout,*) ' ========== '
577	IF(lwp) WRITE(numout,*)
578	IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) &
579	& CALL ctl_stop( ' Open boundaries do not fit, we stop' )
580	ELSE IF( icorner(4) == 1 ) THEN
581	CALL ctl_stop( ' Open boundaries do not fit at NW corner, we stop' )
582	END IF
583
584	! 6. Initialization of open boundary variables (u, v, t, s)
585	! --------------------------------------------------------------
586	! only if at least one boundary is radiative
587	IF ( inumfbc < nbobc .AND. ln_rstart ) THEN
588	! Restart from restart.obc
589	CALL obc_rst_read
590	ELSE
591
592	! ! ... Initialization to zero of radiation arrays.
593	! ! Those have dimensions of local subdomains
594
595	uebnd(:,:,:,:) = 0.e0 ; unbnd(:,:,:,:) = 0.e0
596	vebnd(:,:,:,:) = 0.e0 ; vnbnd(:,:,:,:) = 0.e0
597	tebnd(:,:,:,:) = 0.e0 ; tnbnd(:,:,:,:) = 0.e0
598	sebnd(:,:,:,:) = 0.e0 ; snbnd(:,:,:,:) = 0.e0
599
600	uwbnd(:,:,:,:) = 0.e0 ; usbnd(:,:,:,:) = 0.e0
601	vwbnd(:,:,:,:) = 0.e0 ; vsbnd(:,:,:,:) = 0.e0
602	twbnd(:,:,:,:) = 0.e0 ; tsbnd(:,:,:,:) = 0.e0
603	swbnd(:,:,:,:) = 0.e0 ; ssbnd(:,:,:,:) = 0.e0
604
605	END IF
606
607	! 7. Control print
608	! -----------------------------------------------------------------
609
610	! ... control of the east boundary
611	IF( lp_obc_east ) THEN
612	istop = 0
613	IF( jpieob < 4 .OR. jpieob >= jpiglo ) THEN
614	IF(lwp) WRITE(numout,cform_err)
615	IF(lwp) WRITE(numout,*) ' jpieob exceed ', jpim1, ' or less than 4'
616	istop = istop + 1
617	END IF
618
619	IF( lk_mpp ) THEN
620	! ...
621	IF( nimpp > jpieob-5) THEN
622	IF(lwp) WRITE(numout,cform_err)
623	IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the East OBC'
624	IF(lwp) WRITE(numout,*) ' nimpp must be < jpieob-5'
625	istop = istop + 1
626	ENDIF
627	ELSE
628
629	! ... stop if e r r o r (s) detected
630	IF( istop /= 0 ) THEN
631	WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
632	CALL ctl_stop( ctmp1 )
633	ENDIF
634	ENDIF
635	ENDIF
636
637	! ... control of the west boundary
638	IF( lp_obc_west ) THEN
639	istop = 0
640	IF( jpiwob < 2 .OR. jpiwob >= jpiglo ) THEN
641	IF(lwp) WRITE(numout,cform_err)
642	IF(lwp) WRITE(numout,*) ' jpiwob exceed ', jpim1, ' or less than 2'
643	istop = istop + 1
644	END IF
645
646	IF( lk_mpp ) THEN
647	IF( (nimpp < jpiwob+5) .AND. (nimpp > 1) ) THEN
648	IF(lwp) WRITE(numout,cform_err)
649	IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the West OBC'
650	IF(lwp) WRITE(numout,*) ' nimpp must be > jpiwob-5 or =1'
651	istop = istop + 1
652	ENDIF
653	ELSE
654
655	! ... stop if e r r o r (s) detected
656	IF( istop /= 0 ) THEN
657	WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
658	CALL ctl_stop( ctmp1 )
659	ENDIF
660	ENDIF
661	ENDIF
662
663	! control of the north boundary
664	IF( lp_obc_north ) THEN
665	istop = 0
666	IF( jpjnob < 4 .OR. jpjnob >= jpjglo ) THEN
667	IF(lwp) WRITE(numout,cform_err)
668	IF(lwp) WRITE(numout,*) ' jpjnob exceed ', jpjm1,' or less than 4'
669	istop = istop + 1
670	END IF
671
672	IF( lk_mpp ) THEN
673	IF( njmpp > jpjnob-5) THEN
674	IF(lwp) WRITE(numout,cform_err)
675	IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the North OBC'
676	IF(lwp) WRITE(numout,*) ' njmpp must be < jpjnob-5'
677	istop = istop + 1
678	ENDIF
679	ELSE
680
681	! ... stop if e r r o r (s) detected
682	IF( istop /= 0 ) THEN
683	WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
684	CALL ctl_stop( ctmp1 )
685	ENDIF
686	ENDIF
687	ENDIF
688
689	! control of the south boundary
690	IF( lp_obc_south ) THEN
691	istop = 0
692	IF( jpjsob < 2 .OR. jpjsob >= jpjglo ) THEN
693	IF(lwp) WRITE(numout,cform_err)
694	IF(lwp) WRITE(numout,*) ' jpjsob exceed ', jpjm1,' or less than 2'
695	istop = istop + 1
696	END IF
697
698	IF( lk_mpp ) THEN
699	IF( (njmpp < jpjsob+5) .AND. (njmpp > 1) ) THEN
700	IF(lwp) WRITE(numout,cform_err)
701	IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the South OBC'
702	IF(lwp) WRITE(numout,*) ' njmpp must be > jpjsob+5 or =1'
703	istop = istop + 1
704	ENDIF
705	ELSE
706
707	! ... stop if e r r o r (s) detected
708	IF( istop /= 0 ) THEN
709	WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
710	CALL ctl_stop( ctmp1 )
711	ENDIF
712	ENDIF
713	ENDIF
714
715	END SUBROUTINE obc_init
716
717	#else
718	!!---------------------------------------------------------------------------------
719	!! Dummy module NO open boundaries
720	!!---------------------------------------------------------------------------------
721	CONTAINS
722	SUBROUTINE obc_init ! Dummy routine
723	END SUBROUTINE obc_init
724	#endif
725
726	!!=================================================================================
727	END MODULE obcini

Note: See TracBrowser for help on using the repository browser.

Download in other formats: