Changeset 1300 for trunk/NEMO/NST_SRC/agrif_top_update.F90

Timestamp:

2009-02-09T16:36:04+01:00 (15 years ago)

Author:

rblod

Message:

Correct a bug in TOP update part

File:

• trunk/NEMO/NST_SRC/agrif_top_update.F90 (modified) (4 diffs)

trunk/NEMO/NST_SRC/agrif_top_update.F90

@@ -15 +15 @@
    PUBLIC Agrif_Update_Trc
 
-   INTEGER :: nbcline
+   INTEGER, PUBLIC :: nbcline_trc = 0
 
    !!----------------------------------------------------------------------
@@ -39 +39 @@
       Agrif_SpecialValueFineGrid = 0.
  
-     IF (MOD(nbcline,nbclineupdate) == 0) THEN
+     IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
          CALL Agrif_Update_Variable(ztra,trn, procname=updateTRC)
       ELSE
@@ -46 +46 @@
 
       Agrif_UseSpecialValueInUpdate = .FALSE.
+      nbcline_trc = nbcline_trc + 1
 #endif
 
    END SUBROUTINE Agrif_Update_Trc
 
-   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,before)
+   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,l1,l2,before)
       !!---------------------------------------------
       !!   *** ROUTINE UpdateTrc ***
@@ -56 +57 @@
 #  include "domzgr_substitute.h90"
 
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,jptra), INTENT(inout) :: tabres
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2
+      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
    
-      INTEGER :: ji,jj,jk,jn
-
-      DO jn=1, jptra  
+      INTEGER :: ji,jj,jk,jl
 
          IF (before) THEN
-            DO jk=k1,k2
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                     tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+            DO jl=l1,l2
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        tabres(ji,jj,jk,jl) = trn(ji,jj,jk,jl)
+                     ENDDO
                   ENDDO
                ENDDO
             ENDDO
          ELSE
-            DO jk=k1,k2
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                     IF (tabres(ji,jj,jk,jn).NE.0.) THEN
-                        trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk)
-                     ENDIF
+            DO jl=l1,l2
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        IF (tabres(ji,jj,jk,jl).NE.0.) THEN
+                           trn(ji,jj,jk,jl) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk)
+                        ENDIF
+                     ENDDO
                   ENDDO
                ENDDO
             ENDDO
          ENDIF
-
-      END DO
 
    END SUBROUTINE updateTRC