Changeset 2789 for branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

Timestamp:

2011-06-27T13:18:25+02:00 (13 years ago)

Author:

cetlod

Message:

Implementation of the merge of TRA/TRP : first guess, see ticket #842

File:

• branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90 (modified) (4 diffs)

branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

@@ -30 +30 @@
       !!---------------------------------------------
       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY: wrk_3d_1
+      USE wrk_nemo, ONLY: wrk_4d_1
       !!
       INTEGER, INTENT(in) :: kt
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
 
        
       IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
 #if defined TWO_WAY
-      ztab => wrk_3d_1
-      IF( wrk_in_use(3, 1) ) THEN
+      IF( wrk_in_use(4, 1) ) THEN
          CALL ctl_stop('agrif_update_tra: ERROR: requested workspace arrays unavailable')
          RETURN
       END IF
+      ztab => wrk_4d_1
 
       Agrif_UseSpecialValueInUpdate = .TRUE.
@@ -48 +48 @@
 
       IF (MOD(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable(ztab,tn_id, procname=updateT)
-         CALL Agrif_Update_Variable(ztab,sn_id, procname=updateS)
-      ELSE
-         CALL Agrif_Update_Variable(ztab,tn_id,locupdate=(/0,2/), procname=updateT)
-         CALL Agrif_Update_Variable(ztab,sn_id,locupdate=(/0,2/), procname=updateS)
+         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS)
+      ELSE
+         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS)
       ENDIF
 
       Agrif_UseSpecialValueInUpdate = .FALSE.
 
-      IF( wrk_not_released(3, 1) ) THEN
+      IF( wrk_not_released(4, 1) ) THEN
          CALL ctl_stop('Agrif_Update_Tra: ERROR: failed to release workspace arrays')
       END IF
@@ -124 +122 @@
    END SUBROUTINE recompute_diags
 
-   SUBROUTINE updateT( tabres, i1, i2, j1, j2, k1, k2, before )
+   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
       !!---------------------------------------------
       !!           *** ROUTINE updateT ***
@@ -130 +128 @@
 #  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
+      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
-
-      IF (before) THEN
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  tabres(ji,jj,jk) = tn(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSE
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  IF( tabres(ji,jj,jk) .NE. 0. ) THEN
-                     tn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk)
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-   END SUBROUTINE updateT
-
-   SUBROUTINE updateS( tabres, i1, i2, j1, j2, k1, k2, before )
-      !!---------------------------------------------
-      !!           *** ROUTINE updateS ***
-      !!---------------------------------------------
-#  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
-      LOGICAL, iNTENT(in) :: before
-
-      INTEGER :: ji,jj,jk
-
-      IF (before) THEN
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  tabres(ji,jj,jk) = sn(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSE
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  IF (tabres(ji,jj,jk).NE.0.) THEN
-                     sn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk)
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-   END SUBROUTINE updateS
+      INTEGER :: ji,jj,jk,jn
+
+      IF (before) THEN
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)
+                  END DO
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
+                         tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk)
+                     END IF
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+   END SUBROUTINE updateTS
 
    SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before )