subroutine ADJUST(dls, tjloc, acp6, acpr, pnew, tnew, rnew, 
     &                  tadj, radj)

!-----------------------------------------------------------------------
!
!     ADJUST handles all of the adjustments due to condensation. the 
!     computations are not done in the hole. the final adjusted 
!     temperature and moisture are put into "tnew" and "rnew". the 
!     actual tendencys produced are stored for diagnostic purposes 
!     "tadj" and radj".
!
!-----------------------------------------------------------------------

      use allocate_mod

      include 'RESOLUTION.h'
      include 'PARAMETERS.h'
      include 'STDUNITS.h'

      include 'AREAS.h'
      include 'BKINFO.h'
      include 'CONSLEV.h'
      include 'CLCLE.h'
      include 'ESTAB.h'
      include 'GDINFO.h'
      include 'FLAGS.h'
      include 'LIMIT.h'
      include 'QLOGS.h'
      include 'SET.h'
      include 'STORJ.h'
      include 'TIME.h'
      include 'CONVEC.h'

!-----------------------------------------------------------------------
!     user interface variables
!-----------------------------------------------------------------------

      real, intent (in)   , dimension     (ibeg:iend) :: dls
      real, intent (in)   , dimension     (ibeg:iend) :: tjloc
      real, intent (inout), dimension     (ibeg:iend) :: acp6
      real, intent (inout), dimension     (ibeg:iend) :: acpr
      real, intent (in)   , dimension     (ibeg:iend) :: pnew
      real, intent (inout), dimension(kmax,ibeg:iend) :: tnew
      real, intent (inout), dimension(kmax,ibeg:iend) :: rnew
      real, intent (out)  , dimension(kmax,ibeg:iend) :: tadj
      real, intent (out)  , dimension(kmax,ibeg:iend) :: radj

!-----------------------------------------------------------------------
!     internal variables
!-----------------------------------------------------------------------

      integer, dimension(kmax,imx) :: it
      integer, dimension(kmax,imx) :: iwk1
      integer, dimension(kmax,imx) :: iwk2
      integer, dimension(kmax,imx) :: iwk3

      real, dimension(kmax,imx) :: alrm
      real, dimension(kmax,imx) :: es
      real, dimension(kmax,imx) :: esd
      real, dimension(kmax,imx) :: esp
      real, dimension(kmax,imx) :: espd
      real, dimension(kmax,imx) :: h
      real, dimension(kmax,imx) :: hd
      real, dimension(kmax,imx) :: pnewd
      real, dimension(kmax,imx) :: psq
      real, dimension(kmax,imx) :: psqd
      real, dimension(kmax,imx) :: psqm
      real, dimension(kmax,imx) :: ra
      real, dimension(kmax,imx) :: rad
      real, dimension(kmax,imx) :: rmew
      real, dimension(kmax,imx) :: rs
      real, dimension(kmax,imx) :: rsd
      real, dimension(kmax,imx) :: ta
      real, dimension(kmax,imx) :: tad
      real, dimension(kmax,imx) :: tav
      real, dimension(kmax,imx) :: tk
      real, dimension(kmax,imx) :: tkfrac
      real, dimension(kmax,imx) :: tmew
      real, dimension(kmax,imx) :: w2d
      real, dimension(kmax,imx) :: w3d
      real, dimension(kmax,imx) :: w4d
      real, dimension(kmax,imx) :: w5d
      real, dimension(kmax,imx) :: wk1
      real, dimension(kmax,imx) :: wk2
      real, dimension(kmax,imx) :: wk3
      real, dimension(kmax,imx) :: wk4
      real, dimension(kmax,imx) :: wk5
      real, dimension(kmax,imx) :: wk6
      real, dimension(kmax,imx) :: wk7
      real, dimension(kmax,imx) :: wk8
      real, dimension(kmax,imx) :: wk9
      real, dimension(kmax,imx) :: wk10
      real, dimension(kmax,imx) :: wk11
      real, dimension(kmax,imx) :: wk12

      real, dimension(imx)       :: ttlprc

!-----------------------------------------------------------------------
!     code
!-----------------------------------------------------------------------

      epsln = 1.0e-20
      tbat  = 3.0e+02

      if(ttime(ngd) .EQ. 0.0) tbat = deltat
      j = IFIX(tjloc(i1))
      if(iacp .EQ. 0 .AND. l .EQ. 1) then
        if(j .EQ. 1 .AND. ngd .EQ. 1) write(stdout,10) nstep
10    format(' PRECIPITATION RESET AT TIME STEP (NSTEP) = ', i5)
        do i = i1,i2
          acp6(i) = 0.0
        enddo
      endif

