module intjcpdrymod

!$$$ module documentation block
!           .      .    .                                       .
! module:   intjcpdrymod    module for intlimq and its tangent linear intlimq_tl
!   prgmmr:
!
! abstract: module for intlimq and its tangent linear intlimq_tl
!
! program history log:
!   2005-05-11  Yanqiu zhu - wrap intlimq and its tangent linear intlimq_tl into one module
!   2005-11-16  Derber - remove interfaces
!   2005-11-22  Wu - return if factq's = zero
!   2008-11-26  Todling - remove intlimq_tl
!   2009-08-13  lueken - update documentation
!
! subroutines included:
!   sub intjcpdry
!
! variable definitions:
!
! attributes:
!   language: f90
!   machine:
!
!$$$ end documentation block

implicit none

PRIVATE
PUBLIC intjcpdry


contains

 subroutine intjcpdry(rq,rc,rp,sq,sc,sp,mype)
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    intjcpdry   adjoint for mean dry ps conservation
!   prgmmr: kleist           org: np23                date: 2009-07-07
!
! abstract: calculate stepsize contribution and penalty for limiting changes to dry mass
!
! program history log:
!   2009-07-07  kleist
!
!   input argument list:
!     rq       - q search direction
!     rc       - cloud water search direction
!     rp       - surface pressure search direction
!     sq       - q increment
!     sc       - cloud water increment
!     sp       - increment in grid space
!     mype     - integer PE
!
!   output argument list:
!     rq       - q search direction
!     rc       - cloud water search direction
!     rp       - surface pressure search direction
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
!$$$
  use kinds, only: r_kind,i_kind
  use constants, only: zero
  use gridmod, only: lat2,lon2,nsig
  use guess_grids, only: ges_prsi,ntguessig
  use jcmod, only: bamp_jcpdry
  implicit none

! Declare passed variables
  real(r_kind),dimension(lat2,lon2,nsig),intent(in   ) :: sq,sc
  real(r_kind),dimension(lat2,lon2,nsig),intent(inout) :: rq,rc
  real(r_kind),dimension(lat2,lon2)     ,intent(in   ) :: sp
  real(r_kind),dimension(lat2,lon2)     ,intent(inout) :: rp
  integer(i_kind)                       ,intent(in   ) :: mype

! Declare local variables
  real(r_kind),dimension(lat2,lon2):: sqint,rqint
  real(r_kind) spave,rpave,sqave,rqave,sdmass,rdmass
  integer(i_kind) i,j,k,it
  
  sqint=zero ; rqint=zero
  it=ntguessig

  do k=1,nsig
     do j=1,lon2
        do i=1,lat2
           sqint(i,j)=sqint(i,j) + ( (sq(i,j,k)+sc(i,j,k))* &
               (ges_prsi(i,j,k,it)-ges_prsi(i,j,k+1,it)) )
        end do
     end do
  end do

! First, use MPI to get global mean increment
  call global_mean(sp,spave,mype)
  call global_mean(sqint,sqave,mype)

! Subtract out water to get incremental dry ps
  sdmass=spave-sqave

  rdmass=bamp_jcpdry*sdmass

  rpave=rdmass
  rqave=-rdmass
  call global_mean_ad(rp,rpave,mype)
  call global_mean_ad(rqint,rqave,mype)

  do k=1,nsig
     do j=2,lon2-1
        do i=2,lat2-1
           rq(i,j,k)=rq(i,j,k) + rqint(i,j)*(ges_prsi(i,j,k,it)-ges_prsi(i,j,k+1,it))
           rc(i,j,k)=rc(i,j,k) + rqint(i,j)*(ges_prsi(i,j,k,it)-ges_prsi(i,j,k+1,it))
        end do
     end do
  end do

  return
end subroutine intjcpdry

end module intjcpdrymod