```
!-----------------------------------------------------------------------
!BOP
! !ROUTINE: pkez --- Calculate solution to hydrostatic equation
!
! !INTERFACE:
!****6***0*********0*********0*********0*********0*********0**********72

subroutine pkez(nx, im, km, jfirst, jlast, kfirst, klast,    & 3,1
ifirst, ilast, pe, pk, akap, ks, peln, pkz, eta)
!****6***0*********0*********0*********0*********0*********0**********72
!
! !USES:
use shr_kind_mod, only: r8 => shr_kind_r8

implicit none

!
! This routine may be called assuming either yz or xy decompositions.
! For xy decomposition, the effective "nx" is 1.
!

! !INPUT PARAMETERS:
integer nx                          ! SMP decomposition in x
integer im, km                      ! Dimensions
integer jfirst, jlast               ! Latitude strip
integer kfirst, klast               ! Vertical strip
integer ifirst, ilast               ! Longitude strip
real (r8)  pe(ifirst:ilast, kfirst:klast+1, jfirst:jlast)    ! Edge pressure
integer ks
logical eta     ! Is on ETA coordinate?
! True:  input pe    ; output pk, pkz, peln
! False: input pe, pk; output     pkz, peln
real (r8) akap

! !INPUT/OUTPUT PARAMETERS:
real (r8)  pk(ifirst:ilast,jfirst:jlast,kfirst:klast+1)

! !OUTPUT PARAMETERS
real (r8) pkz(ifirst:ilast,jfirst:jlast,kfirst:klast)
real (r8) peln(ifirst:ilast, kfirst:klast+1, jfirst:jlast)   ! log pressure (pe) at layer edges

! !DESCRIPTION:
!
!
! !CALLED FROM:
!     te_map and fvccm3
!
! !REVISION HISTORY:
!
!     WS  99.05.19 : Removed fvcore.h
!     WS  99.07.27 : Limited region to jfirst:jlast
!     WS  99.10.22 : Deleted cp as argument (was not used)
!     WS  99.11.05 : Documentation; pruning of arguments
!     SJL 00.01.02 : SMP decomposition in i
!     AAM 00.08.10 : Add kfirst:klast
!     AAM 01.06.27 : Add ifirst:ilast
!
!EOP
!---------------------------------------------------------------------
!BOC

! Local
real (r8) pk2(ifirst:ilast, kfirst:klast+1)
real (r8) pek
real (r8) lnp
integer i, j, k, itot, nxu
integer ixj, jp, it, i1, i2

itot = ilast - ifirst + 1
! Use smaller block sizes only if operating on full i domain
nxu = 1
if (itot .eq. im) nxu = nx

it = itot / nxu
jp = nxu * ( jlast - jfirst + 1 )

!\$omp  parallel do        &
!\$omp  default(shared)    &
!\$omp  private(ixj, i1, i2, i, j, k, pek, lnp, pk2)

! WS 99.07.27 : Limited region to jfirst:jlast

do 1000 ixj=1,jp

j  = jfirst + (ixj-1) / nxu
i1 = ifirst + it * mod(ixj-1, nxu)
i2 = i1 + it - 1

if ( eta ) then

! <<<<<<<<<<< Eta cordinate Coordinate  >>>>>>>>>>>>>>>>>>>
if (kfirst .eq. 1) then
pek =     pe(i1,1,j)**akap
lnp = log(pe(i1,1,j))

do i=i1,i2
pk2(i,1)   = pek
peln(i,1,j) = lnp
enddo
endif

if(ks .ne. 0) then
do k=max(2,kfirst), min(ks+1,klast+1)
pek = pe(i1,k,j)**akap
lnp = log(pe(i1,k,j))
do i=i1,i2
pk2(i,k)   = pek
peln(i,k,j) =  lnp
enddo
enddo

do k=kfirst, min(ks,klast)
pek = (       pk2(i1,k+1)   - pk2(i1,k))   /     &
(akap*(peln(i1,k+1,j) - peln(i1,k,j)) )
do i=i1,i2
pkz(i,j,k) = pek
enddo
enddo
endif

do k=max(ks+2,kfirst), klast+1
#if !defined( VECTOR_MATH )
do i=i1,i2
pk2(i,k) = pe(i,k,j)**akap
enddo
#else
call vlog(pk2(i1,k), pe(i1,k,j), it)
do i=i1,i2
pk2(i,k) = akap * pk2(i,k)
enddo
call vexp(pk2(i1,k), pk2(i1,k), it)
#endif
enddo

do k=max(ks+2,kfirst), klast+1
do i=i1,i2
peln(i,k,j) =  log(pe(i,k,j))
enddo
enddo

do k=max(ks+1,kfirst), klast
do i=i1,i2
pkz(i,j,k) = (pk2(i,k+1) - pk2(i,k)) /         &
(akap*(peln(i,k+1,j) - peln(i,k,j)) )
enddo
enddo

do k=kfirst, klast+1
do i=i1,i2
pk(i,j,k) = pk2(i,k)
enddo
enddo

else

! <<<<<<<<<<< General Coordinate  >>>>>>>>>>>>>>>>>>>

if (kfirst .eq. 1) then
pek =     pk(i1,j,1)
lnp = log(pe(i1,1,j))

do i=i1,i2
pk2(i,1) = pek
peln(i,1,j) = lnp
enddo
endif

do k=max(2,kfirst), klast+1
do i=i1,i2
peln(i,k,j) =  log(pe(i,k,j))
pk2(i,k) =  pk(i,j,k)
enddo
enddo

do k=kfirst, klast
do i=i1,i2
pkz(i,j,k) = (       pk2(i,k+1) - pk2(i,k) )  /    &
(akap*(peln(i,k+1,j) - peln(i,k,j)) )
enddo
enddo

endif
1000  continue

return
!EOC
end
!-----------------------------------------------------------------------
```