#include "cosp_defs.H"
#ifdef COSP_GFDL

!---------------------------------------------------------------------
!------------ FMS version number and tagname for this file -----------

! $Id: prec_scops.F,v 20.0 2013/12/13 23:16:08 fms Exp $
! $Name: tikal $
! cosp_version = 1.3.2
 
#endif

! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation.
! All rights reserved.
! 
! Redistribution and use in source and binary forms, with or without modification, are permitted 
! provided that the following conditions are met:
! 
!     * Redistributions of source code must retain the above copyright notice, this list 
!       of conditions and the following disclaimer.
!     * Redistributions in binary form must reproduce the above copyright notice, this list 
!       of conditions and the following disclaimer in the documentation and/or other materials 
!       provided with the distribution.
!     * Neither the name of the Lawrence Livermore National Security Limited Liability Corporation 
!       nor the names of its contributors may be used to endorse or promote products derived from 
!       this software without specific prior written permission.
! 
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
      
      subroutine prec_scops(npoints,nlev,ncol,ls_p_rate,cv_p_rate,
     &                      frac_out,prec_frac)


      implicit none

      INTEGER npoints       !  number of model points in the horizontal
      INTEGER nlev          !  number of model levels in column
      INTEGER ncol          !  number of subcolumns

      INTEGER i,j,ilev,ibox,cv_col
      
      REAL ls_p_rate(npoints,nlev),cv_p_rate(npoints,nlev)

      REAL frac_out(npoints,ncol,nlev) ! boxes gridbox divided up into
                              ! Equivalent of BOX in original version, but
                              ! indexed by column then row, rather than
                              ! by row then column
                              !TOA to SURFACE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      REAL prec_frac(npoints,ncol,nlev) ! 0 -> clear sky
                                        ! 1 -> LS precipitation
                                        ! 2 -> CONV precipitation
                    ! 3 -> both
                                        !TOA to SURFACE!!!!!!!!!!!!!!!!!!
                    
      INTEGER flag_ls, flag_cv
      INTEGER frac_out_ls(npoints,ncol),frac_out_cv(npoints,ncol) !flag variables for 
                       ! stratiform cloud and convective cloud in the vertical column

      cv_col = 0.05*ncol
      if (cv_col .eq. 0) cv_col=1
 
      do ilev=1,nlev
        do ibox=1,ncol
          do j=1,npoints 
            prec_frac(j,ibox,ilev) = 0
          enddo
        enddo
      enddo
      
      do j=1,npoints
       do ibox=1,ncol
        frac_out_ls(j,ibox)=0
        frac_out_cv(j,ibox)=0
        flag_ls=0
        flag_cv=0
        do ilev=1,nlev
          if (frac_out(j,ibox,ilev) .eq. 1) then 
            flag_ls=1
          endif
          if (frac_out(j,ibox,ilev) .eq. 2) then 
            flag_cv=1
          endif
        enddo !loop over nlev
        if (flag_ls .eq. 1) then
           frac_out_ls(j,ibox)=1
        endif
        if (flag_cv .eq. 1) then
           frac_out_cv(j,ibox)=1
        endif
       enddo  ! loop over ncol
      enddo ! loop over npoints

!      initialize the top layer      
       do j=1,npoints
        flag_ls=0
        flag_cv=0
    
        if (ls_p_rate(j,1) .gt. 0.) then 
            do ibox=1,ncol ! possibility ONE
                if (frac_out(j,ibox,1) .eq. 1) then 
                    prec_frac(j,ibox,1) = 1
                    flag_ls=1
                endif
            enddo ! loop over ncol
            if (flag_ls .eq. 0) then ! possibility THREE
                do ibox=1,ncol
                    if (frac_out(j,ibox,2) .eq. 1) then 
                        prec_frac(j,ibox,1) = 1
                        flag_ls=1
                    endif
                enddo ! loop over ncol
            endif
        if (flag_ls .eq. 0) then ! possibility Four
        do ibox=1,ncol
        if (frac_out_ls(j,ibox) .eq. 1) then 
            prec_frac(j,ibox,1) = 1
            flag_ls=1
        endif
        enddo ! loop over ncol
        endif
        if (flag_ls .eq. 0) then ! possibility Five
        do ibox=1,ncol
    !     prec_frac(j,1:ncol,1) = 1
        prec_frac(j,ibox,1) = 1
        enddo ! loop over ncol
            endif
        endif
       ! There is large scale precipitation
     
        if (cv_p_rate(j,1) .gt. 0.) then 
         do ibox=1,ncol ! possibility ONE
          if (frac_out(j,ibox,1) .eq. 2) then 
           if (prec_frac(j,ibox,1) .eq. 0) then
        prec_frac(j,ibox,1) = 2
       else
        prec_frac(j,ibox,1) = 3
       endif
       flag_cv=1
      endif
        enddo ! loop over ncol
        if (flag_cv .eq. 0) then ! possibility THREE
        do ibox=1,ncol
        if (frac_out(j,ibox,2) .eq. 2) then 
                if (prec_frac(j,ibox,1) .eq. 0) then
            prec_frac(j,ibox,1) = 2
            else
            prec_frac(j,ibox,1) = 3
            endif
            flag_cv=1
        endif
        enddo ! loop over ncol
        endif
        if (flag_cv .eq. 0) then ! possibility Four
        do ibox=1,ncol
        if (frac_out_cv(j,ibox) .eq. 1) then 
                if (prec_frac(j,ibox,1) .eq. 0) then
            prec_frac(j,ibox,1) = 2
            else
            prec_frac(j,ibox,1) = 3
            endif
            flag_cv=1
        endif
        enddo ! loop over ncol
        endif
        if (flag_cv .eq. 0) then  ! possibility Five
        do ibox=1,cv_col
                if (prec_frac(j,ibox,1) .eq. 0) then
            prec_frac(j,ibox,1) = 2
            else
            prec_frac(j,ibox,1) = 3
            endif 
        enddo !loop over cv_col
            endif 
        endif 
        ! There is convective precipitation
        
        enddo ! loop over npoints
