Changeset 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

Timestamp:

2015-08-12T17:46:45+02:00 (9 years ago)

Author:

mattmartin

Message:

OBS simplification changes committed to branch after running SETTE tests to make sure we get the same results as the trunk for ORCA2_LIM_OBS.

File:

• branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90 (modified) (3 diffs)

branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

@@ -1 +1 @@
 #define SPONGE_TOP
 
-Module agrif_top_sponge
+MODULE agrif_top_sponge
 #if defined key_agrif && defined key_top
    USE par_oce
+   USE par_trc
    USE oce
    USE dom_oce
@@ -16 +17 @@
    PRIVATE
 
-   PUBLIC Agrif_Sponge_Trc, interptrn
+   PUBLIC Agrif_Sponge_trc, interptrn_sponge
 
-  !! * Substitutions
+   !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
-   CONTAINS
+CONTAINS
 
-   SUBROUTINE Agrif_Sponge_Trc
+   SUBROUTINE Agrif_Sponge_trc
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Sponge_Trc ***
       !!---------------------------------------------
       !! 
-      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
-      REAL(wp) :: ztra, zabe1, zabe2, zbtr
-      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, ztru, ztrv )
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )
-
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
-
+      CALL Agrif_sponge
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      ztabr = 0.e0
-      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn)
+      tabspongedone_trn = .FALSE.
+      CALL Agrif_Bc_Variable(trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge)
       Agrif_UseSpecialValue = .FALSE.
-
-      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)
-
-      CALL Agrif_sponge
-
-      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
-
-            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
-      ENDDO
- 
-      CALL wrk_dealloc( jpi, jpj, ztru, ztrv )
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )
 
 #endif
@@ -88 +49 @@
    END SUBROUTINE Agrif_Sponge_Trc
 
-   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
+   SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
       !!---------------------------------------------
-      !!   *** ROUTINE interptn ***
+      !!   *** ROUTINE interptrn_sponge ***
       !!---------------------------------------------
       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
+      LOGICAL, INTENT(in) :: before
+
+
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+
+      REAL(wp) :: ztra, zabe1, zabe2, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff
       !
-      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      IF (before) THEN
+         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE      
 
-   END SUBROUTINE interptrn
+         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)      
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+
+               DO jj = j1,j2-1
+                  DO ji = i1,i2-1
+                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
+                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                  ENDDO
+               ENDDO
+
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+
+                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN 
+                        zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,jk)
+                        ! horizontal diffusive trends
+                        ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  )
+                        ! add it to the general tracer trends
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                     ENDIF
+
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+      !                 
+   END SUBROUTINE interptrn_sponge
 
 #else