Changeset 10499 for NEMO/trunk/src/OCE

Timestamp:

2019-01-10T16:12:24+01:00 (5 years ago)

Author:

deazer

Message:

Fix ticket #2154

Location:

NEMO/trunk/src/OCE

Files:

• DIA/dia25h.F90 (modified) (2 diffs)
• DIA/diatmb.F90 (modified) (2 diffs)
• DOM/istate.F90 (modified) (1 diff)
• DYN/wet_dry.F90 (modified) (4 diffs)
• SBC/sbcmod.F90 (modified) (3 diffs)
• TRA/trasbc.F90 (modified) (2 diffs)

NEMO/trunk/src/OCE/DIA/dia25h.F90

@@ -13 +13 @@
    USE in_out_manager  ! I/O units
    USE iom             ! I/0 library
+   USE wet_dry
 
    IMPLICIT NONE
@@ -211 +212 @@
          CALL iom_put( "salin25h", zw3d  )   ! salinity
          zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
-         CALL iom_put( "ssh25h", zw2d )   ! sea surface 
+         IF( ll_wd ) THEN
+            CALL iom_put( "ssh25h", zw2d+ssh_ref )   ! sea surface 
+         ELSE
+            CALL iom_put( "ssh25h", zw2d )   ! sea surface
+         ENDIF
          ! Write velocities (instantaneous)
          zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:))

NEMO/trunk/src/OCE/DIA/diatmb.F90

@@ -12 +12 @@
    USE in_out_manager  ! I/O units
    USE iom             ! I/0 library
+   USE wet_dry
 
    IMPLICIT NONE
@@ -108 +109 @@
       CALL dia_calctmb( tsn(:,:,:,jp_tem), zwtmb )
       !ssh already output but here we output it masked
-      CALL iom_put( "sshnmasked", sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
+      IF( ll_wd ) THEN
+         CALL iom_put( "sshnmasked", (sshn(:,:)+ssh_ref)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
+      ELSE
+         CALL iom_put( "sshnmasked", sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
+      ENDIF
+
       CALL iom_put( "top_temp"  , zwtmb(:,:,1) )    ! tmb Temperature
       CALL iom_put( "mid_temp"  , zwtmb(:,:,2) )    ! tmb Temperature

NEMO/trunk/src/OCE/DOM/istate.F90

@@ -100 +100 @@
             !
             sshb(:,:)   = 0._wp               ! set the ocean at rest
+            IF( ll_wd ) THEN
+               sshb(:,:) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD 
+               !
+               ! Apply minimum wetdepth criterion
+               !
+               DO jj = 1,jpj
+                  DO ji = 1,jpi
+                     IF( ht_0(ji,jj) + sshb(ji,jj)  < rn_wdmin1 ) THEN
+                        sshb(ji,jj) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )
+                     ENDIF
+                  END DO
+               END DO 
+            ENDIF 
             ub  (:,:,:) = 0._wp
             vb  (:,:,:) = 0._wp  

NEMO/trunk/src/OCE/DYN/wet_dry.F90

@@ -45 +45 @@
    REAL(wp), PUBLIC  ::   r_rn_wdmin1 !: 1/minimum water depth on dried cells 
    REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerance of minimum water depth on dried cells
+   REAL(wp), PUBLIC  ::   rn_wd_sbcdep   !: Depth at which to taper sbc fluxes
+   REAL(wp), PUBLIC  ::   rn_wd_sbcfra   !: Fraction of SBC at taper depth
    REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying will be considered
    INTEGER , PUBLIC  ::   nn_wdit     !: maximum number of iteration for W/D limiter
@@ -74 +76 @@
       !!
       NAMELIST/namwad/ ln_wd_il, ln_wd_dl   , rn_wdmin0, rn_wdmin1, rn_wdmin2, rn_wdld,   &
-         &             nn_wdit , ln_wd_dl_bc, ln_wd_dl_rmp
+         &             nn_wdit , ln_wd_dl_bc, ln_wd_dl_rmp, rn_wd_sbcdep,rn_wd_sbcfra
       !!----------------------------------------------------------------------
       !
@@ -85 +87 @@
       IF(lwm) WRITE ( numond, namwad )
       !
+      IF( rn_wd_sbcfra>=1 )   CALL ctl_stop( 'STOP', 'rn_wd_sbcfra >=1 : must be < 1' )
       IF(lwp) THEN                  ! control print
          WRITE(numout,*)
@@ -99 +102 @@
          WRITE(numout,*) '      T => baroclinic u,v=0 at dry pts: ln_wd_dl_bc = ', ln_wd_dl_bc     
          WRITE(numout,*) '      use a ramp for rwd limiter:  ln_wd_dl_rwd_rmp = ', ln_wd_dl_rmp
+         WRITE(numout,*) '      cut off depth sbc for wd   rn_wd_sbcdep       = ', rn_wd_sbcdep
+         WRITE(numout,*) '      fraction to start sbc wgt rn_wd_sbcfra        = ', rn_wd_sbcfra
       ENDIF
       IF( .NOT. ln_read_cfg ) THEN

NEMO/trunk/src/OCE/SBC/sbcmod.F90

@@ -58 +58 @@
    USE lib_mpp        ! MPP library
    USE timing         ! Timing
+   USE wet_dry
    USE diurnal_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic
 
@@ -377 +378 @@
       !
       LOGICAL ::   ll_sas, ll_opa   ! local logical
+      !
+      REAL(wp) ::     zthscl        ! wd  tanh scale
+      REAL(wp), DIMENSION(jpi,jpj) ::  zwdht, zwght  ! wd dep over wd limit, wgt  
+
       !!---------------------------------------------------------------------
       !
@@ -461 +466 @@
 !!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
 !!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1. )
+      IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now
+         zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999 
+         zwdht(:,:) = sshn(:,:) + ht_0(:,:) - rn_wdmin1   ! do this calc of water
+                                                     ! depth above wd limit once
+         WHERE( zwdht(:,:) <= 0.0 )
+            taum(:,:) = 0.0
+            utau(:,:) = 0.0
+            vtau(:,:) = 0.0
+            qns (:,:) = 0.0
+            qsr (:,:) = 0.0
+            emp (:,:) = min(emp(:,:),0.0) !can allow puddles to grow but not shrink
+            sfx (:,:) = 0.0
+         END WHERE
+         zwght(:,:) = tanh(zthscl*zwdht(:,:))
+         WHERE( zwdht(:,:) > 0.0  .and. zwdht(:,:) < rn_wd_sbcdep ) !  5 m hard limit here is arbitrary
+            qsr  (:,:) =  qsr(:,:)  * zwght(:,:)
+            qns  (:,:) =  qns(:,:)  * zwght(:,:)
+            taum (:,:) =  taum(:,:) * zwght(:,:)
+            utau (:,:) =  utau(:,:) * zwght(:,:)
+            vtau (:,:) =  vtau(:,:) * zwght(:,:)
+            sfx  (:,:) =  sfx(:,:)  * zwght(:,:)
+            emp  (:,:) =  emp(:,:)  * zwght(:,:)
+         END WHERE
+      ENDIF
       !
       IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !

NEMO/trunk/src/OCE/TRA/trasbc.F90

@@ -27 +27 @@
    USE trd_oce        ! trends: ocean variables
    USE trdtra         ! trends manager: tracers 
-   USE wet_dry,  ONLY : ll_wd, rn_wdmin1, r_rn_wdmin1   ! Wetting and drying
 #if defined key_asminc   
    USE asminc         ! Assimilation increment
@@ -125 +124 @@
       DO jj = 2, jpj
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now
-               IF ( sshn(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN
-                  sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
-               ELSE IF ( sshn(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN
-                  sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj) &
-                       &                * tanh ( 5._wp * ( ( sshn(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 ) * r_rn_wdmin1 ) )
-               ELSE
-                  sbc_tsc(ji,jj,jp_tem) = 0._wp
-               ENDIF
-            ELSE 
-               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
-            ENDIF
-
+            sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
             sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)   ! salt flux due to freezing/melting
          END DO