Changeset 14706


Ignore:
Timestamp:
2021-04-13T18:31:16+02:00 (4 months ago)
Author:
dancopsey
Message:

Merge in revisions 14678 to 14705 of:

http://forge.ipsl.jussieu.fr/nemo/log/NEMO/branches/NERC/dev_r11078_OSMOSIS_IMMERSE_Nurser_4.0

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0.1_FKOSM_m11715/src/OCE/ZDF/zdfosm.F90

    r14679 r14706  
    858858    ! Rate of change of hbl 
    859859    CALL zdf_osm_calculate_dhdt( zdhdt ) 
     860    ! Test if surface boundary layer coupled to bottom. 
     861    lcoup(:,:) = .FALSE.                                    ! ag 19/03 
    860862    DO jj = 2, jpjm1 
    861863       DO ji = 2, jpim1 
     
    863865          ! adjustment to represent limiting by ocean bottom 
    864866          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 ) ) THEN 
    866                 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(:,:)) 
    867869                lpyc(ji,jj) = .FALSE. 
     870                lcoup(ji,jj) = .TRUE.                            ! ag 19/03 
    868871             ENDIF 
    869872          ENDIF 
    870873#ifdef key_osm_debug 
    871874          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) 
    874878             FLUSH(narea+100) 
    875879          END IF 
     
    890894       END DO 
    891895    END DO 
    892  
    893 ! Test if surface boundary layer coupled to bottom. 
    894  
    895     lcoup(:,:) = .FALSE.                                    ! ag 19/03 
    896     DO jj = 2, jpjm1                                        ! ag 19/03 
    897       DO ji = 2, jpim1                                      ! ag 19/03 
    898         IF ( mbkt(ji,jj) >2 ) THEN ! to ensure mbkt(ji,jj) - 2 > 0 so no incorrect array access 
    899            IF ( zhbl_t(ji,jj) >= gdepw_n(ji,jj,mbkt(ji,jj) - 2) ) THEN ! ag 19/03 
    900               zhbl_t(ji,jj) = gdepw_n(ji,jj,mbkt(ji,jj)-2)     ! ag 19/03 
    901               lcoup(ji,jj) = .TRUE.                            ! ag 19/03 
    902            ENDIF                                               ! ag 19/03 
    903         ENDIF                                               ! ag 19/03 
    904       END DO                                                ! ag 19/03 
    905     END DO                                                  ! ag 19/03 
    906896 
    907897    ! 
     
    932922#ifdef key_osm_debug 
    933923                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= Fl: 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' 
    935925                   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) 
    937927                   FLUSH(narea+100) 
    938928                END IF 
     
    15591549          DO ji = 2, jpim1 
    15601550             DO jk = ibld(ji,jj) + 1, jpkm1 
    1561                 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
    1562                 zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
     1551                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) 
    15631553             END DO 
    15641554          END DO 
     
    15721562          DO ji = 2, jpim1 
    15731563             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_difconv 
     1564                IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = MAX(rn_difconv,zdiffut(ji,jj,jk)) 
    15751565             END DO 
    15761566          END DO 
     
    18031793      REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 
    18041794 
     1795      pb_coup(:,:) = 0._wp 
     1796 
    18051797      DO jj = 2, jpjm1 
    18061798         DO ji = 2, jpim1 
    1807             pb_coup(ji,jj) = 0._wp 
    18081799            IF ( lconv(ji,jj) ) THEN 
    18091800 
     
    18691860                  pvispyc_s_sc(ji,jj) = 0._wp  ! ag 19/03 
    18701861                  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| 
    18721863                    !     already calculated at T-points in SUBROUTINE zdf_drg from zdfdrg.F90 
    18731864                    !  Gives friction velocity sqrt bottom drag/rho_0 i.e. u* = SQRT(rCdU_bot*ub) 
    18741865                    ! 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  & 
    18781869                  &                                           + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  ) ) 
    18791870 
     
    18821873#ifdef key_osm_debug 
    18831874                    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) 
    18861878                    END IF 
    18871879#endif 
    1888 #ifdef key_osm_debug 
    1889                     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 #endif 
     1880! #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 
    18931885                    pz_b = -zhml(ji,jj) + gdepw_n(ji,jj,mbkt(ji,jj)+1)  ! ag 19/03  
    18941886                    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 
     
    19011893                    END IF 
    19021894#endif 
    1903 #ifdef key_osm_debug 
    1904                     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 #endif 
     1895! #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 
    19071899                  ELSE     ! ag 19/03 
    19081900                    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 
     
    36753667          hbl (ji,jj) = gdepw_n(ji,jj,iiki  )    ! Turbocline depth 
    36763668          dh (ji,jj) = e3t_n(ji,jj,iiki-1  )     ! Turbocline depth 
     3669          hml (ji,jj) = hbl(ji,jj) - dh(ji,jj) 
    36773670       END DO 
    36783671    END DO 
Note: See TracChangeset for help on using the changeset viewer.