Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

obcini.F90 @ 3839

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

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obcini.F90 @ 3839

Download in other formats: