shapiro_mod Module Reference

Functions/Subroutines
subroutine	shapiro2d_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, amask, a)
subroutine	shapiro3d_tile (ng, tile, model, lbi, ubi, lbj, ubj, lbk, ubk, imins, imaxs, jmins, jmaxs, amask, a)

Function/Subroutine Documentation

shapiro2d_tile()

subroutine shapiro_mod::shapiro2d_tile	(	integer, intent(in)	ng,
		integer, intent(in)	tile,
		integer, intent(in)	model,
		integer, intent(in)	lbi,
		integer, intent(in)	ubi,
		integer, intent(in)	lbj,
		integer, intent(in)	ubj,
		integer, intent(in)	imins,
		integer, intent(in)	imaxs,
		integer, intent(in)	jmins,
		integer, intent(in)	jmaxs,
		real(r8), dimension(lbi:,lbj:), intent(in)	amask,
		real(r8), dimension(lbi:,lbj:), intent(inout)	a )

Definition at line 26 of file shapiro.F.

!***********************************************************************
!
      USE mod_param
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
      integer, intent(in) :: LBi, UBi, LBj, UBj
      integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
 
#ifdef ASSUMED_SHAPE
# ifdef MASKING
      real(r8), intent(in) :: Amask(LBi:,LBj:)
# endif
      real(r8), intent(inout) :: A(LBi:,LBj:)
#else
# ifdef MASKING
      real(r8), intent(in) :: Amask(LBi:UBi,LBj:UBj)
# endif
      real(r8), intent(inout) :: A(LBi:UBi,LBj:UBj)
#endif
!
!  Local variable declarations.
!
      integer :: i, j
!
      real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Awrk1
      real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Awrk2
 
#include "set_bounds.h"
!
!-----------------------------------------------------------------------
!  Shapiro filter requested 2D field.
!-----------------------------------------------------------------------
!
!  This subroutine will apply a Shapiro filter of order 2 (defined
!  as twice the order in Shapiro (1970), with N even) to an array, A.
!  The order of the filter is reduced at the boundaries and at the
!  mask edges, if any.
!
!  Initialize filter in the Y-direction.
!
      DO j=jstr,jend
        DO i=istr-1,iend+1
#ifdef MASKING
          awrk1(i,j)=0.25_r8*                                           &
     &               (a(i,j-1)*amask(i,j-1)+                            &
     &                a(i,j+1)*amask(i,j+1)-                            &
     &                2.0_r8*a(i,j)*amask(i,j))*                        &
     &               amask(i,j-1)*amask(i,j+1)*amask(i,j)
#else
          awrk1(i,j)=0.25_r8*                                           &
     &               (a(i,j-1)+a(i,j+1)-2.0_r8*a(i,j))
#endif
        END DO
      END DO
!
!  Add the changes to the field.
!
      DO j=jstr,jend
        DO i=istr-1,iend+1
          awrk2(i,j)=a(i,j)+awrk1(i,j)
        END DO
      END DO
!
!  Initialize filter in the X-direction.
!
      DO j=jstr,jend
        DO i=istr,iend
#ifdef MASKING
          awrk1(i,j)=0.25_r8*                                           &
     &               (awrk2(i-1,j)*amask(i-1,j)+                        &
     &                awrk2(i+1,j)*amask(i+1,j)-                        &
     &                2.0_r8*awrk2(i,j)*amask(i,j))*                    &
     &               amask(i-1,j)*amask(i+1,j)*amask(i,j)
#else
          awrk1(i,j)=0.25_r8*                                           &
     &               (awrk2(i-1,j)+awrk2(i+1,j)-2.0_r8*awrk2(i,j))
#endif
        END DO
      END DO
!
!  Add changes to field.
!
      DO j=jstr,jend
        DO i=istr,iend
          a(i,j)=awrk2(i,j)+awrk1(i,j)
        END DO
      END DO
!
      RETURN

