Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

zdfbfr.F90 @ 7910

Last change on this file since 7910 was 7910, checked in by timgraham, 7 years ago
All wrk_alloc removed
Property svn:keywords set to `Id`
File size: 24.6 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 bottom friction coefficient (non-linear bottom friction only)
16	!! zdf_bfr_init : read in namelist and control the bottom friction parameters.
17	!!----------------------------------------------------------------------
18	USE oce ! ocean dynamics and tracers variables
19	USE dom_oce ! ocean space and time domain variables
20	USE zdf_oce ! ocean vertical physics variables
21	USE in_out_manager ! I/O manager
22	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
23	USE lib_mpp ! distributed memory computing
24	USE prtctl ! Print control
25	USE timing ! Timing
26	USE phycst, ONLY: vkarmn
27
28	IMPLICIT NONE
29	PRIVATE
30
31	PUBLIC zdf_bfr ! called by step.F90
32	PUBLIC zdf_bfr_init ! called by nemogcm.F90
33
34	! !!* Namelist nambfr: bottom friction namelist *
35	INTEGER , PUBLIC :: nn_bfr ! = 0/1/2/3 type of bottom friction (PUBLIC for TAM)
36	REAL(wp), PUBLIC :: rn_bfri1 ! bottom drag coefficient (linear case) (PUBLIC for TAM)
37	REAL(wp), PUBLIC :: rn_bfri2 ! bottom drag coefficient (non linear case) (PUBLIC for TAM)
38	REAL(wp), PUBLIC :: rn_bfri2_max ! Maximum bottom drag coefficient (non linear case and ln_loglayer=T) (PUBLIC for TAM)
39	REAL(wp), PUBLIC :: rn_bfeb2 ! background bottom turbulent kinetic energy [m2/s2] (PUBLIC for TAM)
40	REAL(wp), PUBLIC :: rn_bfrien ! local factor to enhance coefficient bfri (PUBLIC for TAM)
41	LOGICAL , PUBLIC :: ln_bfr2d ! logical switch for 2D enhancement (PUBLIC for TAM)
42	REAL(wp), PUBLIC :: rn_tfri1 ! top drag coefficient (linear case) (PUBLIC for TAM)
43	REAL(wp), PUBLIC :: rn_tfri2 ! top drag coefficient (non linear case) (PUBLIC for TAM)
44	REAL(wp), PUBLIC :: rn_tfri2_max ! Maximum top drag coefficient (non linear case and ln_loglayer=T) (PUBLIC for TAM)
45	REAL(wp), PUBLIC :: rn_tfeb2 ! background top turbulent kinetic energy [m2/s2] (PUBLIC for TAM)
46	REAL(wp), PUBLIC :: rn_tfrien ! local factor to enhance coefficient tfri (PUBLIC for TAM)
47	LOGICAL , PUBLIC :: ln_tfr2d ! logical switch for 2D enhancement (PUBLIC for TAM)
48
49	LOGICAL , PUBLIC :: ln_loglayer ! switch for log layer bfr coeff. (PUBLIC for TAM)
50	REAL(wp), PUBLIC :: rn_bfrz0 ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM)
51	REAL(wp), PUBLIC :: rn_tfrz0 ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM)
52	LOGICAL , PUBLIC :: ln_bfrimp ! logical switch for implicit bottom friction
53	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: bfrcoef2d, tfrcoef2d ! 2D bottom/top drag coefficient (PUBLIC for TAM)
54
55	!! * Substitutions
56	# include "vectopt_loop_substitute.h90"
57	!!----------------------------------------------------------------------
58	!! NEMO/OPA 4.0 , NEMO Consortium (2011)
59	!! $Id$
60	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
61	!!----------------------------------------------------------------------
62	CONTAINS
63
64	INTEGER FUNCTION zdf_bfr_alloc()
65	!!----------------------------------------------------------------------
66	!! * FUNCTION zdf_bfr_alloc *
67	!!----------------------------------------------------------------------
68	ALLOCATE( bfrcoef2d(jpi,jpj), tfrcoef2d(jpi,jpj), STAT=zdf_bfr_alloc )
69	!
70	IF( lk_mpp ) CALL mpp_sum ( zdf_bfr_alloc )
71	IF( zdf_bfr_alloc /= 0 ) CALL ctl_warn('zdf_bfr_alloc: failed to allocate arrays.')
72	END FUNCTION zdf_bfr_alloc
73
74
75	SUBROUTINE zdf_bfr( kt )
76	!!----------------------------------------------------------------------
77	!! * ROUTINE zdf_bfr *
78	!!
79	!! ** Purpose : compute the bottom friction coefficient.
80	!!
81	!! ** Method : Calculate and store part of the momentum trend due
82	!! to bottom friction following the chosen friction type
83	!! (free-slip, linear, or quadratic). The component
84	!! calculated here is multiplied by the bottom velocity in
85	!! dyn_bfr to provide the trend term.
86	!! The coefficients are updated at each time step only
87	!! in the quadratic case.
88	!!
89	!! ** Action : bfrua , bfrva bottom friction coefficients
90	!!----------------------------------------------------------------------
91	INTEGER, INTENT( in ) :: kt ! ocean time-step index
92	!!
93	INTEGER :: ji, jj ! dummy loop indices
94	INTEGER :: ikbt, ikbu, ikbv ! local integers
95	REAL(wp) :: zvu, zuv, zecu, zecv, ztmp ! temporary scalars
96	REAL(wp), DIMENSION(jpi,jpj) :: zbfrt, ztfrt
97	!!----------------------------------------------------------------------
98	!
99	IF( nn_timing == 1 ) CALL timing_start('zdf_bfr')
100	!
101	IF( nn_bfr == 2 ) THEN ! quadratic bottom friction only
102	!
103
104	IF ( ln_loglayer.AND. .NOT.ln_linssh ) THEN ! "log layer" bottom friction coefficient
105
106	DO jj = 1, jpj
107	DO ji = 1, jpi
108	ikbt = mbkt(ji,jj)
109	!! JC: possible WAD implementation should modify line below if layers vanish
110	ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
111	zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
112	zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max)
113	END DO
114	END DO
115	! (ISF)
116	IF ( ln_isfcav ) THEN
117	DO jj = 1, jpj
118	DO ji = 1, jpi
119	ikbt = mikt(ji,jj)
120	! JC: possible WAD implementation should modify line below if layers vanish
121	ztmp = (1.-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
122	ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
123	ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max)
124	END DO
125	END DO
126	END IF
127	!
128	ELSE
129	zbfrt(:,:) = bfrcoef2d(:,:)
130	ztfrt(:,:) = tfrcoef2d(:,:)
131	ENDIF
132
133	DO jj = 2, jpjm1
134	DO ji = 2, jpim1
135	ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points
136	ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points)
137	!
138	zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) &
139	& + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu) )
140	zuv = 0.25 * ( un(ji,jj ,ikbv) + un(ji-1,jj ,ikbv) &
141	& + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) )
142	!
143	zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 )
144	zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 )
145	!
146	bfrua(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) * zecu
147	bfrva(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) * zecv
148	!
149	! in case of 2 cell water column, we assume each cell feels the top and bottom friction
150	IF ( ln_isfcav ) THEN
151	IF ( miku(ji,jj) + 1 >= mbku(ji,jj) ) THEN
152	bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) &
153	& + ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) ) &
154	& * zecu * (1._wp - umask(ji,jj,1))
155	ENDIF
156	IF( mikv(ji,jj) + 1 >= mbkv(ji,jj) ) THEN
157	bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) &
158	& + ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) ) &
159	& * zecv * (1._wp - vmask(ji,jj,1))
160	ENDIF
161	ENDIF
162	END DO
163	END DO
164	CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition
165
166	IF( ln_isfcav ) THEN
167	DO jj = 2, jpjm1
168	DO ji = 2, jpim1
169	! (ISF) ========================================================================
170	ikbu = miku(ji,jj) ! ocean top level at u- and v-points
171	ikbv = mikv(ji,jj) ! (1st wet ocean u- and v-points)
172	!
173	zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) &
174	& + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu) )
175	zuv = 0.25 * ( un(ji,jj ,ikbv) + un(ji-1,jj ,ikbv) &
176	& + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) )
177	!
178	zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_tfeb2 )
179	zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_tfeb2 )
180	!
181	tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) * zecu * (1._wp - umask(ji,jj,1))
182	tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1))
183	! (ISF) END ====================================================================
184	! in case of 2 cell water column, we assume each cell feels the top and bottom friction
185	IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN
186	tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) &
187	& + ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) ) &
188	& * zecu * (1._wp - umask(ji,jj,1))
189	END IF
190	IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN
191	tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) &
192	& + ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) ) &
193	& * zecv * (1._wp - vmask(ji,jj,1))
194	END IF
195	END DO
196	END DO
197	CALL lbc_lnk( tfrua, 'U', 1. ) ; CALL lbc_lnk( tfrva, 'V', 1. ) ! Lateral boundary condition
198	END IF
199	!
200	!
201	IF(ln_ctl) CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr - u: ', mask1=umask, &
202	& tab2d_2=bfrva, clinfo2= ' v: ', mask2=vmask,ovlap=1 )
203	ENDIF
204	!
205	IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr')
206	!
207	END SUBROUTINE zdf_bfr
208
209
210	SUBROUTINE zdf_bfr_init
211	!!----------------------------------------------------------------------
212	!! * ROUTINE zdf_bfr_init *
213	!!
214	!! ** Purpose : Initialization of the bottom friction
215	!!
216	!! ** Method : Read the nambfr namelist and check their consistency
217	!! called at the first timestep (nit000)
218	!!----------------------------------------------------------------------
219	USE iom ! I/O module for ehanced bottom friction file
220	!!
221	INTEGER :: inum ! logical unit for enhanced bottom friction file
222	INTEGER :: ji, jj ! dummy loop indexes
223	INTEGER :: ikbt, ikbu, ikbv ! temporary integers
224	INTEGER :: ictu, ictv ! - -
225	INTEGER :: ios
226	REAL(wp) :: zminbfr, zmaxbfr ! temporary scalars
227	REAL(wp) :: zmintfr, zmaxtfr ! temporary scalars
228	REAL(wp) :: ztmp, zfru, zfrv ! - -
229	!!
230	NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfri2_max, rn_bfeb2, rn_bfrz0, ln_bfr2d, &
231	& rn_tfri1, rn_tfri2, rn_tfri2_max, rn_tfeb2, rn_tfrz0, ln_tfr2d, &
232	& rn_bfrien, rn_tfrien, ln_bfrimp, ln_loglayer
233	!!----------------------------------------------------------------------
234	!
235	IF( nn_timing == 1 ) CALL timing_start('zdf_bfr_init')
236	!
237	! !* Allocate zdfbfr arrays
238	IF( zdf_bfr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_bfr_init : unable to allocate arrays' )
239	!
240	! !* Parameter control and print
241	!
242	REWIND( numnam_ref ) ! Namelist nambfr in reference namelist : Bottom momentum boundary condition
243	READ ( numnam_ref, nambfr, IOSTAT = ios, ERR = 901)
244	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in reference namelist', lwp )
245
246	REWIND( numnam_cfg ) ! Namelist nambfr in configuration namelist : Bottom momentum boundary condition
247	READ ( numnam_cfg, nambfr, IOSTAT = ios, ERR = 902 )
248	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in configuration namelist', lwp )
249	IF(lwm) WRITE ( numond, nambfr )
250	IF(lwp) WRITE(numout,*)
251	IF(lwp) WRITE(numout,*) 'zdf_bfr_init : momentum bottom friction'
252	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
253	IF(lwp) WRITE(numout,*) ' Namelist nam_bfr : set bottom friction parameters'
254	!
255	SELECT CASE (nn_bfr)
256	!
257	CASE( 0 )
258	IF(lwp) WRITE(numout,*) ' free-slip '
259	bfrua(:,:) = 0._wp
260	bfrva(:,:) = 0._wp
261	tfrua(:,:) = 0._wp
262	tfrva(:,:) = 0._wp
263	!
264	CASE( 1 )
265	IF(lwp) WRITE(numout,*) ' linear botton friction'
266	IF(lwp) WRITE(numout,*) ' bottom friction coef. rn_bfri1 = ', rn_bfri1
267	IF( ln_bfr2d ) THEN
268	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d
269	IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
270	ENDIF
271	IF ( ln_isfcav ) THEN
272	IF(lwp) WRITE(numout,*) ' top friction coef. rn_bfri1 = ', rn_tfri1
273	IF( ln_tfr2d ) THEN
274	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
275	IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
276	ENDIF
277	END IF
278	!
279	IF(ln_bfr2d) THEN
280	! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
281	CALL iom_open('bfr_coef.nc',inum)
282	CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
283	CALL iom_close(inum)
284	bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
285	ELSE
286	bfrcoef2d(:,:) = rn_bfri1 ! initialize bfrcoef2d to the namelist variable
287	ENDIF
288	!
289	bfrua(:,:) = - bfrcoef2d(:,:)
290	bfrva(:,:) = - bfrcoef2d(:,:)
291	!
292	IF ( ln_isfcav ) THEN
293	IF(ln_tfr2d) THEN
294	! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
295	CALL iom_open('tfr_coef.nc',inum)
296	CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
297	CALL iom_close(inum)
298	tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
299	ELSE
300	tfrcoef2d(:,:) = rn_tfri1 ! initialize tfrcoef2d to the namelist variable
301	ENDIF
302	!
303	tfrua(:,:) = - tfrcoef2d(:,:)
304	tfrva(:,:) = - tfrcoef2d(:,:)
305	END IF
306	!
307	CASE( 2 )
308	IF(lwp) WRITE(numout,*) ' quadratic bottom friction'
309	IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri2 = ', rn_bfri2
310	IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_bfri2_max = ', rn_bfri2_max
311	IF(lwp) WRITE(numout,*) ' background tke rn_bfeb2 = ', rn_bfeb2
312	IF(lwp) WRITE(numout,*) ' log formulation ln_bfr2d = ', ln_loglayer
313	IF(lwp) WRITE(numout,*) ' bottom roughness rn_bfrz0 [m] = ', rn_bfrz0
314	IF( rn_bfrz0 <= 0._wp ) THEN
315	WRITE(ctmp1,*) ' bottom roughness must be strictly positive'
316	CALL ctl_stop( ctmp1 )
317	ENDIF
318	IF( ln_bfr2d ) THEN
319	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d
320	IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
321	ENDIF
322	IF ( ln_isfcav ) THEN
323	IF(lwp) WRITE(numout,*) ' quadratic top friction'
324	IF(lwp) WRITE(numout,*) ' friction coef. rn_tfri2 = ', rn_tfri2
325	IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_tfri2_max = ', rn_tfri2_max
326	IF(lwp) WRITE(numout,*) ' background tke rn_tfeb2 = ', rn_tfeb2
327	IF(lwp) WRITE(numout,*) ' log formulation ln_tfr2d = ', ln_loglayer
328	IF(lwp) WRITE(numout,*) ' top roughness rn_tfrz0 [m] = ', rn_tfrz0
329	IF( rn_tfrz0 <= 0._wp ) THEN
330	WRITE(ctmp1,*) ' top roughness must be strictly positive'
331	CALL ctl_stop( ctmp1 )
332	ENDIF
333	IF( ln_tfr2d ) THEN
334	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
335	IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
336	ENDIF
337	END IF
338	!
339	IF(ln_bfr2d) THEN
340	! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
341	CALL iom_open('bfr_coef.nc',inum)
342	CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
343	CALL iom_close(inum)
344	!
345	bfrcoef2d(:,:) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
346	ELSE
347	bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable
348	ENDIF
349
350	IF ( ln_isfcav ) THEN
351	IF(ln_tfr2d) THEN
352	! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
353	CALL iom_open('tfr_coef.nc',inum)
354	CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
355	CALL iom_close(inum)
356	!
357	tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
358	ELSE
359	tfrcoef2d(:,:) = rn_tfri2 ! initialize tfrcoef2d to the namelist variable
360	ENDIF
361	END IF
362	!
363	IF( ln_loglayer.AND. ln_linssh ) THEN ! set "log layer" bottom friction once for all
364	DO jj = 1, jpj
365	DO ji = 1, jpi
366	ikbt = mbkt(ji,jj)
367	ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
368	bfrcoef2d(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
369	bfrcoef2d(ji,jj) = MIN(bfrcoef2d(ji,jj), rn_bfri2_max)
370	END DO
371	END DO
372	IF ( ln_isfcav ) THEN
373	DO jj = 1, jpj
374	DO ji = 1, jpi
375	ikbt = mikt(ji,jj)
376	ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp
377	tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
378	tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max)
379	END DO
380	END DO
381	END IF
382	ENDIF
383	!
384	CASE DEFAULT
385	IF(lwp) WRITE(ctmp1,*) ' bad flag value for nn_bfr = ', nn_bfr
386	CALL ctl_stop( ctmp1 )
387	!
388	END SELECT
389	!
390	IF(lwp) WRITE(numout,*) ' implicit bottom friction switch ln_bfrimp = ', ln_bfrimp
391	!
392	! ! Make sure ln_zdfexp=.false. when use implicit bfr
393	IF( ln_bfrimp .AND. ln_zdfexp ) THEN
394	IF(lwp) THEN
395	WRITE(numout,*)
396	WRITE(numout,*) 'Implicit bottom friction can only be used when ln_zdfexp=.false.'
397	WRITE(numout,*) ' but you set: ln_bfrimp=.true. and ln_zdfexp=.true.!!!!'
398	WRITE(ctmp1,*) ' set either ln_zdfexp = .false or ln_bfrimp = .false.'
399	CALL ctl_stop( ctmp1 )
400	END IF
401	END IF
402	!
403	! Basic stability check on bottom friction coefficient
404	!
405	ictu = 0 ! counter for stability criterion breaches at U-pts
406	ictv = 0 ! counter for stability criterion breaches at V-pts
407	zminbfr = 1.e10_wp ! initialise tracker for minimum of bottom friction coefficient
408	zmaxbfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient
409	zmintfr = 1.e10_wp ! initialise tracker for minimum of bottom friction coefficient
410	zmaxtfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient
411	!
412	DO jj = 2, jpjm1
413	DO ji = 2, jpim1
414	ikbu = mbku(ji,jj) ! deepest ocean level at u- and v-points
415	ikbv = mbkv(ji,jj)
416	zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt
417	zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt
418	IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN
419	IF( ln_ctl ) THEN
420	WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbu
421	WRITE(numout,*) 'BFR ', ABS( bfrcoef2d(ji,jj) ), zfru
422	ENDIF
423	ictu = ictu + 1
424	ENDIF
425	IF( ABS( bfrcoef2d(ji,jj) ) > zfrv ) THEN
426	IF( ln_ctl ) THEN
427	WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbv
428	WRITE(numout,*) 'BFR ', bfrcoef2d(ji,jj), zfrv
429	ENDIF
430	ictv = ictv + 1
431	ENDIF
432	zminbfr = MIN( zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) ) )
433	zmaxbfr = MAX( zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) ) )
434	! (ISF)
435	IF ( ln_isfcav ) THEN
436	ikbu = miku(ji,jj) ! 1st wet ocean level at u- and v-points
437	ikbv = mikv(ji,jj)
438	zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt
439	zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt
440	IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN
441	IF( ln_ctl ) THEN
442	WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu
443	WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru
444	ENDIF
445	ictu = ictu + 1
446	ENDIF
447	IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN
448	IF( ln_ctl ) THEN
449	WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv
450	WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv
451	ENDIF
452	ictv = ictv + 1
453	ENDIF
454	zmintfr = MIN( zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) ) )
455	zmaxtfr = MAX( zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) ) )
456	END IF
457	! END ISF
458	END DO
459	END DO
460	IF( lk_mpp ) THEN
461	CALL mpp_sum( ictu )
462	CALL mpp_sum( ictv )
463	CALL mpp_min( zminbfr )
464	CALL mpp_max( zmaxbfr )
465	IF ( ln_isfcav) CALL mpp_min( zmintfr )
466	IF ( ln_isfcav) CALL mpp_max( zmaxtfr )
467	ENDIF
468	IF( .NOT.ln_bfrimp) THEN
469	IF( lwp .AND. ictu + ictv > 0 ) THEN
470	WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' U-points '
471	WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' V-points '
472	WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr
473	IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr
474	WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary'
475	ENDIF
476	ENDIF
477	!
478	IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr_init')
479	!
480	END SUBROUTINE zdf_bfr_init
481
482	!!======================================================================
483	END MODULE zdfbfr

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

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

Context Navigation

source: branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90 @ 7910

Download in other formats: