source: trunk/NEMO/NST_SRC/agrif_top_interp.F90 @ 635

!
      Module agrif_top_interp
#if defined key_agrif && defined key_passivetrc
      USE par_oce
      USE oce
      USE dom_oce      
      USE sol_oce
      USE trc
      USE sms

      CONTAINS
      SUBROUTINE Agrif_trc( kt )

      Implicit none
      
   !! * Substitutions
#  include "domzgr_substitute.h90"  
#  include "vectopt_loop_substitute.h90"
!
      INTEGER :: kt
      REAL(wp) tratemp(jpi,jpj,jpk,jptra)
      INTEGER :: ji,jj,jk,jn
      REAL(wp) :: rhox
      REAL(wp) :: alpha1, alpha2, alpha3, alpha4
      REAL(wp) :: alpha5, alpha6, alpha7
!
        IF (Agrif_Root()) RETURN

           Agrif_SpecialValue=0.
           Agrif_UseSpecialValue = .TRUE.
           tratemp = 0.

           Call Agrif_Bc_variable(tratemp,trn)
           Agrif_UseSpecialValue = .FALSE.
       
           rhox = Agrif_Rhox()
   
           alpha1 = (rhox-1.)/2.
           alpha2 = 1.-alpha1
   
           alpha3 = (rhox-1)/(rhox+1)
           alpha4 = 1.-alpha3
   
           alpha6 = 2.*(rhox-1.)/(rhox+1.)
           alpha7 = -(rhox-1)/(rhox+3)
           alpha5 = 1. - alpha6 - alpha7
   
!
      If ((nbondi == 1).OR.(nbondi == 2)) THEN
      
      tra(nlci,:,:,:) = alpha1 * tratemp(nlci,:,:,:) + alpha2 * tratemp(nlci-1,:,:,:)
      
    Do jn=1,jptra 
      Do jk=1,jpk      
      Do jj=1,jpj
        IF (umask(nlci-2,jj,jk).EQ.0.) THEN
        tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
        ELSE
        tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
         IF (un(nlci-2,jj,jk).GT.0.) THEN
          tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) &
                               +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk)
         ENDIF
        ENDIF
      End Do
      enddo 
    END DO
      ENDIF        
     
      If ((nbondj == 1).OR.(nbondj == 2)) THEN
      
      tra(:,nlcj,:,:) = alpha1 * tratemp(:,nlcj,:,:) + alpha2 * tratemp(:,nlcj-1,:,:)
 
   DO jn=1, jptra            
      Do jk=1,jpk      
      Do ji=1,jpi
        IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN
        tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
        ELSE
        tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
          IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN
           tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) &
                                +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk)
          ENDIF
        ENDIF
      End Do
      enddo
   END DO
      ENDIF

      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
      
      tra(1,:,:,:) = alpha1 * tratemp(1,:,:,:) + alpha2 * tratemp(2,:,:,:)
      
     DO jn=1, jptra
      Do jk=1,jpk      
      Do jj=1,jpj
        IF (umask(2,jj,jk).EQ.0.) THEN
        tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
        ELSE
        tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
         IF (un(2,jj,jk).LT.0.) THEN
           tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) &
                           +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
         ENDIF
        ENDIF
      End Do
      enddo
     END DO
      ENDIF
      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
      
      tra(:,1,:,:) = alpha1 * tratemp(:,1,:,:) + alpha2 * tratemp(:,2,:,:)
            
   DO jn=1, jptra  
    Do jk=1,jpk      
      Do ji=1,jpi
        IF (vmask(ji,2,jk).EQ.0.) THEN
        tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
        ELSE
        tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
          IF (vn(ji,2,jk) .LT. 0.) THEN
            tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)&
                            +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
          ENDIF
        ENDIF
      End Do
      enddo
     END DO 
      ENDIF

      End Subroutine Agrif_trc
!
!


#else
      CONTAINS
      subroutine Agrif_TOP_Interp_empty

      end subroutine Agrif_TOP_Interp_empty
#endif
      End Module agrif_top_interp