Changeset 11394 for branches/UKMO/dev_r5518_GO6_package_FOAMv14_STOPACK/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
- Timestamp:
- 2019-08-02T15:14:02+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_FOAMv14_STOPACK/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r6498 r11394 57 57 USE agrif_opa_update 58 58 #endif 59 60 59 USE stopack 61 60 62 61 IMPLICIT NONE … … 93 92 REAL(wp) :: rhftau_scl = 1.0_wp ! scale factor applied to HF part of taum (nn_etau=3) 94 93 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2] 95 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_lc0, rn_ediff0, rn_ediss0, rn_ebb0, rn_efr0 96 95 97 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 96 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_niw !: TKE budget- near-inertial waves term 97 99 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: efr ! surface boundary condition for nn_etau = 4 98 100 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz 99 103 #if defined key_c1d 100 104 ! !!** 1D cfg only ** ('key_c1d') … … 184 188 avmu(:,:,:) = avmu_k(:,:,:) 185 189 avmv(:,:,:) = avmv_k(:,:,:) 186 ENDIF 190 ENDIF 191 ! 192 IF( nn_spp_tkelc > 0 ) THEN 193 rn_lc0 = rn_lc 194 CALL spp_gen(kt,rn_lc0,nn_spp_tkelc,rn_tkelc_sd, jk_spp_tkelc ) 195 ENDIF 196 IF( nn_spp_tkedf > 0 ) THEN 197 rn_ediff0 = rn_ediff 198 CALL spp_gen(kt,rn_ediff0,nn_spp_tkedf,rn_tkedf_sd, jk_spp_tkedf ) 199 ENDIF 200 IF( nn_spp_tkeds > 0 ) THEN 201 rn_ediss0 = rn_ediss 202 CALL spp_gen(kt,rn_ediss0,nn_spp_tkeds,rn_tkeds_sd, jk_spp_tkeds ) 203 ENDIF 204 IF( nn_spp_tkebb > 0 ) THEN 205 rn_ebb0 = rn_ebb 206 CALL spp_gen(kt,rn_ebb0,nn_spp_tkebb,rn_tkebb_sd, jk_spp_tkebb ) 207 ENDIF 208 IF( nn_spp_tkefr > 0 ) THEN 209 rn_efr0 = rn_efr 210 CALL spp_gen(kt,rn_efr0,nn_spp_tkefr,rn_tkefr_sd, jk_spp_tkefr ) 211 ENDIF 187 212 ! 188 213 CALL tke_tke ! now tke (en) … … 199 224 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 200 225 #endif 201 ! 226 IF ( kt .eq. nitend ) THEN 227 DEALLOCATE ( rn_lc0, rn_ediff0, rn_ediss0, rn_ebb0, rn_efr0 ) 228 ENDIF 229 ! 230 202 231 END SUBROUTINE zdf_tke 203 232 … … 225 254 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 226 255 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 227 REAL(wp) :: z bbrau, zesh2! temporary scalars228 REAL(wp) :: zfact1 , zfact2, zfact3! - -256 REAL(wp) :: zesh2 ! temporary scalars 257 REAL(wp) :: zfact1 ! - - 229 258 REAL(wp) :: ztx2 , zty2 , zcof ! - - 230 259 REAL(wp) :: ztau , zdif ! - - … … 233 262 !!bfr REAL(wp) :: zebot ! - - 234 263 INTEGER , POINTER, DIMENSION(:,: ) :: imlc 235 REAL(wp), POINTER, DIMENSION(:,: ) :: zhlc 264 REAL(wp), POINTER, DIMENSION(:,: ) :: zhlc, zbbrau,zfact2,zfact3 236 265 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw 237 266 !!-------------------------------------------------------------------- … … 240 269 ! 241 270 CALL wrk_alloc( jpi,jpj, imlc ) ! integer 242 CALL wrk_alloc( jpi,jpj, zhlc ) 271 CALL wrk_alloc( jpi,jpj, zhlc ) 272 CALL wrk_alloc( jpi,jpj, zbbrau ) 273 CALL wrk_alloc( jpi,jpj, zfact2 ) 274 CALL wrk_alloc( jpi,jpj, zfact3 ) 243 275 CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 244 276 ! 245 zbbrau = rn_ebb / rau0 ! Local constant initialisation277 zbbrau = rn_ebb0 / rau0 ! Local constant initialisation 246 278 zfact1 = -.5_wp * rdt 247 zfact2 = 1.5_wp * rdt * rn_ediss 248 zfact3 = 0.5_wp * rn_ediss 279 zfact2 = 1.5_wp * rdt * rn_ediss0 280 zfact3 = 0.5_wp * rn_ediss0 249 281 ! 250 282 ! … … 261 293 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 262 294 DO ji = fs_2, fs_jpim1 ! vector opt. 263 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)295 en(ji,jj,1) = MAX( rn_emin0, zbbrau(ji,jj) * taum(ji,jj) ) * tmask(ji,jj,1) 264 296 END DO 265 297 END DO … … 326 358 ! ! vertical velocity due to LC 327 359 zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) ) 328 zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )360 zwlc = zind * rn_lc0(ji,jj) * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 329 361 ! ! TKE Langmuir circulation source term 330 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp -fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) / &362 en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) / & 331 363 & zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 364 332 365 END DO 333 366 END DO … … 380 413 zd_up(ji,jj,jk) = zzd_up ! Matrix (zdiag, zd_up, zd_lw) 381 414 zd_lw(ji,jj,jk) = zzd_lw 382 zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * tmask(ji,jj,jk)415 zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2(ji,jj) * dissl(ji,jj,jk) * tmask(ji,jj,jk) 383 416 ! 384 417 ! ! right hand side in en 385 418 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zesh2 - avt(ji,jj,jk) * rn2(ji,jj,jk) & 386 & + zfact3 * dissl(ji,jj,jk) * en (ji,jj,jk) ) &419 & + zfact3(ji,jj) * dissl(ji,jj,jk) * en (ji,jj,jk) ) & 387 420 & * wmask(ji,jj,jk) 388 421 END DO … … 455 488 DO jj = 2, jpjm1 456 489 DO ji = fs_2, fs_jpim1 ! vector opt. 457 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) &458 & * ( 1._wp -fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)490 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr0(ji,jj) * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) & 491 & * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 459 492 END DO 460 493 END DO … … 464 497 DO ji = fs_2, fs_jpim1 ! vector opt. 465 498 jk = nmln(ji,jj) 466 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) &467 & * ( 1._wp -fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)499 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr0(ji,jj) * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) & 500 & * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 468 501 END DO 469 502 END DO … … 480 513 zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean 481 514 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 482 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) &483 & * ( 1._wp -fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)515 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau(ji,jj) * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) & 516 & * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 484 517 END DO 485 518 END DO … … 516 549 CALL wrk_dealloc( jpi,jpj, imlc ) ! integer 517 550 CALL wrk_dealloc( jpi,jpj, zhlc ) 551 CALL wrk_dealloc( jpi,jpj, zbbrau ) 552 CALL wrk_dealloc( jpi,jpj, zfact2 ) 553 CALL wrk_dealloc( jpi,jpj, zfact3 ) 518 554 CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 519 555 ! … … 698 734 DO ji = fs_2, fs_jpim1 ! vector opt. 699 735 zsqen = SQRT( en(ji,jj,jk) ) 700 zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen736 zav = rn_ediff0(ji,jj) * zmxlm(ji,jj,jk) * zsqen 701 737 avm (ji,jj,jk) = MAX( zav, avmb(jk) ) * wmask(ji,jj,jk) 702 738 avt (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) … … 704 740 END DO 705 741 END DO 742 IF(nn_spp_avt > 0 ) CALL spp_gen(1 ,avt(:,:,jk),nn_spp_avt,rn_avt_sd, jk_spp_avt, jk) 743 IF(nn_spp_avm > 0 ) CALL spp_gen(1 ,avm(:,:,jk),nn_spp_avm,rn_avm_sd, jk_spp_avm, jk) 706 744 END DO 707 745 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) … … 840 878 rn_mxl0 = rmxl_min 841 879 ENDIF 880 881 ALLOCATE( rn_lc0 (jpi,jpj) ) ; rn_lc0 = rn_lc 882 ALLOCATE( rn_ediff0(jpi,jpj) ) ; rn_ediff0 = rn_ediff 883 ALLOCATE( rn_ediss0(jpi,jpj) ) ; rn_ediss0 = rn_ediss 884 ALLOCATE( rn_ebb0 (jpi,jpj) ) ; rn_ebb0 = rn_ebb 885 ALLOCATE( rn_efr0 (jpi,jpj) ) ; rn_efr0 = rn_efr 842 886 843 IF( nn_etau == 2 ) THEN844 ierr = zdf_mxl_alloc()845 nmln(:,:) = nlb10 ! Initialization of nmln846 ENDIF847 887 848 888 IF( nn_etau /= 0 .and. nn_htau == 2 ) THEN … … 950 990 CALL tke_avn ! recompute avt, avm, avmu, avmv and dissl (approximation) 951 991 ! 952 avt_k (:,:,:) = avt (:,:,:)953 avm_k (:,:,:) = avm (:,:,:)954 avmu_k(:,:,:) = avmu(:,:,:)955 avmv_k(:,:,:) = avmv(:,:,:)956 !957 992 DO jit = nit000 + 1, nit000 + 10 ; CALL zdf_tke( jit ) ; END DO 958 993 ENDIF 959 994 ELSE !* Start from rest 960 995 en(:,:,:) = rn_emin * tmask(:,:,:) 961 DO jk = 1, jpk ! set the Kz to the background value962 avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)963 avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)964 avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)965 avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)966 END DO967 996 ENDIF 968 997 ! 998 avt_k (:,:,:) = avt (:,:,:) 999 avm_k (:,:,:) = avm (:,:,:) 1000 avmu_k(:,:,:) = avmu(:,:,:) 1001 avmv_k(:,:,:) = avmv(:,:,:) 1002 969 1003 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 970 1004 ! ! -------------------
Note: See TracChangeset
for help on using the changeset viewer.
