steepz.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

!----------------------------------------------------------------------- 
!BOP
! !ROUTINE:  steepz --- Calculate attributes for PPM
!
! !INTERFACE:
      subroutine steepz(i1, i2, km, a4, df2, dm, dq, dp, d4)

! !USES:
      use precision
      implicit none

! !INPUT PARAMETERS:
      integer km                        ! Total levels
      integer i1                        ! Starting longitude
      integer i2                        ! Finishing longitude
      real(r8)  dp(i1:i2,km)            ! grid size
      real(r8)  dq(i1:i2,km)            ! backward diff of q
      real(r8)  d4(i1:i2,km)            ! backward sum:  dp(k)+ dp(k-1) 
      real(r8) df2(i1:i2,km)            ! first guess mismatch
      real(r8)  dm(i1:i2,km)            ! monotonic mismatch

! !INPUT/OUTPUT PARAMETERS:
      real(r8)  a4(4,i1:i2,km)          ! first guess/steepened

!
! !DESCRIPTION:
!   This is complicated stuff related to the Piecewise Parabolic Method
!   and I need to read the Collela/Woodward paper before documenting
!   thoroughly.
!
! !REVISION HISTORY: 
!   ??.??.??    Lin?       Creation
!   01.03.26    Sawyer     Added ProTeX documentation
!
!EOP
!-----------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
      integer i, k
      real(r8) alfa(i1:i2,km)
      real(r8)    f(i1:i2,km)
      real(r8)  rat(i1:i2,km)
      real(r8)  dg2

! Compute ratio of dq/dp
      do k=2,km
         do i=i1,i2
            rat(i,k) = dq(i,k-1) / d4(i,k)
         enddo
      enddo

! Compute F
      do k=2,km-1
         do i=i1,i2
            f(i,k) = (rat(i,k+1) - rat(i,k))                             &
                     / ( dp(i,k-1)+dp(i,k)+dp(i,k+1) )
         enddo
      enddo

      do k=3,km-2
         do i=i1,i2
         if(f(i,k+1)*f(i,k-1).lt.0. .and. df2(i,k).ne.0.) then
            dg2 = (f(i,k+1)-f(i,k-1))*((dp(i,k+1)-dp(i,k-1))**2          &
                   + d4(i,k)*d4(i,k+1) )
            alfa(i,k) = max(0., min(0.5, -0.1875*dg2/df2(i,k))) 
         else
            alfa(i,k) = 0.
         endif
         enddo
      enddo

      do k=4,km-2
         do i=i1,i2
            a4(2,i,k) = (1.-alfa(i,k-1)-alfa(i,k)) * a4(2,i,k) +         &
                        alfa(i,k-1)*(a4(1,i,k)-dm(i,k))    +             &
                        alfa(i,k)*(a4(1,i,k-1)+dm(i,k-1))
         enddo
      enddo

      return
!EOC
      end subroutine steepz
!-----------------------------------------------------------------------