!      end of initializing the top layer

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!     working on the levels from top to surface
      do ilev=2,nlev
       do j=1,npoints
        flag_ls=0
        flag_cv=0
    
        if (ls_p_rate(j,ilev) .gt. 0.) then 
         do ibox=1,ncol ! possibility ONE&TWO
          if ((frac_out(j,ibox,ilev) .eq. 1) .or. 
     &       ((prec_frac(j,ibox,ilev-1) .eq. 1) 
     &       .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 
           prec_frac(j,ibox,ilev) = 1
           flag_ls=1
          endif
        enddo ! loop over ncol
        if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
        do ibox=1,ncol
        if (frac_out(j,ibox,ilev+1) .eq. 1) then 
            prec_frac(j,ibox,ilev) = 1
            flag_ls=1
        endif
        enddo ! loop over ncol
        endif
        if (flag_ls .eq. 0) then ! possibility Four
        do ibox=1,ncol
        if (frac_out_ls(j,ibox) .eq. 1) then 
            prec_frac(j,ibox,ilev) = 1
            flag_ls=1
        endif
        enddo ! loop over ncol
        endif
        if (flag_ls .eq. 0) then ! possibility Five
        do ibox=1,ncol
!     prec_frac(j,1:ncol,ilev) = 1
        prec_frac(j,ibox,ilev) = 1
        enddo ! loop over ncol
         endif
      endif ! There is large scale precipitation
    
        if (cv_p_rate(j,ilev) .gt. 0.) then 
         do ibox=1,ncol ! possibility ONE&TWO
          if ((frac_out(j,ibox,ilev) .eq. 2) .or. 
     &       ((prec_frac(j,ibox,ilev-1) .eq. 2) 
     &       .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 
            if (prec_frac(j,ibox,ilev) .eq. 0) then
         prec_frac(j,ibox,ilev) = 2
        else
         prec_frac(j,ibox,ilev) = 3
        endif 
        flag_cv=1
        endif
       enddo ! loop over ncol
        if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
        do ibox=1,ncol
        if (frac_out(j,ibox,ilev+1) .eq. 2) then 
                if (prec_frac(j,ibox,ilev) .eq. 0) then
            prec_frac(j,ibox,ilev) = 2
            else
            prec_frac(j,ibox,ilev) = 3
            endif
            flag_cv=1
        endif
        enddo ! loop over ncol
        endif
        if (flag_cv .eq. 0) then ! possibility Four
        do ibox=1,ncol
        if (frac_out_cv(j,ibox) .eq. 1) then 
                if (prec_frac(j,ibox,ilev) .eq. 0) then
            prec_frac(j,ibox,ilev) = 2
            else
            prec_frac(j,ibox,ilev) = 3
            endif
            flag_cv=1
        endif
        enddo ! loop over ncol
        endif
        if (flag_cv .eq. 0) then  ! possibility Five 
        do ibox=1,cv_col
                if (prec_frac(j,ibox,ilev) .eq. 0) then
            prec_frac(j,ibox,ilev) = 2
            else
            prec_frac(j,ibox,ilev) = 3
            endif 
        enddo !loop over cv_col 
            endif 
        endif ! There is convective precipitation
    
        enddo ! loop over npoints
        enddo ! loop over nlev

      end

