module ProcessM

  implicit none

  private
  public :: ProcessDT, NewProcessDT, SetNewProcess

  type :: NewProcessDT
  end type NewProcessDT

  interface SetNewProcess
     procedure :: constructor
  end interface SetNewProcess

  type ProcessDT
     class(NewProcessDT), allocatable :: process
   contains
     procedure :: setProcess
     procedure :: change
  end type ProcessDT

contains

  type(ProcessDT) function constructor(process)
    class(NewProcessDT), intent(in) :: process
    call constructor%setProcess(process)
  end function Constructor

  subroutine setProcess(this, process)
    implicit none
    class(ProcessDT)   , intent(inout) :: this
    class(NewProcessDT), intent(in)    :: process
    allocate(this%process, source = process)
  end subroutine setProcess

  subroutine change(this, newProcess)
    implicit none
    class(ProcessDT)   , intent(inout) :: this
    class(NewProcessDT), intent(in)    :: newProcess
    deallocate(this%process)
    allocate(this%process, source = newProcess)
  end subroutine change

end module ProcessM


text:
      subroutine qqb_zbjet(p,msq)
      implicit none
c--- J.Campbell,  7/4/05
c--- Matrix element squared averaged over initial colors and spins
c     q(-p1)+qbar(-p2) --> Z + b(p5) + g(p6)
c                          |
c                          --> l(p3)+a(p4)
c
c--- all momenta are incoming
c--- Extended to include charm quark production via the variable "flav"
      include 'constants.f'
      include 'masses.f'
      include 'ewcouple.f'
      include 'heavyflav.f'
      include 'qcdcouple.f'
      include 'zcouple.f'
      include 'ewcharge.f'
      include 'sprods_com.f'
      include 'zprods_com.f'
      include 'msq_cs.f'
      include 'nflav.f'
      integer i,j,k,pq,pl,j1,j2,j3,icol
      double precision msq(-nf:nf,-nf:nf),p(mxpart,4),fac,faclo,
     .   qgZqg2(2,2),gqZqg2(2,2),
     .   qgZqg2_cs(0:2,2,2),gqZqg2_cs(0:2,2,2),
     .   qbgZqbg2_cs(0:2,2,2),gqbZqbg2_cs(0:2,2,2)
      double complex a111,a112,a121,a211,a122,a212,a221,a222
c      double complex b111,b112,b121,b211,b122,b212,b221,b222
      double complex qRb_a(2,2,2),qRb_b(2,2,2)
      double complex qqb_a(2,2,2),qqb_b(2,2,2),prop
      double complex qbq_a(2,2,2),qbq_b(2,2,2)
      double complex qbR_a(2,2,2),qbR_b(2,2,2)
      double complex qq_a(2,2,2),qq_b(2,2,2)
      double complex qR_a(2,2,2),qR_b(2,2,2)
      double complex qbRb_a(2,2,2),qbRb_b(2,2,2)
      double complex qbqb_a(2,2,2),qbqb_b(2,2,2)
      integer,parameter::swap(2)=(/2,1/),swap1(0:2)=(/0,2,1/)

c--- initialize the matrix element squared
      msq(:,:)=0d0
      msq_cs(:,:,:)=0d0

      call spinoru(6,p,za,zb)

      prop=s(3,4)/dcmplx((s(3,4)-zmass**2),zmass*zwidth)

c--- calculate the amplitudes which involve 2 heavy quarks
c--- and 2 gluons
      call z2jetsq(1,5,3,4,2,6,za,zb,qgZqg2)
      call storecsz(qgZqg2_cs)
      call z2jetsq(2,5,3,4,1,6,za,zb,gqZqg2)
      call storecsz(gqZqg2_cs)

      do j=1,2
      do k=1,2
      do i=0,2
      qbgZqbg2_cs(i,j,k)=qgZqg2_cs(swap1(i),swap(j),k)
      gqbZqbg2_cs(i,j,k)=gqZqg2_cs(swap1(i),swap(j),k)
      enddo
      enddo
      enddo

      fac=v*xn/four*(esq*gsq)**2
      do pq=1,2
      do pl=1,2
        do i=0,2
          gqZqg2_cs(i,pq,pl)  = aveqg*fac*gqZqg2_cs(i,pq,pl)
          qgZqg2_cs(i,pq,pl)  = aveqg*fac*qgZqg2_cs(i,pq,pl)
          gqbZqbg2_cs(i,pq,pl)= aveqg*fac*gqbZqbg2_cs(i,pq,pl)
          qbgZqbg2_cs(i,pq,pl)= aveqg*fac*qbgZqbg2_cs(i,pq,pl)
        enddo

        gqZqg2(pq,pl)  = gqZqg2_cs(1,pq,pl) +gqZqg2_cs(2,pq,pl)
     .                  +gqZqg2_cs(0,pq,pl)
        qgZqg2(pq,pl)  = qgZqg2_cs(1,pq,pl)  +qgZqg2_cs(2,pq,pl)
     .                  +qgZqg2_cs(0,pq,pl)
      enddo
      enddo

c--- calculate the amplitudes which involve 2 heavy quarks
c--- and 2 light quarks

c--- qRb->qRb
      call ampqqb_qqb(1,5,2,6,qRb_a,qRb_b)
c--- qR->qR
c instead of calling ampqqb_qqb(1,5,6,2,qR_a,qR_b)
      do j1=1,2
      do j2=1,2
      do j3=1,2
      qR_a(j1,j2,j3)=+qRb_a(j1,swap(j2),j3)
      qR_b(j1,j2,j3)=-qRb_b(j1,swap(j2),j3)
      enddo
      enddo
      enddo

c--- qbRb->qbRb
c instead of calling ampqqb_qqb(5,1,2,6,qbRb_a,qbRb_b)
      do j1=1,2
      do j2=1,2
      do j3=1,2
      qbRb_a(j1,j2,j3)=-qRb_a(swap(j1),j2,j3)
      qbRb_b(j1,j2,j3)=+qRb_b(swap(j1),j2,j3)
      enddo
      enddo
      enddo

c--- qqb->qqb
c-- changed from 1,2,5,6
      call ampqqb_qqb(1,6,2,5,qqb_a,qqb_b)
c--- qbq->qqb
c instead of calling ampqqb_qqb(2,1,5,6,qbq_a,qbq_b)
      do j1=1,2
      do j2=1,2
      do j3=1,2
      qbq_a(j1,j2,j3)=-qqb_a(swap(j1),j2,j3)
      qbq_b(j1,j2,j3)=+qqb_b(swap(j1),j2,j3)
      enddo
      enddo
      enddo

c--- qq->qq
      call ampqqb_qqb(1,6,5,2,qq_a,qq_b)
c--- qbqb->qbqb
c instead of calling ampqqb_qqb(6,1,2,5,qbqb_a,qbqb_b)
      do j1=1,2
      do j2=1,2
      do j3=1,2
      qbqb_a(j1,j2,j3)=-qq_a(swap(j1),swap(j2),j3)
      qbqb_b(j1,j2,j3)=-qq_b(swap(j1),swap(j2),j3)
      enddo
      enddo
      enddo

c--- qbR->qbR
      call ampqqb_qqb(6,1,5,2,qbR_a,qbR_b)
c--- qbq->qbq
      call ampqqb_qqb(5,1,6,2,qbq_a,qbq_b)

      faclo=4d0*V*gsq**2*esq**2*aveqq

c--- add up the various contributions
      do j=-nflav,nflav
      do k=-nflav,nflav

      if ((abs(j) .ne. flav) .and. (abs(k) .ne. flav)) goto 99
      if ((abs(j) .eq. flav) .and. (abs(k) .eq. flav)) goto 99
c--- so that either abs(j) or abs(k) = flav (but not both).

c--- Q-G contribution
      if     ((j .eq. +flav) .and. (k .eq. 0)) then
        do icol=0,2
           msq_cs(icol,j,k)=
     .     +abs(Q(j)*q1+L(j)*l1*prop)**2*qgZqg2_cs(icol,1,1)
     .     +abs(Q(j)*q1+R(j)*r1*prop)**2*qgZqg2_cs(icol,2,2)
     .     +abs(Q(j)*q1+L(j)*r1*prop)**2*qgZqg2_cs(icol,1,2)
     .     +abs(Q(j)*q1+R(j)*l1*prop)**2*qgZqg2_cs(icol,2,1)
        enddo
c--- Qb-G contribution
      elseif ((j .eq. -flav) .and. (k .eq. 0)) then
        do icol=0,2
           msq_cs(icol,j,k)=
     .     +abs(Q(-j)*q1+L(-j)*l1*prop)**2*qbgZqbg2_cs(icol,1,1)
     .     +abs(Q(-j)*q1+R(-j)*r1*prop)**2*qbgZqbg2_cs(icol,2,2)
     .     +abs(Q(-j)*q1+L(-j)*r1*prop)**2*qbgZqbg2_cs(icol,1,2)
     .     +abs(Q(-j)*q1+R(-j)*l1*prop)**2*qbgZqbg2_cs(icol,2,1)
        enddo
c--- G-Q contribution
      elseif ((j .eq. 0) .and. (k .eq. +flav)) then
        do icol=0,2
           msq_cs(icol,j,k)=
     .     +abs(Q(k)*q1+L(k)*l1*prop)**2*gqZqg2_cs(icol,1,1)
     .     +abs(Q(k)*q1+R(k)*r1*prop)**2*gqZqg2_cs(icol,2,2)
     .     +abs(Q(k)*q1+L(k)*r1*prop)**2*gqZqg2_cs(icol,1,2)
     .     +abs(Q(k)*q1+R(k)*l1*prop)**2*gqZqg2_cs(icol,2,1)
        enddo
c--- G-Qb contribution
      elseif ((j .eq. 0) .and. (k .eq. -flav)) then
        do icol=0,2
           msq_cs(icol,j,k)=
     .     +abs(Q(-k)*q1+L(-k)*l1*prop)**2*gqbZqbg2_cs(icol,1,1)
     .     +abs(Q(-k)*q1+R(-k)*r1*prop)**2*gqbZqbg2_cs(icol,2,2)
     .     +abs(Q(-k)*q1+L(-k)*r1*prop)**2*gqbZqbg2_cs(icol,1,2)
     .     +abs(Q(-k)*q1+R(-k)*l1*prop)**2*gqbZqbg2_cs(icol,2,1)
        enddo
c--- Q-Q contribution
      elseif ((j .gt. 0) .and. (k .gt. 0)) then
        if     (j .eq. +flav) then
          a111=(Q(j)*q1+L(j)*l1*prop)*qR_a(1,1,1)
     .        +(Q(k)*q1+L(k)*l1*prop)*qR_b(1,1,1)
          a121=(Q(j)*q1+L(j)*l1*prop)*qR_a(1,2,1)
     .        +(Q(k)*q1+R(k)*l1*prop)*qR_b(1,2,1)
          a112=(Q(j)*q1+L(j)*r1*prop)*qR_a(1,1,2)
     .        +(Q(k)*q1+L(k)*r1*prop)*qR_b(1,1,2)
          a122=(Q(j)*q1+L(j)*r1*prop)*qR_a(1,2,2)
     .        +(Q(k)*q1+R(k)*r1*prop)*qR_b(1,2,2)
          a211=(Q(j)*q1+R(j)*l1*prop)*qR_a(2,1,1)
     .        +(Q(k)*q1+L(k)*l1*prop)*qR_b(2,1,1)
          a221=(Q(j)*q1+R(j)*l1*prop)*qR_a(2,2,1)
     .        +(Q(k)*q1+R(k)*l1*prop)*qR_b(2,2,1)
          a212=(Q(j)*q1+R(j)*r1*prop)*qR_a(2,1,2)
     .        +(Q(k)*q1+L(k)*r1*prop)*qR_b(2,1,2)
          a222=(Q(j)*q1+R(j)*r1*prop)*qR_a(2,2,2)
     .        +(Q(k)*q1+R(k)*r1*prop)*qR_b(2,2,2)
        elseif (k .eq. +flav) then
          a111=(Q(j)*q1+L(j)*l1*prop)*qq_a(1,1,1)
     .        +(Q(k)*q1+L(k)*l1*prop)*qq_b(1,1,1)
          a121=(Q(j)*q1+L(j)*l1*prop)*qq_a(1,2,1)
     .        +(Q(k)*q1+R(k)*l1*prop)*qq_b(1,2,1)
          a112=(Q(j)*q1+L(j)*r1*prop)*qq_a(1,1,2)
     .        +(Q(k)*q1+L(k)*r1*prop)*qq_b(1,1,2)
          a122=(Q(j)*q1+L(j)*r1*prop)*qq_a(1,2,2)
     .        +(Q(k)*q1+R(k)*r1*prop)*qq_b(1,2,2)
          a211=(Q(j)*q1+R(j)*l1*prop)*qq_a(2,1,1)
     .        +(Q(k)*q1+L(k)*l1*prop)*qq_b(2,1,1)
          a221=(Q(j)*q1+R(j)*l1*prop)*qq_a(2,2,1)
     .        +(Q(k)*q1+R(k)*l1*prop)*qq_b(2,2,1)
          a212=(Q(j)*q1+R(j)*r1*prop)*qq_a(2,1,2)
     .        +(Q(k)*q1+L(k)*r1*prop)*qq_b(2,1,2)
          a222=(Q(j)*q1+R(j)*r1*prop)*qq_a(2,2,2)
     .        +(Q(k)*q1+R(k)*r1*prop)*qq_b(2,2,2)
        endif
        msq_cs(0,j,k)=zip
        msq_cs(1,j,k)=
     .  +faclo*(abs(a111)**2+abs(a112)**2+abs(a221)**2+abs(a222)**2
     .         +abs(a122)**2+abs(a212)**2+abs(a121)**2+abs(a211)**2)
        msq_cs(2,j,k)=zip
