- Timestamp:
- 2017-03-09T13:52:43+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
- Property svn:keywords deleted
r5682 r7773 58 58 #endif 59 59 60 61 60 62 IMPLICIT NONE 61 63 PRIVATE … … 91 93 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 92 94 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 93 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: apdlr ! now mixing lenght of dissipation94 95 #if defined key_c1d 95 96 ! !!** 1D cfg only ** ('key_c1d') … … 117 118 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 118 119 #endif 119 & apdlr(jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 120 & STAT= zdf_tke_alloc ) 120 & htau (jpi,jpj) , dissl(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 121 121 ! 122 122 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) … … 197 197 #if defined key_agrif 198 198 ! Update child grid f => parent grid 199 IF(lwp) WRITE(numout,*) 'sebseb', Agrif_Root(), kt, Agrif_NbStepint()200 199 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 201 200 #endif 202 201 ! 203 END SUBROUTINE zdf_tke202 END SUBROUTINE zdf_tke 204 203 205 204 … … 330 329 zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 331 330 ! ! TKE Langmuir circulation source term 332 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 331 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) / & 332 & zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 333 333 END DO 334 334 END DO … … 345 345 ! 346 346 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 347 DO jj = 1, jpjm1 348 DO ji = 1, fs_jpim1 ! vector opt. 349 z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk ) + avm(ji+1,jj,jk) ) & 350 & * ( un(ji,jj,jk-1) - un(ji ,jj,jk) ) & 351 & * ( ub(ji,jj,jk-1) - ub(ji ,jj,jk) ) / ( 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) ) / ( fse3vw_n(ji,jj,jk) * fse3vw_b(ji,jj,jk) ) 355 END DO 356 END DO 357 END DO 358 ! 359 IF( nn_pdl == 1 ) THEN !* Prandtl number case: compute apdlr 360 ! Note that zesh2 is also computed in the next loop. 361 ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops 362 DO jk = 2, jpkm1 363 DO jj = 2, jpjm1 364 DO ji = fs_2, fs_jpim1 ! vector opt. 365 ! ! shear prod. at w-point weightened by mask 366 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 367 & + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 368 ! ! local Richardson number 369 zri = MAX( rn2b(ji,jj,jk), 0._wp ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear ) 370 apdlr(ji,jj,jk) = MAX( 0.1_wp, ri_cri / MAX( ri_cri , zri ) ) 371 372 END DO 373 END DO 374 END DO 375 ! 376 ENDIF 377 ! 347 DO jj = 1, jpj ! here avmu, avmv used as workspace 348 DO ji = 1, jpi 349 avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) & 350 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) & 351 & / ( fse3uw_n(ji,jj,jk) & 352 & * fse3uw_b(ji,jj,jk) ) 353 avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) & 354 & * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) & 355 & / ( fse3vw_n(ji,jj,jk) & 356 & * fse3vw_b(ji,jj,jk) ) 357 END DO 358 END DO 359 END DO 360 ! 378 361 DO jk = 2, jpkm1 !* Matrix and right hand side in en 379 362 DO jj = 2, jpjm1 … … 690 673 DO jj = 2, jpjm1 691 674 DO ji = fs_2, fs_jpim1 ! vector opt. 692 avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 675 zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 676 ! ! shear 677 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) ) & 678 & + avmu(ji ,jj,jk) * ( un(ji ,jj,jk-1) - un(ji ,jj,jk) ) * ( ub(ji ,jj,jk-1) - ub(ji ,jj,jk) ) 679 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) ) & 680 & + avmv(ji,jj ,jk) * ( vn(ji,jj ,jk-1) - vn(ji,jj ,jk) ) * ( vb(ji,jj ,jk-1) - vb(ji,jj ,jk) ) 681 ! ! local Richardson number 682 zri = MAX( rn2b(ji,jj,jk), 0._wp ) * zcoef / (zdku + zdkv + rn_bshear ) 683 zpdlr = MAX( 0.1_wp, 0.2 / MAX( 0.2 , zri ) ) 684 !!gm and even better with the use of the "true" ri_crit=0.22222... (this change the results!) 685 !!gm zpdlr = MAX( 0.1_wp, ri_crit / MAX( ri_crit , zri ) ) 686 avt(ji,jj,jk) = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 693 687 # if defined key_c1d 694 e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * wmask(ji,jj,jk)! c1d configuration : save masked Prandlt number695 e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk)! c1d config. : save Ri688 e_pdl(ji,jj,jk) = zpdlr * wmask(ji,jj,jk) ! c1d configuration : save masked Prandlt number 689 e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk) ! c1d config. : save Ri 696 690 # endif 697 691 END DO … … 729 723 !!---------------------------------------------------------------------- 730 724 INTEGER :: ji, jj, jk ! dummy loop indices 731 INTEGER :: ios 725 INTEGER :: ios, ierr 732 726 !! 733 727 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & … … 787 781 ENDIF 788 782 789 IF( nn_etau == 2 ) CALL zdf_mxl( nit000 ) ! Initialization of nmln 783 IF( nn_etau == 2 ) THEN 784 ierr = zdf_mxl_alloc() 785 nmln(:,:) = nlb10 ! Initialization of nmln 786 ENDIF 790 787 791 788 ! !* depth of penetration of surface tke
Note: See TracChangeset
for help on using the changeset viewer.