Changeset 6152 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

Timestamp:

2015-12-21T23:33:57+01:00 (8 years ago)

Author:

acc

Message:

Add wetting and drying option from dev_r5803_NOC_WAD branch. Logically isolated code changes in domvvl.F90, domzgr.F90, dynhpg.F90, dynspg_ts.F90, sshwzv.F90 and nemogcm.F90. New module wet_dry.F90 in DYN. Fully SETTE tested with code deactivated (ln_wad=.false.). No test case yet available to justify activating option (still under development)

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90 (modified) (10 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

@@ -23 +23 @@
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! ocean surface boundary condition
+   USE wet_dry         ! wetting and drying
    USE restart         ! ocean restart
    !
@@ -687 +688 @@
       !                                                             !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
       !
-      INTEGER ::   ji, jj, jk                                          ! dummy loop indices
+      INTEGER ::   ji, jj, jk                                       ! dummy loop indices
+      REAL(wp) ::  zlnwd                                            ! =1./0. when ln_wd = T/F
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_interpol')
+      !
+      IF(ln_wd) THEN
+        zlnwd = 1.0_wp
+      ELSE
+        zlnwd = 0.0_wp
+      END IF
       !
       SELECT CASE ( pout )    !==  type of interpolation  ==!
@@ -698 +706 @@
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1e2u(ji,jj)                                   &
+                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
                      &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
                      &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
@@ -711 +719 @@
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1e2v(ji,jj)                                   &
+                  pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
                      &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
                      &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
@@ -724 +732 @@
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1e2f(ji,jj)               &
+                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
+                     &                       *    r1_e1e2f(ji,jj)                                                  &
                      &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
                      &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
@@ -739 +748 @@
 !!gm BUG? use here wmask in case of ISF ?  to be checked
          DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )   &
-               &                            +            0.5_wp * tmask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) )
+            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )   &
+               &                            * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )                               &
+               &                            +            0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )     &
+               &                            * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) )
          END DO
          !
@@ -749 +760 @@
 !!gm BUG? use here wumask in case of ISF ?  to be checked
          DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )   &
-               &                             +            0.5_wp * umask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) )
+            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
+               &                             * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )                              &
+               &                             +            0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
+               &                             * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) )
          END DO
          !
@@ -759 +772 @@
 !!gm BUG? use here wvmask in case of ISF ?  to be checked
          DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )   &
-               &                             +            0.5_wp * vmask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) )
+            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
+               &                             * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )                              &
+               &                             +            0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
+               &                             * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) )
          END DO
       END SELECT
@@ -784 +799 @@
       CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
       !
-      INTEGER ::   jk
+      INTEGER ::   ji, jj, jk
       INTEGER ::   id1, id2, id3, id4, id5     ! local integers
       !!----------------------------------------------------------------------
@@ -872 +887 @@
             e3t_n(:,:,:) = e3t_0(:,:,:)
             sshn(:,:) = 0.0_wp
+
+            IF( ln_wd ) THEN
+              DO jj = 1, jpj
+                DO ji = 1, jpi
+                  IF( e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1 ) THEN
+                     e3t_b(ji,jj,:) = 0.5_wp * rn_wdmin1 
+                     e3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1 
+                     e3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1 
+                     sshb(ji,jj) = rn_wdmin1 - bathy(ji,jj)
+                     sshn(ji,jj) = rn_wdmin1 - bathy(ji,jj)
+                     ssha(ji,jj) = rn_wdmin1 - bathy(ji,jj)
+                  ENDIF
+                ENDDO
+              ENDDO
+            END IF
+
             IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN
                tilde_e3t_b(:,:,:) = 0.0_wp