!-----------------------------------------------------------------------
!     initialize arrays
!-----------------------------------------------------------------------

      do i = i1,i2
        do k = 1,kmax
          ta  (k,i) = tnew(k,i)
          ra  (k,i) = rnew(k,i)
          tmew(k,i) = tnew(k,i)
          rmew(k,i) = rnew(k,i)
        enddo
      enddo
      do i = i1,i2
        do k = 1,kmax
          pnewd(k,i) = pnew(i)
          psq  (k,i) = pnew(i)*qv (k,i)
          psqm (k,i) = pnew(i)*qmd(k,i)
        enddo
      enddo

!----------------------------------------------------------------------- 
!     check that temperature range does not exceed estab range
!-----------------------------------------------------------------------

      do i = i1,i2
        do k = 1,kmax
          if(ta(k,i) .GT. 375.1) go to 30
        enddo
      enddo
      do i = i1,i2
        do k = 1,kmax
          if(ta(k,i) .LT. 173.2) go to 30
        enddo
      enddo
      go to 50

30    continue
      write(stdout,35) k, i
35    format(' TEMPERATURE POINT IN "ADJUST" AT POINT (K,I) OUT OF RANGE 
     & ', 2(I5,2X))

      write(stdout,40) j, ngd, ((tnew(k,i),k=1,kmax),i = i1,i2)
40    format(' TEMPERATURES BAD IN ROW ', I5,' GRID NUMBER ', I5, /,
     &(4X,10E11.4))

      stop

50    continue

!----------------------------------------------------------------------- 
!     only do convective adjustment during corrector step
!----------------------------------------------------------------------- 

      if(itr .EQ. 0 .AND. l .EQ. 0) go to 420

!----------------------------------------------------------------------- 
!     calculate h, rs, and es
!----------------------------------------------------------------------- 

      do i = i1,i2
        do k = 1,kmax
          tk    (k,i) = ta(k,i) - 153.16
          it    (k,i) = tk(k,i)
          tkfrac(k,i) = tk(k,i) - FLOAT(it(k,i))
        enddo
      enddo
      do i = i1,i2
        do k = 1,kmax
          wk3(k,i) = tab  (it(k,i) + 1)
          wk4(k,i) = tab  (it(k,i) + 2)
          wk5(k,i) = table(it(k,i) + 1)
          wk6(k,i) = table(it(k,i) + 2)
        enddo
      enddo
      do i = i1,i2
        do k = 1,kmax
          es (k,i) = wk3(k,i) + tkfrac(k,i)*wk5(k,i)
          esp(k,i) = wk4(k,i) + tkfrac(k,i)*wk6(k,i)
        enddo
      enddo

!-----------------------------------------------------------------------
!     having just obtained the saturated vapor pressure, we will now
!     obtain the value of saturated mixing ratio "rs" at the current
!     temperature. using this we will compute the humidity "h".
!-----------------------------------------------------------------------

      do i = i1,i2
        do k = 1,kmax
          rs(k,i) = .622*es(k,i)/(psq(k,i) - es(k,i))
          h (k,i) = ra(k,i)/rs(k,i)
        enddo
      enddo
      do i = i1,i2
        do k = 1,kmax
          h(k,i) = AMAX1(h(k,i),.001)
          enddo
      enddo


!-----------------------------------------------------------------------
!     large scale condensation will be done on those points with a
!     humidity greater than 100 percent
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!     computation of large scale condensation processes
!-----------------------------------------------------------------------


      call largeh (h, rs, es, esp, ta, ra, psq)

      do k = 1,kmax
        do i = i1,i2
          tmew(k,i) = ta(k,i)
          rmew(k,i) = ra(k,i)
        enddo
      enddo

!-----------------------------------------------------------------------
!     ends code for large scale condensation
!-----------------------------------------------------------------------

      do i = i1,i2
        do k = 1,kmax-1
          w2d (k,i) = w2 (k+1,i)
          w3d (k,i) = w3 (k+1,i)
          w4d (k,i) = w4 (k+1,i)
          w5d (k,i) = w5 (k+1,i)
          tad (k,i) = ta (k+1,i)
          rad (k,i) = ra (k+1,i)
          psqd(k,i) = psq(k+1,i)
          esd (k,i) = es (k+1,i)
          espd(k,i) = esp(k+1,i)
          rsd (k,i) = rs (k+1,i)
          hd  (k,i) = h  (k+1,i)
        enddo
      enddo
      do i = i1,i2
        w2d (kmax,i) = w2 (kmax,i)
        w3d (kmax,i) = w3 (kmax,i)
        w4d (kmax,i) = w4 (kmax,i)
        w5d (kmax,i) = w5 (kmax,i)
        tad (kmax,i) = ta (kmax,i)
        rad (kmax,i) = ra (kmax,i)
        psqd(kmax,i) = psq(kmax,i)
        esd (kmax,i) = es (kmax,i)
        espd(kmax,i) = esp(kmax,i)
        rsd (kmax,i) = rs (kmax,i)
        hd  (kmax,i) = h  (kmax,i)
      enddo

!----------------------------------------------------------------------- 
!     moist convective adjustment
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!     this first requires a check as to whether the lapse rate of
!     the environment is greater than a modified moist adiabatic 
!     lapse rate (with entrainment included)
!-----------------------------------------------------------------------

      do i = i1,i2
        do k = 1,kmax
          tav (k,i) = 0.5*(tad(k,i) + ta(k,i))
          wk4 (k,i) = tav(k,i) - 153.16
          wk5 (k,i) = tav(k,i) - 153.16 + .5
          wk6 (k,i) = tav(k,i) - 153.16 - .5
          iwk1(k,i) = IFIX(wk4(k,i))
          iwk2(k,i) = IFIX(wk5(k,i))
          iwk3(k,i) = IFIX(wk6(k,i))
          wk4 (k,i) = wk4(k,i) - FLOAT(iwk1(k,i))
          wk5 (k,i) = wk5(k,i) - FLOAT(iwk2(k,i))
          wk6 (k,i) = wk6(k,i) - FLOAT(iwk3(k,i))
        enddo
      enddo
      do i = i1,i2
        do k = 1,kmax
          wk7 (k,i) = tab  (iwk1(k,i) + 1)
          wk8 (k,i) = tab  (iwk2(k,i) + 1)
          wk9 (k,i) = tab  (iwk3(k,i) + 1)
          wk10(k,i) = table(iwk1(k,i) + 1)
          wk11(k,i) = table(iwk2(k,i) + 1)
          wk12(k,i) = table(iwk3(k,i) + 1)
        enddo
      enddo
      do i = i1,i2
        do k = 1,kmax
          wk1(k,i) = wk7(k,i) + wk4(k,i)*wk10(k,i)
          wk2(k,i) = wk8(k,i) + wk5(k,i)*wk11(k,i)
          wk3(k,i) = wk9(k,i) + wk6(k,i)*wk12(k,i)
        enddo
      enddo
      do i = i1,i2
        do k = 1,kmax
        wk2 (k,i) = wk2(k,i) - wk3(k,i)
        wk3 (k,i) = ta(k,i)*qqlogv(k,i) + tad(k,i)*qqlogd(k,i)
        wk4 (k,i) = psqm(k,i) + ala6*wk1(k,i)/tav(k,i)
        wk5 (k,i) = psqm(k,i) + alcp6*wk2(k,i)
        alrm(k,i) = arcppp*wk3(k,i)*wk4(k,i)/wk5(k,i)
        wk1 (k,i) = tad(k,i) - ta(k,i) - alrm(k,i)
        wk4 (k,i) = 0.622*(espd(k,i) - esd(k,i))/psqd(k,i)
        wk5 (k,i) = arga*wk3(k,i)*alll/(cppp + alll*wk4(k,i))
        wk3 (k,i) = alp1d(k,i)*SQRT(hd(k,i))
        wk4 (k,i) = (rs(k,i) - ra(k,i))*w2d(k,i) + (rsd(k,i) - 
     &              rad(k,i))*w3d(k,i)
        wk2 (k,i) = (wk3(k,i)*wk1(k,i) - wk5(k,i)*wk4(k,i))/(wk3(k,i)*
     &               w5d(k,i) + wk5(k,i)*w4d(k,i))
        enddo
      enddo

!-----------------------------------------------------------------------
!     the array "wk2" is the difference between the environment and the 
!     cloud lapse rate. if this value is greater than 0.05 in any 
!     vertical level of a column, we assume that the column is
!     convectively unstable and adjustment must be done. this 
!     condition is tested in the UNSTBL.  if no column in this row is 
!     unstable, we will then return from UNSTBL. otherwise, adjustment 
!     will be done until every column in the row has been made neutral.
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!     now test and do the moist convective adjustment
!-----------------------------------------------------------------------

      call UNSTBL (ta, ra, psq, psqm, wk2, h, i1, i2, j)

!-----------------------------------------------------------------------
!     the new temperature and mixing ratio is not instantly adjusted
!     to the new stable state. rather, the adjustment is spread over a
!     certain relaxation time "tbat"
!-----------------------------------------------------------------------

      do i = i1,i2
        do k = 1,kmax
          ta(k,i) = tmew(k,i) + (ta(k,i) - tmew(k,i))*deltat/tbat
          ra(k,i) = rmew(k,i) + (ra(k,i) - rmew(k,i))*deltat/tbat
        enddo
      enddo

!-----------------------------------------------------------------------
!     final check of supersaturation
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!     the humidity for the new adjusted temperature will now be 
!     obtained. this will be used to determine whether the new state has 
!     any points that are super-saturated. if so, the excess moisture 
!     will be rained out
!-----------------------------------------------------------------------

      do i = i1,i2
        do k = 1,kmax
          tk(k,i) = ta(k,i) - 153.16
          it(k,i) = tk(k,i)
        enddo
      enddo
       do i = i1,i2
         do k = 1,kmax
           wk3(k,i) = tab  (it(k,i) + 1)
           wk5(k,i) = table(it(k,i) + 1)
         enddo
      enddo
      do i = i1,i2
        do k = 1,kmax
          es(k,i) = wk3(k,i) + (tk(k,i) - FLOAT(it(k,i)))*wk5(k,i)
          rs(k,i) = .622*es(k,i)/(psq(k,i) - es(k,i))
          h (k,i) = AMAX1(ra(k,i)/rs(k,i),.001)
        enddo
      enddo

!-----------------------------------------------------------------------
!     computation of large scale condensation processes
!-----------------------------------------------------------------------


      call largeh (h, rs, es, esp, ta, ra, psq)
!-----------------------------------------------------------------------
!     ends code for large scale condensation
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!     we have just returned from testing whether any points were
!     super-saturated. if so, we 'rained out' the excess moisture
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!     estimate precipitation during deltat(delt)
!-----------------------------------------------------------------------

      if(l .EQ. 0) go to 420
      do i = i1,i2
        ttlprc(i) = 0.0
      enddo
      do k = 1,kmax
        do i = i1,i2
          ttlprc(i) = ttlprc(i) + (rnew(k,i) - ra(k,i))*dqv(k,i)
        enddo
      enddo
      factr = rdeltx*deltat/ggg
      do i = i1,i2
        ttlprc(i) = ttlprc(i)*pnew(i)*factr
        acp6  (i) = acp6(i) + ttlprc(i)
        acpr  (i) = acpr(i) + ttlprc(i)
      enddo
      if(mxmflg .NE. 0) then
        do i = i1,i2,inc
          if(j .GT. js .AND. j .LT. jn .AND. 
     &       i .GT. iw .AND. i .LT. ie) ttlprc(i) = 0.
          if(j .GT. js .AND. j .LT. jn .AND. 
     &       i .GT. iw .AND. i .LT. ie) then
          else
            ttlp(i,j) = ttlprc(i)/dstp
          endif
        enddo
      endif
      if(intflg .NE. 0) then
        do i = i1,i2,inc
          if(j .GT. js .AND. j .LT. jn .AND. 
     &       i .GT. iw .AND. i .LT. ie) then
          else
            areams(i,j,6,ngd) = areams(i,j,6,ngd) + ttlprc(i)*dls(i)*
     &                          deltat/dstp
            endif
        enddo
      endif

!----------------------------------------------------------------------- 
!     negative mixing ratio adjustments
!-----------------------------------------------------------------------

420   continue
      do i = i1,i2
        do k = 1,kmax - 2
          if(ra(k,i) .LE. epsln) then
            ra(k+1,i) = ra(k+1,i) - ddqk(i,k)*(epsln - ra(k,i))
            ra(k+2,i) = ra(k+2,i) - ddqk(i,k)*(epsln - ra(k,i))
            ra(k,i)   = epsln
          endif
        enddo
      enddo

!-----------------------------------------------------------------------
!     at the kmax-1 level negative mixing ratios can only be borrowed
!     from the kmax level
!-----------------------------------------------------------------------

      do i = i1,i2
        if(ra(kmax-1,i) .LE. epsln) then
          ra(kmax,i)  = ra(kmax,i) - ddqk(i,kmax-1)*
     &                  (epsln - ra(kmax-1,i))
          ra(kmax-1,i) = epsln
        endif
        if(ra(kmax,i) .LE. epsln) then
          ra(kmax,i) = epsln
        endif
      enddo

!-----------------------------------------------------------------------
!     estimate tendency of pstar*t and pstar*r due to adjustment
!-----------------------------------------------------------------------

      do i = i1,i2
        do k = 1,kmax
          tadj(k,i) = (ta(k,i) - tnew(k,i))*pnewd(k,i)*rdeltx
          radj(k,i) = (ra(k,i) - rnew(k,i))*pnewd(k,i)*rdeltx
          tnew(k,i) = ta(k,i)
          rnew(k,i) = ra(k,i)
        enddo
      enddo

      return
      end subroutine ADJUST