Context Navigation

zdfbfr.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 25.4 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	IF(lflush) CALL flush(numout)
108	ENDIF
109	!
110	IF( nn_bfr == 2 ) THEN ! quadratic bottom friction only
111	!
112	CALL wrk_alloc( jpi, jpj, zbfrt, ztfrt )
113
114	IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient
115
116	DO jj = 1, jpj
117	DO ji = 1, jpi
118	ikbt = mbkt(ji,jj)
119	!! JC: possible WAD implementation should modify line below if layers vanish
120	ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
121	zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
122	zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max)
123	END DO
124	END DO
125	! (ISF)
126	IF ( ln_isfcav ) THEN
127	DO jj = 1, jpj
128	DO ji = 1, jpi
129	ikbt = mikt(ji,jj)
130	! JC: possible WAD implementation should modify line below if layers vanish
131	ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
132	ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
133	ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max)
134	END DO
135	END DO
136	END IF
137	!
138	ELSE
139	zbfrt(:,:) = bfrcoef2d(:,:)
140	ztfrt(:,:) = tfrcoef2d(:,:)
141	ENDIF
142
143	DO jj = 2, jpjm1
144	DO ji = 2, jpim1
145	ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points
146	ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points)
147	!
148	zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) &
149	& + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu) )
150	zuv = 0.25 * ( un(ji,jj ,ikbv) + un(ji-1,jj ,ikbv) &
151	& + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) )
152	!
153	zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 )
154	zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 )
155	!
156	bfrua(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) * zecu
157	bfrva(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) * zecv
158	!
159	! in case of 2 cell water column, we assume each cell feels the top and bottom friction
160	IF ( ln_isfcav ) THEN
161	IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN
162	bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) &
163	& + ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) ) &
164	& * zecu * (1._wp - umask(ji,jj,1))
165	END IF
166	IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN
167	bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) &
168	& + ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) ) &
169	& * zecv * (1._wp - vmask(ji,jj,1))
170	END IF
171	END IF
172	END DO
173	END DO
174	CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition
175
176	IF ( ln_isfcav ) THEN
177	DO jj = 2, jpjm1
178	DO ji = 2, jpim1
179	! (ISF) ========================================================================
180	ikbu = miku(ji,jj) ! ocean top level at u- and v-points
181	ikbv = mikv(ji,jj) ! (1st wet ocean u- and v-points)
182	!
183	zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) &
184	& + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu) )
185	zuv = 0.25 * ( un(ji,jj ,ikbv) + un(ji-1,jj ,ikbv) &
186	& + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) )
187	!
188	zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_tfeb2 )
189	zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_tfeb2 )
190	!
191	tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) * zecu * (1._wp - umask(ji,jj,1))
192	tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1))
193	! (ISF) END ====================================================================
194	! in case of 2 cell water column, we assume each cell feels the top and bottom friction
195	IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN
196	tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) &
197	& + ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) ) &
198	& * zecu * (1._wp - umask(ji,jj,1))
199	END IF
200	IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN
201	tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) &
202	& + ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) ) &
203	& * zecv * (1._wp - vmask(ji,jj,1))
204	END IF
205	END DO
206	END DO
207	CALL lbc_lnk( tfrua, 'U', 1. ) ; CALL lbc_lnk( tfrva, 'V', 1. ) ! Lateral boundary condition
208	END IF
209	!
210	!
211	IF(ln_ctl) CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr - u: ', mask1=umask, &
212	& tab2d_2=bfrva, clinfo2= ' v: ', mask2=vmask,ovlap=1 )
213	CALL wrk_dealloc( jpi,jpj,zbfrt, ztfrt )
214	ENDIF
215	!
216	IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr')
217	!
218	END SUBROUTINE zdf_bfr
219
220
221	SUBROUTINE zdf_bfr_init
222	!!----------------------------------------------------------------------
223	!! * ROUTINE zdf_bfr_init *
224	!!
225	!! ** Purpose : Initialization of the bottom friction
226	!!
227	!! ** Method : Read the nambfr namelist and check their consistency
228	!! called at the first timestep (nit000)
229	!!----------------------------------------------------------------------
230	USE iom ! I/O module for ehanced bottom friction file
231	!!
232	INTEGER :: inum ! logical unit for enhanced bottom friction file
233	INTEGER :: ji, jj ! dummy loop indexes
234	INTEGER :: ikbt, ikbu, ikbv ! temporary integers
235	INTEGER :: ictu, ictv ! - -
236	INTEGER :: ios
237	REAL(wp) :: zminbfr, zmaxbfr ! temporary scalars
238	REAL(wp) :: zmintfr, zmaxtfr ! temporary scalars
239	REAL(wp) :: ztmp, zfru, zfrv ! - -
240	!!
241	NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfri2_max, rn_bfeb2, rn_bfrz0, ln_bfr2d, &
242	& rn_tfri1, rn_tfri2, rn_tfri2_max, rn_tfeb2, rn_tfrz0, ln_tfr2d, &
243	& rn_bfrien, rn_tfrien, ln_bfrimp, ln_loglayer
244	!!----------------------------------------------------------------------
245	!
246	IF( nn_timing == 1 ) CALL timing_start('zdf_bfr_init')
247	!
248	! !* Allocate zdfbfr arrays
249	IF( zdf_bfr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_bfr_init : unable to allocate arrays' )
250	!
251	! !* Parameter control and print
252	!
253	REWIND( numnam_ref ) ! Namelist nambfr in reference namelist : Bottom momentum boundary condition
254	READ ( numnam_ref, nambfr, IOSTAT = ios, ERR = 901)
255	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in reference namelist', lwp )
256
257	REWIND( numnam_cfg ) ! Namelist nambfr in configuration namelist : Bottom momentum boundary condition
258	READ ( numnam_cfg, nambfr, IOSTAT = ios, ERR = 902 )
259	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in configuration namelist', lwp )
260	IF(lwm .AND. nprint > 2) WRITE ( numond, nambfr )
261	IF(lwp) WRITE(numout,*)
262	IF(lwp) WRITE(numout,*) 'zdf_bfr_init : momentum bottom friction'
263	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
264	IF(lwp) WRITE(numout,*) ' Namelist nam_bfr : set bottom friction parameters'
265	IF(lwp .AND. lflush) CALL flush(numout)
266	!
267	SELECT CASE (nn_bfr)
268	!
269	CASE( 0 )
270	IF(lwp) WRITE(numout,*) ' free-slip '
271	bfrua(:,:) = 0.e0
272	bfrva(:,:) = 0.e0
273	tfrua(:,:) = 0.e0
274	tfrva(:,:) = 0.e0
275	!
276	CASE( 1 )
277	IF(lwp) WRITE(numout,*) ' linear botton friction'
278	IF(lwp) WRITE(numout,*) ' bottom friction coef. rn_bfri1 = ', rn_bfri1
279	IF( ln_bfr2d ) THEN
280	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d
281	IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
282	ENDIF
283	IF ( ln_isfcav ) THEN
284	IF(lwp) WRITE(numout,*) ' top friction coef. rn_bfri1 = ', rn_tfri1
285	IF( ln_tfr2d ) THEN
286	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
287	IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
288	ENDIF
289	END IF
290	!
291	IF(ln_bfr2d) THEN
292	! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
293	CALL iom_open('bfr_coef.nc',inum)
294	CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
295	CALL iom_close(inum)
296	bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
297	ELSE
298	bfrcoef2d(:,:) = rn_bfri1 ! initialize bfrcoef2d to the namelist variable
299	ENDIF
300	!
301	bfrua(:,:) = - bfrcoef2d(:,:)
302	bfrva(:,:) = - bfrcoef2d(:,:)
303	!
304	IF ( ln_isfcav ) THEN
305	IF(ln_tfr2d) THEN
306	! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
307	CALL iom_open('tfr_coef.nc',inum)
308	CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
309	CALL iom_close(inum)
310	tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
311	ELSE
312	tfrcoef2d(:,:) = rn_tfri1 ! initialize tfrcoef2d to the namelist variable
313	ENDIF
314	!
315	tfrua(:,:) = - tfrcoef2d(:,:)
316	tfrva(:,:) = - tfrcoef2d(:,:)
317	END IF
318	!
319	CASE( 2 )
320	IF(lwp) WRITE(numout,*) ' quadratic bottom friction'
321	IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri2 = ', rn_bfri2
322	IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_bfri2_max = ', rn_bfri2_max
323	IF(lwp) WRITE(numout,*) ' background tke rn_bfeb2 = ', rn_bfeb2
324	IF(lwp) WRITE(numout,*) ' log formulation ln_bfr2d = ', ln_loglayer
325	IF(lwp) WRITE(numout,*) ' bottom roughness rn_bfrz0 [m] = ', rn_bfrz0
326	IF( rn_bfrz0<=0.e0 ) THEN
327	WRITE(ctmp1,*) ' bottom roughness must be strictly positive'
328	CALL ctl_stop( ctmp1 )
329	ENDIF
330	IF( ln_bfr2d ) THEN
331	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d
332	IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
333	ENDIF
334	IF ( ln_isfcav ) THEN
335	IF(lwp) WRITE(numout,*) ' quadratic top friction'
336	IF(lwp) WRITE(numout,*) ' friction coef. rn_tfri2 = ', rn_tfri2
337	IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_tfri2_max = ', rn_tfri2_max
338	IF(lwp) WRITE(numout,*) ' background tke rn_tfeb2 = ', rn_tfeb2
339	IF(lwp) WRITE(numout,*) ' log formulation ln_tfr2d = ', ln_loglayer
340	IF(lwp) WRITE(numout,*) ' top roughness rn_tfrz0 [m] = ', rn_tfrz0
341	IF( rn_tfrz0<=0.e0 ) THEN
342	WRITE(ctmp1,*) ' top roughness must be strictly positive'
343	CALL ctl_stop( ctmp1 )
344	ENDIF
345	IF( ln_tfr2d ) THEN
346	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
347	IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
348	ENDIF
349	END IF
350	!
351	IF(ln_bfr2d) THEN
352	! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
353	CALL iom_open('bfr_coef.nc',inum)
354	CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
355	CALL iom_close(inum)
356	!
357	bfrcoef2d(:,:) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
358	ELSE
359	bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable
360	ENDIF
361
362	IF ( ln_isfcav ) THEN
363	IF(ln_tfr2d) THEN
364	! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
365	CALL iom_open('tfr_coef.nc',inum)
366	CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
367	CALL iom_close(inum)
368	!
369	tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
370	ELSE
371	tfrcoef2d(:,:) = rn_tfri2 ! initialize tfrcoef2d to the namelist variable
372	ENDIF
373	END IF
374	!
375	IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all
376	DO jj = 1, jpj
377	DO ji = 1, jpi
378	ikbt = mbkt(ji,jj)
379	ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
380	bfrcoef2d(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
381	bfrcoef2d(ji,jj) = MIN(bfrcoef2d(ji,jj), rn_bfri2_max)
382	END DO
383	END DO
384	IF ( ln_isfcav ) THEN
385	DO jj = 1, jpj
386	DO ji = 1, jpi
387	ikbt = mikt(ji,jj)
388	ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp
389	tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
390	tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max)
391	END DO
392	END DO
393	END IF
394	ENDIF
395	!
396	CASE DEFAULT
397	IF(lwp) WRITE(ctmp1,*) ' bad flag value for nn_bfr = ', nn_bfr
398	CALL ctl_stop( ctmp1 )
399	!
400	END SELECT
401	!
402	IF(lwp) WRITE(numout,*) ' implicit bottom friction switch ln_bfrimp = ', ln_bfrimp
403	IF(lwp .AND. lflush) CALL flush(numout)
404	!
405	! ! Make sure ln_zdfexp=.false. when use implicit bfr
406	IF( ln_bfrimp .AND. ln_zdfexp ) THEN
407	IF(lwp) THEN
408	WRITE(numout,*)
409	WRITE(numout,*) 'Implicit bottom friction can only be used when ln_zdfexp=.false.'
410	WRITE(numout,*) ' but you set: ln_bfrimp=.true. and ln_zdfexp=.true.!!!!'
411	WRITE(ctmp1,*) ' set either ln_zdfexp = .false or ln_bfrimp = .false.'
412	CALL ctl_stop( ctmp1 )
413	END IF
414	END IF
415	!
416	! Basic stability check on bottom friction coefficient
417	!
418	ictu = 0 ! counter for stability criterion breaches at U-pts
419	ictv = 0 ! counter for stability criterion breaches at V-pts
420	zminbfr = 1.e10_wp ! initialise tracker for minimum of bottom friction coefficient
421	zmaxbfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient
422	zmintfr = 1.e10_wp ! initialise tracker for minimum of bottom friction coefficient
423	zmaxtfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient
424	!
425	DO jj = 2, jpjm1
426	DO ji = 2, jpim1
427	ikbu = mbku(ji,jj) ! deepest ocean level at u- and v-points
428	ikbv = mbkv(ji,jj)
429	zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
430	zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
431	IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN
432	IF( ln_ctl ) THEN
433	WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbu
434	WRITE(numout,*) 'BFR ', ABS( bfrcoef2d(ji,jj) ), zfru
435	IF(lflush) CALL flush(numout)
436	ENDIF
437	ictu = ictu + 1
438	ENDIF
439	IF( ABS( bfrcoef2d(ji,jj) ) > zfrv ) THEN
440	IF( ln_ctl ) THEN
441	WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbv
442	WRITE(numout,*) 'BFR ', bfrcoef2d(ji,jj), zfrv
443	IF(lflush) CALL flush(numout)
444	ENDIF
445	ictv = ictv + 1
446	ENDIF
447	zminbfr = MIN( zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) ) )
448	zmaxbfr = MAX( zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) ) )
449	! (ISF)
450	IF ( ln_isfcav ) THEN
451	ikbu = miku(ji,jj) ! 1st wet ocean level at u- and v-points
452	ikbv = mikv(ji,jj)
453	zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
454	zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
455	IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN
456	IF( ln_ctl ) THEN
457	WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu
458	WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru
459	IF(lflush) CALL flush(numout)
460	ENDIF
461	ictu = ictu + 1
462	ENDIF
463	IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN
464	IF( ln_ctl ) THEN
465	WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv
466	WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv
467	IF(lflush) CALL flush(numout)
468	ENDIF
469	ictv = ictv + 1
470	ENDIF
471	zmintfr = MIN( zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) ) )
472	zmaxtfr = MAX( zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) ) )
473	END IF
474	! END ISF
475	END DO
476	END DO
477	IF( lk_mpp ) THEN
478	CALL mpp_sum( ictu )
479	CALL mpp_sum( ictv )
480	CALL mpp_min( zminbfr )
481	CALL mpp_max( zmaxbfr )
482	IF ( ln_isfcav) CALL mpp_min( zmintfr )
483	IF ( ln_isfcav) CALL mpp_max( zmaxtfr )
484	ENDIF
485	IF( .NOT.ln_bfrimp) THEN
486	IF( lwp .AND. ictu + ictv > 0 ) THEN
487	WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' U-points '
488	WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' V-points '
489	WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr
490	IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr
491	WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary'
492	IF(lflush) CALL flush(numout)
493	ENDIF
494	ENDIF
495	!
496	IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr_init')
497	!
498	END SUBROUTINE zdf_bfr_init
499
500	!!======================================================================
501	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/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90 @ 11101

Download in other formats: