Changeset 14706
- Timestamp:
- 2021-04-13T18:31:16+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.1_FKOSM_m11715/src/OCE/ZDF/zdfosm.F90
r14679 r14706 858 858 ! Rate of change of hbl 859 859 CALL zdf_osm_calculate_dhdt( zdhdt ) 860 ! Test if surface boundary layer coupled to bottom. 861 lcoup(:,:) = .FALSE. ! ag 19/03 860 862 DO jj = 2, jpjm1 861 863 DO ji = 2, jpim1 … … 863 865 ! adjustment to represent limiting by ocean bottom 864 866 IF ( mbkt(ji,jj) >2 ) THEN ! to ensure mbkt(ji,jj) - 2 > 0 so no incorrect array access 865 IF( zhbl_t(ji,jj) > =gdepw_n(ji, jj, mbkt(ji,jj) - 2 ) ) THEN866 zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw_n(ji,jj, mbkt(ji,jj) - 2) - depth_tol)! ht_n(:,:))867 IF( zhbl_t(ji,jj) > gdepw_n(ji, jj, mbkt(ji,jj) - 2 ) ) THEN 868 zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw_n(ji,jj, mbkt(ji,jj) - 2))! ht_n(:,:)) 867 869 lpyc(ji,jj) = .FALSE. 870 lcoup(ji,jj) = .TRUE. ! ag 19/03 868 871 ENDIF 869 872 ENDIF 870 873 #ifdef key_osm_debug 871 874 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 872 WRITE(narea+100,'(2(a,g11.3),/,2(a,g11.3))')'after zdf_osm_calculate_dhdt: zhbl_t=',zhbl_t(ji,jj), 'hbl=', hbl(ji,jj),& 873 & 'delta hbl from dzdhdt', zdhdt(ji,jj)*rn_rdt,' delta hbl from w ', wn(ji,jj,ibld(ji,jj))*rn_rdt 875 WRITE(narea+100,'(2(a,g11.3),/,2(a,g11.3),2(a,l7))')'after zdf_osm_calculate_dhdt: zhbl_t=',zhbl_t(ji,jj), 'hbl=', hbl(ji,jj),& 876 & 'delta hbl from dzdhdt', zdhdt(ji,jj)*rn_rdt,' delta hbl from w ', wn(ji,jj,ibld(ji,jj))*rn_rdt, & 877 & ' lcoup= ',lcoup(ji,jj), ' lpyc= ', lpyc(ji,jj) 874 878 FLUSH(narea+100) 875 879 END IF … … 890 894 END DO 891 895 END DO 892 893 ! Test if surface boundary layer coupled to bottom.894 895 lcoup(:,:) = .FALSE. ! ag 19/03896 DO jj = 2, jpjm1 ! ag 19/03897 DO ji = 2, jpim1 ! ag 19/03898 IF ( mbkt(ji,jj) >2 ) THEN ! to ensure mbkt(ji,jj) - 2 > 0 so no incorrect array access899 IF ( zhbl_t(ji,jj) >= gdepw_n(ji,jj,mbkt(ji,jj) - 2) ) THEN ! ag 19/03900 zhbl_t(ji,jj) = gdepw_n(ji,jj,mbkt(ji,jj)-2) ! ag 19/03901 lcoup(ji,jj) = .TRUE. ! ag 19/03902 ENDIF ! ag 19/03903 ENDIF ! ag 19/03904 END DO ! ag 19/03905 END DO ! ag 19/03906 896 907 897 ! … … 932 922 #ifdef key_osm_debug 933 923 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 934 WRITE(narea+100,'(a)')'After setting pycnocline thickness BL running aground: lpyc= F l: ibld(ji,jj) >= mbkt(ji,jj) -2'924 WRITE(narea+100,'(a)')'After setting pycnocline thickness BL running aground: lpyc= F5: ibld(ji,jj) >= mbkt(ji,jj) -2' 935 925 WRITE(narea+100,'(2(a,i7),2(a,g11.3))')' ibld=',ibld(ji,jj),' imld=',imld(ji,jj), ' zdh=',zdh(ji,jj), ' zhml=',zhml(ji,jj) 936 WRITE(narea+100,'(2(a,g11.3))')'dh=',dh ,' hml=',hml(ji,jj)926 WRITE(narea+100,'(2(a,g11.3))')'dh=',dh(ji,jj),' hml=',hml(ji,jj) 937 927 FLUSH(narea+100) 938 928 END IF … … 1559 1549 DO ji = 2, jpim1 1560 1550 DO jk = ibld(ji,jj) + 1, jpkm1 1561 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri1562 zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri1551 zdiffut(ji,jj,jk) = MAX(zdiffut(ji,jj,jk), zrimix(ji,jj,jk)*rn_difri) 1552 zviscos(ji,jj,jk) = MAX(zviscos(ji,jj,jk), zrimix(ji,jj,jk)*rn_difri) 1563 1553 END DO 1564 1554 END DO … … 1572 1562 DO ji = 2, jpim1 1573 1563 DO jk = ibld(ji,jj) + 1, jpkm1 1574 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv1564 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = MAX(rn_difconv,zdiffut(ji,jj,jk)) 1575 1565 END DO 1576 1566 END DO … … 1803 1793 REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 1804 1794 1795 pb_coup(:,:) = 0._wp 1796 1805 1797 DO jj = 2, jpjm1 1806 1798 DO ji = 2, jpim1 1807 pb_coup(ji,jj) = 0._wp1808 1799 IF ( lconv(ji,jj) ) THEN 1809 1800 … … 1869 1860 pvispyc_s_sc(ji,jj) = 0._wp ! ag 19/03 1870 1861 IF(lcoup(ji,jj) ) THEN ! ag 19/03 1871 ! code from SUBROUTINE tke_tke zdftke.F90; uses bottom drag velocity rCdU_bot(ji,jj) = Cd|ub|1862 ! code from SUBROUTINE tke_tke zdftke.F90; uses bottom drag velocity rCdU_bot(ji,jj) = -Cd|ub| 1872 1863 ! already calculated at T-points in SUBROUTINE zdf_drg from zdfdrg.F90 1873 1864 ! Gives friction velocity sqrt bottom drag/rho_0 i.e. u* = SQRT(rCdU_bot*ub) 1874 1865 ! wet-cell averaging .. 1875 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )1876 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )1877 pb_coup(ji,jj) = 0.4 * SQRT( rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 &1866 zmsku = 0.5 * ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 1867 zmskv = 0.5 * ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 1868 pb_coup(ji,jj) = 0.4 * SQRT(-rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 & 1878 1869 & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) ) 1879 1870 … … 1882 1873 #ifdef key_osm_debug 1883 1874 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1884 WRITE(narea+100,'(3(a,g11.3))')' lcoup = T; 1st pz_b= ', pz_b, 'pb_coup', pb_coup(ji,jj), ' pc_coup_vis', pc_coup_vis(ji,jj) 1885 FLUSH(narea+100) 1875 WRITE(narea+100,'(4(a,g11.3))')' lcoup = T; 1st pz_b= ', pz_b, ' pb_coup ', pb_coup(ji,jj), ' pc_coup_vis ', pc_coup_vis(ji,jj), ' rCdU_bot ',rCdU_bot(ji,jj) 1876 WRITE(narea+100,'(2(a,g11.3))')' zmsku ', zmsku, ' zmskv ', zmskv 1877 FLUSH(narea+100) 1886 1878 END IF 1887 1879 #endif 1888 #ifdef key_osm_debug1889 WRITE(narea+400,'(4(a,i7))') ' lcoup = T at ji=',ji,' jj= ',jj,' jig= ', mig(ji), 'jjg= ', mjg(jj)1890 WRITE(narea+400,'(3(a,g11.3))') '1st pz_b= ', pz_b, 'pb_coup', pb_coup(ji,jj), ' pc_coup_vis', pc_coup_vis(ji,jj)1891 FLUSH(narea+400)1892 #endif1880 ! #ifdef key_osm_debug 1881 ! WRITE(narea+400,'(4(a,i7))') ' lcoup = T at ji=',ji,' jj= ',jj,' jig= ', mig(ji), ' jjg= ', mjg(jj) 1882 ! WRITE(narea+400,'(3(a,g11.3))') '1st pz_b= ', pz_b, 'pb_coup', pb_coup(ji,jj), ' pc_coup_vis', pc_coup_vis(ji,jj) 1883 ! FLUSH(narea+400) 1884 ! #endif 1893 1885 pz_b = -zhml(ji,jj) + gdepw_n(ji,jj,mbkt(ji,jj)+1) ! ag 19/03 1894 1886 pbeta_v_sc(ji,jj) = 1.0 - 2.0 * ( pb_coup(ji,jj) * pz_b + pc_coup_vis(ji,jj) * pz_b**2 ) / pvisml_sc(ji,jj) ! ag 19/03 … … 1901 1893 END IF 1902 1894 #endif 1903 #ifdef key_osm_debug1904 WRITE(narea+400,'(3(a,g11.3))') '2nd pz_b= ', pz_b,' pc_coup_vis', pc_coup_vis(ji,jj)1905 FLUSH(narea+400)1906 #endif1895 ! #ifdef key_osm_debug 1896 ! WRITE(narea+400,'(3(a,g11.3))') '2nd pz_b= ', pz_b,' pc_coup_dif', pc_coup_dif(ji,jj) 1897 ! FLUSH(narea+400) 1898 ! #endif 1907 1899 ELSE ! ag 19/03 1908 1900 pbeta_d_sc(ji,jj) = 1.0 - ( ( pdifpyc_n_sc(ji,jj) + 1.4 * pdifpyc_s_sc(ji,jj) ) / ( pdifml_sc(ji,jj) + epsln ) )**p2third ! ag 19/03 … … 3675 3667 hbl (ji,jj) = gdepw_n(ji,jj,iiki ) ! Turbocline depth 3676 3668 dh (ji,jj) = e3t_n(ji,jj,iiki-1 ) ! Turbocline depth 3669 hml (ji,jj) = hbl(ji,jj) - dh(ji,jj) 3677 3670 END DO 3678 3671 END DO
Note: See TracChangeset
for help on using the changeset viewer.