c--- Qb-Qb contribution
      elseif ((j .lt. 0) .and. (k .lt. 0)) then
        if     (j .eq. -flav) then
          a111=(Q(-j)*q1+L(-j)*l1*prop)*qbRb_a(1,1,1)
     .        +(Q(-k)*q1+L(-k)*l1*prop)*qbRb_b(1,1,1)
          a121=(Q(-j)*q1+L(-j)*l1*prop)*qbRb_a(1,2,1)
     .        +(Q(-k)*q1+R(-k)*l1*prop)*qbRb_b(1,2,1)

          a112=(Q(-j)*q1+L(-j)*r1*prop)*qbRb_a(1,1,2)
     .        +(Q(-k)*q1+L(-k)*r1*prop)*qbRb_b(1,1,2)
          a122=(Q(-j)*q1+L(-j)*r1*prop)*qbRb_a(1,2,2)
     .        +(Q(-k)*q1+R(-k)*r1*prop)*qbRb_b(1,2,2)

          a211=(Q(-j)*q1+R(-j)*l1*prop)*qbRb_a(2,1,1)
     .        +(Q(-k)*q1+L(-k)*l1*prop)*qbRb_b(2,1,1)
          a221=(Q(-j)*q1+R(-j)*l1*prop)*qbRb_a(2,2,1)
     .        +(Q(-k)*q1+R(-k)*l1*prop)*qbRb_b(2,2,1)

          a212=(Q(-j)*q1+R(-j)*r1*prop)*qbRb_a(2,1,2)
     .        +(Q(-k)*q1+L(-k)*r1*prop)*qbRb_b(2,1,2)
          a222=(Q(-j)*q1+R(-j)*r1*prop)*qbRb_a(2,2,2)
     .        +(Q(-k)*q1+R(-k)*r1*prop)*qbRb_b(2,2,2)
        elseif (k .eq. -flav) then
          a111=(Q(-j)*q1+L(-j)*l1*prop)*qbqb_a(1,1,1)
     .        +(Q(-k)*q1+L(-k)*l1*prop)*qbqb_b(1,1,1)
          a121=(Q(-j)*q1+L(-j)*l1*prop)*qbqb_a(1,2,1)
     .        +(Q(-k)*q1+R(-k)*l1*prop)*qbqb_b(1,2,1)

          a112=(Q(-j)*q1+L(-j)*r1*prop)*qbqb_a(1,1,2)
     .        +(Q(-k)*q1+L(-k)*r1*prop)*qbqb_b(1,1,2)
          a122=(Q(-j)*q1+L(-j)*r1*prop)*qbqb_a(1,2,2)
     .        +(Q(-k)*q1+R(-k)*r1*prop)*qbqb_b(1,2,2)

          a211=(Q(-j)*q1+R(-j)*l1*prop)*qbqb_a(2,1,1)
     .        +(Q(-k)*q1+L(-k)*l1*prop)*qbqb_b(2,1,1)
          a221=(Q(-j)*q1+R(-j)*l1*prop)*qbqb_a(2,2,1)
     .        +(Q(-k)*q1+R(-k)*l1*prop)*qbqb_b(2,2,1)

          a212=(Q(-j)*q1+R(-j)*r1*prop)*qbqb_a(2,1,2)
     .        +(Q(-k)*q1+L(-k)*r1*prop)*qbqb_b(2,1,2)
          a222=(Q(-j)*q1+R(-j)*r1*prop)*qbqb_a(2,2,2)
     .        +(Q(-k)*q1+R(-k)*r1*prop)*qbqb_b(2,2,2)
        endif
        msq_cs(0,j,k)=zip
        msq_cs(1,j,k)=
     .  +faclo*(abs(a111)**2+abs(a112)**2+abs(a221)**2+abs(a222)**2
     .         +abs(a122)**2+abs(a212)**2+abs(a121)**2+abs(a211)**2)
        msq_cs(2,j,k)=zip
c--- Q-Qb contribution
      elseif ((j .gt. 0) .and. (k .lt. 0)) then
        if     (j .eq. +flav) then
          a111=(Q(+j)*q1+L(+j)*l1*prop)*qRb_a(1,1,1)
     .        +(Q(-k)*q1+L(-k)*l1*prop)*qRb_b(1,1,1)
          a112=(Q(+j)*q1+L(+j)*r1*prop)*qRb_a(1,1,2)
     .        +(Q(-k)*q1+L(-k)*r1*prop)*qRb_b(1,1,2)
          a221=(Q(+j)*q1+R(+j)*l1*prop)*qRb_a(2,2,1)
     .        +(Q(-k)*q1+R(-k)*l1*prop)*qRb_b(2,2,1)
          a222=(Q(+j)*q1+R(+j)*r1*prop)*qRb_a(2,2,2)
     .        +(Q(-k)*q1+R(-k)*r1*prop)*qRb_b(2,2,2)

          a121=(Q(+j)*q1+L(+j)*l1*prop)*qRb_a(1,2,1)
     .        +(Q(-k)*q1+R(-k)*l1*prop)*qRb_b(1,2,1)
          a122=(Q(+j)*q1+L(+j)*r1*prop)*qRb_a(1,2,2)
     .        +(Q(-k)*q1+R(-k)*r1*prop)*qRb_b(1,2,2)
          a211=(Q(+j)*q1+R(+j)*l1*prop)*qRb_a(2,1,1)
     .        +(Q(-k)*q1+L(-k)*l1*prop)*qRb_b(2,1,1)
          a212=(Q(+j)*q1+R(+j)*r1*prop)*qRb_a(2,1,2)
     .        +(Q(-k)*q1+L(-k)*r1*prop)*qRb_b(2,1,2)
        elseif (k .eq. -flav) then
          a111=(Q(+j)*q1+L(+j)*l1*prop)*qqb_a(1,1,1)
     .        +(Q(-k)*q1+L(-k)*l1*prop)*qqb_b(1,1,1)
          a112=(Q(+j)*q1+L(+j)*r1*prop)*qqb_a(1,1,2)
     .        +(Q(-k)*q1+L(-k)*r1*prop)*qqb_b(1,1,2)
          a221=(Q(+j)*q1+R(+j)*l1*prop)*qqb_a(2,2,1)
     .        +(Q(-k)*q1+R(-k)*l1*prop)*qqb_b(2,2,1)
          a222=(Q(+j)*q1+R(+j)*r1*prop)*qqb_a(2,2,2)
     .        +(Q(-k)*q1+R(-k)*r1*prop)*qqb_b(2,2,2)

          a121=(Q(+j)*q1+L(+j)*l1*prop)*qqb_a(1,2,1)
     .        +(Q(-k)*q1+R(-k)*l1*prop)*qqb_b(1,2,1)
          a122=(Q(+j)*q1+L(+j)*r1*prop)*qqb_a(1,2,2)
     .        +(Q(-k)*q1+R(-k)*r1*prop)*qqb_b(1,2,2)
          a211=(Q(+j)*q1+R(+j)*l1*prop)*qqb_a(2,1,1)
     .        +(Q(-k)*q1+L(-k)*l1*prop)*qqb_b(2,1,1)
          a212=(Q(+j)*q1+R(+j)*r1*prop)*qqb_a(2,1,2)
     .        +(Q(-k)*q1+L(-k)*r1*prop)*qqb_b(2,1,2)
        endif
        msq_cs(0,j,k)=zip
        msq_cs(1,j,k)=zip
        msq_cs(2,j,k)=
     .  +faclo*(abs(a111)**2+abs(a112)**2+abs(a221)**2+abs(a222)**2
     .         +abs(a122)**2+abs(a212)**2+abs(a121)**2+abs(a211)**2)
      elseif ((j .lt. 0) .and. (k .gt. 0)) then
