Context Navigation

zdfbfr.F90 @ 9383

Last change on this file since 9383 was 9383, checked in by andmirek, 6 years ago
#2050 fixes and changes
File size: 26.2 KB

Rev	Line
[3]	1	MODULE zdfbfr
	2	!!======================================================================
	3	!! * MODULE zdfbfr *
	4	!! Ocean physics: Bottom friction
	5	!!======================================================================
[1662]	6	!! History : OPA ! 1997-06 (G. Madec, A.-M. Treguier) Original code
[1601]	7	!! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module
[1708]	8	!! 3.2 ! 2009-09 (A.C.Coward) Correction to include barotropic contribution
[2528]	9	!! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
[3633]	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
[1601]	12	!!----------------------------------------------------------------------
[3]	13
	14	!!----------------------------------------------------------------------
[4381]	15	!! zdf_bfr : update bottom friction coefficient (non-linear bottom friction only)
[1601]	16	!! zdf_bfr_init : read in namelist and control the bottom friction parameters.
[3]	17	!!----------------------------------------------------------------------
	18	USE oce ! ocean dynamics and tracers variables
[3764]	19	USE dom_oce ! ocean space and time domain variables
[3]	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)
[1671]	23	USE lib_mpp ! distributed memory computing
[258]	24	USE prtctl ! Print control
[3294]	25	USE timing ! Timing
[4381]	26	USE wrk_nemo ! Memory Allocation
[3633]	27	USE phycst, ONLY: vkarmn
	28
[3]	29	IMPLICIT NONE
	30	PRIVATE
	31
[2528]	32	PUBLIC zdf_bfr ! called by step.F90
[4381]	33	PUBLIC zdf_bfr_init ! called by nemogcm.F90
[9366]	34	PRIVATE bfr_namelist
[2715]	35
[4147]	36	! !!* Namelist nambfr: bottom friction namelist *
	37	INTEGER , PUBLIC :: nn_bfr ! = 0/1/2/3 type of bottom friction (PUBLIC for TAM)
	38	REAL(wp), PUBLIC :: rn_bfri1 ! bottom drag coefficient (linear case) (PUBLIC for TAM)
	39	REAL(wp), PUBLIC :: rn_bfri2 ! bottom drag coefficient (non linear case) (PUBLIC for TAM)
[4381]	40	REAL(wp), PUBLIC :: rn_bfri2_max ! Maximum bottom drag coefficient (non linear case and ln_loglayer=T) (PUBLIC for TAM)
[4147]	41	REAL(wp), PUBLIC :: rn_bfeb2 ! background bottom turbulent kinetic energy [m2/s2] (PUBLIC for TAM)
	42	REAL(wp), PUBLIC :: rn_bfrien ! local factor to enhance coefficient bfri (PUBLIC for TAM)
	43	LOGICAL , PUBLIC :: ln_bfr2d ! logical switch for 2D enhancement (PUBLIC for TAM)
[4990]	44	REAL(wp), PUBLIC :: rn_tfri1 ! top drag coefficient (linear case) (PUBLIC for TAM)
	45	REAL(wp), PUBLIC :: rn_tfri2 ! top drag coefficient (non linear case) (PUBLIC for TAM)
	46	REAL(wp), PUBLIC :: rn_tfri2_max ! Maximum top drag coefficient (non linear case and ln_loglayer=T) (PUBLIC for TAM)
	47	REAL(wp), PUBLIC :: rn_tfeb2 ! background top turbulent kinetic energy [m2/s2] (PUBLIC for TAM)
	48	REAL(wp), PUBLIC :: rn_tfrien ! local factor to enhance coefficient tfri (PUBLIC for TAM)
	49	LOGICAL , PUBLIC :: ln_tfr2d ! logical switch for 2D enhancement (PUBLIC for TAM)
	50
[4147]	51	LOGICAL , PUBLIC :: ln_loglayer ! switch for log layer bfr coeff. (PUBLIC for TAM)
	52	REAL(wp), PUBLIC :: rn_bfrz0 ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM)
[4990]	53	REAL(wp), PUBLIC :: rn_tfrz0 ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM)
[4381]	54	LOGICAL , PUBLIC :: ln_bfrimp ! logical switch for implicit bottom friction
[4990]	55	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: bfrcoef2d, tfrcoef2d ! 2D bottom/top drag coefficient (PUBLIC for TAM)
[3]	56
	57	!! * Substitutions
[2528]	58	# include "vectopt_loop_substitute.h90"
[3]	59	# include "domzgr_substitute.h90"
	60	!!----------------------------------------------------------------------
[2715]	61	!! NEMO/OPA 4.0 , NEMO Consortium (2011)
[2528]	62	!! $Id$
	63	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	64	!!----------------------------------------------------------------------
	65	CONTAINS
	66
[2715]	67	INTEGER FUNCTION zdf_bfr_alloc()
	68	!!----------------------------------------------------------------------
	69	!! * FUNCTION zdf_bfr_alloc *
	70	!!----------------------------------------------------------------------
[4990]	71	ALLOCATE( bfrcoef2d(jpi,jpj), tfrcoef2d(jpi,jpj), STAT=zdf_bfr_alloc )
[2715]	72	!
	73	IF( lk_mpp ) CALL mpp_sum ( zdf_bfr_alloc )
	74	IF( zdf_bfr_alloc /= 0 ) CALL ctl_warn('zdf_bfr_alloc: failed to allocate arrays.')
	75	END FUNCTION zdf_bfr_alloc
	76
	77
[3]	78	SUBROUTINE zdf_bfr( kt )
	79	!!----------------------------------------------------------------------
	80	!! * ROUTINE zdf_bfr *
[3764]	81	!!
[1708]	82	!! ** Purpose : compute the bottom friction coefficient.
[3]	83	!!
[3764]	84	!! ** Method : Calculate and store part of the momentum trend due
	85	!! to bottom friction following the chosen friction type
[1662]	86	!! (free-slip, linear, or quadratic). The component
	87	!! calculated here is multiplied by the bottom velocity in
	88	!! dyn_bfr to provide the trend term.
[1708]	89	!! The coefficients are updated at each time step only
	90	!! in the quadratic case.
[1662]	91	!!
	92	!! ** Action : bfrua , bfrva bottom friction coefficients
[3]	93	!!----------------------------------------------------------------------
	94	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[1601]	95	!!
[3633]	96	INTEGER :: ji, jj ! dummy loop indices
[4381]	97	INTEGER :: ikbt, ikbu, ikbv ! local integers
	98	REAL(wp) :: zvu, zuv, zecu, zecv, ztmp ! temporary scalars
[4990]	99	REAL(wp), POINTER, DIMENSION(:,:) :: zbfrt, ztfrt
[3]	100	!!----------------------------------------------------------------------
[3294]	101	!
	102	IF( nn_timing == 1 ) CALL timing_start('zdf_bfr')
	103	!
[4381]	104	IF( kt == nit000 .AND. lwp ) THEN
	105	WRITE(numout,*)
	106	WRITE(numout,*) 'zdf_bfr : Set bottom friction coefficient (non-linear case)'
	107	WRITE(numout,*) '~~~~~~~~'
	108	ENDIF
	109	!
	110	IF( nn_bfr == 2 ) THEN ! quadratic bottom friction only
[1662]	111	!
[4990]	112	CALL wrk_alloc( jpi, jpj, zbfrt, ztfrt )
[3633]	113
[4381]	114	IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient
[3820]	115
[4381]	116	DO jj = 1, jpj
	117	DO ji = 1, jpi
	118	ikbt = mbkt(ji,jj)
[4990]	119	!! JC: possible WAD implementation should modify line below if layers vanish
[4381]	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)
[5120]	123	END DO
	124	END DO
[4990]	125	! (ISF)
[5120]	126	IF ( ln_isfcav ) THEN
	127	DO jj = 1, jpj
	128	DO ji = 1, jpi
	129	ikbt = mikt(ji,jj)
[4990]	130	! JC: possible WAD implementation should modify line below if layers vanish
[5120]	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
[4381]	135	END DO
[5120]	136	END IF
[4381]	137	!
	138	ELSE
	139	zbfrt(:,:) = bfrcoef2d(:,:)
[4990]	140	ztfrt(:,:) = tfrcoef2d(:,:)
[3633]	141	ENDIF
	142
[3]	143	DO jj = 2, jpjm1
	144	DO ji = 2, jpim1
[3764]	145	ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points
[2528]	146	ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points)
[1662]	147	!
[2528]	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) )
[1662]	152	!
[2528]	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 )
[1662]	155	!
[4381]	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
[4990]	158	!
	159	! in case of 2 cell water column, we assume each cell feels the top and bottom friction
[5120]	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
[4990]	171	END IF
[3]	172	END DO
	173	END DO
[5332]	174	CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition
	175
[5120]	176	IF ( ln_isfcav ) THEN
	177	DO jj = 2, jpjm1
	178	DO ji = 2, jpim1
	179	! (ISF) ========================================================================
[5332]	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)
[5120]	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	!
[5332]	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 )
[5120]	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
[5332]	207	CALL lbc_lnk( tfrua, 'U', 1. ) ; CALL lbc_lnk( tfrva, 'V', 1. ) ! Lateral boundary condition
[5120]	208	END IF
[1601]	209	!
[1708]	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 )
[4990]	213	CALL wrk_dealloc( jpi,jpj,zbfrt, ztfrt )
[1662]	214	ENDIF
	215	!
[3294]	216	IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr')
	217	!
[3]	218	END SUBROUTINE zdf_bfr
	219
	220
	221	SUBROUTINE zdf_bfr_init
	222	!!----------------------------------------------------------------------
	223	!! * ROUTINE zdf_bfr_init *
[3764]	224	!!
[3]	225	!! ** Purpose : Initialization of the bottom friction
	226	!!
[4381]	227	!! ** Method : Read the nambfr namelist and check their consistency
	228	!! called at the first timestep (nit000)
[3]	229	!!----------------------------------------------------------------------
[1662]	230	USE iom ! I/O module for ehanced bottom friction file
	231	!!
[3633]	232	INTEGER :: inum ! logical unit for enhanced bottom friction file
	233	INTEGER :: ji, jj ! dummy loop indexes
[4381]	234	INTEGER :: ikbt, ikbu, ikbv ! temporary integers
	235	INTEGER :: ictu, ictv ! - -
[4147]	236	INTEGER :: ios
[3633]	237	REAL(wp) :: zminbfr, zmaxbfr ! temporary scalars
[4990]	238	REAL(wp) :: zmintfr, zmaxtfr ! temporary scalars
[4381]	239	REAL(wp) :: ztmp, zfru, zfrv ! - -
[1708]	240	!!
[4381]	241	NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfri2_max, rn_bfeb2, rn_bfrz0, ln_bfr2d, &
[4990]	242	& rn_tfri1, rn_tfri2, rn_tfri2_max, rn_tfeb2, rn_tfrz0, ln_tfr2d, &
	243	& rn_bfrien, rn_tfrien, ln_bfrimp, ln_loglayer
[3]	244	!!----------------------------------------------------------------------
[3294]	245	!
	246	IF( nn_timing == 1 ) CALL timing_start('zdf_bfr_init')
	247	!
[4381]	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	!
[9366]	253	IF(lwm) THEN
	254	REWIND( numnam_ref ) ! Namelist nambfr in reference namelist : Bottom momentum boundary condition
	255	READ ( numnam_ref, nambfr, IOSTAT = ios, ERR = 901)
[9383]	256	901 CONTINUE
	257	ENDIF
	258	call mpp_bcast(ios)
	259	IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in reference namelist', lwp )
	260	IF(lwm) THEN
[9366]	261	REWIND( numnam_cfg ) ! Namelist nambfr in configuration namelist : Bottom momentum boundary condition
	262	READ ( numnam_cfg, nambfr, IOSTAT = ios, ERR = 902 )
[9383]	263	902 CONTINUE
[9366]	264	ENDIF
[9383]	265	call mpp_bcast(ios)
	266	IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in configuration namelist', lwp )
	267
[9366]	268	IF(lwm) WRITE ( numond, nambfr )
[3]	269
[9366]	270	CALL bfr_namelist() ! Broadcast namelist
	271
[1662]	272	IF(lwp) WRITE(numout,*)
[4381]	273	IF(lwp) WRITE(numout,*) 'zdf_bfr_init : momentum bottom friction'
	274	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
[1708]	275	IF(lwp) WRITE(numout,*) ' Namelist nam_bfr : set bottom friction parameters'
[4381]	276	!
[1662]	277	SELECT CASE (nn_bfr)
[2715]	278	!
[3]	279	CASE( 0 )
[1708]	280	IF(lwp) WRITE(numout,*) ' free-slip '
[1662]	281	bfrua(:,:) = 0.e0
	282	bfrva(:,:) = 0.e0
[4990]	283	tfrua(:,:) = 0.e0
	284	tfrva(:,:) = 0.e0
[1662]	285	!
[3]	286	CASE( 1 )
[1708]	287	IF(lwp) WRITE(numout,*) ' linear botton friction'
[4990]	288	IF(lwp) WRITE(numout,*) ' bottom friction coef. rn_bfri1 = ', rn_bfri1
[1708]	289	IF( ln_bfr2d ) THEN
	290	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d
	291	IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
[1662]	292	ENDIF
[5332]	293	IF ( ln_isfcav ) THEN
	294	IF(lwp) WRITE(numout,*) ' top friction coef. rn_bfri1 = ', rn_tfri1
	295	IF( ln_tfr2d ) THEN
	296	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
	297	IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
	298	ENDIF
	299	END IF
[1601]	300	!
[3764]	301	IF(ln_bfr2d) THEN
[1662]	302	! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
	303	CALL iom_open('bfr_coef.nc',inum)
	304	CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
	305	CALL iom_close(inum)
[2715]	306	bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
[4381]	307	ELSE
	308	bfrcoef2d(:,:) = rn_bfri1 ! initialize bfrcoef2d to the namelist variable
[1662]	309	ENDIF
[4381]	310	!
[1662]	311	bfrua(:,:) = - bfrcoef2d(:,:)
	312	bfrva(:,:) = - bfrcoef2d(:,:)
	313	!
[5332]	314	IF ( ln_isfcav ) THEN
	315	IF(ln_tfr2d) THEN
	316	! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
	317	CALL iom_open('tfr_coef.nc',inum)
	318	CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
	319	CALL iom_close(inum)
	320	tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
	321	ELSE
	322	tfrcoef2d(:,:) = rn_tfri1 ! initialize tfrcoef2d to the namelist variable
	323	ENDIF
	324	!
	325	tfrua(:,:) = - tfrcoef2d(:,:)
	326	tfrva(:,:) = - tfrcoef2d(:,:)
	327	END IF
	328	!
[3]	329	CASE( 2 )
[4381]	330	IF(lwp) WRITE(numout,*) ' quadratic bottom friction'
[1708]	331	IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri2 = ', rn_bfri2
[4381]	332	IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_bfri2_max = ', rn_bfri2_max
[1708]	333	IF(lwp) WRITE(numout,*) ' background tke rn_bfeb2 = ', rn_bfeb2
[4381]	334	IF(lwp) WRITE(numout,*) ' log formulation ln_bfr2d = ', ln_loglayer
	335	IF(lwp) WRITE(numout,*) ' bottom roughness rn_bfrz0 [m] = ', rn_bfrz0
	336	IF( rn_bfrz0<=0.e0 ) THEN
	337	WRITE(ctmp1,*) ' bottom roughness must be strictly positive'
	338	CALL ctl_stop( ctmp1 )
	339	ENDIF
[1708]	340	IF( ln_bfr2d ) THEN
	341	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d
	342	IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
[1662]	343	ENDIF
[5332]	344	IF ( ln_isfcav ) THEN
	345	IF(lwp) WRITE(numout,*) ' quadratic top friction'
	346	IF(lwp) WRITE(numout,*) ' friction coef. rn_tfri2 = ', rn_tfri2
	347	IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_tfri2_max = ', rn_tfri2_max
	348	IF(lwp) WRITE(numout,*) ' background tke rn_tfeb2 = ', rn_tfeb2
	349	IF(lwp) WRITE(numout,*) ' log formulation ln_tfr2d = ', ln_loglayer
	350	IF(lwp) WRITE(numout,*) ' top roughness rn_tfrz0 [m] = ', rn_tfrz0
	351	IF( rn_tfrz0<=0.e0 ) THEN
	352	WRITE(ctmp1,*) ' top roughness must be strictly positive'
	353	CALL ctl_stop( ctmp1 )
	354	ENDIF
	355	IF( ln_tfr2d ) THEN
	356	IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
	357	IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
	358	ENDIF
	359	END IF
[1708]	360	!
[3764]	361	IF(ln_bfr2d) THEN
[1662]	362	! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
	363	CALL iom_open('bfr_coef.nc',inum)
	364	CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
	365	CALL iom_close(inum)
[4381]	366	!
	367	bfrcoef2d(:,:) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
	368	ELSE
	369	bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable
[1662]	370	ENDIF
[5332]	371
	372	IF ( ln_isfcav ) THEN
	373	IF(ln_tfr2d) THEN
	374	! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
	375	CALL iom_open('tfr_coef.nc',inum)
	376	CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
	377	CALL iom_close(inum)
	378	!
	379	tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
	380	ELSE
	381	tfrcoef2d(:,:) = rn_tfri2 ! initialize tfrcoef2d to the namelist variable
	382	ENDIF
	383	END IF
[1601]	384	!
[4381]	385	IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all
	386	DO jj = 1, jpj
	387	DO ji = 1, jpi
	388	ikbt = mbkt(ji,jj)
	389	ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
	390	bfrcoef2d(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
	391	bfrcoef2d(ji,jj) = MIN(bfrcoef2d(ji,jj), rn_bfri2_max)
	392	END DO
	393	END DO
[5332]	394	IF ( ln_isfcav ) THEN
	395	DO jj = 1, jpj
	396	DO ji = 1, jpi
	397	ikbt = mikt(ji,jj)
	398	ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp
	399	tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
	400	tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max)
	401	END DO
	402	END DO
	403	END IF
[4381]	404	ENDIF
	405	!
[3]	406	CASE DEFAULT
[1708]	407	IF(lwp) WRITE(ctmp1,*) ' bad flag value for nn_bfr = ', nn_bfr
[474]	408	CALL ctl_stop( ctmp1 )
[1601]	409	!
[3]	410	END SELECT
[4381]	411	!
	412	IF(lwp) WRITE(numout,*) ' implicit bottom friction switch ln_bfrimp = ', ln_bfrimp
	413	!
	414	! ! Make sure ln_zdfexp=.false. when use implicit bfr
	415	IF( ln_bfrimp .AND. ln_zdfexp ) THEN
[3820]	416	IF(lwp) THEN
	417	WRITE(numout,*)
[4381]	418	WRITE(numout,*) 'Implicit bottom friction can only be used when ln_zdfexp=.false.'
	419	WRITE(numout,*) ' but you set: ln_bfrimp=.true. and ln_zdfexp=.true.!!!!'
	420	WRITE(ctmp1,*) ' set either ln_zdfexp = .false or ln_bfrimp = .false.'
[3820]	421	CALL ctl_stop( ctmp1 )
	422	END IF
	423	END IF
[1601]	424	!
[1662]	425	! Basic stability check on bottom friction coefficient
	426	!
	427	ictu = 0 ! counter for stability criterion breaches at U-pts
	428	ictv = 0 ! counter for stability criterion breaches at V-pts
[1708]	429	zminbfr = 1.e10_wp ! initialise tracker for minimum of bottom friction coefficient
	430	zmaxbfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient
[4990]	431	zmintfr = 1.e10_wp ! initialise tracker for minimum of bottom friction coefficient
	432	zmaxtfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient
[1662]	433	!
	434	DO jj = 2, jpjm1
	435	DO ji = 2, jpim1
[2528]	436	ikbu = mbku(ji,jj) ! deepest ocean level at u- and v-points
	437	ikbv = mbkv(ji,jj)
	438	zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
	439	zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
[1708]	440	IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN
	441	IF( ln_ctl ) THEN
[2528]	442	WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbu
	443	WRITE(numout,*) 'BFR ', ABS( bfrcoef2d(ji,jj) ), zfru
[1662]	444	ENDIF
	445	ictu = ictu + 1
	446	ENDIF
[1708]	447	IF( ABS( bfrcoef2d(ji,jj) ) > zfrv ) THEN
	448	IF( ln_ctl ) THEN
	449	WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbv
	450	WRITE(numout,*) 'BFR ', bfrcoef2d(ji,jj), zfrv
[1662]	451	ENDIF
	452	ictv = ictv + 1
	453	ENDIF
[1708]	454	zminbfr = MIN( zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) ) )
	455	zmaxbfr = MAX( zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) ) )
[5332]	456	! (ISF)
	457	IF ( ln_isfcav ) THEN
	458	ikbu = miku(ji,jj) ! 1st wet ocean level at u- and v-points
	459	ikbv = mikv(ji,jj)
	460	zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
	461	zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
	462	IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN
	463	IF( ln_ctl ) THEN
	464	WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu
	465	WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru
	466	ENDIF
	467	ictu = ictu + 1
	468	ENDIF
	469	IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN
	470	IF( ln_ctl ) THEN
	471	WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv
	472	WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv
	473	ENDIF
	474	ictv = ictv + 1
	475	ENDIF
	476	zmintfr = MIN( zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) ) )
	477	zmaxtfr = MAX( zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) ) )
	478	END IF
	479	! END ISF
[1662]	480	END DO
	481	END DO
[1708]	482	IF( lk_mpp ) THEN
[1662]	483	CALL mpp_sum( ictu )
	484	CALL mpp_sum( ictv )
[1708]	485	CALL mpp_min( zminbfr )
	486	CALL mpp_max( zmaxbfr )
[5332]	487	IF ( ln_isfcav) CALL mpp_min( zmintfr )
	488	IF ( ln_isfcav) CALL mpp_max( zmaxtfr )
[1662]	489	ENDIF
[3294]	490	IF( .NOT.ln_bfrimp) THEN
[2528]	491	IF( lwp .AND. ictu + ictv > 0 ) THEN
[5332]	492	WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' U-points '
	493	WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' V-points '
[1708]	494	WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr
[5332]	495	IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr
	496	WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary'
[1662]	497	ENDIF
[3294]	498	ENDIF
[1662]	499	!
[3294]	500	IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr_init')
	501	!
[3]	502	END SUBROUTINE zdf_bfr_init
	503
[9366]	504	SUBROUTINE bfr_namelist()
	505	!!---------------------------------------------------------------------
	506	!! * ROUTINE zdf_namelist *
	507	!!
	508	!! ** Purpose : Broadcast namelist variables read by procesor lwm
	509	!!
	510	!! ** Method : use lib_mpp
	511	!!----------------------------------------------------------------------
	512	#if defined key_mpp_mpi
	513	CALL mpp_bcast(nn_bfr)
	514	CALL mpp_bcast(rn_bfri1)
	515	CALL mpp_bcast(rn_bfri2)
	516	CALL mpp_bcast(rn_bfri2_max)
	517	CALL mpp_bcast(rn_bfeb2)
	518	CALL mpp_bcast(rn_bfrz0)
	519	CALL mpp_bcast(ln_bfr2d)
	520	CALL mpp_bcast(rn_tfri1)
	521	CALL mpp_bcast(rn_tfri2)
	522	CALL mpp_bcast(rn_tfri2_max)
	523	CALL mpp_bcast(rn_tfeb2)
	524	CALL mpp_bcast(rn_tfrz0)
	525	CALL mpp_bcast(ln_tfr2d)
	526	CALL mpp_bcast(rn_bfrien)
	527	CALL mpp_bcast(rn_tfrien)
	528	CALL mpp_bcast(ln_bfrimp)
	529	CALL mpp_bcast(ln_loglayer)
	530	#endif
	531	END SUBROUTINE bfr_namelist
[3]	532	!!======================================================================
	533	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/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90 @ 9383

Download in other formats: