! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! Copyright (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:

! 1. Redistributions of source code must retain the above copyright notice, this list of 
!    conditions and the following disclaimer.

! 2. 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.

! 3. Neither the name of the copyright holder 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 HOLDER 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.

! History:
! May 2015- D. Swales - Modified for COSPv2.0
! 
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
module mod_prec_scops
   implicit none
contains
      
      subroutine prec_scops(npoints,nlev,ncol,ls_p_rate,cv_p_rate,frac_out,prec_frac)

        USE COSP_KINDS, ONLY: wp
        use mod_cosp_config, ONLY: scops_ccfrac

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

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

      REAL(WP) 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(WP) 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 = scops_ccfrac*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 subroutine prec_scops
end module mod_prec_scops