Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn.F90 @ 22

Last change on this file since 22 was 10, checked in by cholod, 12 years ago
allow to start without obc restart
File size: 29.1 KB

Line
1	MODULE obcdyn
2	#if defined key_obc
3	!!=================================================================================
4	!! * MODULE obcdyn *
5	!! Ocean dynamics: Radiation of velocities on each open boundary
6	!!=================================================================================
7
8	!!---------------------------------------------------------------------------------
9	!! obc_dyn : call the subroutine for each open boundary
10	!! obc_dyn_east : radiation of the east open boundary velocities
11	!! obc_dyn_west : radiation of the west open boundary velocities
12	!! obc_dyn_north : radiation of the north open boundary velocities
13	!! obc_dyn_south : radiation of the south open boundary velocities
14	!!----------------------------------------------------------------------------------
15
16	!!----------------------------------------------------------------------------------
17	!! * Modules used
18	USE oce ! ocean dynamics and tracers
19	USE dom_oce ! ocean space and time domain
20	USE phycst ! physical constants
21	USE obc_oce ! ocean open boundary conditions
22	USE lbclnk ! ???
23	USE lib_mpp ! ???
24	USE in_out_manager ! I/O manager
25	USE dynspg_oce
26
27	IMPLICIT NONE
28	PRIVATE
29
30	!! * Accessibility
31	PUBLIC obc_dyn ! routine called in dynspg_flt (free surface case)
32
33	!! * Module variables
34	INTEGER :: ji, jj, jk ! dummy loop indices
35
36	INTEGER :: & ! ... boundary space indices
37	nib = 1, & ! nib = boundary point
38	nibm = 2, & ! nibm = 1st interior point
39	nibm2 = 3, & ! nibm2 = 2nd interior point
40	! ... boundary time indices
41	nit = 1, & ! nit = now
42	nitm = 2, & ! nitm = before
43	nitm2 = 3 ! nitm2 = before-before
44
45	REAL(wp) :: rtaue , rtauw , rtaun , rtaus , &
46	rtauein, rtauwin, rtaunin, rtausin
47
48	! IND4
49	LOGICAL :: ll_fbc
50	! IND4
51
52	!!---------------------------------------------------------------------------------
53
54	CONTAINS
55
56	SUBROUTINE obc_dyn ( kt )
57	!!------------------------------------------------------------------------------
58	!! SUBROUTINE obc_dyn
59	!! ********************
60	!! ** Purpose :
61	!! Compute dynamics (u,v) at the open boundaries.
62	!! if defined key_dynspg_flt:
63	!! this routine is called by dynspg_flt and updates
64	!! ua, va which are the actual velocities (not trends)
65	!!
66	!! The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north,
67	!! and/or lp_obc_south allow the user to determine which boundary is an
68	!! open one (must be done in the param_obc.h90 file).
69	!!
70	!! ** Reference :
71	!! Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
72	!!
73	!! History :
74	!! ! 95-03 (J.-M. Molines) Original, SPEM
75	!! ! 97-07 (G. Madec, J.-M. Molines) addition
76	!! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
77	!! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization
78	!!----------------------------------------------------------------------
79	!! * Arguments
80	INTEGER, INTENT( in ) :: kt
81
82	!!----------------------------------------------------------------------
83	!! OPA 9.0 , LOCEAN-IPSL (2005)
84	!! $Id: obcdyn.F90 1528 2009-07-23 14:38:47Z rblod $
85	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
86	!!----------------------------------------------------------------------
87
88	! 0. Local constant initialization
89	! --------------------------------
90
91	IF( kt == nit000 .OR. ln_rstart) THEN
92	! ... Boundary restoring coefficient
93	rtaue = 2. * rdt / rdpeob
94	rtauw = 2. * rdt / rdpwob
95	rtaun = 2. * rdt / rdpnob
96	rtaus = 2. * rdt / rdpsob
97	! ... Boundary restoring coefficient for inflow ( all boundaries)
98	rtauein = 2. * rdt / rdpein
99	rtauwin = 2. * rdt / rdpwin
100	rtaunin = 2. * rdt / rdpnin
101	rtausin = 2. * rdt / rdpsin
102	END IF
103	! IND4
104	! ll_fbc = ( ( ( kt < nit000+3 ) .AND. .NOT. ln_rstart ) .OR. lk_dynspg_exp )
105	! IF ( cp_cfg == "indian" .OR. cp_cfg == "bengal" ) THEN
106	ll_fbc = ( ( ( kt < nit000+30 ) .AND. .NOT. ln_obc_rstart ) .OR. lk_dynspg_exp )
107	! ENDIF
108	! IND4
109
110
111	IF( lp_obc_east ) CALL obc_dyn_east ( kt )
112	IF( lp_obc_west ) CALL obc_dyn_west ( kt )
113	IF( lp_obc_north ) CALL obc_dyn_north( kt )
114	IF( lp_obc_south ) CALL obc_dyn_south( kt )
115
116	IF( lk_mpp ) THEN
117	! IND4 BUG OBC_RADIA
118	! IF( kt >= nit000+3 .AND. ln_rstart ) THEN
119	CALL lbc_lnk( ub, 'U', -1. )
120	CALL lbc_lnk( vb, 'V', -1. )
121	! END IF
122	! IND4
123	CALL lbc_lnk( ua, 'U', -1. )
124	CALL lbc_lnk( va, 'V', -1. )
125	ENDIF
126
127	END SUBROUTINE obc_dyn
128
129
130	SUBROUTINE obc_dyn_east ( kt )
131	!!------------------------------------------------------------------------------
132	!! * SUBROUTINE obc_dyn_east *
133	!!
134	!! ** Purpose :
135	!! Apply the radiation algorithm on east OBC velocities ua, va using the
136	!! phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module
137	!! If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC
138	!!
139	!! History :
140	!! ! 95-03 (J.-M. Molines) Original from SPEM
141	!! ! 97-07 (G. Madec, J.-M. Molines) additions
142	!! ! 97-12 (M. Imbard) Mpp adaptation
143	!! ! 00-06 (J.-M. Molines)
144	!! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
145	!! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization
146	!!------------------------------------------------------------------------------
147	!! * Arguments
148	INTEGER, INTENT( in ) :: kt
149
150	!! * Local declaration
151	REAL(wp) :: z05cx, ztau, zin
152	!!------------------------------------------------------------------------------
153
154	! 1. First three time steps and more if lfbceast is .TRUE.
155	! In that case open boundary conditions are FIXED.
156	! --------------------------------------------------------
157
158	! IND4
159	! IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast .OR. lk_dynspg_exp ) THEN
160	IF ( ll_fbc .OR. lfbceast ) THEN
161	! IND4
162
163	! 1.1 U zonal velocity
164	! --------------------
165	DO ji = nie0, nie1
166	DO jk = 1, jpkm1
167	DO jj = 1, jpj
168	ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + &
169	uemsk(jj,jk)*ufoe(jj,jk)
170	END DO
171	END DO
172	END DO
173
174	! 1.2 V meridional velocity
175	! -------------------------
176	DO ji = nie0+1, nie1+1
177	DO jk = 1, jpkm1
178	DO jj = 1, jpj
179	va(ji,jj,jk) = va(ji,jj,jk) * (1.-vemsk(jj,jk)) + &
180	vfoe(jj,jk)*vemsk(jj,jk)
181	END DO
182	END DO
183	END DO
184
185	ELSE
186
187	! 2. Beyond the fourth time step if lfbceast is .FALSE.
188	! -----------------------------------------------------
189
190	! 2.1. u-component of the velocity
191	! ---------------------------------
192	!
193	! nibm2 nibm nib
194	! \| nibm \| nib \|///
195	! \| \| \| \| \|///
196	! jj-line --f----v----f----v----f---
197	! \| \| \| \| \|///
198	! \| \| \|///
199	! jj-line u T u T u///
200	! \| \| \|///
201	! \| \| \| \| \|///
202	! jpieob-2 jpieob-1 jpieob
203	! \| \|
204	! jpieob-1 jpieob
205	!
206	! ... If free surface formulation:
207	! ... radiative conditions on the total part + relaxation toward climatology
208	! ... (jpjedp1, jpjefm1),jpieob
209	DO ji = nie0, nie1
210	DO jk = 1, jpkm1
211	DO jj = 1, jpj
212	z05cx = u_cxebnd(jj,jk)
213	z05cx = z05cx / e1t(ji,jj)
214	z05cx = min( z05cx, 1. )
215	! ... z05cx=< 0, inflow zin=0, ztau=1
216	! > 0, outflow zin=1, ztau=rtaue
217	zin = sign( 1., z05cx )
218	zin = 0.5*( zin + abs(zin) )
219	! ... for inflow rtauein is used for relaxation coefficient else rtaue
220	ztau = (1.-zin ) * rtauein + zin * rtaue
221	z05cx = z05cx * zin
222	! ... update ua with radiative or climatological velocity
223	ua(ji,jj,jk) = ua(ji,jj,jk) * ( 1. - uemsk(jj,jk) ) + &
224	uemsk(jj,jk) * ( ( 1. - z05cx - ztau ) &
225	* uebnd(jj,jk,nib ,nitm) + 2.*z05cx &
226	* uebnd(jj,jk,nibm,nit ) + ztau * ufoe (jj,jk) ) &
227	/ (1. + z05cx)
228	END DO
229	END DO
230	END DO
231
232	! 2.2 v-component of the velocity
233	! -------------------------------
234	!
235	! nibm2 nibm nib
236	! \| nibm \| nib///\|///
237	! \| \| \| \|////\|///
238	! jj-line --v----f----v----f----v---
239	! \| \| \| \|////\|///
240	! \| \| \| \|////\|///
241	! \| jpieob-1 \| jpieob /\|///
242	! \| \| \|
243	! jpieob-1 jpieob jpieob+1
244	!
245	! ... radiative condition
246	! ... (jpjedp1, jpjefm1), jpieob+1
247	DO ji = nie0+1, nie1+1
248	DO jk = 1, jpkm1
249	DO jj = 1, jpj
250	z05cx = v_cxebnd(jj,jk)
251	z05cx = z05cx / e1f(ji-1,jj)
252	z05cx = min( z05cx, 1. )
253	! ... z05cx=< 0, inflow zin=0, ztau=1
254	! > 0, outflow zin=1, ztau=rtaue
255	zin = sign( 1., z05cx )
256	zin = 0.5*( zin + abs(zin) )
257	! ... for inflow rtauein is used for relaxation coefficient else rtaue
258	ztau = (1.-zin ) * rtauein + zin * rtaue
259	z05cx = z05cx * zin
260	! ... update va with radiative or climatological velocity
261	va(ji,jj,jk) = va(ji,jj,jk) * (1. - vemsk(jj,jk) ) + &
262	vemsk(jj,jk) * ( ( 1. - z05cx - ztau ) &
263	* vebnd(jj,jk,nib ,nitm) + 2.*z05cx &
264	* vebnd(jj,jk,nibm,nit ) + ztau * vfoe(jj,jk) ) &
265	/ (1. + z05cx)
266	END DO
267	END DO
268	END DO
269
270	END IF
271
272	END SUBROUTINE obc_dyn_east
273
274
275	SUBROUTINE obc_dyn_west ( kt )
276	!!------------------------------------------------------------------------------
277	!! * SUBROUTINE obc_dyn_west *
278	!!
279	!! ** Purpose :
280	!! Apply the radiation algorithm on west OBC velocities ua, va using the
281	!! phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module
282	!! If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC
283	!!
284	!! History :
285	!! ! 95-03 (J.-M. Molines) Original from SPEM
286	!! ! 97-07 (G. Madec, J.-M. Molines) additions
287	!! ! 97-12 (M. Imbard) Mpp adaptation
288	!! ! 00-06 (J.-M. Molines)
289	!! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
290	!! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization
291	!!------------------------------------------------------------------------------
292	!! * Arguments
293	INTEGER, INTENT( in ) :: kt
294
295	!! * Local declaration
296	REAL(wp) :: z05cx, ztau, zin
297	!!------------------------------------------------------------------------------
298
299	! 1. First three time steps and more if lfbcwest is .TRUE.
300	! In that case open boundary conditions are FIXED.
301	! --------------------------------------------------------
302
303	! IND4
304	! IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest .OR. lk_dynspg_exp ) THEN
305	IF ( ll_fbc .OR. lfbcwest ) THEN
306	! IND4
307
308	! 1.1 U zonal velocity
309	! ---------------------
310	DO ji = niw0, niw1
311	DO jk = 1, jpkm1
312	DO jj = 1, jpj
313	ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + &
314	uwmsk(jj,jk)*ufow(jj,jk)
315	END DO
316	END DO
317	END DO
318
319	! 1.2 V meridional velocity
320	! -------------------------
321	DO ji = niw0, niw1
322	DO jk = 1, jpkm1
323	DO jj = 1, jpj
324	va(ji,jj,jk) = va(ji,jj,jk) * (1.-vwmsk(jj,jk)) + &
325	vfow(jj,jk)*vwmsk(jj,jk)
326	END DO
327	END DO
328	END DO
329
330	ELSE
331
332	! 2. Beyond the fourth time step if lfbcwest is .FALSE.
333	! -----------------------------------------------------
334
335	! 2.1. u-component of the velocity
336	! ---------------------------------
337	!
338	! nib nibm nibm2
339	! ///\| nib \| nibm \|
340	! ///\| \| \| \| \|
341	! ---f----v----f----v----f-- jj-line
342	! ///\| \| \| \| \|
343	! ///\| \| \|
344	! ///u T u T u jj-line
345	! ///\| \| \|
346	! ///\| \| \| \| \|
347	! jpiwob jpiwob+1 jpiwob+2
348	! \| \|
349	! jpiwob+1 jpiwob+2
350	!
351	! ... If free surface formulation:
352	! ... radiative conditions on the total part + relaxation toward climatology
353	! ... (jpjwdp1, jpjwfm1), jpiwob
354	DO ji = niw0, niw1
355	DO jk = 1, jpkm1
356	DO jj = 1, jpj
357	z05cx = u_cxwbnd(jj,jk)
358	z05cx = z05cx / e1t(ji+1,jj)
359	z05cx = max( z05cx, -1. )
360	! ... z05c > 0, inflow zin=0, ztau=1
361	! =< 0, outflow zin=1, ztau=rtauw
362	zin = sign( 1., -1. * z05cx )
363	zin = 0.5*( zin + abs(zin) )
364	ztau = (1.-zin )* rtauwin + zin * rtauw
365	z05cx = z05cx * zin
366	! ... update un with radiative or climatological velocity
367	ua(ji,jj,jk) = ua(ji,jj,jk) * ( 1. - uwmsk(jj,jk) ) + &
368	uwmsk(jj,jk) * ( ( 1. + z05cx - ztau ) &
369	* uwbnd(jj,jk,nib ,nitm) - 2.*z05cx &
370	* uwbnd(jj,jk,nibm,nit ) + ztau * ufow (jj,jk) ) &
371	/ (1. - z05cx)
372	END DO
373	END DO
374	END DO
375
376	! 2.2 v-component of the velocity
377	! -------------------------------
378	!
379	! nib nibm nibm2
380	! ///\|///nib \| nibm \| nibm2
381	! ///\|////\| \| \| \| \| \|
382	! ---v----f----v----f----v----f----v-- jj-line
383	! ///\|////\| \| \| \| \| \|
384	! ///\|////\| \| \| \| \| \|
385	! jpiwob jpiwob+1 jpiwob+2
386	! \| \| \|
387	! jpiwob jpiwob+1 jpiwob+2
388	!
389	! ... radiative condition plus Raymond-Kuo
390	! ... (jpjwdp1, jpjwfm1),jpiwob
391	DO ji = niw0, niw1
392	DO jk = 1, jpkm1
393	DO jj = 1, jpj
394	z05cx = v_cxwbnd(jj,jk)
395	z05cx = z05cx / e1f(ji,jj)
396	z05cx = max( z05cx, -1. )
397	! ... z05cx > 0, inflow zin=0, ztau=1
398	! =< 0, outflow zin=1, ztau=rtauw
399	zin = sign( 1., -1. * z05cx )
400	zin = 0.5*( zin + abs(zin) )
401	ztau = (1.-zin )rtauwin + zin rtauw
402	z05cx = z05cx * zin
403	! ... update va with radiative or climatological velocity
404	va(ji,jj,jk) = va(ji,jj,jk) * (1. - vwmsk(jj,jk) ) + &
405	vwmsk(jj,jk) * ( ( 1. + z05cx - ztau ) &
406	* vwbnd(jj,jk,nib ,nitm) - 2.*z05cx &
407	* vwbnd(jj,jk,nibm,nit ) + ztau * vfow (jj,jk) ) &
408	/ (1. - z05cx)
409	END DO
410	END DO
411	END DO
412
413	END IF
414
415	END SUBROUTINE obc_dyn_west
416
417	SUBROUTINE obc_dyn_north ( kt )
418	!!------------------------------------------------------------------------------
419	!! SUBROUTINE obc_dyn_north
420	!! *************************
421	!! ** Purpose :
422	!! Apply the radiation algorithm on north OBC velocities ua, va using the
423	!! phase velocities calculated in obc_rad_north subroutine in obcrad.F90 module
424	!! If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC
425	!!
426	!! History :
427	!! ! 95-03 (J.-M. Molines) Original from SPEM
428	!! ! 97-07 (G. Madec, J.-M. Molines) additions
429	!! ! 97-12 (M. Imbard) Mpp adaptation
430	!! ! 00-06 (J.-M. Molines)
431	!! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
432	!! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization
433	!!------------------------------------------------------------------------------
434	!! * Arguments
435	INTEGER, INTENT( in ) :: kt
436
437	!! * Local declaration
438	REAL(wp) :: z05cx, ztau, zin
439	!!------------------------------------------------------------------------------
440
441	! 1. First three time steps and more if lfbcnorth is .TRUE.
442	! In that case open boundary conditions are FIXED.
443	! ---------------------------------------------------------
444
445	! IND4
446	! IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth .OR. lk_dynspg_exp ) THEN
447	IF ( ll_fbc .OR. lfbcnorth ) THEN
448	! IND4
449
450	! 1.1 U zonal velocity
451	! --------------------
452	DO jj = njn0+1, njn1+1
453	DO jk = 1, jpkm1
454	DO ji = 1, jpi
455	ua(ji,jj,jk)= ua(ji,jj,jk) * (1.-unmsk(ji,jk)) + &
456	ufon(ji,jk)*unmsk(ji,jk)
457	END DO
458	END DO
459	END DO
460
461	! 1.2 V meridional velocity
462	! -------------------------
463	DO jj = njn0, njn1
464	DO jk = 1, jpkm1
465	DO ji = 1, jpi
466	va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + &
467	vfon(ji,jk)*vnmsk(ji,jk)
468	END DO
469	END DO
470	END DO
471
472	ELSE
473
474	! 2. Beyond the fourth time step if lfbcnorth is .FALSE.
475	! ------------------------------------------------------
476
477	! 2.1. u-component of the velocity
478	! --------------------------------
479	!
480	! ji-row
481	! \|
482	! nib ///u////// jpjnob + 1
483	! /////\|//////
484	! nib -----f----- jpjnob
485	! \|
486	! nibm-- u ---- jpjnob
487	! \|
488	! nibm -----f----- jpjnob-1
489	! \|
490	! nibm2-- u ---- jpjnob-1
491	! \|
492	! nibm2 -----f----- jpjnob-2
493	! \|
494	!
495	! ... radiative condition
496	! ... jpjnob+1,(jpindp1, jpinfm1)
497	DO jj = njn0+1, njn1+1
498	DO jk = 1, jpkm1
499	DO ji = 1, jpi
500	z05cx= u_cynbnd(ji,jk)
501	z05cx = z05cx / e2f(ji, jj-1)
502	z05cx = min( z05cx, 1. )
503	! ... z05cx=< 0, inflow zin=0, ztau=1
504	! > 0, outflow zin=1, ztau=rtaun
505	zin = sign( 1., z05cx )
506	zin = 0.5*( zin + abs(zin) )
507	! ... for inflow rtaunin is used for relaxation coefficient else rtaun
508	ztau = (1.-zin ) * rtaunin + zin * rtaun
509	! ... for u, when inflow, ufon is prescribed
510	z05cx = z05cx * zin
511	! ... update un with radiative or climatological velocity
512	ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-unmsk(ji,jk)) + &
513	unmsk(ji,jk) * ( ( 1. - z05cx - ztau ) &
514	* unbnd(ji,jk,nib ,nitm) + 2.*z05cx &
515	* unbnd(ji,jk,nibm,nit ) + ztau * ufon (ji,jk) ) &
516	/ (1. + z05cx)
517	END DO
518	END DO
519	END DO
520
521	! 2.2 v-component of the velocity
522	! -------------------------------
523	!
524	! ji-row ji-row
525	! \| \|
526	! /////\|/////////////////
527	! nib -----f----v----f---- jpjnob
528	! \| \|
529	! nib - u -- T -- u ---- jpjnob
530	! \| \|
531	! nibm -----f----v----f---- jpjnob-1
532	! \| \|
533	! nibm -- u -- T -- u --- jpjnob-1
534	! \| \|
535	! nibm2 -----f----v----f---- jpjnob-2
536	! \| \|
537	!
538	! ... Free surface formulation:
539	! ... radiative conditions on the total part + relaxation toward climatology
540	! ... jpjnob,(jpindp1, jpinfm1)
541	DO jj = njn0, njn1
542	DO jk = 1, jpkm1
543	DO ji = 1, jpi
544	! ... 2* gradj(v) (T-point i=nibm, time mean)
545	z05cx = v_cynbnd(ji,jk)
546	z05cx = z05cx / e2t(ji,jj)
547	z05cx = min( z05cx, 1. )
548	! ... z05cx=< 0, inflow zin=0, ztau=1
549	! > 0, outflow zin=1, ztau=rtaun
550	zin = sign( 1., z05cx )
551	zin = 0.5*( zin + abs(zin) )
552	! ... for inflow rtaunin is used for relaxation coefficient else rtaun
553	ztau = (1.-zin ) * rtaunin + zin * rtaun
554	z05cx = z05cx * zin
555	! ... update va with radiative or climatological velocity
556	va(ji,jj,jk) = va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + &
557	vnmsk(ji,jk) * ( ( 1. - z05cx - ztau ) &
558	* vnbnd(ji,jk,nib ,nitm) + 2.*z05cx &
559	* vnbnd(ji,jk,nibm,nit ) + ztau * vfon (ji,jk) ) &
560	/ (1. + z05cx)
561	END DO
562	END DO
563	END DO
564	END IF
565
566	END SUBROUTINE obc_dyn_north
567
568	SUBROUTINE obc_dyn_south ( kt )
569	!!------------------------------------------------------------------------------
570	!! SUBROUTINE obc_dyn_south
571	!! *************************
572	!! ** Purpose :
573	!! Apply the radiation algorithm on south OBC velocities ua, va using the
574	!! phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module
575	!! If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC
576	!!
577	!! History :
578	!! ! 95-03 (J.-M. Molines) Original from SPEM
579	!! ! 97-07 (G. Madec, J.-M. Molines) additions
580	!! ! 97-12 (M. Imbard) Mpp adaptation
581	!! ! 00-06 (J.-M. Molines)
582	!! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
583	!! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization
584	!!------------------------------------------------------------------------------
585	!! * Arguments
586	INTEGER, INTENT( in ) :: kt
587
588	!! * Local declaration
589	REAL(wp) :: z05cx, ztau, zin
590
591	!!------------------------------------------------------------------------------
592	!! OPA 8.5, LODYC-IPSL (2002)
593	!!------------------------------------------------------------------------------
594
595	! 1. First three time steps and more if lfbcsouth is .TRUE.
596	! In that case open boundary conditions are FIXED.
597	! ---------------------------------------------------------
598
599	! IND4
600	! IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth .OR. lk_dynspg_exp ) THEN
601	IF ( ll_fbc .OR. lfbcsouth ) THEN
602	! IND4
603
604	! 1.1 U zonal velocity
605	! --------------------
606	DO jj = njs0, njs1
607	DO jk = 1, jpkm1
608	DO ji = 1, jpi
609	ua(ji,jj,jk)= ua(ji,jj,jk) * (1.-usmsk(ji,jk)) + &
610	usmsk(ji,jk) * ufos(ji,jk)
611	END DO
612	END DO
613	END DO
614
615	! 1.2 V meridional velocity
616	! -------------------------
617	DO jj = njs0, njs1
618	DO jk = 1, jpkm1
619	DO ji = 1, jpi
620	va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + &
621	vsmsk(ji,jk) * vfos(ji,jk)
622	END DO
623	END DO
624	END DO
625
626	ELSE
627
628	! 2. Beyond the fourth time step if lfbcsouth is .FALSE.
629	! ------------------------------------------------------
630
631	! 2.1. u-component of the velocity
632	! --------------------------------
633	!
634	! ji-row
635	! \|
636	! nibm2 -----f----- jpjsob +2
637	! \|
638	! nibm2 -- u ---- jpjsob +2
639	! \|
640	! nibm -----f----- jpjsob +1
641	! \|
642	! nibm -- u ---- jpjsob +1
643	! \|
644	! nib -----f----- jpjsob
645	! /////\|//////
646	! nib ////u///// jpjsob
647	!
648	! ... radiative condition plus Raymond-Kuo
649	! ... jpjsob,(jpisdp1, jpisfm1)
650	DO jj = njs0, njs1
651	DO jk = 1, jpkm1
652	DO ji = 1, jpi
653	z05cx= u_cysbnd(ji,jk)
654	z05cx = z05cx / e2f(ji, jj)
655	z05cx = max( z05cx, -1. )
656	! ... z05cx > 0, inflow zin=0, ztau=1
657	! =< 0, outflow zin=1, ztau=rtaus
658	zin = sign( 1., -1. * z05cx )
659	zin = 0.5*( zin + abs(zin) )
660	ztau = (1.-zin ) * rtausin + zin * rtaus
661	z05cx = z05cx * zin
662	! ... update ua with radiative or climatological velocity
663	ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-usmsk(ji,jk)) + &
664	usmsk(ji,jk) * ( ( 1. + z05cx - ztau ) &
665	* usbnd(ji,jk,nib ,nitm) - 2.*z05cx &
666	* usbnd(ji,jk,nibm,nit ) + ztau * ufos (ji,jk) ) &
667	/ (1. - z05cx)
668	END DO
669	END DO
670	END DO
671
672	! 2.2 v-component of the velocity
673	! -------------------------------
674	!
675	! ji-row ji-row
676	! \| \|
677	! nibm2 -----f----v----f---- jpjsob+2
678	! \| \|
679	! nibm - u -- T -- u ---- jpjsob+2
680	! \| \|
681	! nibm -----f----v----f---- jpjsob+1
682	! \| \|
683	! nib -- u -- T -- u --- jpjsob+1
684	! \| \|
685	! nib -----f----v----f---- jpjsob
686	! /////////////////////
687	!
688	! ... Free surface formulation:
689	! ... radiative conditions on the total part + relaxation toward climatology
690	! ... jpjsob,(jpisdp1,jpisfm1)
691	DO jj = njs0, njs1
692	DO jk = 1, jpkm1
693	DO ji = 1, jpi
694	z05cx = v_cysbnd(ji,jk)
695	z05cx = z05cx / e2t(ji,jj+1)
696	z05cx = max( z05cx, -1. )
697	! ... z05c > 0, inflow zin=0, ztau=1
698	! =< 0, outflow zin=1, ztau=rtaus
699	zin = sign( 1., -1. * z05cx )
700	zin = 0.5*( zin + abs(zin) )
701	ztau = (1.-zin )rtausin + zin rtaus
702	z05cx = z05cx * zin
703	! ... update va with radiative or climatological velocity
704	va(ji,jj,jk) = va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + &
705	vsmsk(ji,jk) * ( ( 1. + z05cx - ztau ) &
706	* vsbnd(ji,jk,nib ,nitm) - 2.*z05cx &
707	* vsbnd(ji,jk,nibm,nit ) + ztau * vfos (ji,jk) ) &
708	/ (1. - z05cx)
709	END DO
710	END DO
711	END DO
712	END IF
713
714	END SUBROUTINE obc_dyn_south
715	#else
716	!!=================================================================================
717	!! * MODULE obcdyn *
718	!! Ocean dynamics: Radiation of velocities on each open boundary
719	!!=================================================================================
720	CONTAINS
721
722	SUBROUTINE obc_dyn
723	! No open boundaries ==> empty routine
724	END SUBROUTINE obc_dyn
725	#endif
726
727	END MODULE obcdyn

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

Download in other formats: