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.

zdfbfr.F90 in branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/ZDF – NEMO

Context Navigation

source: branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90 @ 3764

Last change on this file since 3764 was 3764, checked in by smasson, 11 years ago
dev_MERGE_2012: report bugfixes done in the trunk from r3555 to r3763 into dev_MERGE_2012
Property svn:keywords set to `Id`
File size: 14.7 KB

Line
1	MODULE zdfbfr
2	!!======================================================================
3	!! * MODULE zdfbfr *
4	!! Ocean physics: Bottom friction
5	!!======================================================================
6	!! History : OPA ! 1997-06 (G. Madec, A.-M. Treguier) Original code
7	!! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module
8	!! 3.2 ! 2009-09 (A.C.Coward) Correction to include barotropic contribution
9	!! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
10	!! 3.4 ! 2011-11 (H. Liu) implementation of semi-implicit bottom friction option
11	!! ! 2012-06 (H. Liu) implementation of Log Layer bottom friction option
12	!!----------------------------------------------------------------------
13
14	!!----------------------------------------------------------------------
15	!! zdf_bfr : update momentum Kz at the ocean bottom due to the type of bottom friction chosen
16	!! zdf_bfr_init : read in namelist and control the bottom friction parameters.
17	!! zdf_bfr_2d : read in namelist and control the bottom friction parameters.
18	!!----------------------------------------------------------------------
19	USE oce ! ocean dynamics and tracers variables
20	USE dom_oce ! ocean space and time domain variables
21	USE zdf_oce ! ocean vertical physics variables
22	USE in_out_manager ! I/O manager
23	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
24	USE lib_mpp ! distributed memory computing
25	USE prtctl ! Print control
26	USE timing ! Timing
27
28	USE phycst, ONLY: vkarmn
29
30	IMPLICIT NONE
31	PRIVATE
32
33	PUBLIC zdf_bfr ! called by step.F90
34	PUBLIC zdf_bfr_init ! called by opa.F90
35
36	! !!* Namelist nambfr: bottom friction namelist *
37	INTEGER , PUBLIC :: nn_bfr = 0 ! = 0/1/2/3 type of bottom friction (PUBLIC for TAM)
38	REAL(wp), PUBLIC :: rn_bfri1 = 4.0e-4_wp ! bottom drag coefficient (linear case) (PUBLIC for TAM)
39	REAL(wp), PUBLIC :: rn_bfri2 = 1.0e-3_wp ! bottom drag coefficient (non linear case) (PUBLIC for TAM)
40	REAL(wp), PUBLIC :: rn_bfeb2 = 2.5e-3_wp ! background bottom turbulent kinetic energy [m2/s2] (PUBLIC for TAM)
41	REAL(wp), PUBLIC :: rn_bfrien = 30._wp ! local factor to enhance coefficient bfri (PUBLIC for TAM)
42	LOGICAL , PUBLIC :: ln_bfr2d = .false. ! logical switch for 2D enhancement (PUBLIC for TAM)
43	LOGICAL , PUBLIC :: ln_loglayer = .false. ! switch for log layer bfr coeff. (PUBLIC for TAM)
44	REAL(wp), PUBLIC :: rn_bfrz0 = 0.003_wp ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM)
45	LOGICAL , PUBLIC :: ln_bfrimp = .false. ! logical switch for implicit bottom friction
46	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: bfrcoef2d ! 2D bottom drag coefficient (PUBLIC for TAM)
47
48	!! * Substitutions
49	# include "vectopt_loop_substitute.h90"
50	# include "domzgr_substitute.h90"
51	!!----------------------------------------------------------------------
52	!! NEMO/OPA 4.0 , NEMO Consortium (2011)
53	!! $Id$
54	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
55	!!----------------------------------------------------------------------
56	CONTAINS
57
58	INTEGER FUNCTION zdf_bfr_alloc()
59	!!----------------------------------------------------------------------
60	!! * FUNCTION zdf_bfr_alloc *
61	!!----------------------------------------------------------------------
62	ALLOCATE( bfrcoef2d(jpi,jpj), STAT=zdf_bfr_alloc )
63	!
64	IF( lk_mpp ) CALL mpp_sum ( zdf_bfr_alloc )
65	IF( zdf_bfr_alloc /= 0 ) CALL ctl_warn('zdf_bfr_alloc: failed to allocate arrays.')
66	END FUNCTION zdf_bfr_alloc
67
68
69	SUBROUTINE zdf_bfr( kt )
70	!!----------------------------------------------------------------------
71	!! * ROUTINE zdf_bfr *
72	!!
73	!! ** Purpose : compute the bottom friction coefficient.
74	!!
75	!! ** Method : Calculate and store part of the momentum trend due
76	!! to bottom friction following the chosen friction type
77	!! (free-slip, linear, or quadratic). The component
78	!! calculated here is multiplied by the bottom velocity in
79	!! dyn_bfr to provide the trend term.
80	!! The coefficients are updated at each time step only
81	!! in the quadratic case.
82	!!
83	!! ** Action : bfrua , bfrva bottom friction coefficients
84	!!----------------------------------------------------------------------
85	INTEGER, INTENT( in ) :: kt ! ocean time-step index
86	!!
87	INTEGER :: ji, jj ! dummy loop indices
88	INTEGER :: ikbu, ikbv ! local integers
89	REAL(wp) :: zvu, zuv, zecu, zecv, ztmp ! temporary scalars
90	!!----------------------------------------------------------------------
91	!
92	IF( nn_timing == 1 ) CALL timing_start('zdf_bfr')
93	!
94	IF( nn_bfr == 2 ) THEN ! quadratic botton friction
95	! Calculate and store the quadratic bottom friction coefficient bfrua and bfrva
96	! where bfrUa = C_d*SQRT(u_bot^2 + v_bot^2 + e_b) {U=[u,v]}
97	! from these the trend due to bottom friction: -F_h/e3U can be calculated
98	! where -F_h/e3U_bot = bfrUa*Ub/e3U_bot {U=[u,v]}
99	!
100
101	IF(ln_loglayer) THEN ! "log layer" bottom friction coefficient
102	# if defined key_vectopt_loop
103	DO jj = 1, 1
104	DO ji = 1, jpij ! vector opt. (forced unrolling)
105	# else
106	DO jj = 1, jpj
107	DO ji = 1, jpi
108	# endif
109	ztmp = 0.5_wp * fse3t(ji,jj,mbkt(ji,jj))
110	ztmp = max(ztmp, rn_bfrz0)
111	bfrcoef2d(ji,jj) = ( log( ztmp / rn_bfrz0 ) / vkarmn ) ** (-2)
112	END DO
113	END DO
114	ENDIF
115
116	# if defined key_vectopt_loop
117	DO jj = 1, 1
118	!CDIR NOVERRCHK
119	DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)
120	# else
121	!CDIR NOVERRCHK
122	DO jj = 2, jpjm1
123	!CDIR NOVERRCHK
124	DO ji = 2, jpim1
125	# endif
126	ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points
127	ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points)
128	!
129	zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) &
130	& + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu) )
131	zuv = 0.25 * ( un(ji,jj ,ikbv) + un(ji-1,jj ,ikbv) &
132	& + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) )
133	!
134	zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 )
135	zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 )
136	!
137	bfrua(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji+1,jj ) ) * zecu
138	bfrva(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji ,jj+1) ) * zecv
139	END DO
140	END DO
141
142	!
143	CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition
144	!
145	IF(ln_ctl) CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr - u: ', mask1=umask, &
146	& tab2d_2=bfrva, clinfo2= ' v: ', mask2=vmask,ovlap=1 )
147	ENDIF
148
149	!
150	IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr')
151	!
152	END SUBROUTINE zdf_bfr
153
154
155	SUBROUTINE zdf_bfr_init
156	!!----------------------------------------------------------------------
157	!! * ROUTINE zdf_bfr_init *
158	!!
159	!! ** Purpose : Initialization of the bottom friction
160	!!
161	!! ** Method : Read the nammbf namelist and check their consistency
162	!! called at the first timestep (nit000)
163	!!----------------------------------------------------------------------
164	USE iom ! I/O module for ehanced bottom friction file
165	!!
166	INTEGER :: inum ! logical unit for enhanced bottom friction file
167	INTEGER :: ji, jj ! dummy loop indexes
168	INTEGER :: ikbu, ikbv ! temporary integers
169	INTEGER :: ictu, ictv ! - -
170	REAL(wp) :: zminbfr, zmaxbfr ! temporary scalars
171	REAL(wp) :: zfru, zfrv ! - -
172	!!
173	NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2, rn_bfrz0, ln_bfr2d, &
174	& rn_bfrien, ln_bfrimp, ln_loglayer
175	!!----------------------------------------------------------------------
176	!
177	IF( nn_timing == 1 ) CALL timing_start('zdf_bfr_init')
178	!
179	REWIND ( numnam ) !* Read Namelist nam_bfr : bottom momentum boundary condition
180	READ ( numnam, nambfr )
181
182	! !* Parameter control and print
183	IF(lwp) WRITE(numout,*)
184	IF(lwp) WRITE(numout,*) 'zdf_bfr : momentum bottom friction'
185	IF(lwp) WRITE(numout,*) '~~~~~~~'
186	IF(lwp) WRITE(numout,*) ' Namelist nam_bfr : set bottom friction parameters'
187
188	! ! allocate zdfbfr arrays
189	IF( zdf_bfr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_bfr_init : unable to allocate arrays' )
190
191	! ! Make sure ln_zdfexp=.false. when use implicit bfr
192	IF( ln_bfrimp .AND. ln_zdfexp ) THEN
193	IF(lwp) THEN
194	WRITE(numout,*)
195	WRITE(numout,*) 'Implicit bottom friction can only be used when ln_zdfexp=.false.'
196	WRITE(numout,*) ' but you set: ln_bfrimp=.true. and ln_zdfexp=.true.!!!!'
197	WRITE(ctmp1,*) ' set either ln_zdfexp = .false or ln_bfrimp = .false.'
198	CALL ctl_stop( ctmp1 )
199	END IF
200	END IF
201
202	SELECT CASE (nn_bfr)
203	!
204	CASE( 0 )
205	IF(lwp) WRITE(numout,*) ' free-slip '
206	bfrua(:,:) = 0.e0
207	bfrva(:,:) = 0.e0
208	!
209	CASE( 1 )
210	IF(lwp) WRITE(numout,*) ' linear botton friction'
211	IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri1 = ', rn_bfri1
212	IF( ln_bfr2d ) THEN
213	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d
214	IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
215	ENDIF
216	!
217	bfrcoef2d(:,:) = rn_bfri1 ! initialize bfrcoef2d to the namelist variable
218	!
219	IF(ln_bfr2d) THEN
220	! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
221	CALL iom_open('bfr_coef.nc',inum)
222	CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
223	CALL iom_close(inum)
224	bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
225	ENDIF
226	bfrua(:,:) = - bfrcoef2d(:,:)
227	bfrva(:,:) = - bfrcoef2d(:,:)
228	!
229	CASE( 2 )
230	IF(lwp) WRITE(numout,*) ' quadratic botton friction'
231	IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri2 = ', rn_bfri2
232	IF(lwp) WRITE(numout,*) ' background tke rn_bfeb2 = ', rn_bfeb2
233	IF( ln_bfr2d ) THEN
234	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d
235	IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
236	ENDIF
237	bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable
238
239	!
240	IF(ln_bfr2d) THEN
241	! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
242	CALL iom_open('bfr_coef.nc',inum)
243	CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
244	CALL iom_close(inum)
245	bfrcoef2d(:,:)= rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
246	ENDIF
247	!
248	CASE DEFAULT
249	IF(lwp) WRITE(ctmp1,*) ' bad flag value for nn_bfr = ', nn_bfr
250	CALL ctl_stop( ctmp1 )
251	!
252	END SELECT
253	IF(lwp) WRITE(numout,*) ' implicit bottom friction switch ln_bfrimp = ', ln_bfrimp
254	!
255	! Basic stability check on bottom friction coefficient
256	!
257	ictu = 0 ! counter for stability criterion breaches at U-pts
258	ictv = 0 ! counter for stability criterion breaches at V-pts
259	zminbfr = 1.e10_wp ! initialise tracker for minimum of bottom friction coefficient
260	zmaxbfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient
261	!
262	# if defined key_vectopt_loop
263	DO jj = 1, 1
264	!CDIR NOVERRCHK
265	DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)
266	# else
267	!CDIR NOVERRCHK
268	DO jj = 2, jpjm1
269	!CDIR NOVERRCHK
270	DO ji = 2, jpim1
271	# endif
272	ikbu = mbku(ji,jj) ! deepest ocean level at u- and v-points
273	ikbv = mbkv(ji,jj)
274	zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
275	zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
276	IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN
277	IF( ln_ctl ) THEN
278	WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbu
279	WRITE(numout,*) 'BFR ', ABS( bfrcoef2d(ji,jj) ), zfru
280	ENDIF
281	ictu = ictu + 1
282	ENDIF
283	IF( ABS( bfrcoef2d(ji,jj) ) > zfrv ) THEN
284	IF( ln_ctl ) THEN
285	WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbv
286	WRITE(numout,*) 'BFR ', bfrcoef2d(ji,jj), zfrv
287	ENDIF
288	ictv = ictv + 1
289	ENDIF
290	zminbfr = MIN( zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) ) )
291	zmaxbfr = MAX( zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) ) )
292	END DO
293	END DO
294	IF( lk_mpp ) THEN
295	CALL mpp_sum( ictu )
296	CALL mpp_sum( ictv )
297	CALL mpp_min( zminbfr )
298	CALL mpp_max( zmaxbfr )
299	ENDIF
300	IF( .NOT.ln_bfrimp) THEN
301	IF( lwp .AND. ictu + ictv > 0 ) THEN
302	WRITE(numout,*) ' Bottom friction stability check failed at ', ictu, ' U-points '
303	WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' V-points '
304	WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr
305	WRITE(numout,*) ' Bottom friction coefficient will be reduced where necessary'
306	ENDIF
307	ENDIF
308	!
309	IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr_init')
310	!
311	END SUBROUTINE zdf_bfr_init
312
313	!!======================================================================
314	END MODULE zdfbfr

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

Download in other formats: