Changeset 10883 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/ZDF/zdfgls.F90
- Timestamp:
- 2019-04-18T14:29:58+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/ZDF/zdfgls.F90
r10425 r10883 124 124 125 125 126 SUBROUTINE zdf_gls( kt, p_sh2, p_avm, p_avt )126 SUBROUTINE zdf_gls( kt, Kbb, Kmm, p_sh2, p_avm, p_avt ) 127 127 !!---------------------------------------------------------------------- 128 128 !! *** ROUTINE zdf_gls *** … … 134 134 !! 135 135 INTEGER , INTENT(in ) :: kt ! ocean time step 136 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 136 137 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: p_sh2 ! shear production term 137 138 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points) … … 176 177 zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 177 178 zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) ! (CAUTION: CdU<0) 178 ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT( ( zmsku*( u b(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 &179 & + ( zmskv*( v b(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 )179 ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT( ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2 & 180 & + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2 ) 180 181 END DO 181 182 END DO … … 185 186 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 186 187 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0) 187 ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT( ( zmsku*( u b(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 &188 & + ( zmskv*( v b(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 )188 ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT( ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2 & 189 & + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2 ) 189 190 END DO 190 191 END DO … … 222 223 DO jj = 2, jpjm1 223 224 DO ji = fs_2, fs_jpim1 ! vector opt. 224 zup = hmxl_n(ji,jj,jk) * gdepw _n(ji,jj,mbkt(ji,jj)+1)225 zdown = vkarmn * gdepw _n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) )225 zup = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 226 zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ) 226 227 zcoef = ( zup / MAX( zdown, rsmall ) ) 227 228 zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk) … … 276 277 zcof = rfact_tke * tmask(ji,jj,jk) 277 278 ! ! lower diagonal, in fact not used for jk = 2 (see surface conditions) 278 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t _n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )279 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 279 280 ! ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions) 280 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t _n(ji,jj,jk ) * e3w_n(ji,jj,jk) )281 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk,Kmm) ) 281 282 ! ! diagonal 282 283 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) … … 306 307 ! 307 308 ! One level below 308 en (:,:,2) = MAX( rc02r * ustar2_surf(:,:) * ( 1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw _n(:,:,2)) &309 en (:,:,2) = MAX( rc02r * ustar2_surf(:,:) * ( 1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm)) & 309 310 & / zhsro(:,:) )**(1.5_wp*ra_sf) )**(2._wp/3._wp) , rn_emin ) 310 311 zd_lw(:,:,2) = 0._wp … … 325 326 zdiag(:,:,2) = zdiag(:,:,2) + zd_lw(:,:,2) ! Remove zd_lw from zdiag 326 327 zd_lw(:,:,2) = 0._wp 327 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept _n(:,:,1)/zhsro(:,:)) ))328 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:)) )) 328 329 zflxs(:,:) = rsbc_tke2 * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 329 & * ( ( zhsro(:,:)+gdept _n(:,:,1) ) / zhsro(:,:) )**(1.5_wp*ra_sf)330 !!gm why not : * ( 1._wp + gdept _n(:,:,1) / zhsro(:,:) )**(1.5_wp*ra_sf)331 en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w _n(:,:,2)330 & * ( ( zhsro(:,:)+gdept(:,:,1,Kmm) ) / zhsro(:,:) )**(1.5_wp*ra_sf) 331 !!gm why not : * ( 1._wp + gdept(:,:,1,Kmm) / zhsro(:,:) )**(1.5_wp*ra_sf) 332 en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 332 333 ! 333 334 ! … … 526 527 zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk) 527 528 ! ! lower diagonal 528 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t _n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )529 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 529 530 ! ! upper diagonal 530 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t _n(ji,jj,jk ) * e3w_n(ji,jj,jk) )531 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk,Kmm) ) 531 532 ! ! diagonal 532 533 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) … … 554 555 ! 555 556 ! One level below 556 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw _n(:,:,2)/zhsro(:,:) )))557 zdep (:,:) = (zhsro(:,:) + gdepw _n(:,:,2)) * zkar(:,:)557 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(:,:,2,Kmm)/zhsro(:,:) ))) 558 zdep (:,:) = (zhsro(:,:) + gdepw(:,:,2,Kmm)) * zkar(:,:) 558 559 psi (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 559 560 zd_lw(:,:,2) = 0._wp … … 575 576 ! 576 577 ! Set psi vertical flux at the surface: 577 zkar (:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept _n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope578 zdep (:,:) = ((zhsro(:,:) + gdept _n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)578 zkar (:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:) )) ! Lengh scale slope 579 zdep (:,:) = ((zhsro(:,:) + gdept(:,:,1,Kmm)) / zhsro(:,:))**(rmm*ra_sf) 579 580 zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 580 581 zdep (:,:) = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * & 581 & ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept _n(:,:,1))**(rnn-1.)582 & ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept(:,:,1,Kmm))**(rnn-1.) 582 583 zflxs(:,:) = zdep(:,:) * zflxs(:,:) 583 psi (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w _n(:,:,2)584 psi (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 584 585 ! 585 586 END SELECT … … 607 608 ! 608 609 ! Just above last level, Dirichlet condition again (GOTM like) 609 zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t _n(ji,jj,ibotm1) )610 zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t(ji,jj,ibotm1,Kmm) ) 610 611 psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot )**rmm * zdep(ji,jj)**rnn 611 612 zd_lw(ji,jj,ibotm1) = 0._wp … … 635 636 ! 636 637 ! Set psi vertical flux at the bottom: 637 zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t _n(ji,jj,ibotm1)638 zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t(ji,jj,ibotm1,Kmm) 638 639 zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) ) & 639 640 & * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp) 640 psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w _n(ji,jj,ibotm1)641 psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w(ji,jj,ibotm1,Kmm) 641 642 END DO 642 643 END DO
Note: See TracChangeset
for help on using the changeset viewer.