c--- Qb-Q contribution
        if     (j .eq. -flav) then
          a111=(Q(-j)*q1+L(-j)*l1*prop)*qbq_a(1,1,1)
     .        +(Q(+k)*q1+L(+k)*l1*prop)*qbq_b(1,1,1)
          a121=(Q(-j)*q1+L(-j)*l1*prop)*qbq_a(1,2,1)
     .        +(Q(+k)*q1+R(+k)*l1*prop)*qbq_b(1,2,1)
          a112=(Q(-j)*q1+L(-j)*r1*prop)*qbq_a(1,1,2)
     .        +(Q(+k)*q1+L(+k)*r1*prop)*qbq_b(1,1,2)
          a122=(Q(-j)*q1+L(-j)*r1*prop)*qbq_a(1,2,2)
     .        +(Q(+k)*q1+R(+k)*r1*prop)*qbq_b(1,2,2)
          a211=(Q(-j)*q1+R(-j)*l1*prop)*qbq_a(2,1,1)
     .        +(Q(+k)*q1+L(+k)*l1*prop)*qbq_b(2,1,1)
          a221=(Q(-j)*q1+R(-j)*l1*prop)*qbq_a(2,2,1)
     .        +(Q(+k)*q1+R(+k)*l1*prop)*qbq_b(2,2,1)
          a212=(Q(-j)*q1+R(-j)*r1*prop)*qbq_a(2,1,2)
     .        +(Q(+k)*q1+L(+k)*r1*prop)*qbq_b(2,1,2)
          a222=(Q(-j)*q1+R(-j)*r1*prop)*qbq_a(2,2,2)
     .        +(Q(+k)*q1+R(+k)*r1*prop)*qbq_b(2,2,2)
        elseif (k .eq. +flav) then
          a111=(Q(-j)*q1+L(-j)*l1*prop)*qbR_a(1,1,1)
     .        +(Q(+k)*q1+L(+k)*l1*prop)*qbR_b(1,1,1)
          a121=(Q(-j)*q1+L(-j)*l1*prop)*qbR_a(1,2,1)
     .        +(Q(+k)*q1+R(+k)*l1*prop)*qbR_b(1,2,1)
          a112=(Q(-j)*q1+L(-j)*r1*prop)*qbR_a(1,1,2)
     .        +(Q(+k)*q1+L(+k)*r1*prop)*qbR_b(1,1,2)
          a122=(Q(-j)*q1+L(-j)*r1*prop)*qbR_a(1,2,2)
     .        +(Q(+k)*q1+R(+k)*r1*prop)*qbR_b(1,2,2)
          a211=(Q(-j)*q1+R(-j)*l1*prop)*qbR_a(2,1,1)
     .        +(Q(+k)*q1+L(+k)*l1*prop)*qbR_b(2,1,1)
          a221=(Q(-j)*q1+R(-j)*l1*prop)*qbR_a(2,2,1)
     .        +(Q(+k)*q1+R(+k)*l1*prop)*qbR_b(2,2,1)
          a212=(Q(-j)*q1+R(-j)*r1*prop)*qbR_a(2,1,2)
     .        +(Q(+k)*q1+L(+k)*r1*prop)*qbR_b(2,1,2)
          a222=(Q(-j)*q1+R(-j)*r1*prop)*qbR_a(2,2,2)
     .        +(Q(+k)*q1+R(+k)*r1*prop)*qbR_b(2,2,2)
        endif
        msq_cs(0,j,k)=zip
        msq_cs(1,j,k)=zip
        msq_cs(2,j,k)=
     .  +faclo*(abs(a111)**2+abs(a112)**2+abs(a221)**2+abs(a222)**2
     .         +abs(a122)**2+abs(a212)**2+abs(a121)**2+abs(a211)**2)
      endif

c--- only the colour-ordered matrix elements are calculated above, so
c--- we have to calculate the total for "msq"
      msq(j,k)=msq_cs(0,j,k)+msq_cs(1,j,k)+msq_cs(2,j,k)

   99 continue
      enddo
      enddo

      return
      end

ext: f

max_stars_repo_name: tmartini/JHUGen

max_issues_repo_name: tmartini/JHUGen

max_forks_repo_name: tmartini/JHUGen


text:
module Mod_nsm_NonLinearDerivatives
   use typre
   use Mod_PointerSetter
   use mod_nsm_BaseElmope
   implicit none
   private
   public SetPointersNonLinearDerivatives

   type, extends(PointerSetter) :: SPNonLinearDerivatives
contains
      procedure :: SpecificSet => SpecificSetNonLinearDerivatives
   end type
   type(SPNonLinearDerivatives) :: SetPointersNonLinearDerivatives

contains

   subroutine SpecificSetNonLinearDerivatives(d)
      implicit none
      class(SPNonLinearDerivatives) :: d
      integer(ip) :: kfl_nonlinear

      call a%Mesh%IsNonLinearElement(ielem,kfl_nonlinear)
      if (kfl_nonlinear == 1) call ConcatenateProcedures(ProcHook_InGauss,InGaussNonLinearDerivatives)
   end subroutine

   !Computation Subroutine
   subroutine InGaussNonLinearDerivatives
      implicit none

      call e%elmder
      call e%elmhes
   end subroutine

end module

max_stars_repo_name: ciaid-colombia/InsFEM

max_issues_repo_name: ciaid-colombia/InsFEM

max_forks_repo_name: ciaid-colombia/InsFEM


text:
      subroutine qlinit
      implicit none

      write(*,*) '===================================================='
      write(*,*) '  This is QCDLoop - version 1.95                    '
      write(*,*) '  Authors: Keith Ellis and Giulia Zanderighi        '
      write(*,*) '  (ellis@fnal.gov, g.zanderighi1@physics.ox.ac.uk)  '
      write(*,*) '  For details see FERMILAB-PUB-07-633-T,OUTP-07/16P '
      write(*,*) '  arXiv:0712.1851 [hep-ph], published in            '
      write(*,*) '  JHEP 0802:002,2008.                               '
      write(*,*) '===================================================='

      call ffini

      end


module mod_global

   use mod_cte, only: kd
   use mod_ios, only: write_out

   implicit none

   contains

      elemental function pbc( r, L )
      ! Periodic Boundary Conditions applied to r for a box side of size L
         implicit none
         real(kd), intent(in) :: r, L
         real(kd)             :: pbc

         pbc = r - L * anint( r / L )
       ! pbc = r - L * nint( r / L )

      end function pbc

      subroutine start_tracking_time( start_cpu_time, start_wall_time )
         !
         real(kd), intent(out) :: start_cpu_time
         integer, intent(out)  :: start_wall_time

         call cpu_time(start_cpu_time)
         call system_clock(start_wall_time)

      end subroutine start_tracking_time

      subroutine end_tracking_time( start_cpu_time, start_wall_time, filename )
         !
         real(kd), intent(in)     :: start_cpu_time
         integer, intent(in)      :: start_wall_time
         character(*), intent(in) :: filename
         real(kd)                 :: end_cpu_time, wall_time
         integer                  :: end_wall_time, count_rate, count_max

         ! Calculation time.
         call cpu_time(end_cpu_time)
         call system_clock(end_wall_time, count_rate, count_max)
         if (end_wall_time < start_wall_time) then
            end_wall_time = end_wall_time + count_max
         end if
         wall_time = real(end_wall_time-start_wall_time,kd)/real(count_rate,kd)

         call write_out( " ", filename )
         call write_out( "Wall time:", wall_time, filename )
         call write_out( "CPU time:", end_cpu_time-start_cpu_time, filename )

      end subroutine end_tracking_time

end module mod_global


MODULE module_physics_addtendc
   USE module_state_description
   USE module_configure
CONTAINS
SUBROUTINE update_phy_ten(rph_tendf,rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
                      scalar_tendf,mu_tendf, &
                      RTHRATEN,RTHBLTEN,RTHCUTEN,RTHSHTEN, &
                      RUBLTEN,RUCUTEN,RUSHTEN, &
                      RVBLTEN,RVCUTEN,RVSHTEN, &
                      RQVBLTEN,RQCBLTEN,RQIBLTEN,RQNIBLTEN, &
                      RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN, &
                      RQCNCUTEN,RQINCUTEN, &
                      RQVSHTEN,RQCSHTEN,RQRSHTEN,RQISHTEN,RQSSHTEN,RQGSHTEN,&
                      RQCNSHTEN,RQINSHTEN, &
                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RPHNDGDTEN, &
                      RQVNDGDTEN,RMUNDGDTEN, &
                      rthfrten,rqvfrten, &
                      n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
                                   ims, ime, jms, jme, kms, kme, &
                                   its, ite, jts, jte, kts, kte, &
                                   n_moist,n_scalar,rk_step
   LOGICAL , INTENT(IN) :: adv_moist_cond
   REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) :: &
                                                         ru_tendf, &
                                                         rv_tendf, &
                                                         rt_tendf, &
                                                         rph_tendf
   REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) :: mu_tendf
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
          INTENT(INOUT) :: moist_tendf
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
          INTENT(INOUT) :: scalar_tendf
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
                                                       RTHRATEN, &
                                                       RTHBLTEN, &
                                                       RTHCUTEN, &
                                                       RTHSHTEN, &
                                                        RUBLTEN, &
                                                        RUCUTEN, &
                                                        RUSHTEN, &
                                                        RVBLTEN, &
                                                        RVCUTEN, &
                                                        RVSHTEN, &
                                                       RQVBLTEN, &
                                                       RQCBLTEN, &
                                                       RQIBLTEN, &
                                                      RQNIBLTEN, &
                                                       RQVCUTEN, &
                                                       RQCCUTEN, &
                                                       RQRCUTEN, &
                                                       RQICUTEN, &
                                                       RQSCUTEN, &
                                                      RQCNCUTEN, &
                                                      RQINCUTEN, &
                                                       RQVSHTEN, &
                                                       RQCSHTEN, &
                                                       RQRSHTEN, &
                                                       RQISHTEN, &
                                                       RQSSHTEN, &
                                                       RQGSHTEN, &
                                                      RQCNSHTEN, &
                                                      RQINSHTEN, &
                                                     RTHNDGDTEN, &
                                                     RPHNDGDTEN, &
                                                     RQVNDGDTEN, &
                                                      RUNDGDTEN, &
                                                      RVNDGDTEN
   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
                                                       rthfrten, &
                                                       rqvfrten
   if (config_flags%ra_lw_physics .gt. 0 .or. &
       config_flags%ra_sw_physics .gt. 0) &
      CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   if (config_flags%bl_pbl_physics .gt. 0) &
      CALL phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
                      rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
                      scalar_tendf,adv_moist_cond, &
                      RTHBLTEN,RUBLTEN,RVBLTEN, &
                      RQVBLTEN,RQCBLTEN,RQIBLTEN, &
                      RQNIBLTEN, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   if (config_flags%cu_physics .gt. 0) &
      CALL phy_cu_ten(config_flags,rk_step,n_moist,n_scalar, &
                      rt_tendf,ru_tendf,rv_tendf, &
                      RUCUTEN,RVCUTEN,RTHCUTEN, &
                      RQVCUTEN,RQCCUTEN,RQRCUTEN, &
                      RQICUTEN,RQSCUTEN,RQCNCUTEN,RQINCUTEN, &
                      moist_tendf, &
                      scalar_tendf,adv_moist_cond, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   if (config_flags%shcu_physics .gt. 0) &
      CALL phy_shcu_ten(config_flags,rk_step,n_moist,n_scalar, &
                      rt_tendf,ru_tendf,rv_tendf, &
                      RUSHTEN,RVSHTEN,RTHSHTEN, &
                      RQVSHTEN,RQCSHTEN,RQRSHTEN, &
                      RQISHTEN,RQSSHTEN,RQGSHTEN,RQCNSHTEN, &
                      RQINSHTEN,moist_tendf,scalar_tendf, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   if (config_flags%grid_fdda .gt. 0) &
      CALL phy_fg_ten(config_flags,rk_step,n_moist, &
                      rph_tendf,rt_tendf,ru_tendf,rv_tendf, &
                      mu_tendf, moist_tendf, &
                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
                      RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   if (config_flags%ifire .gt. 0) &
      CALL phy_fr_ten(config_flags,rk_step,n_moist, &
                      rt_tendf,ru_tendf,rv_tendf, &
                      mu_tendf, moist_tendf, &
                      rthfrten,rqvfrten, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
END SUBROUTINE update_phy_ten
SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
                                   ims, ime, jms, jme, kms, kme, &
                                   its, ite, jts, jte, kts, kte
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
                                                       RTHRATEN
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
                                                       rt_tendf
   INTEGER :: i,j,k
   CALL add_a2a(rt_tendf,RTHRATEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
END SUBROUTINE phy_ra_ten
SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
                      rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
                      scalar_tendf,adv_moist_cond, &
                      RTHBLTEN,RUBLTEN,RVBLTEN, &
                      RQVBLTEN,RQCBLTEN,RQIBLTEN,RQNIBLTEN, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
                                   ims, ime, jms, jme, kms, kme, &
                                   its, ite, jts, jte, kts, kte, &
                                   n_moist, n_scalar, rk_step
   LOGICAL , INTENT(IN) :: adv_moist_cond
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
          INTENT(INOUT) :: moist_tendf
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
          INTENT(INOUT) :: scalar_tendf
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
                                                       RTHBLTEN, &
                                                        RUBLTEN, &
                                                        RVBLTEN, &
                                                       RQVBLTEN, &
                                                       RQCBLTEN, &
                                                       RQIBLTEN, &
                                                      RQNIBLTEN
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
                                                       rt_tendf, &
                                                       ru_tendf, &
                                                       rv_tendf
   INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
   SELECT CASE(config_flags%bl_pbl_physics)
      CASE (YSUSCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
      CASE (MRFSCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
      CASE (ACMPBLSCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR)THEN
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        ENDIF
       ENDIF
      CASE (MYJPBLSCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ELSE
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
      CASE (QNSEPBLSCHEME,QNSEPBL09SCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ELSE
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
      CASE (GFSSCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
      CASE (MYNNPBLSCHEME2,MYNNPBLSCHEME3)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
       CASE (BOULACSCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ELSE
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
       CASE (CAMUWPBLSCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQNIBLTEN,&
               config_flags, &
               ids,ide, jds, jde, kds, kde, &
               ims, ime, jms, jme, kms, kme, &
               its, ite, jts, jte, kts, kte )
       ELSE
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QNI .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QNI),RQNIBLTEN,&
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
      CASE (TEMFPBLSCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
      CASE (GBMPBLSCHEME)
           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
      CASE DEFAULT
       print*,'phy_bl_ten: The pbl scheme does not exist'
   END SELECT
END SUBROUTINE phy_bl_ten
SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,n_scalar, &
                      rt_tendf,ru_tendf,rv_tendf, &
                      RUCUTEN,RVCUTEN,RTHCUTEN, &
                      RQVCUTEN,RQCCUTEN,RQRCUTEN, &
                      RQICUTEN,RQSCUTEN,RQCNCUTEN,RQINCUTEN, &
                      moist_tendf, &
                      scalar_tendf,adv_moist_cond, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
                                   ims, ime, jms, jme, kms, kme, &
                                   its, ite, jts, jte, kts, kte, &
                                   n_moist, n_scalar, rk_step
   LOGICAL , INTENT(IN) :: adv_moist_cond
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
          INTENT(INOUT) :: moist_tendf
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
          INTENT(INOUT) :: scalar_tendf
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
                                                        RUCUTEN, &
                                                        RVCUTEN, &
                                                       RTHCUTEN, &
                                                       RQVCUTEN, &
                                                       RQCCUTEN, &
                                                       RQRCUTEN, &
                                                       RQICUTEN, &
                                                       RQSCUTEN, &
                                                      RQCNCUTEN, &
                                                      RQINCUTEN
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
                                                       rt_tendf, &
                                                       ru_tendf, &
                                                       rv_tendf
   INTEGER :: i,j,k
   SELECT CASE (config_flags%cu_physics)
   CASE (KFSCHEME)
        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QR .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QS .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
   CASE (BMJSCHEME)
        CALL add_a2a(rt_tendf,RTHCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
   CASE (KFETASCHEME, KFCUPSCHEME)
        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QR .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QS .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
   CASE (GDSCHEME, G3SCHEME, GFSCHEME)
        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
   CASE (NSASSCHEME)
        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
   CASE (SASSCHEME,OSASSCHEME,MESO_SAS)
        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
   CASE (CAMZMSCHEME)
        CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QNC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(scalar_tendf(ims,kms,jms,P_QNC),RQCNCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QNI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(scalar_tendf(ims,kms,jms,P_QNI),RQINCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
   CASE (TIEDTKESCHEME)
        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       IF(.not. adv_moist_cond)THEN
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QT .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
       ENDIF
   CASE DEFAULT
   END SELECT
END SUBROUTINE phy_cu_ten
SUBROUTINE phy_shcu_ten(config_flags,rk_step,n_moist,n_scalar, &
                      rt_tendf,ru_tendf,rv_tendf, &
                      RUSHTEN,RVSHTEN,RTHSHTEN, &
                      RQVSHTEN,RQCSHTEN,RQRSHTEN, &
                      RQISHTEN,RQSSHTEN,RQGSHTEN,RQCNSHTEN, &
                      RQINSHTEN,moist_tendf,scalar_tendf, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
                                   ims, ime, jms, jme, kms, kme, &
                                   its, ite, jts, jte, kts, kte, &
                                   n_moist, n_scalar, rk_step
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
          INTENT(INOUT) :: moist_tendf
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
          INTENT(INOUT) :: scalar_tendf
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
                                                        RUSHTEN, &
                                                        RVSHTEN, &
                                                       RTHSHTEN, &
                                                       RQVSHTEN, &
                                                       RQCSHTEN, &
                                                       RQRSHTEN, &
                                                       RQISHTEN, &
                                                       RQSSHTEN, &
                                                       RQGSHTEN, &
                                                      RQCNSHTEN, &
                                                      RQINSHTEN
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
                                                       rt_tendf, &
                                                       ru_tendf, &
                                                       rv_tendf
   INTEGER :: i,j,k
   SELECT CASE (config_flags%shcu_physics)
   CASE (CAMUWSHCUSCHEME)
        CALL add_a2c_u(ru_tendf,RUSHTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        CALL add_a2c_v(rv_tendf,RVSHTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        CALL add_a2a(rt_tendf,RTHSHTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVSHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCSHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QR .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRSHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQISHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QS .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSSHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QG .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGSHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QNC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(scalar_tendf(ims,kms,jms,P_QNC),RQCNSHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QNI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(scalar_tendf(ims,kms,jms,P_QNI),RQINSHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
   CASE (GRIMSSHCUSCHEME)
        CALL add_a2a(rt_tendf,RTHSHTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVSHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QC .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCSHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
        if (P_QI .ge. PARAM_FIRST_SCALAR) &
        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQISHTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
   CASE DEFAULT
   END SELECT
END SUBROUTINE phy_shcu_ten
SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist, &
                      rph_tendf,rt_tendf,ru_tendf,rv_tendf, &
                      mu_tendf, moist_tendf, &
                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
                      RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
                                   ims, ime, jms, jme, kms, kme, &
                                   its, ite, jts, jte, kts, kte, &
                                   n_moist, rk_step
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
          INTENT(INOUT) :: moist_tendf
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
                                                       RTHNDGDTEN, &
                                                       RPHNDGDTEN, &
                                                        RUNDGDTEN, &
                                                        RVNDGDTEN, &
                                                       RQVNDGDTEN
   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
                                                       rph_tendf,&
                                                       rt_tendf, &
                                                       ru_tendf, &
                                                       rv_tendf
   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
   INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
   SELECT CASE(config_flags%grid_fdda)
      CASE (PSUFDDAGD)
           CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags, &
                ids,ide, jds, jde, kds, kds, &
                ims, ime, jms, jme, kms, kms, &
                its, ite, jts, jte, kts, kts )
        if (P_QV .ge. PARAM_FIRST_SCALAR) &
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
      CASE (SPNUDGING)
           CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2a_ph(rph_tendf,RPHNDGDTEN,config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
      CASE DEFAULT
   END SELECT
END SUBROUTINE phy_fg_ten
SUBROUTINE phy_fr_ten(config_flags,rk_step,n_moist, &
                      rt_tendf,ru_tendf,rv_tendf, &
                      mu_tendf, moist_tendf, &
                      rthfrten,rqvfrten, &
                      ids, ide, jds, jde, kds, kde, &
                      ims, ime, jms, jme, kms, kme, &
                      its, ite, jts, jte, kts, kte )
   USE module_state_description, ONLY : &
                   FIRE_SFIRE
   IMPLICIT NONE
   TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
                                   ims, ime, jms, jme, kms, kme, &
                                   its, ite, jts, jte, kts, kte, &
                                   n_moist, rk_step
   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
          INTENT(INOUT) :: moist_tendf
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
                                                       rthfrten, &
                                                       rqvfrten
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
                                                       rt_tendf, &
                                                       ru_tendf, &
                                                       rv_tendf
   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
   INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
   SELECT CASE(config_flags%ifire)
      CASE (FIRE_SFIRE)
           CALL add_a2a(rt_tendf,rthfrten, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),rqvfrten, &
                config_flags, &
                ids,ide, jds, jde, kds, kde, &
                ims, ime, jms, jme, kms, kme, &
                its, ite, jts, jte, kts, kte )
      CASE DEFAULT
   END SELECT
END SUBROUTINE phy_fr_ten
SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
                     CLDFRA_CUP, &
                     RQICUTEN,RQSCUTEN, &
                     RAINC,RAINCV,RAINSH,PRATEC,PRATESH, &
                     NCA, HTOP,HBOT,CUTOP,CUBOT, &
                     CUPPT, DT, config_flags, &
                     ids,ide, jds,jde, kds,kde, &
                     ims,ime, jms,jme, kms,kme, &
                     its,ite, jts,jte, kts,kte )
   USE module_state_description
   USE module_cu_kf
   USE module_cu_kfeta
   IMPLICIT NONE
   TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
   INTEGER, INTENT(IN ) :: &
                                      ids,ide, jds,jde, kds,kde, &
                                      ims,ime, jms,jme, kms,kme, &
                                      its,ite, jts,jte, kts,kte
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
         INTENT(INOUT) :: RTHCUTEN, &
                                                       RQVCUTEN, &
                                                       RQCCUTEN, &
                                                       RQRCUTEN, &
                                                       RQICUTEN, &
                                                       RQSCUTEN, &
                                                       CLDFRA_CUP
   REAL, DIMENSION( ims:ime , jms:jme ), &
          INTENT(INOUT) :: RAINC, &
                                                         RAINSH, &
                                                         RAINCV, &
                                                         PRATEC, &
                                                        PRATESH, &
                                                            NCA, &
                                                           HTOP, &
                                                           HBOT, &
                                                          CUTOP, &
                                                          CUBOT, &
                                                          CUPPT
   REAL, INTENT(IN) :: DT
   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
   INTEGER :: NCUTOP, NCUBOT
   IF (config_flags%cu_physics .eq. 0) return
   i_start = its
   i_end = min( ite,ide-1 )
   j_start = jts
   j_end = min( jte,jde-1 )
   k_start = kts
   k_end = min( kte, kde-1 )
   DO J = j_start,j_end
   DO i = i_start,i_end
      RAINC(I,J) = RAINC(I,J) + PRATEC(I,J)*DT
      RAINSH(I,J) = RAINSH(I,J) + PRATESH(I,J)*DT
      CUPPT(I,J) = CUPPT(I,J) + (PRATEC(I,J)+PRATESH(I,J))*DT/1000.
   ENDDO
   ENDDO
   SELECT CASE (config_flags%cu_physics)
   CASE (KFSCHEME)
        DO J = j_start,j_end
        DO i = i_start,i_end
           IF ( NCA(I,J) .GT. 0 ) THEN
              IF ( NINT(NCA(I,J) / DT) .le. 0 ) THEN
                 DO k = k_start,k_end
                    RTHCUTEN(i,k,j)=0.
                    RQVCUTEN(i,k,j)=0.
                    RQCCUTEN(i,k,j)=0.
                    RQRCUTEN(i,k,j)=0.
                    if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
                    if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
                 ENDDO
              ENDIF
              NCA(I,J)=NCA(I,J)-DT
           ENDIF
        ENDDO
        ENDDO
   CASE (BMJSCHEME, CAMZMSCHEME)
        DO J = j_start,j_end
        DO i = i_start,i_end
           NCUTOP=NINT(CUTOP(I,J))
           NCUBOT=NINT(CUBOT(I,J))
           IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
             HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
           ENDIF
           IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
             HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
           ENDIF
        ENDDO
        ENDDO
   CASE (KFETASCHEME, KFCUPSCHEME)
        DO J = j_start,j_end
        DO i = i_start,i_end
           NCUTOP=NINT(CUTOP(I,J))
           NCUBOT=NINT(CUBOT(I,J))
           IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
             HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
           ENDIF
           IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
             HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
           ENDIF
           IF ( NCA(I,J) .GT. 0 ) THEN
              IF ( NINT(NCA(I,J) / DT) .LE. 1 ) THEN
                 DO k = k_start,k_end
                    RTHCUTEN(i,k,j)=0.
                    RQVCUTEN(i,k,j)=0.
                    RQCCUTEN(i,k,j)=0.
                    RQRCUTEN(i,k,j)=0.
                    if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
                    if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
                    CLDFRA_CUP(i,k,j)=0.
                 ENDDO
              ENDIF
              NCA(I,J)=NCA(I,J)-DT
           ENDIF
        ENDDO
        ENDDO
   CASE DEFAULT
   END SELECT
END SUBROUTINE advance_ppt
SUBROUTINE add_a2a(lvar,rvar,config_flags, &
                   ids,ide, jds, jde, kds, kde, &
                   ims, ime, jms, jme, kms, kme, &
                   its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
   INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
                              ims, ime, jms, jme, kms, kme, &
                              its, ite, jts, jte, kts, kte
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
                                                      rvar
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
                                                      lvar
   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
   i_start = its
   i_end = MIN(ite,ide-1)
   j_start = jts
   j_end = MIN(jte,jde-1)
   ktf = min(kte,kde-1)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_start = MAX(ids+1,its)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_end = MIN(ide-2,ite)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_start = MAX(jds+1,jts)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_end = MIN(jde-2,jte)
      IF ( config_flags%periodic_x ) i_start = its
      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
   DO j = j_start,j_end
   DO k = kts,ktf
   DO i = i_start,i_end
      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
   ENDDO
   ENDDO
   ENDDO
END SUBROUTINE add_a2a
SUBROUTINE add_a2a_ph(lvar,rvar,config_flags, &
                   ids,ide, jds, jde, kds, kde, &
                   ims, ime, jms, jme, kms, kme, &
                   its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
   INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
                              ims, ime, jms, jme, kms, kme, &
                              its, ite, jts, jte, kts, kte
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
                                                      rvar
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
                                                      lvar
   INTEGER :: i,j,k,i_start,i_end,j_start,j_end
   i_start = its
   i_end = MIN(ite,ide-1)
   j_start = jts
   j_end = MIN(jte,jde-1)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_start = MAX(ids+1,its)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_end = MIN(ide-2,ite)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_start = MAX(jds+1,jts)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_end = MIN(jde-2,jte)
      IF ( config_flags%periodic_x ) i_start = its
      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
   DO j = j_start,j_end
   DO k = kts,kte
   DO i = i_start,i_end
      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
   ENDDO
   ENDDO
   ENDDO
END SUBROUTINE add_a2a_ph
SUBROUTINE add_a2c_u(lvar,rvar,config_flags, &
                   ids,ide, jds, jde, kds, kde, &
                   ims, ime, jms, jme, kms, kme, &
                   its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
                              ims, ime, jms, jme, kms, kme, &
                              its, ite, jts, jte, kts, kte
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
                                                      rvar
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
                                                      lvar
   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
   ktf=min(kte,kde-1)
   i_start = its
   i_end = ite
   j_start = jts
   j_end = MIN(jte,jde-1)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_start = MAX(ids+1,its)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_end = MIN(ide-1,ite)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_start = MAX(jds+1,jts)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_end = MIN(jde-2,jte)
      IF ( config_flags%periodic_x ) i_start = its
      IF ( config_flags%periodic_x ) i_end = ite
   DO j = j_start,j_end
   DO k = kts,ktf
   DO i = i_start,i_end
      lvar(i,k,j) = lvar(i,k,j) + &
                       0.5*(rvar(i,k,j)+rvar(i-1,k,j))
   ENDDO
   ENDDO
   ENDDO
END SUBROUTINE add_a2c_u
SUBROUTINE add_a2c_v(lvar,rvar,config_flags, &
                   ids,ide, jds, jde, kds, kde, &
                   ims, ime, jms, jme, kms, kme, &
                   its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
                              ims, ime, jms, jme, kms, kme, &
                              its, ite, jts, jte, kts, kte
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
                                                      rvar
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
                                                      lvar
   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
   ktf=min(kte,kde-1)
   i_start = its
   i_end = MIN(ite,ide-1)
   j_start = jts
   j_end = jte
   IF ( config_flags%specified .or. &
        config_flags%nested) i_start = MAX(ids+1,its)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_end = MIN(ide-2,ite)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_start = MAX(jds+1,jts)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_end = MIN(jde-1,jte)
      IF ( config_flags%periodic_x ) i_start = its
      IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
   DO j = j_start,j_end
   DO k = kts,kte
   DO i = i_start,i_end
      lvar(i,k,j) = lvar(i,k,j) + &
                     0.5*(rvar(i,k,j)+rvar(i,k,j-1))
   ENDDO
   ENDDO
   ENDDO
END SUBROUTINE add_a2c_v
SUBROUTINE add_c2c_u(lvar,rvar,config_flags, &
                   ids,ide, jds, jde, kds, kde, &
                   ims, ime, jms, jme, kms, kme, &
                   its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
                              ims, ime, jms, jme, kms, kme, &
                              its, ite, jts, jte, kts, kte
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
                                                      rvar
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
                                                      lvar
   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
   ktf=min(kte,kde-1)
   i_start = its
   i_end = ite
   j_start = jts
   j_end = MIN(jte,jde-1)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_start = MAX(ids+1,its)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_end = MIN(ide-1,ite)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_start = MAX(jds+1,jts)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_end = MIN(jde-2,jte)
   DO j = j_start,j_end
   DO k = kts,ktf
   DO i = i_start,i_end
      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
   ENDDO
   ENDDO
   ENDDO
END SUBROUTINE add_c2c_u
SUBROUTINE add_c2c_v(lvar,rvar,config_flags, &
                   ids,ide, jds, jde, kds, kde, &
                   ims, ime, jms, jme, kms, kme, &
                   its, ite, jts, jte, kts, kte )
   IMPLICIT NONE
   TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
   INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
                              ims, ime, jms, jme, kms, kme, &
                              its, ite, jts, jte, kts, kte
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
                                                      rvar
   REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
                                                      lvar
   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
   ktf=min(kte,kde-1)
   i_start = its
   i_end = MIN(ite,ide-1)
   j_start = jts
   j_end = jte
   IF ( config_flags%specified .or. &
        config_flags%nested) i_start = MAX(ids+1,its)
   IF ( config_flags%specified .or. &
        config_flags%nested) i_end = MIN(ide-2,ite)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_start = MAX(jds+1,jts)
   IF ( config_flags%specified .or. &
        config_flags%nested) j_end = MIN(jde-1,jte)
   DO j = j_start,j_end
   DO k = kts,kte
   DO i = i_start,i_end
      lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
   ENDDO
   ENDDO
   ENDDO
END SUBROUTINE add_c2c_v
END MODULE module_physics_addtendc