Changeset 3566 for branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

Timestamp:

2012-11-15T19:09:49+01:00 (11 years ago)

Author:

cetlod

Message:

branch dev_r3387_LOCEAN6_AGRIF_LIM: add some corrections to make AGRIF compatible with TOP

File:

• branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90 (modified) (5 diffs)

branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

@@ -8 +8 @@
    USE in_out_manager
    USE agrif_oce
+   USE agrif_opa_sponge
    USE trc
    USE lib_mpp
@@ -17 +18 @@
    PUBLIC Agrif_Sponge_Trc, interptrn
 
+  !! * Substitutions
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.3 , NEMO Consortium (2010)
@@ -29 +32 @@
       !!   *** ROUTINE Agrif_Sponge_Trc ***
       !!---------------------------------------------
-#include "domzgr_substitute.h90"
       !! 
-      INTEGER :: ji,jj,jk,jl
-      INTEGER :: spongearea
+      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
       REAL(wp) :: ztra, zabe1, zabe2, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff, ztru, ztrv, ztab
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff
 
 #if defined SPONGE_TOP
-      CALL wrk_alloc( jpi, jpj, localviscsponge )
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab )
+      CALL wrk_alloc( jpi, jpj, ztru, ztrv )
+      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )
 
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
@@ -46 +48 @@
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      ztab = 0.e0
-      CALL Agrif_Bc_Variable(ztab, tra_id,calledweight=timecoeff,procname=interptrn)
+      ztabr = 0.e0
+      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn)
       Agrif_UseSpecialValue = .FALSE.
 
-      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztab(:,:,:,:)
+      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)
 
-      spongearea = 2 + 2 * Agrif_irhox()
+      CALL Agrif_sponge
 
-      localviscsponge = 0.
-      
-      IF (.NOT. spongedoneT) THEN
-         spe1ur(:,:) = 0.
-         spe2vr(:,:) = 0.
+      DO jn = 1, jptra
+         DO jk = 1, jpkm1
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
+                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
+                  ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                  ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
+               ENDDO
+            ENDDO
 
-      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO ji = 2, spongearea
-            localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2)
+            DO jj = 2,jpjm1
+               DO ji = 2,jpim1
+                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
+                  ! horizontal diffusive trends
+                  ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  )
+                  ! add it to the general tracer trends
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !
          ENDDO
-    
-    spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) &
-          * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:)
-
-         spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
-             localviscsponge(2:spongearea,2:jpj)) &
-           * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1)
-      ENDIF
-
-      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO ji = nlci-spongearea + 1,nlci-1
-            localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2)
-         ENDDO
-    
-    spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
-           localviscsponge(nlci-spongearea + 2:nlci-1,:)) &
-          * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:)
-
-         spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
-              + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) &
-           * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1)
-      ENDIF
-
-
-      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO jj = 2, spongearea
-            localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2)
-         ENDDO
-    
-    spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
-           localviscsponge(2:jpi,2:spongearea)) &
-          * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea)
-
-         spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
-             localviscsponge(:,3:spongearea)) &
-           * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1)
-      ENDIF
-
-      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO jj = nlcj-spongearea + 1,nlcj-1
-            localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2)
-         ENDDO
-    
-    spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
-            localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) &
-          * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1)
-
-         spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
-            localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) &
-           * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2)
-      ENDIF
-      
-         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))
-
-         spongedoneT = .TRUE.
-      ENDIF
-
-      DO jl = 1, jptra
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
-               zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
-               ztru(ji,jj,jk,jl) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jl) - trbdiff(ji,jj,jk,jl) )
-               ztrv(ji,jj,jk,jl) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jl) - trbdiff(ji,jj,jk,jl) )
-            ENDDO
-         ENDDO
-
-         DO jj = 2,jpjm1
-            DO ji = 2,jpim1
-               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-               ! horizontal diffusive trends
-               ztra = zbtr * (  ztru(ji,jj,jk,jl) - ztru(ji-1,jj,jk,jl)   &
-                  &          + ztrv(ji,jj,jk,jl) - ztrv(ji,jj-1,jk,jl)  )
-               ! add it to the general tracer trends
-               tra(ji,jj,jk,jl) = (tra(ji,jj,jk,jl) + ztra)
-            END DO
-         END DO
-
-      ENDDO
       ENDDO
  
-      CALL wrk_dealloc( jpi, jpj, localviscsponge )
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab )
+      CALL wrk_dealloc( jpi, jpj, ztru, ztrv )
+      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )
 
 #endif
@@ -153 +88 @@
    END SUBROUTINE Agrif_Sponge_Trc
 
-   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,l1,l2)
+   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
       !!---------------------------------------------
       !!   *** ROUTINE interptn ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"       
-      
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2,l1:l2) = trn(i1:i2,j1:j2,k1:k2,l1:l2)
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      !
+      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
 
    END SUBROUTINE interptrn