Referenced by lmd_bkpp_tile(), lmd_skpp_tile(), regrid_mod::regrid_nf90(), and regrid_mod::regrid_pio().

Here is the caller graph for this function:

shapiro3d_tile()

subroutine shapiro_mod::shapiro3d_tile	(	integer, intent(in)	ng,
		integer, intent(in)	tile,
		integer, intent(in)	model,
		integer, intent(in)	lbi,
		integer, intent(in)	ubi,
		integer, intent(in)	lbj,
		integer, intent(in)	ubj,
		integer, intent(in)	lbk,
		integer, intent(in)	ubk,
		integer, intent(in)	imins,
		integer, intent(in)	imaxs,
		integer, intent(in)	jmins,
		integer, intent(in)	jmaxs,
		real(r8), dimension(lbi:,lbj:), intent(in)	amask,
		real(r8), dimension(lbi:,lbj:,lbk:), intent(inout)	a )

Definition at line 129 of file shapiro.F.

!***********************************************************************
!
      USE mod_param
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
      integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
      integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
# ifdef ASSUMED_SHAPE
#  ifdef MASKING
      real(r8), intent(in) :: Amask(LBi:,LBj:)
#  endif
      real(r8), intent(inout) :: A(LBi:,LBj:,LBk:)
# else
#  ifdef MASKING
      real(r8), intent(in) :: Amask(LBi:UBi,LBj:UBj)
#  endif
      real(r8), intent(inout) :: A(LBi:UBi,LBj:UBj,LBk:UBk)
# endif
!
!  Local variable declarations.
!
      integer :: i, j, k
!
      real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Awrk1
      real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Awrk2
 
# include "set_bounds.h"
!
!-----------------------------------------------------------------------
!  Shapiro filter requested 3D field.
!-----------------------------------------------------------------------
!
!  This subroutine will apply a Shapiro filter of order 2 (defined
!  as twice the order in Shapiro (1970), with N even) to an array, A.
!  The order of the filter is reduced at the boundaries and at the
!  mask edges, if any.
!
!  Initialize filter in the Y-direction.
!
      DO k=lbk,ubk
        DO j=jstr,jend
          DO i=istr-1,iend+1
# ifdef MASKING
            awrk1(i,j)=0.25_r8*                                         &
     &                 (a(i,j-1,k)*amask(i,j-1)+                        &
     &                  a(i,j+1,k)*amask(i,j+1)-                        &
     &                  2.0_r8*a(i,j,k)*amask(i,j))*                    &
     &                 amask(i,j-1)*amask(i,j+1)*amask(i,j)
# else
            awrk1(i,j)=0.25_r8*                                         &
     &                 (a(i,j-1,k)+a(i,j+1,k)-2.0_r8*a(i,j,k))
# endif
          END DO
        END DO
!
!  Add the changes to the field.
!
        DO j=jstr,jend
          DO i=istr-1,iend+1
            awrk2(i,j)=a(i,j,k)+awrk1(i,j)
          END DO
        END DO
!
!  Initialize filter in the X-direction.
!
        DO j=jstr,jend
          DO i=istr,iend
# ifdef MASKING
            awrk1(i,j)=0.25_r8*                                         &
     &                 (awrk2(i-1,j)*amask(i-1,j)+                      &
     &                  awrk2(i+1,j)*amask(i+1,j)-                      &
     &                  2.0_r8*awrk2(i,j)*amask(i,j))*                  &
     &                 amask(i-1,j)*amask(i+1,j)*amask(i,j)
# else
            awrk1(i,j)=0.25_r8*                                         &
     &                 (awrk2(i-1,j)+awrk2(i+1,j)-2.0_r8*awrk2(i,j))
# endif
          END DO
        END DO
!
!  Add changes to field.
!
        DO j=jstr,jend
          DO i=istr,iend
            a(i,j,k)=awrk2(i,j)+awrk1(i,j)
          END DO
        END DO
      END DO
!
      RETURN