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

Context Navigation

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

Last change on this file since 416 was 416, checked in by opalod, 18 years ago
nemo_v1_update_039 : CT : add some tests to catch user's mistakes
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 33.1 KB

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

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

Download in other formats: