Changeset 3294 for trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

Timestamp:

2012-01-28T17:44:18+01:00 (12 years ago)

Author:

rblod

Message:

Merge of 3.4beta into the trunk

File:

• trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90 (modified) (8 diffs)

trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

@@ -8 +8 @@
    USE in_out_manager
    USE agrif_oce
+   USE wrk_nemo  
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptn, interpsn, interpun, interpvn
+   PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn
 
    !!----------------------------------------------------------------------
@@ -27 +28 @@
       !!---------------------------------------------
 #include "domzgr_substitute.h90"
-      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY: wrk_2d_1
-      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2
-      USE wrk_nemo, ONLY: wrk_3d_3, wrk_3d_4
-      USE wrk_nemo, ONLY: wrk_3d_7, wrk_3d_6
-      USE wrk_nemo, ONLY: wrk_3d_8
       !!
-      INTEGER :: ji,jj,jk
+      INTEGER :: ji,jj,jk,jn
       INTEGER :: spongearea
       REAL(wp) :: timecoeff
-      REAL(wp) :: zta, zsa, zabe1, zabe2, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: tbdiff, sbdiff
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, zsu, ztv, zsv
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
+      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
+      REAL(wp), POINTER, DIMENSION(:,:    ) :: localviscsponge
+      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff
 
 #if defined SPONGE
-      localviscsponge => wrk_2d_1
-      tbdiff => wrk_3d_1 ;sbdiff => wrk_3d_2
-      ztu => wrk_3d_3 ; zsu => wrk_3d_4
-      ztv => wrk_3d_7 ; zsv => wrk_3d_6
-      ztab => wrk_3d_8
+      CALL wrk_alloc( jpi, jpj, localviscsponge, ztu, ztv )
+      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
 
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
@@ -55 +47 @@
       Agrif_UseSpecialValue = .TRUE.
       ztab = 0.e0
-      CALL Agrif_Bc_Variable(ztab, ta_id,calledweight=timecoeff,procname=interptn)
+      CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn)
       Agrif_UseSpecialValue = .FALSE.
 
-      tbdiff(:,:,:) = tb(:,:,:) - ztab(:,:,:)
-
-      ztab = 0.e0
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = .TRUE.
-      CALL Agrif_Bc_Variable(ztab, sa_id,calledweight=timecoeff,procname=interpsn)
-      Agrif_UseSpecialValue = .FALSE.
-
-      sbdiff(:,:,:) = sb(:,:,:) - ztab(:,:,:)
+      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:)
 
       spongearea = 2 + 2 * Agrif_irhox()
@@ -137 +121 @@
       ENDIF
 
-      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)
-               ztu(ji,jj,jk) = zabe1 * ( tbdiff(ji+1,jj  ,jk) - tbdiff(ji,jj,jk) )
-               zsu(ji,jj,jk) = zabe1 * ( sbdiff(ji+1,jj  ,jk) - sbdiff(ji,jj,jk) )
-               ztv(ji,jj,jk) = zabe2 * ( tbdiff(ji  ,jj+1,jk) - tbdiff(ji,jj,jk) )
-               zsv(ji,jj,jk) = zabe2 * ( sbdiff(ji  ,jj+1,jk) - sbdiff(ji,jj,jk) )
+      DO jn = 1, jpts
+         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)
+                  ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+                  ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+               ENDDO
             ENDDO
-         ENDDO
-
-         DO jj = 2,jpjm1
-            DO ji = 2,jpim1
-               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-               ! horizontal diffusive trends
-               zta = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
-                  &          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-               zsa = zbtr * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)   &
-                  &          + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = (ta(ji,jj,jk) + zta)
-               sa(ji,jj,jk) = (sa(ji,jj,jk) + zsa)
+
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
+                  ! horizontal diffusive trends
+                  ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  )   &
+                  &              + ztv(ji,jj) - ztv(ji  ,jj-1)  )
+                  ! add it to the general tracer trends
+                  tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
+               END DO
             END DO
-         END DO
-
+            !
+         ENDDO
       ENDDO
 
+      CALL wrk_dealloc( jpi, jpj, localviscsponge, ztu, ztv )
+      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
 #endif
 
@@ -174 +158 @@
       !!---------------------------------------------
 #include "domzgr_substitute.h90"
-      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY: wrk_2d_1
-      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2
-      USE wrk_nemo, ONLY: wrk_3d_3, wrk_3d_4
-      USE wrk_nemo, ONLY: wrk_3d_5
       !!
       INTEGER :: ji,jj,jk
@@ -190 +169 @@
 
 #if defined SPONGE
-      localviscsponge => wrk_2d_1
-      ubdiff => wrk_3d_1 ; vbdiff => wrk_3d_2
-      rotdiff => wrk_3d_3 ; hdivdiff => wrk_3d_4
-      ztab => wrk_3d_5
+      CALL wrk_alloc( jpi, jpj, localviscsponge )
+      CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
 
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
@@ -340 +317 @@
       END DO                                           !   End of slab
       !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, localviscsponge )
+      CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
 
 #endif
@@ -345 +324 @@
    END SUBROUTINE Agrif_Sponge_dyn
 
-   SUBROUTINE interptn(tabres,i1,i2,j1,j2,k1,k2)
-      !!---------------------------------------------
-      !!   *** ROUTINE interptn ***
+   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptsn ***
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"       
       
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2) = tn(i1:i2,j1:j2,k1:k2)
-
-   END SUBROUTINE interptn
-
-   SUBROUTINE interpsn(tabres,i1,i2,j1,j2,k1,k2)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpsn ***
-      !!---------------------------------------------
-#  include "domzgr_substitute.h90"       
-      
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2) = sn(i1:i2,j1:j2,k1:k2)
-
-   END SUBROUTINE interpsn
+      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) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
+
+   END SUBROUTINE interptsn
 
    SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2)