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/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/ZDF – NEMO

Context Navigation

source: branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90 @ 4666

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

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

Download in other formats: