Changeset 6986 for branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90

Timestamp:

2016-10-04T17:46:55+02:00 (8 years ago)

Author:

acc

Message:

Branch dev_r6393_NOC_WAD. Introduced some WAD test cases, tidied and corrected WAD code

File:

• branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90 (modified) (8 diffs)

branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90

@@ -46 +46 @@
    PUBLIC   wad_lmt                   ! routine called by sshwzv.F90
    PUBLIC   wad_lmt_bt                ! routine called by dynspg_ts.F90
+   PUBLIC   wad_istate                ! routine called by istate.F90 and domvvl.F90
 
    !! * Substitutions
@@ -132 +133 @@
        
         zflag  = 0
-        zdepwd = 150._wp   !maximum depth on which that W/D could possibly happen
+        zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen
 
        
@@ -156 +157 @@
         zflxv(:,:) = zflxv(:,:) * e1v(:,:)
        
+        wdmask(:,:) = 1
         DO jj = 2, jpjm1
            DO ji = 2, jpim1 
@@ -168 +170 @@
 
               zdep2 = bathy(ji,jj) + sshb1(ji,jj) - rn_wdmin1
-              IF(zdep2 < 0._wp) THEN  !add more safty, but not necessary
+              IF(zdep2 .le. 0._wp) THEN  !add more safty, but not necessary
                 !zdep2 = 0._wp
                 sshb1(ji,jj) = rn_wdmin1 - bathy(ji,jj)
+                wdmask(ji,jj) = 0._wp
               END IF
            ENDDO
@@ -186 +189 @@
               DO ji = 2, jpim1 
         
-                 wdmask(ji,jj) = 0
                  IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 
                  IF(bathy(ji,jj) > zdepwd) CYCLE
@@ -201 +203 @@
           
                  IF(zdep1 > zdep2) THEN
-                   IF(jk1 .eq. 1) wdmask(ji,jj) = 1
                    zflag = 1
+                   wdmask(ji, jj) = 0
                    zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
                    zcoef = max(zcoef, 0._wp)
@@ -231 +233 @@
         CALL lbc_lnk( un, 'U', -1. )
         CALL lbc_lnk( vn, 'V', -1. )
+      !
+        un_b(:,:) = un_b(:,:) * zwdlmtu(:, :)
+        vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :)
+        CALL lbc_lnk( un_b, 'U', -1. )
+        CALL lbc_lnk( vn_b, 'V', -1. )
        
         IF(zflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!'
@@ -390 +397 @@
       IF( nn_timing == 1 )  CALL timing_stop('wad_lmt')
    END SUBROUTINE wad_lmt_bt
+
+   SUBROUTINE wad_istate
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE wad_istate  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers for WAD test
+      !!      configurations (channels or bowls with initial ssh gradients)
+      !!
+      !! ** Method  : - set temperature field
+      !!              - set salinity field
+      !!              - set ssh slope (needs to be repeated in domvvl_rst_init to
+      !!                               set vertical metrics )
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj            ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      ! Uniform T & S in all test cases
+      tsn(:,:,:,jp_tem) = 10._wp
+      tsb(:,:,:,jp_tem) = 10._wp
+      tsn(:,:,:,jp_sal) = 35._wp
+      tsb(:,:,:,jp_sal) = 35._wp
+      SELECT CASE ( jp_cfg ) 
+         !                                        ! ====================
+         CASE ( 1 )                               ! WAD 1 configuration
+            !                                     ! ====================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_wad : Closed box with EW linear bottom slope'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            do ji = 1,jpi
+             sshn(ji,:) = ( -5.5_wp + 5.5_wp*FLOAT(mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1)
+            end do
+            !                                     ! ====================
+         CASE ( 2 )                               ! WAD 2 configuration
+            !                                     ! ====================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel, mid-range initial ssh slope'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            do ji = 1,jpi
+             sshn(ji,:) = ( -5.5_wp + 3.9_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1)
+            end do
+            !                                     ! ====================
+         CASE ( 3 )                               ! WAD 3 configuration
+            !                                     ! ====================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel, extreme initial ssh slope' 
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            do ji = 1,jpi
+             sshn(ji,:) = ( -7.5_wp + 6.9_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1)
+            end do
+
+            !
+            !                                     ! ====================
+         CASE ( 4 )                               ! WAD 4 configuration
+            !                                     ! ====================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic bowl, mid-range initial ssh slope' 
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            do ji = 1,jpi
+             sshn(ji,:) = ( -5.5_wp + 3.9_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1)
+             ! very small displacement test:
+             !sshn(ji,:) = ( -0.05_wp + 0.05_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1)
+            end do
+
+            !
+            !                                    ! ===========================
+         CASE DEFAULT                            ! NONE existing configuration
+            !                                    ! ===========================
+            WRITE(ctmp1,*) 'WAD test with a ', jp_cfg,' option is not coded'
+            !
+            CALL ctl_stop( ctmp1 )
+            !
+      END SELECT
+      !
+      ! Apply minimum wetdepth criterion
+      !
+      do jj = 1,jpj
+         do ji = 1,jpi
+            IF( bathy(ji,jj) + sshn(ji,jj) < 0.4_wp) THEN
+               sshn(ji,jj) = tmask(ji,jj,1)*(0.4_wp - bathy(ji,jj))
+            ENDIF
+         end do
+      end do
+      sshb = sshn
+      ssha = sshn
+      !
+   END SUBROUTINE wad_istate
+
+   !!=====================================================================
 END MODULE wet_dry