smooth_diff2d.F

C $Header: /u/gcmpack/MITgcm/pkg/smooth/smooth_diff2d.F,v 1.2 2010/04/13 04:43:45 gforget Exp $
C $Name:  $

#include "SMOOTH_OPTIONS.h"

      subroutine smooth_diff2D (
     U     fld_in,mask_in,nbt_in,mythid)

C     *==========================================================*
C     | SUBROUTINE smooth_diff2D
C     | o Routine that smoothes a 2D field, using diffusion
C     *==========================================================*

      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "GRID.h"
#include "PARAMS.h"
#ifdef ALLOW_AUTODIFF_TAMC
#include "tamc.h"
#include "tamc_keys.h"
#endif /* ALLOW_AUTODIFF_TAMC */
#include "SMOOTH.h"

      integer i,j,k, bi, bj
      integer itlo,ithi
      integer jtlo,jthi
      integer myThid,myIter(nSx,nSy),key_in

      _RL smooth2Dmask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)

      _RL mask_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nR,nSx,nSy)
      _RL fld_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      _RL gt_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      _RL gtm1_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      integer nbt_in

      integer iloop, ilev_1, ilev_2, ilev_3
      integer max_lev2, max_lev3
      _RL ab15,ab05
      _RL gt_tmp 
      character*( 80) fnamegeneric


c for now: useless, because level 3 is recomputed anyway 
c but : if level3 was computed during the fwd loop by callung
c       mdsmooth_diff3D (assumes that it would be called
c       directly by the_main_loop) then I would need to pass key_in
c       as a parameter, with different values for T, S, ...
c       in order not to overwrite the same tape
      key_in=0

      jtlo = mybylo(mythid)
      jthi = mybyhi(mythid)
      itlo = mybxlo(mythid)
      ithi = mybxhi(mythid)

      DO bj = jtlo,jthi
       DO bi = itlo,ithi
        DO j = 1,sNy
         DO i = 1,sNx
           gt_in(i,j,bi,bj)   = 0. _d 0
           gtm1_in(i,j,bi,bj)   = 0. _d 0
           smooth2Dmask(i,j,bi,bj) = mask_in(i,j,1,bi,bj)
         ENDDO
        ENDDO
       ENDDO
      ENDDO

      _EXCH_XY_RL ( fld_in , myThid )
      _EXCH_XY_RL ( gt_in , myThid )
      _EXCH_XY_RL ( gtm1_in , myThid )
      _EXCH_XY_RL ( smooth2Dmask , myThid )

#ifdef ALLOW_TAMC_CHECKPOINTING

c checkpointing:
      max_lev3=nbt_in/(nchklev_1*nchklev_2)+1
      max_lev2=nbt_in/nchklev_1+1
#ifdef ALLOW_AUTODIFF_TAMC
CADJ INIT tape_smooth2D_lev3 = USER
#endif /* ALLOW_AUTODIFF_TAMC */
      do ilev_3 = 1,nchklev_3
        if(ilev_3.le.max_lev3) then
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE fld_in = tape_smooth2D_lev3 ,  
CADJ & key = key_in*max_lev3 + ilev_3
CADJ STORE gTm1_in = tape_smooth2D_lev3 ,   
CADJ & key = key_in*max_lev3 + ilev_3
#endif /* ALLOW_AUTODIFF_TAMC */
#ifdef ALLOW_AUTODIFF_TAMC
CADJ INIT tape_smooth2D_lev2 = USER
#endif /* ALLOW_AUTODIFF_TAMC */

      do ilev_2 = 1,nchklev_2
         if(ilev_2.le.max_lev2) then
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE fld_in = tape_smooth2D_lev2 ,   
CADJ & key = key_in*nchklev_2 + ilev_2
CADJ STORE gTm1_in = tape_smooth2D_lev2 ,    
CADJ & key = key_in*nchklev_2 + ilev_2
#endif /* ALLOW_AUTODIFF_TAMC */
#ifdef ALLOW_AUTODIFF_TAMC
CADJ INIT tape_smooth2D_lev1  = COMMON,
CADJ & nchklev_1*nsx*nsy*nthreads_chkpt
#endif /* ALLOW_AUTODIFF_TAMC */

      do ilev_1 = 1,nchklev_1
      iloop = (ilev_2 - 1)*nchklev_1 + ilev_1
     &            + (ilev_3 - 1)*nchklev_2*nchklev_1
      if ( iloop .le. nbt_in ) then
