!----------------------------------------------------------------------- !BOP! !ROUTINE:  kmppm --- Perform piecewise parabolic method in vertical!! !INTERFACE:      subroutine kmppm(dm, a4, itot, lmt)! !USES:      use precision      implicit none! !INPUT PARAMETERS:      real(r8)    dm(*)     ! ??????      integer     itot      ! Total Longitudes      integer lmt           ! 0: Standard PPM constraint                            ! 1: Improved full monotonicity constraint (Lin)                            ! 2: Positive definite constraint                            ! 3: do nothing (return immediately)! !INPUT/OUTPUT PARAMETERS:      real(r8)    a4(4,*)   ! ???????                            ! AA <-- a4(1,i)                            ! AL <-- a4(2,i)                            ! AR <-- a4(3,i)                            ! A6 <-- a4(4,i)! !DESCRIPTION:!!    Writes a standard set of data to the history buffer. !! !REVISION HISTORY: !    00.04.24   Lin       Last modification!    01.03.26   Sawyer    Added ProTeX documentation!!EOP!-----------------------------------------------------------------------!BOC!! !LOCAL VARIABLES:      real(r8)       r12      parameter (r12 = 1./12.)      real(r8) qmp      integer i      real(r8) da1, da2, a6da      real(r8) fmin!-----------------------------------------------------------------------      if ( lmt .eq. 3 ) return      if(lmt .eq. 0) then! Standard PPM constraint      do i=1,itot      if(dm(i) .eq. 0.) then         a4(2,i) = a4(1,i)         a4(3,i) = a4(1,i)         a4(4,i) = 0.      else         da1  = a4(3,i) - a4(2,i)         da2  = da1**2         a6da = a4(4,i)*da1         if(a6da .lt. -da2) then            a4(4,i) = 3.*(a4(2,i)-a4(1,i))            a4(3,i) = a4(2,i) - a4(4,i)         elseif(a6da .gt. da2) then            a4(4,i) = 3.*(a4(3,i)-a4(1,i))            a4(2,i) = a4(3,i) - a4(4,i)         endif      endif      enddo      elseif (lmt .eq. 1) then! Improved full monotonicity constraint (Lin)! Note: no need to provide first guess of A6 <-- a4(4,i)      do i=1, itot           qmp = 2.*dm(i)         a4(2,i) = a4(1,i)-sign(min(abs(qmp),abs(a4(2,i)-a4(1,i))), qmp)         a4(3,i) = a4(1,i)+sign(min(abs(qmp),abs(a4(3,i)-a4(1,i))), qmp)         a4(4,i) = 3.*( 2.*a4(1,i) - (a4(2,i)+a4(3,i)) )      enddo      elseif (lmt .eq. 2) then! Positive definite constraint      do i=1,itot      if( abs(a4(3,i)-a4(2,i)) .lt. -a4(4,i) ) then      fmin = a4(1,i)+0.25*(a4(3,i)-a4(2,i))**2/a4(4,i)+a4(4,i)*r12         if( fmin .lt. 0. ) then         if(a4(1,i).lt.a4(3,i) .and. a4(1,i).lt.a4(2,i)) then            a4(3,i) = a4(1,i)            a4(2,i) = a4(1,i)            a4(4,i) = 0.         elseif(a4(3,i) .gt. a4(2,i)) then            a4(4,i) = 3.*(a4(2,i)-a4(1,i))            a4(3,i) = a4(2,i) - a4(4,i)         else            a4(4,i) = 3.*(a4(3,i)-a4(1,i))            a4(2,i) = a4(3,i) - a4(4,i)         endif         endif      endif      enddo      endif      return!EOC      end subroutine kmppm!-----------------------------------------------------------------------