source: trunk/NEMO/NST_SRC/agrif_top_update.F90 @ 1146

#define TWO_WAY

MODULE agrif_top_update

#if defined key_agrif && defined key_passivetrc
   USE par_oce
   USE oce
   USE dom_oce
   USE agrif_oce
   USE trcstp
   USE sms

   IMPLICIT NONE
   PRIVATE

   PUBLIC Agrif_Update_Trc

   INTEGER :: nbcline

   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(ztra,trn, procname=updateTRC)
      ELSE
         CALL Agrif_Update_Variable(ztra,trn,locupdate=(/0,2/), procname=updateTRC)
      ENDIF

      Agrif_UseSpecialValueInUpdate = .FALSE.
#endif

   END SUBROUTINE Agrif_Update_Trc

   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,before)
      !!---------------------------------------------
      !!   *** ROUTINE UpdateTrc ***
      !!---------------------------------------------
#  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
      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 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

#else
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