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

Timestamp:

2007-03-07T14:28:16+01:00 (17 years ago)

Author:

opalod

Message:

nemo_v2_update_008:RB: clean agrif routines and add sponge layer coefficient in namelist

File:

• trunk/NEMO/NST_SRC/agrif_top_update.F90 (modified) (1 diff)

trunk/NEMO/NST_SRC/agrif_top_update.F90

@@ -1 +1 @@
 #define TWO_WAY
 
-      Module agrif_top_update
+MODULE agrif_top_update
+
 #if defined key_agrif && defined key_passivetrc
-      USE par_oce
-      USE oce
-      USE dom_oce
-      USE trc
-      USE sms
-      
-      Integer, Parameter :: nbclineupdate = 3
-      Integer :: nbcline
+   USE par_oce
+   USE oce
+   USE dom_oce
+   USE trcstp
+   USE sms
 
-      Contains
+   IMPLICIT NONE
+   PRIVATE
 
-      Subroutine Agrif_Update_Trc( kt )
-!
-!     Modules used:
-!
+   PUBLIC Agrif_Update_Trc
 
-      implicit none
-!
-!     Declarations:
-      INTEGER :: kt
-!
-!
-!     Variables
-!
-      Real :: tabtemp(jpi,jpj,jpk,jptra)
-!
-!     Begin
-!
+   INTEGER, PARAMETER :: nbclineupdate = 3
+   INTEGER :: nbcline
 
-      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return
-#if defined TWO_WAYxiv8
+   CONTAINS
+
+   SUBROUTINE Agrif_Update_Trc( kt )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Trc ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: kt
+  
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztra
+
+      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+
+#if defined TWO_WAY
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-      IF (mod(nbcline,nbclineupdate) == 0) THEN
-      Call Agrif_Update_Variable(tabtemp,trn, procname=updateTRC)
+ 
+     IF (MOD(nbcline,nbclineupdate) == 0) THEN
+         CALL Agrif_Update_Variable(ztra,trn, procname=updateTRC)
       ELSE
-      Call Agrif_Update_Variable(tabtemp,trn,locupdate=(/0,2/), procname=updateTRC)
+         CALL Agrif_Update_Variable(ztra,trn,locupdate=(/0,2/), procname=updateTRC)
       ENDIF
-
 
       Agrif_UseSpecialValueInUpdate = .FALSE.
 #endif
 
-      End subroutine Agrif_Update_Trc
+   END SUBROUTINE Agrif_Update_Trc
 
+   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE UpdateTrc ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
 
-       subroutine updateTRC(tabres,i1,i2,j1,j2,k1,k2,before)
-       Implicit none
-#  include "domzgr_substitute.h90"
-       integer i1,i2,j1,j2,k1,k2
-       integer ji,jj,jk,jn
-       real,dimension(i1:i2,j1:j2,k1:k2,jptra) :: tabres
-       LOGICAL :: before
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,jptra), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+   
+      INTEGER :: ji,jj,jk,jn
 
-    DO jn=1, jptra  
-       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)
-             ENDDO
-           ENDDO
-         ENDDO
-         
-       ELSE
+      DO jn=1, jptra  
 
-         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
-             ENDDO
+         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)
+                  ENDDO
+               ENDDO
             ENDDO
-          ENDDO
-       ENDIF
+         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
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDIF
 
-    END DO
- 
-       end subroutine updateTRC
+      END DO
 
-       
+   END SUBROUTINE updateTRC
 
-       
 #else
-       CONTAINS
-       subroutine agrif_top_update_empty
-       end subroutine agrif_top_update_empty
+CONTAINS
+   SUBROUTINE agrif_top_update_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE agrif_Top_update_empty ***
+      !!---------------------------------------------
+      WRITE(*,*)  'agrif_top_update : You should not have seen this print! error?'
+   END SUBROUTINE agrif_top_update_empty
 #endif
-       End Module agrif_top_update
+END Module agrif_top_update