Changeset 6102 for branches/2015/dev_agrif_v3_6_STABLE/NEMOGCM
- Timestamp:
- 2015-12-17T16:48:54+01:00 (8 years ago)
- Location:
- branches/2015/dev_agrif_v3_6_STABLE/NEMOGCM/NEMO
- Files:
-
- 4 edited
-
NST_SRC/agrif_user.F90 (modified) (1 diff)
-
OPA_SRC/ZDF/zdf_oce.F90 (modified) (2 diffs)
-
OPA_SRC/ZDF/zdfgls.F90 (modified) (4 diffs)
-
OPA_SRC/ZDF/zdftke.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_agrif_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r5081 r6102 316 316 ! 317 317 # if defined key_zdftke 318 CALL Agrif_Update_tke(0)318 ! CALL Agrif_Update_tke(0) 319 319 # endif 320 320 ! -
branches/2015/dev_agrif_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r6092 r6102 43 43 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avmu , avmv !: vertical viscosity coef at uw- & vw-pts [m2/s] 44 44 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avm , avt !: vertical viscosity & diffusivity coef at w-pt [m2/s] 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2] 48 45 49 46 !!---------------------------------------------------------------------- 50 47 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 62 59 & avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) , & 63 60 & tfrua(jpi, jpj), tfrva(jpi, jpj) , & 64 & avmu (jpi,jpj,jpk), avm (jpi,jpj,jpk), & 65 & avmv (jpi,jpj,jpk), avt (jpi,jpj,jpk), & 66 & avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk), & 67 & avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk), & 68 & en (jpi,jpj,jpk), STAT = zdf_oce_alloc ) 61 & avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk) , & 62 & avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk) , STAT = zdf_oce_alloc ) 69 63 ! 70 64 IF( zdf_oce_alloc /= 0 ) CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') -
branches/2015/dev_agrif_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r6092 r6102 42 42 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 43 43 ! 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy 44 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 45 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k ! not enhanced Kz 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avm_k ! not enhanced Kz 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k ! not enhanced Kz 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmv_k ! not enhanced Kz 46 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustars2 !: Squared surface velocity scale at T-points 47 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustarb2 !: Squared bottom velocity scale at T-points … … 115 120 !! *** FUNCTION zdf_gls_alloc *** 116 121 !!---------------------------------------------------------------------- 117 ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 122 ALLOCATE( en(jpi,jpj,jpk), mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 123 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 124 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), & 118 125 & ustars2(jpi,jpj), ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 119 126 ! … … 322 329 ! 323 330 ! One level below 324 en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2))/zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp) 331 en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2)) & 332 & / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp) 325 333 en(:,:,2) = MAX(en(:,:,2), rn_emin ) 326 334 z_elem_a(:,:,2) = 0._wp … … 343 351 z_elem_a(:,:,2) = 0._wp 344 352 zkar(:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:)) )) 345 zflxs(:,:) = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) * ((zhsro(:,:)+fsdept(:,:,1))/zhsro(:,:) )**(1.5_wp*ra_sf) 353 zflxs(:,:) = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) & 354 & * ((zhsro(:,:)+fsdept(:,:,1))/zhsro(:,:) )**(1.5_wp*ra_sf) 346 355 347 356 en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2) -
branches/2015/dev_agrif_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r6099 r6102 53 53 USE timing ! Timing 54 54 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 55 #if defined key_agrif56 USE agrif_opa_interp57 USE agrif_opa_update58 #endif59 55 60 56 IMPLICIT NONE … … 89 85 REAL(wp) :: rhftau_scl = 1.0_wp ! scale factor applied to HF part of taum (nn_etau=3) 90 86 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2] 91 88 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 92 89 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 93 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: apdlr ! now mixing lenght of dissipation 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz 94 92 #if defined key_c1d 95 93 ! !!** 1D cfg only ** ('key_c1d') … … 102 100 # include "vectopt_loop_substitute.h90" 103 101 !!---------------------------------------------------------------------- 104 !! NEMO/OPA 3.6, NEMO Consortium (2011)102 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 105 103 !! $Id$ 106 104 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 117 115 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 118 116 #endif 119 & apdlr(jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 120 & STAT= zdf_tke_alloc ) 117 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 118 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 119 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc ) 121 120 ! 122 121 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) … … 174 173 !!---------------------------------------------------------------------- 175 174 ! 176 #if defined key_agrif177 ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2)178 IF( .NOT.Agrif_Root() ) CALL Agrif_Tke179 #endif180 !181 175 IF( kt /= nit000 ) THEN ! restore before value to compute tke 182 176 avt (:,:,:) = avt_k (:,:,:) … … 195 189 avmv_k(:,:,:) = avmv(:,:,:) 196 190 ! 197 #if defined key_agrif 198 ! Update child grid f => parent grid 199 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 200 #endif 201 ! 202 END SUBROUTINE zdf_tke 191 END SUBROUTINE zdf_tke 203 192 204 193 … … 234 223 INTEGER , POINTER, DIMENSION(:,: ) :: imlc 235 224 REAL(wp), POINTER, DIMENSION(:,: ) :: zhlc 236 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw, z3du, z3dv 237 REAL(wp) :: zri ! local Richardson number 225 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw 238 226 !!-------------------------------------------------------------------- 239 227 ! … … 242 230 CALL wrk_alloc( jpi,jpj, imlc ) ! integer 243 231 CALL wrk_alloc( jpi,jpj, zhlc ) 244 CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw , z3du, z3dv)232 CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 245 233 ! 246 234 zbbrau = rn_ebb / rau0 ! Local constant initialisation … … 344 332 ! 345 333 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 346 DO jj = 1, jpjm1 347 DO ji = 1, fs_jpim1 ! vector opt. 348 z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk ) + avm(ji+1,jj,jk) ) & 349 & * ( un(ji,jj,jk-1) - un(ji ,jj,jk) ) & 350 & * ( ub(ji,jj,jk-1) - ub(ji ,jj,jk) ) * wumask(ji,jj,jk) & 351 & / ( fse3uw_n(ji,jj,jk) * fse3uw_b(ji,jj,jk) ) 352 z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk ) + avm(ji,jj+1,jk) ) & 353 & * ( vn(ji,jj,jk-1) - vn(ji,jj ,jk) ) & 354 & * ( vb(ji,jj,jk-1) - vb(ji,jj ,jk) ) * wvmask(ji,jj,jk) & 355 & / ( fse3vw_n(ji,jj,jk) * fse3vw_b(ji,jj,jk) ) 356 END DO 357 END DO 358 END DO 359 ! 360 IF( nn_pdl == 1 ) THEN !* Prandtl number case: compute apdlr 361 ! Note that zesh2 is also computed in the next loop. 362 ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops 363 DO jk = 2, jpkm1 364 DO jj = 2, jpjm1 365 DO ji = fs_2, fs_jpim1 ! vector opt. 366 ! ! shear prod. at w-point weightened by mask 367 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 368 & + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 369 ! ! local Richardson number 370 zri = MAX( rn2b(ji,jj,jk), 0._wp ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear ) 371 apdlr(ji,jj,jk) = MAX( 0.1_wp, ri_cri / MAX( ri_cri , zri ) ) 372 373 END DO 374 END DO 375 END DO 376 ! 377 ENDIF 378 ! 334 DO jj = 1, jpj ! here avmu, avmv used as workspace 335 DO ji = 1, jpi 336 avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) & 337 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) & 338 & / ( fse3uw_n(ji,jj,jk) & 339 & * fse3uw_b(ji,jj,jk) ) 340 avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) & 341 & * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) & 342 & / ( fse3vw_n(ji,jj,jk) & 343 & * fse3vw_b(ji,jj,jk) ) 344 END DO 345 END DO 346 END DO 347 ! 379 348 DO jk = 2, jpkm1 !* Matrix and right hand side in en 380 349 DO jj = 2, jpjm1 … … 385 354 zzd_lw = zcof * ( avm (ji,jj,jk ) + avm (ji,jj,jk-1) ) & ! lower diagonal 386 355 & / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk ) ) 387 !! shear prod. at w-point weightened by mask388 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) &389 & + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )390 !356 ! ! shear prod. at w-point weightened by mask 357 zesh2 = ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 358 & + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 359 ! 391 360 zd_up(ji,jj,jk) = zzd_up ! Matrix (zdiag, zd_up, zd_lw) 392 361 zd_lw(ji,jj,jk) = zzd_lw … … 486 455 CALL wrk_dealloc( jpi,jpj, imlc ) ! integer 487 456 CALL wrk_dealloc( jpi,jpj, zhlc ) 488 CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw , z3du, z3dv)457 CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 489 458 ! 490 459 IF( nn_timing == 1 ) CALL timing_stop('tke_tke') … … 530 499 INTEGER :: ji, jj, jk ! dummy loop indices 531 500 REAL(wp) :: zrn2, zraug, zcoef, zav ! local scalars 532 REAL(wp) :: zdku, z ri, zsqen ! - -501 REAL(wp) :: zdku, zpdlr, zri, zsqen ! - - 533 502 REAL(wp) :: zdkv, zemxl, zemlm, zemlp ! - - 534 503 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld … … 691 660 DO jj = 2, jpjm1 692 661 DO ji = fs_2, fs_jpim1 ! vector opt. 693 avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 662 zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 663 ! ! shear 664 zdku = avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) * ( ub(ji-1,jj,jk-1) - ub(ji-1,jj,jk) ) & 665 & + avmu(ji ,jj,jk) * ( un(ji ,jj,jk-1) - un(ji ,jj,jk) ) * ( ub(ji ,jj,jk-1) - ub(ji ,jj,jk) ) 666 zdkv = avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) * ( vb(ji,jj-1,jk-1) - vb(ji,jj-1,jk) ) & 667 & + avmv(ji,jj ,jk) * ( vn(ji,jj ,jk-1) - vn(ji,jj ,jk) ) * ( vb(ji,jj ,jk-1) - vb(ji,jj ,jk) ) 668 ! ! local Richardson number 669 zri = MAX( rn2b(ji,jj,jk), 0._wp ) * zcoef / (zdku + zdkv + rn_bshear ) 670 zpdlr = MAX( 0.1_wp, 0.2 / MAX( 0.2 , zri ) ) 671 !!gm and even better with the use of the "true" ri_crit=0.22222... (this change the results!) 672 !!gm zpdlr = MAX( 0.1_wp, ri_crit / MAX( ri_crit , zri ) ) 673 avt(ji,jj,jk) = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 694 674 # if defined key_c1d 695 e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * tmask(ji,jj,jk)! c1d configuration : save masked Prandlt number696 e_ric(ji,jj,jk) = zri * tmask(ji,jj,jk)! c1d config. : save Ri675 e_pdl(ji,jj,jk) = zpdlr * wmask(ji,jj,jk) ! c1d configuration : save masked Prandlt number 676 e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk) ! c1d config. : save Ri 697 677 # endif 698 678 END DO
Note: See TracChangeset
for help on using the changeset viewer.