#ifdef ALLOW_AUTODIFF_TAMC
c needed?? CADJ STORE fld_in = tape_smooth2D_lev1 ,   
c CADJ & key = key_in*nchklev_1 + ilev_1
CADJ STORE gtm1_in = tape_smooth2D_lev1 ,   
CADJ & key = key_in*nchklev_1 + ilev_1
#endif /* ALLOW_AUTODIFF_TAMC */


#else /* ALLOW_TAMC_CHECKPOINTING */
      do iloop=1,nbt_in
#endif

      DO bj = jtlo,jthi
         DO bi = itlo,ithi
            DO j = 1,sNy
               DO i = 1,sNx

      gt_in(i,j,bi,bj)=0.

      if (smooth2Dmask(i,j,bi,bj).NE.0.) then

      gt_in(i,j,bi,bj)=gt_in(i,j,bi,bj)+
     & smooth2D_Kux(i,j,bi,bj)*dyG(i,j,bi,bj)*
     & smooth2Dmask(i,j,bi,bj)*smooth2Dmask(i-1,j,bi,bj)*
     & (fld_in(i,j,bi,bj)-fld_in(i-1,j,bi,bj))*recip_dxC(i,j,bi,bj)

      gt_in(i,j,bi,bj)=gt_in(i,j,bi,bj)+
     & smooth2D_Kux(i+1,j,bi,bj)*dyG(i+1,j,bi,bj)*
     & smooth2Dmask(i,j,bi,bj)*smooth2Dmask(i+1,j,bi,bj)*
     & (fld_in(i,j,bi,bj)-fld_in(i+1,j,bi,bj))*recip_dxC(i+1,j,bi,bj)

      gt_in(i,j,bi,bj)=gt_in(i,j,bi,bj)+
     & smooth2D_Kvy(i,j,bi,bj)*dxG(i,j,bi,bj)*
     & smooth2Dmask(i,j,bi,bj)*smooth2Dmask(i,j-1,bi,bj)*
     & (fld_in(i,j,bi,bj)-fld_in(i,j-1,bi,bj))*recip_dyC(i,j,bi,bj)

      gt_in(i,j,bi,bj)=gt_in(i,j,bi,bj)+
     & smooth2D_Kvy(i,j+1,bi,bj)*dxG(i,j+1,bi,bj)*
     & smooth2Dmask(i,j,bi,bj)*smooth2Dmask(i,j+1,bi,bj)*
     & (fld_in(i,j,bi,bj)-fld_in(i,j+1,bi,bj))*recip_dyC(i,j+1,bi,bj)

      endif

           ENDDO
          ENDDO
         ENDDO
        ENDDO

      do bj = jtlo,jthi
         do bi = itlo,ithi
c Adams-Bashforth timestepping 
      myIter(bi,bj)=iloop-1
      IF ( myIter(bi,bj).EQ.0 ) THEN
       ab15=1.0
       ab05=0.0
      ELSE
       ab15=1.5+abEps
       ab05=-(0.5+abEps)
      ENDIF
            DO j = 1,sNy
               DO i = 1,sNx
c Compute effective G-term with Adams-Bashforth
        gt_tmp = ab15*gt_in(i,j,bi,bj)
     &         + ab05*gtm1_in(i,j,bi,bj)
        gtm1_in(i,j,bi,bj) = gt_in(i,j,bi,bj)
        gt_in(i,j,bi,bj) = gt_tmp 
c time step:
      fld_in(i,j,bi,bj)=fld_in(i,j,bi,bj)
     & -gt_in(i,j,bi,bj)*recip_rA(i,j,bi,bj)*smooth2DdelTime
           gt_in(i,j,bi,bj)=0
           ENDDO
          ENDDO
         ENDDO
        ENDDO

      _EXCH_XY_RL ( gt_in , myThid )
      _EXCH_XY_RL ( fld_in , myThid )
      _EXCH_XY_RL ( gtm1_in , myThid )

#ifdef ALLOW_TAMC_CHECKPOINTING
      endif
      enddo
      endif
      enddo
      endif
      enddo
#else /* ALLOW_TAMC_CHECKPOINTING */
      enddo 
#endif

      end