Changeset 5727 for branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/wadlmt.F90

Timestamp:

2015-09-10T19:05:13+02:00 (9 years ago)

Author:

rfurner

Message:

some bug fixes for wetting and drying elements...still not working though

File:

• branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/wadlmt.F90 (modified) (10 diffs)

branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/wadlmt.F90

@@ -131 +131 @@
               DO ji = 2, jpim1 
         
-                 wdmask(ji,jj) = 0
+!                 wdmask(ji,jj) = 0
                  IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 
                  IF(bathy(ji,jj) > zdepwd) CYCLE
@@ -148 +148 @@
                  IF(zdep1 > zdep2) THEN
                    zflag = 1
-                   wdmask(ji, jj) = 1
+!                   wdmask(ji, jj) = 1
                    zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
                    zcoef = max(zcoef, 0._wp)
@@ -170 +170 @@
         END DO  ! jk1 loop
        
-        un(:,:,:) = un(:,:,:) * zwdlmtu(ji, jj) 
-        vn(:,:,:) = vn(:,:,:) * zwdlmtv(ji, jj) 
+        DO jk = 1, jpkm1
+          un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :) 
+          vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :) 
+        END DO
 
         CALL lbc_lnk( un, 'U', -1. )
@@ -213 +215 @@
       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace
       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   sum_e3u, sum_e3v         ! local 2D workspace
 
       !!----------------------------------------------------------------------
@@ -223 +226 @@
         CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
         CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)
+        CALL wrk_alloc( jpi, jpj, sum_e3u, sum_e3v)
         !
        
@@ -235 +239 @@
         zflxp(:,:)   = 0._wp
         zflxn(:,:)   = 0._wp
-        zflxu(:,:)   = 0._wp
-        zflxv(:,:)   = 0._wp
+!RF bug fix!        zflxu(:,:)   = 0._wp
+!RF bug fix!        zflxv(:,:)   = 0._wp
 
         zwdlmtu(:,:)  = 1._wp
@@ -243 +247 @@
         ! Horizontal Flux in u and v direction
        
-        zflxu(:,:) = zflxu(:,:) * e2u(:,:)
-        zflxv(:,:) = zflxv(:,:) * e1v(:,:)
+!RF bug fix        zflxu(:,:) = zflxu(:,:) * e2u(:,:)
+!RF bug fix        zflxv(:,:) = zflxv(:,:) * e1v(:,:)
        
         DO jj = 2, jpjm1
@@ -276 +280 @@
               DO ji = 2, jpim1 
         
-                 wdmask(ji,jj) = 0
-                 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 
-                 IF(bathy(ji,jj) > zdepwd) CYCLE
+!                 wdmask(ji,jj) = 0
+                 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE   ! we don't care about land cells
+                 IF(bathy(ji,jj) > zdepwd) CYCLE       ! and cells which will unlikely go dried out 
         
-                 !ztmp = e1t(ji,jj) * e2t(ji,jj)     !there must be an array ready for this
                  ztmp = e12t(ji,jj)
 
@@ -316 +319 @@
         END DO  ! jk1 loop
        
-        zflxu(:,:) = zflxu(:,:) * zwdlmtu(ji, jj) 
-        zflxv(:,:) = zflxv(:,:) * zwdlmtv(ji, jj) 
+        zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :) 
+        zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :) 
 
         CALL lbc_lnk( zflxu, 'U', -1. )
@@ -330 +333 @@
         CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
         CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)
+        CALL wrk_dealloc( jpi, jpj, sum_e3u, sum_e3v)
       !
       END IF