! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation. ! All rights reserved. ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/llnl/prec_scops.f $ ! ! 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 subroutine prec_scops