Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

zdfbfr.F90 @ 5418

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

Download in other formats: