- Timestamp:
- 2014-01-29T15:26:21+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r4147 r4381 13 13 14 14 !!---------------------------------------------------------------------- 15 !! zdf_bfr : update momentum Kz at the ocean bottom due to the type of bottom friction chosen15 !! zdf_bfr : update bottom friction coefficient (non-linear bottom friction only) 16 16 !! zdf_bfr_init : read in namelist and control the bottom friction parameters. 17 !! zdf_bfr_2d : read in namelist and control the bottom friction parameters.18 17 !!---------------------------------------------------------------------- 19 18 USE oce ! ocean dynamics and tracers variables … … 25 24 USE prtctl ! Print control 26 25 USE timing ! Timing 27 26 USE wrk_nemo ! Memory Allocation 28 27 USE phycst, ONLY: vkarmn 29 28 … … 32 31 33 32 PUBLIC zdf_bfr ! called by step.F90 34 PUBLIC zdf_bfr_init ! called by opa.F9033 PUBLIC zdf_bfr_init ! called by nemogcm.F90 35 34 36 35 ! !!* Namelist nambfr: bottom friction namelist * … … 38 37 REAL(wp), PUBLIC :: rn_bfri1 ! bottom drag coefficient (linear case) (PUBLIC for TAM) 39 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 40 REAL(wp), PUBLIC :: rn_bfeb2 ! background bottom turbulent kinetic energy [m2/s2] (PUBLIC for TAM) 41 41 REAL(wp), PUBLIC :: rn_bfrien ! local factor to enhance coefficient bfri (PUBLIC for TAM) … … 43 43 LOGICAL , PUBLIC :: ln_loglayer ! switch for log layer bfr coeff. (PUBLIC for TAM) 44 44 REAL(wp), PUBLIC :: rn_bfrz0 ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM) 45 LOGICAL , PUBLIC :: ln_bfrimp! logical switch for implicit bottom friction45 LOGICAL , PUBLIC :: ln_bfrimp ! logical switch for implicit bottom friction 46 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: bfrcoef2d ! 2D bottom drag coefficient (PUBLIC for TAM) 47 47 … … 86 86 !! 87 87 INTEGER :: ji, jj ! dummy loop indices 88 INTEGER :: ikb u, ikbv! local integers89 REAL(wp) :: zvu, zuv, zecu, zecv 90 REAL(wp) :: ztmp, ztmp1 ! temporary scalars88 INTEGER :: ikbt, ikbu, ikbv ! local integers 89 REAL(wp) :: zvu, zuv, zecu, zecv, ztmp ! temporary scalars 90 REAL(wp), POINTER, DIMENSION(:,:) :: zbfrt 91 91 !!---------------------------------------------------------------------- 92 92 ! 93 93 IF( nn_timing == 1 ) CALL timing_start('zdf_bfr') 94 94 ! 95 IF( nn_bfr == 2 ) THEN ! quadratic botton friction 96 ! Calculate and store the quadratic bottom friction coefficient bfrua and bfrva 97 ! where bfrUa = C_d*SQRT(u_bot^2 + v_bot^2 + e_b) {U=[u,v]} 98 ! from these the trend due to bottom friction: -F_h/e3U can be calculated 99 ! where -F_h/e3U_bot = bfrUa*Ub/e3U_bot {U=[u,v]} 100 ! 101 102 IF(ln_loglayer) THEN ! "log layer" bottom friction coefficient 103 104 ! add 2D-enhancement bottom friction 105 ztmp1 = 1._wp 106 IF(ABS(rn_bfri2) >= 1.e-10 ) THEN 107 ztmp1 = 1._wp / rn_bfri2 108 ELSE 109 CALL ctl_stop( 'rn_bfri2 must not be less than 1.e-10') 110 END IF 95 IF( kt == nit000 .AND. lwp ) THEN 96 WRITE(numout,*) 97 WRITE(numout,*) 'zdf_bfr : Set bottom friction coefficient (non-linear case)' 98 WRITE(numout,*) '~~~~~~~~' 99 ENDIF 100 ! 101 IF( nn_bfr == 2 ) THEN ! quadratic bottom friction only 102 ! 103 CALL wrk_alloc( jpi, jpj, zbfrt ) 104 105 IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient 111 106 112 107 # if defined key_vectopt_loop 113 DO jj = 1, 1 114 DO ji = 1, jpij ! vector opt. (forced unrolling) 108 DO jj = 1, 1 109 !CDIR NOVERRCHK 110 DO ji = 1, jpij ! vector opt. (forced unrolling) 115 111 # else 116 DO jj = 1, jpj 117 DO ji = 1, jpi 112 !CDIR NOVERRCHK 113 DO jj = 1, jpj 114 !CDIR NOVERRCHK 115 DO ji = 1, jpi 118 116 # endif 119 ztmp = 0.5_wp * fse3t(ji,jj,mbkt(ji,jj)) 120 ztmp = max(ztmp, rn_bfrz0 + 1.e-10) 121 bfrcoef2d(ji,jj) = bfrcoef2d(ji,jj) * ztmp1 * & 122 & ( log( ztmp / rn_bfrz0 ) / vkarmn ) ** (-2) 123 END DO 124 END DO 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 ! 125 ELSE 126 zbfrt(:,:) = bfrcoef2d(:,:) 125 127 ENDIF 126 128 … … 146 148 zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 ) 147 149 ! 148 bfrua(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji+1,jj ) ) * zecu149 bfrva(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji ,jj+1) ) * zecv150 bfrua(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) * zecu 151 bfrva(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) * zecv 150 152 END DO 151 153 END DO … … 156 158 IF(ln_ctl) CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr - u: ', mask1=umask, & 157 159 & tab2d_2=bfrva, clinfo2= ' v: ', mask2=vmask,ovlap=1 ) 158 ENDIF159 160 CALL wrk_dealloc( jpi,jpj,zbfrt ) 161 ENDIF 160 162 ! 161 163 IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr') … … 170 172 !! ** Purpose : Initialization of the bottom friction 171 173 !! 172 !! ** Method : Read the nam mbfnamelist and check their consistency173 !! called at the first timestep (nit000)174 !! ** Method : Read the nambfr namelist and check their consistency 175 !! called at the first timestep (nit000) 174 176 !!---------------------------------------------------------------------- 175 177 USE iom ! I/O module for ehanced bottom friction file … … 177 179 INTEGER :: inum ! logical unit for enhanced bottom friction file 178 180 INTEGER :: ji, jj ! dummy loop indexes 179 INTEGER :: ikb u, ikbv ! temporary integers180 INTEGER :: ictu, ictv ! - -181 INTEGER :: ikbt, ikbu, ikbv ! temporary integers 182 INTEGER :: ictu, ictv ! - - 181 183 INTEGER :: ios 182 184 REAL(wp) :: zminbfr, zmaxbfr ! temporary scalars 183 REAL(wp) :: z fru, zfrv! - -184 !! 185 NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bf eb2, rn_bfrz0, ln_bfr2d, &185 REAL(wp) :: ztmp, zfru, zfrv ! - - 186 !! 187 NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfri2_max, rn_bfeb2, rn_bfrz0, ln_bfr2d, & 186 188 & rn_bfrien, ln_bfrimp, ln_loglayer 187 189 !!---------------------------------------------------------------------- 188 190 ! 189 191 IF( nn_timing == 1 ) CALL timing_start('zdf_bfr_init') 192 ! 193 ! !* Allocate zdfbfr arrays 194 IF( zdf_bfr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_bfr_init : unable to allocate arrays' ) 195 ! 196 ! !* Parameter control and print 190 197 ! 191 198 REWIND( numnam_ref ) ! Namelist nambfr in reference namelist : Bottom momentum boundary condition … … 197 204 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in configuration namelist', lwp ) 198 205 WRITE ( numond, nambfr ) 199 200 ! !* Parameter control and print201 206 IF(lwp) WRITE(numout,*) 202 IF(lwp) WRITE(numout,*) 'zdf_bfr : momentum bottom friction'203 IF(lwp) WRITE(numout,*) '~~~~~~~ '207 IF(lwp) WRITE(numout,*) 'zdf_bfr_init : momentum bottom friction' 208 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 204 209 IF(lwp) WRITE(numout,*) ' Namelist nam_bfr : set bottom friction parameters' 205 206 ! ! allocate zdfbfr arrays 207 IF( zdf_bfr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_bfr_init : unable to allocate arrays' ) 208 210 ! 211 SELECT CASE (nn_bfr) 212 ! 213 CASE( 0 ) 214 IF(lwp) WRITE(numout,*) ' free-slip ' 215 bfrua(:,:) = 0.e0 216 bfrva(:,:) = 0.e0 217 ! 218 CASE( 1 ) 219 IF(lwp) WRITE(numout,*) ' linear botton friction' 220 IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri1 = ', rn_bfri1 221 IF( ln_bfr2d ) THEN 222 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d 223 IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien 224 ENDIF 225 ! 226 IF(ln_bfr2d) THEN 227 ! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 228 CALL iom_open('bfr_coef.nc',inum) 229 CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array 230 CALL iom_close(inum) 231 bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 232 ELSE 233 bfrcoef2d(:,:) = rn_bfri1 ! initialize bfrcoef2d to the namelist variable 234 ENDIF 235 ! 236 bfrua(:,:) = - bfrcoef2d(:,:) 237 bfrva(:,:) = - bfrcoef2d(:,:) 238 ! 239 CASE( 2 ) 240 IF(lwp) WRITE(numout,*) ' quadratic bottom friction' 241 IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri2 = ', rn_bfri2 242 IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_bfri2_max = ', rn_bfri2_max 243 IF(lwp) WRITE(numout,*) ' background tke rn_bfeb2 = ', rn_bfeb2 244 IF(lwp) WRITE(numout,*) ' log formulation ln_bfr2d = ', ln_loglayer 245 IF(lwp) WRITE(numout,*) ' bottom roughness rn_bfrz0 [m] = ', rn_bfrz0 246 IF( rn_bfrz0<=0.e0 ) THEN 247 WRITE(ctmp1,*) ' bottom roughness must be strictly positive' 248 CALL ctl_stop( ctmp1 ) 249 ENDIF 250 IF( ln_bfr2d ) THEN 251 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d 252 IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien 253 ENDIF 254 ! 255 IF(ln_bfr2d) THEN 256 ! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 257 CALL iom_open('bfr_coef.nc',inum) 258 CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array 259 CALL iom_close(inum) 260 ! 261 bfrcoef2d(:,:) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 262 ELSE 263 bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable 264 ENDIF 265 ! 266 IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all 267 # if defined key_vectopt_loop 268 DO jj = 1, 1 269 !CDIR NOVERRCHK 270 DO ji = 1, jpij ! vector opt. (forced unrolling) 271 # else 272 !CDIR NOVERRCHK 273 DO jj = 1, jpj 274 !CDIR NOVERRCHK 275 DO ji = 1, jpi 276 # endif 277 ikbt = mbkt(ji,jj) 278 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 279 bfrcoef2d(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) 280 bfrcoef2d(ji,jj) = MIN(bfrcoef2d(ji,jj), rn_bfri2_max) 281 END DO 282 END DO 283 ENDIF 284 ! 285 CASE DEFAULT 286 IF(lwp) WRITE(ctmp1,*) ' bad flag value for nn_bfr = ', nn_bfr 287 CALL ctl_stop( ctmp1 ) 288 ! 289 END SELECT 290 ! 291 IF(lwp) WRITE(numout,*) ' implicit bottom friction switch ln_bfrimp = ', ln_bfrimp 292 ! 209 293 ! ! Make sure ln_zdfexp=.false. when use implicit bfr 210 294 IF( ln_bfrimp .AND. ln_zdfexp ) THEN … … 217 301 END IF 218 302 END IF 219 220 SELECT CASE (nn_bfr)221 !222 CASE( 0 )223 IF(lwp) WRITE(numout,*) ' free-slip '224 bfrua(:,:) = 0.e0225 bfrva(:,:) = 0.e0226 !227 CASE( 1 )228 IF(lwp) WRITE(numout,*) ' linear botton friction'229 IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri1 = ', rn_bfri1230 IF( ln_bfr2d ) THEN231 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d232 IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien233 ENDIF234 !235 bfrcoef2d(:,:) = rn_bfri1 ! initialize bfrcoef2d to the namelist variable236 !237 IF(ln_bfr2d) THEN238 ! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement239 CALL iom_open('bfr_coef.nc',inum)240 CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array241 CALL iom_close(inum)242 bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )243 ENDIF244 bfrua(:,:) = - bfrcoef2d(:,:)245 bfrva(:,:) = - bfrcoef2d(:,:)246 !247 CASE( 2 )248 IF(lwp) WRITE(numout,*) ' quadratic botton friction'249 IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri2 = ', rn_bfri2250 IF(lwp) WRITE(numout,*) ' background tke rn_bfeb2 = ', rn_bfeb2251 IF( ln_bfr2d ) THEN252 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_bfr2d = ', ln_bfr2d253 IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien254 ENDIF255 bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable256 257 !258 IF(ln_bfr2d) THEN259 ! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement260 CALL iom_open('bfr_coef.nc',inum)261 CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array262 CALL iom_close(inum)263 bfrcoef2d(:,:)= rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )264 ENDIF265 !266 CASE DEFAULT267 IF(lwp) WRITE(ctmp1,*) ' bad flag value for nn_bfr = ', nn_bfr268 CALL ctl_stop( ctmp1 )269 !270 END SELECT271 272 IF( nn_bfr /= 2 .AND. ln_loglayer ) THEN273 IF(lwp) THEN274 WRITE(numout,*)275 WRITE(numout,*) 'Loglayer can only be by applied for quadratic bottom friction'276 WRITE(numout,*) 'but you have set: nn_bfr /= 2 and ln_loglayer=.true.!!!!'277 WRITE(ctmp1,*) 'check nn_bfr and ln_loglayer (should be 2 and true)'278 CALL ctl_stop( ctmp1 )279 END IF280 END IF281 282 283 284 IF(lwp) WRITE(numout,*) ' implicit bottom friction switch ln_bfrimp = ', ln_bfrimp285 303 ! 286 304 ! Basic stability check on bottom friction coefficient
Note: See TracChangeset
for help on using the changeset viewer.
