LCOV - code coverage report
Current view: top level - physics/cosp2/src/src/simulator/actsim - lidar_simulator.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 419 529 79.2 %
Date: 2025-03-13 19:12:29 Functions: 6 7 85.7 %

          Line data    Source code
       1             : ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
       2             : ! Copyright (c) 2009, Centre National de la Recherche Scientifique
       3             : ! All rights reserved.
       4             : !
       5             : ! Redistribution and use in source and binary forms, with or without modification, are 
       6             : ! permitted provided that the following conditions are met:
       7             : !
       8             : ! 1. Redistributions of source code must retain the above copyright notice, this list of 
       9             : !    conditions and the following disclaimer.
      10             : !
      11             : ! 2. Redistributions in binary form must reproduce the above copyright notice, this list
      12             : !    of conditions and the following disclaimer in the documentation and/or other 
      13             : !    materials provided with the distribution.
      14             : !
      15             : ! 3. Neither the name of the copyright holder nor the names of its contributors may be 
      16             : !    used to endorse or promote products derived from this software without specific prior
      17             : !    written permission.
      18             : !
      19             : ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY 
      20             : ! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 
      21             : ! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL 
      22             : ! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
      23             : ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT 
      24             : ! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
      25             : ! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
      26             : ! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
      27             : ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
      28             : !
      29             : ! History
      30             : ! May 2007: ActSim code of M. Chiriaco and H. Chepfer rewritten by S. Bony
      31             : !
      32             : ! May 2008, H. Chepfer:
      33             : ! - Units of pressure inputs: Pa 
      34             : ! - Non Spherical particles : LS Ice NS coefficients, CONV Ice NS coefficients
      35             : ! - New input: ice_type (0=ice-spheres ; 1=ice-non-spherical)
      36             : !
      37             : ! June 2008, A. Bodas-Salcedo:
      38             : ! - Ported to Fortran 90 and optimisation changes
      39             : !
      40             : ! August 2008, J-L Dufresne:
      41             : ! - Optimisation changes (sum instructions suppressed)
      42             : !
      43             : ! October 2008, S. Bony,  H. Chepfer and J-L. Dufresne :  
      44             : ! - Interface with COSP v2.0:
      45             : !      cloud fraction removed from inputs
      46             : !      in-cloud condensed water now in input (instead of grid-averaged value)
      47             : !      depolarisation diagnostic removed
      48             : !      parasol (polder) reflectances (for 5 different solar zenith angles) added
      49             : !
      50             : ! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne : 
      51             : ! - Modification of the integration of the lidar equation.
      52             : ! - change the cloud detection threshold
      53             : !
      54             : ! April 2008, A. Bodas-Salcedo:
      55             : ! - Bug fix in computation of pmol and pnorm of upper layer
      56             : !
      57             : ! April 2008, J-L. Dufresne
      58             : ! - Bug fix in computation of pmol and pnorm, thanks to Masaki Satoh: a factor 2 
      59             : ! was missing. This affects the ATB values but not the cloud fraction. 
      60             : !
      61             : ! January 2013, G. Cesana and H. Chepfer:
      62             : ! - Add the perpendicular component of the backscattered signal (pnorm_perp_tot) in the arguments
      63             : ! - Add the temperature for each levels (temp) in the arguments
      64             : ! - Add the computation of the perpendicular component of the backscattered lidar signal 
      65             : ! Reference: Cesana G. and H. Chepfer (2013): Evaluation of the cloud water phase
      66             : ! in a climate model using CALIPSO-GOCCP, J. Geophys. Res., doi: 10.1002/jgrd.50376
      67             : !
      68             : ! May 2015 - D. Swales - Modified for COSPv2.0
      69             : !
      70             : ! Mar 2018 - R. Guzman - Added OPAQ subroutines
      71             : ! References OPAQ:
      72             : !
      73             : !       Guzman et al. (2017): Direct atmosphere opacity observations from CALIPSO provide 
      74             : ! new constraints on cloud-radiation interactions. JGR-Atmospheres, DOI: 10.1002/2016JD025946
      75             : !       Vaillant de Guelis et al. (2017a): The link between outgoing longwave radiation and
      76             : ! the altitude at which a spaceborne lidar beam is fully attenuated. AMT, 10, 4659-4685,
      77             : ! https://doi.org/10.5194/amt-10-4659-2017
      78             : !
      79             : ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      80             : module mod_lidar_simulator
      81             :   USE COSP_KINDS,         ONLY: wp
      82             :   USE MOD_COSP_CONFIG,    ONLY: SR_BINS,S_CLD,S_ATT,S_CLD_ATT,R_UNDEF,calipso_histBsct,  &
      83             :                                 use_vgrid,vgrid_zl,vgrid_zu,vgrid_z,atlid_histBsct,      &
      84             :                                 grLidar532_histBsct,S_CLD_ATLID,S_ATT_ATLID,S_CLD_ATT_ATLID
      85             :   USE MOD_COSP_STATS,     ONLY: COSP_CHANGE_VERTICAL_GRID,hist1d
      86             :   implicit none
      87             :   
      88             :   ! Polynomial coefficients (Alpha, Beta, Gamma) which allow to compute the 
      89             :   ! ATBperpendicular as a function of the ATB for ice or liquid cloud particles 
      90             :   ! derived from CALIPSO-GOCCP observations at 120m vertical grid 
      91             :   ! (Cesana and Chepfer, JGR, 2013).
      92             :   !
      93             :   ! Relationship between ATBice and ATBperp,ice for ice particles:
      94             :   !                ATBperp,ice = Alpha*ATBice 
      95             :   ! Relationship between ATBice and ATBperp,ice for liquid particles:
      96             :   !          ATBperp,ice = Beta*ATBice^2 + Gamma*ATBice
      97             :   real(wp) :: &
      98             :        alpha,beta,gamma    
      99             : 
     100             : contains
     101             :   ! ######################################################################################
     102             :   ! SUBROUTINE lidar_subcolumn
     103             :   ! Inputs with a vertical dimensions (nlev) should ordered in along the vertical 
     104             :   ! dimension from TOA-2-SFC, for example: varIN(nlev) is varIN @ SFC. 
     105             :   ! ######################################################################################
     106       18576 :   subroutine lidar_subcolumn(npoints, ncolumns, nlev, lground, beta_mol, tau_mol,        &
     107       37152 :        betatot, tautot, pmol, pnorm, betatot_ice, tautot_ice, betatot_liq, tautot_liq,   &
     108        9288 :        pnorm_perp_tot)
     109             : 
     110             :     ! INPUTS
     111             :     INTEGER,intent(in) :: & 
     112             :          npoints,      & ! Number of gridpoints
     113             :          ncolumns,     & ! Number of subcolumns
     114             :          nlev            ! Number of levels
     115             :     logical,intent(in) :: &
     116             :          lground         ! True for ground-based lidar simulator
     117             :     REAL(WP),intent(in),dimension(npoints,nlev) :: &
     118             :          beta_mol,     & ! Molecular backscatter coefficient
     119             :          tau_mol         ! Molecular optical depth
     120             :     REAL(WP),intent(in),dimension(npoints,ncolumns,nlev)       :: &
     121             :          betatot,      & ! 
     122             :          tautot          ! Optical thickess integrated from top
     123             :     ! Optional Inputs
     124             :     REAL(WP),intent(in),dimension(npoints,ncolumns,nlev),optional       :: &         
     125             :          betatot_ice,  & ! Backscatter coefficient for ice particles
     126             :          betatot_liq,  & ! Backscatter coefficient for liquid particles
     127             :          tautot_ice,   & ! Total optical thickness of ice
     128             :          tautot_liq      ! Total optical thickness of liq
     129             : 
     130             :     ! OUTPUTS
     131             :     REAL(WP),intent(out),dimension(npoints,nlev) :: &
     132             :          pmol            ! Molecular attenuated backscatter lidar signal power(m^-1.sr^-1)
     133             :     REAL(WP),intent(out),dimension(npoints,ncolumns,nlev) :: &
     134             :          pnorm           ! Molecular backscatter signal power (m^-1.sr^-1)
     135             :     ! Optional outputs
     136             :     REAL(WP),intent(out),dimension(npoints,ncolumns,nlev),optional :: &
     137             :          pnorm_perp_tot  ! Perpendicular lidar backscattered signal power
     138             : 
     139             :     ! LOCAL VARIABLES
     140             :     INTEGER :: k,icol,zi,zf,zinc
     141             :     logical :: lphaseoptics
     142             :     REAL(WP),dimension(npoints) :: &
     143       18576 :          tautot_lay        !
     144             :     REAL(WP),dimension(npoints,ncolumns,nlev) :: &
     145       18576 :          pnorm_liq,      & ! Lidar backscattered signal power for liquid
     146       18576 :          pnorm_ice,      & ! Lidar backscattered signal power for ice
     147       18576 :          pnorm_perp_ice, & ! Perpendicular lidar backscattered signal power for ice
     148       18576 :          pnorm_perp_liq, & ! Perpendicular lidar backscattered signal power for liq
     149       18576 :          beta_perp_ice,  & ! Perpendicular backscatter coefficient for ice
     150       18576 :          beta_perp_liq     ! Perpendicular backscatter coefficient for liquid
     151             : 
     152             :     ! Phase optics?
     153        9288 :     lphaseoptics=.false.
     154        9288 :     if (present(betatot_ice) .and. present(betatot_liq) .and. present(tautot_liq) .and. &
     155        9288 :          present(tautot_ice)) lphaseoptics=.true.
     156             :     
     157             :     ! Is this lidar spaceborne (default) or ground-based?
     158        9288 :     if (lground) then
     159             :        zi   = nlev
     160             :        zf   = 1
     161             :        zinc = -1
     162             :     else
     163        9288 :        zi   = 1
     164        9288 :        zf   = nlev
     165        9288 :        zinc = 1
     166             :     endif    
     167             : 
     168             :     ! ####################################################################################
     169             :     ! *) Molecular signal
     170             :     ! ####################################################################################
     171           0 :     call cmp_backsignal(nlev,npoints,beta_mol(1:npoints,zi:zf:zinc),&
     172        9288 :                         tau_mol(1:npoints,zi:zf:zinc),pmol(1:npoints,zi:zf:zinc))
     173             :                         
     174             :     ! ####################################################################################
     175             :     ! PLANE PARRALLEL FIELDS
     176             :     ! ####################################################################################
     177      102168 :     do icol=1,ncolumns
     178             :        ! #################################################################################
     179             :        ! *) Total Backscatter signal
     180             :        ! #################################################################################
     181       92880 :        call cmp_backsignal(nlev,npoints,betatot(1:npoints,icol,zi:zf:zinc),&
     182   391007520 :             tautot(1:npoints,icol,zi:zf:zinc),pnorm(1:npoints,icol,zi:zf:zinc))
     183             :        
     184             :        ! #################################################################################
     185             :        ! *) Ice/Liq Backscatter signal
     186             :        ! #################################################################################
     187      102168 :        if (lphaseoptics) then
     188             :           ! Computation of the ice and liquid lidar backscattered signal (ATBice and ATBliq)
     189             :           ! Ice only
     190      464400 :           call cmp_backsignal(nlev,npoints,betatot_ice(1:npoints,icol,zi:zf:zinc),&
     191   391379040 :                tautot_ice(1:npoints,icol,zi:zf:zinc), pnorm_ice(1:npoints,icol,zi:zf:zinc))
     192             :           ! Liquid only
     193      464400 :           call cmp_backsignal(nlev,npoints,betatot_liq(1:npoints,icol,zi:zf:zinc),&
     194   391379040 :                tautot_liq(1:npoints,icol,zi:zf:zinc), pnorm_liq(1:npoints,icol,zi:zf:zinc))
     195             :        endif
     196             :     enddo
     197             : 
     198             :     ! ####################################################################################
     199             :     ! PERDENDICULAR FIELDS (Only needed if distinguishing by phase (ice/liquid))
     200             :     ! ####################################################################################
     201        9288 :     if (lphaseoptics) then
     202      102168 :        do icol=1,ncolumns
     203             :           ! #################################################################################
     204             :           ! *) Ice/Liq Perpendicular Backscatter signal
     205             :           ! #################################################################################
     206             :           ! Computation of ATBperp,ice/liq from ATBice/liq including the multiple scattering 
     207             :           ! contribution (Cesana and Chepfer 2013, JGR)
     208     7894800 :           do k=1,nlev
     209             :              ! Ice particles
     210   130273920 :              pnorm_perp_ice(1:npoints,icol,k) = Alpha * pnorm_ice(1:npoints,icol,k)
     211             :              
     212             :              ! Liquid particles
     213             :              pnorm_perp_liq(1:npoints,icol,k) = 1000._wp*Beta*pnorm_liq(1:npoints,icol,k)**2+&
     214   130366800 :                   Gamma*pnorm_liq(1:npoints,icol,k) 
     215             :           enddo
     216             :           
     217             :           ! #################################################################################
     218             :           ! *) Computation of beta_perp_ice/liq using the lidar equation
     219             :           ! #################################################################################
     220             :           ! Ice only
     221      185760 :           call cmp_beta(nlev,npoints,pnorm_perp_ice(1:npoints,icol,zi:zf:zinc),&
     222   391100400 :                tautot_ice(1:npoints,icol,zi:zf:zinc),beta_perp_ice(1:npoints,icol,zi:zf:zinc))        
     223             :           
     224             :           ! Liquid only
     225       92880 :           call cmp_beta(nlev,npoints,pnorm_perp_liq(1:npoints,icol,zi:zf:zinc),&
     226   391007520 :                tautot_liq(1:npoints,icol,zi:zf:zinc),beta_perp_liq(1:npoints,icol,zi:zf:zinc))
     227             :           
     228             :           ! #################################################################################
     229             :           ! *) Perpendicular Backscatter signal
     230             :           ! #################################################################################
     231             :           ! Computation of the total perpendicular lidar signal (ATBperp for liq+ice)
     232             :           ! Upper layer
     233     1736640 :           WHERE(tautot(1:npoints,icol,1) .gt. 0)
     234      278640 :              pnorm_perp_tot(1:npoints,icol,1) = (beta_perp_ice(1:npoints,icol,1)+           &
     235             :                   beta_perp_liq(1:npoints,icol,1)-                                          &
     236             :                   (beta_mol(1:npoints,1)/(1._wp+1._wp/0.0284_wp))) /                        &
     237             :                   (2._wp*tautot(1:npoints,icol,1))*                                         &
     238             :                   (1._wp-exp(-2._wp*tautot(1:npoints,icol,1)))
     239             :           ELSEWHERE
     240      185760 :              pnorm_perp_tot(1:npoints,icol,1) = 0._wp
     241             :           ENDWHERE
     242             :           
     243             :           ! Other layers
     244     7811208 :           do k=2,nlev
     245             :              ! Optical thickness of layer k
     246   128723040 :              tautot_lay(1:npoints) = tautot(1:npoints,icol,k)-tautot(1:npoints,icol,k-1) 
     247             :              
     248             :              ! The perpendicular component of the molecular backscattered signal (Betaperp) 
     249             :              ! has been taken into account two times (once for liquid and once for ice). 
     250             :              ! We remove one contribution using 
     251             :              ! Betaperp=beta_mol(:,k)/(1+1/0.0284)) [bodhaine et al. 1999] in the following 
     252             :              ! equations:
     253   635999040 :              WHERE (pnorm(1:npoints,icol,k) .eq. 0)
     254     7709040 :                 pnorm_perp_tot(1:npoints,icol,k)=0._wp
     255             :              ELSEWHERE
     256             :                 where(tautot_lay(1:npoints) .gt. 0.)
     257     7709040 :                    pnorm_perp_tot(1:npoints,icol,k) = (beta_perp_ice(1:npoints,icol,k)+     &
     258             :                         beta_perp_liq(1:npoints,icol,k)-(beta_mol(1:npoints,k)/(1._wp+1._wp/  &
     259             :                         0.0284_wp)))*EXP(-2._wp*tautot(1:npoints,icol,k-1))/                  &
     260             :                         (2._wp*tautot_lay(1:npoints))* (1._wp-EXP(-2._wp*tautot_lay(1:npoints)))
     261             :                 elsewhere
     262     7709040 :                    pnorm_perp_tot(1:npoints,icol,k) = (beta_perp_ice(1:npoints,icol,k)+     &
     263             :                         beta_perp_liq(1:npoints,icol,k)-(beta_mol(1:npoints,k)/(1._wp+1._wp/  &
     264             :                         0.0284_wp)))*EXP(-2._wp*tautot(1:npoints,icol,k-1))
     265             :                 endwhere
     266             :              ENDWHERE
     267             :           END DO
     268             :        enddo
     269             :     end if
     270       46440 :   end subroutine lidar_subcolumn
     271             : 
     272             :   ! ######################################################################################
     273             :   ! SUBROUTINE lidar_column
     274             :   ! ######################################################################################
     275        9288 :   subroutine lidar_column(npoints, ncol, nlevels, llm, max_bin, ntype, platform, pnorm, pmol,             &
     276       27864 :        pplay, zlev, zlev_half, vgrid_z, ok_lidar_cfad, ncat, cfad2, lidarcld, cldlayer,  &
     277             :        ! Optional stuff below
     278       46440 :        tmp, pnorm_perp, surfelev,  lidarcldphase, lidarcldtype, cldtype, cldtypetemp, &
     279       18576 :        cldtypemeanz, cldtypemeanzse, cldthinemis, cldlayerphase, lidarcldtmp)
     280             : 
     281             :     integer,parameter :: &
     282             :          nphase = 6 ! Number of cloud layer phase types
     283             : 
     284             :     ! Inputs
     285             :     integer,intent(in) :: &
     286             :          npoints, & ! Number of horizontal grid points
     287             :          ncol,    & ! Number of subcolumns
     288             :          nlevels, & ! Number of vertical layers (OLD grid)
     289             :          llm,     & ! Number of vertical layers (NEW grid)
     290             :          max_bin, & ! Number of bins for SR CFADs
     291             :          ncat,    & ! Number of cloud layer types (low,mid,high,total) 
     292             :          ntype      ! Number of OPAQ products (opaque/thin cloud + z_opaque)
     293             :     character(len=*),intent(in) :: &
     294             :          platform   ! Name of platform (e.g. calipso,atlid,grLidar532)
     295             :     real(wp),intent(in),dimension(npoints,ncol,Nlevels) :: &
     296             :          pnorm      ! Lidar ATB
     297             :     real(wp),intent(in),dimension(npoints,Nlevels) :: &
     298             :          pmol,    & ! Molecular ATB
     299             :          pplay      ! Pressure on model levels (Pa)
     300             :     logical,intent(in) :: &
     301             :          ok_lidar_cfad ! True if lidar CFAD diagnostics need to be computed
     302             :     real(wp),intent(in),dimension(npoints,nlevels) :: &
     303             :          zlev        ! Model full levels
     304             :     real(wp),intent(in),dimension(npoints,nlevels+1) :: &
     305             :          zlev_half   ! Model half levels
     306             :     real(wp),intent(in),dimension(llm) :: & 
     307             :          vgrid_z     ! mid-level altitude of the output vertical grid
     308             :     ! Optional Inputs
     309             :     real(wp),intent(in),dimension(npoints,ncol,Nlevels),optional :: &
     310             :          pnorm_perp ! Lidar perpendicular ATB
     311             :     real(wp),intent(in),dimension(npoints),optional :: &
     312             :          surfelev   ! Surface Elevation (m)
     313             :     real(wp),intent(in),dimension(npoints,Nlevels),optional :: &
     314             :          tmp        ! Temperature at each levels
     315             :     
     316             :     ! Outputs
     317             :     real(wp),intent(inout),dimension(npoints,llm) :: &
     318             :          lidarcld      ! 3D "lidar" cloud fraction
     319             :     real(wp),intent(inout),dimension(npoints,ncat) :: &
     320             :          cldlayer      ! "lidar" cloud layer fraction (low, mid, high, total)
     321             :     real(wp),intent(inout),dimension(npoints,max_bin,llm) :: &
     322             :          cfad2         ! CFADs of SR
     323             :     ! Optional Outputs
     324             :     real(wp),intent(out),dimension(npoints,ntype),optional :: & 
     325             :          cldtype,    & ! "lidar" OPAQ type covers (opaque/thin cloud + z_opaque)
     326             :          cldtypetemp   ! Opaque and thin clouds + z_opaque temperature
     327             :     real(wp),intent(out),dimension(npoints,2),optional :: &  
     328             :          cldtypemeanz  ! Opaque and thin clouds altitude 
     329             :     real(wp),intent(out),dimension(npoints,3),optional :: &  
     330             :          cldtypemeanzse ! Opaque, thin clouds and z_opaque altitude with respect to SE
     331             :     real(wp),intent(out),dimension(npoints),optional :: &   
     332             :          cldthinemis   ! Thin clouds emissivity computed from SR
     333             :     real(wp),intent(out),dimension(npoints,llm,nphase),optional :: &
     334             :          lidarcldphase ! 3D "lidar" phase cloud fraction
     335             :     real(wp),intent(out),dimension(npoints,llm,ntype+1),optional :: & 
     336             :          lidarcldtype ! 3D "lidar" OPAQ type fraction 
     337             :     real(wp),intent(out),dimension(npoints,40,5),optional :: &
     338             :          lidarcldtmp   ! 3D "lidar" phase cloud fraction as a function of temp
     339             :     real(wp),intent(out),dimension(npoints,ncat,nphase),optional :: &
     340             :          cldlayerphase ! "lidar" phase low mid high cloud fraction
     341             : 
     342             :     ! Local Variables
     343             :     integer :: ic,i,j
     344             :     logical :: lcalipso,latlid,lgrlidar532
     345             :     real(wp),dimension(npoints,ncol,llm) :: &
     346       18576 :          x3d
     347             :     real(wp),dimension(npoints,llm) :: &
     348       18576 :          x3d_c,pnorm_c
     349             :     real(wp)  :: &
     350             :          xmax
     351       18576 :     real(wp),dimension(npoints,1,Nlevels) :: t_in,ph_in,betamol_in
     352       18576 :     real(wp),dimension(npoints,ncol,llm)  :: pnormFlip,pnorm_perpFlip
     353       18576 :     real(wp),dimension(npoints,1,llm)     :: tmpFlip,pplayFlip,betamolFlip
     354             :     real(wp),dimension(SR_BINS+1)         :: histBsct
     355             :     
     356             :     ! Which lidar platform?
     357        9288 :     lcalipso = .false.
     358        9288 :     latlid = .false.
     359        9288 :     lgrlidar532 = .false.
     360        9288 :     if (platform .eq. 'calipso') lcalipso=.true.
     361        9288 :     if (platform .eq. 'atlid') latlid=.true.
     362        9288 :     if (platform .eq. 'grlidar532') lgrlidar532=.true.
     363             :         
     364             :     ! Vertically regrid input data
     365        9288 :     if (use_vgrid) then 
     366    13036680 :        ph_in(:,1,:) = pplay(:,nlevels:1:-1)
     367        9288 :        call cosp_change_vertical_grid(Npoints,1,Nlevels,zlev(:,nlevels:1:-1),zlev_half(:,nlevels:1:-1),&
     368    33019920 :             ph_in,llm,vgrid_zl(llm:1:-1),vgrid_zu(llm:1:-1),pplayFlip(:,1,llm:1:-1))
     369    13036680 :        betamol_in(:,1,:) = pmol(:,nlevels:1:-1)
     370             :        call cosp_change_vertical_grid(Npoints,1,Nlevels,zlev(:,nlevels:1:-1),zlev_half(:,nlevels:1:-1),&
     371    33010632 :             betamol_in,llm,vgrid_zl(llm:1:-1),vgrid_zu(llm:1:-1),betamolFlip(:,1,llm:1:-1))
     372             :        call cosp_change_vertical_grid(Npoints,Ncol,Nlevels,zlev(:,nlevels:1:-1),zlev_half(:,nlevels:1:-1),&
     373   220267944 :             pnorm(:,:,nlevels:1:-1),llm,vgrid_zl(llm:1:-1),vgrid_zu(llm:1:-1),pnormFlip(:,:,llm:1:-1))
     374        9288 :        if (lcalipso) then
     375    13036680 :           t_in(:,1,:)=tmp(:,nlevels:1:-1)
     376           0 :           call cosp_change_vertical_grid(Npoints,1,Nlevels,zlev(:,nlevels:1:-1),zlev_half(:,nlevels:1:-1),&
     377    33010632 :                t_in,llm,vgrid_zl(llm:1:-1),vgrid_zu(llm:1:-1),tmpFlip(:,1,llm:1:-1))
     378        9288 :           call cosp_change_vertical_grid(Npoints,Ncol,Nlevels,zlev(:,nlevels:1:-1),zlev_half(:,nlevels:1:-1),&
     379   220267944 :                pnorm_perp(:,:,nlevels:1:-1),llm,vgrid_zl(llm:1:-1),vgrid_zu(llm:1:-1),pnorm_perpFlip(:,:,llm:1:-1))
     380             :        endif
     381             :     endif
     382             : 
     383             :     ! Initialization (The histogram bins, are set up during initialization and the
     384             :     ! maximum value is used as the upper bounds.)
     385        9288 :     if (lcalipso)    then
     386        9288 :        xmax = maxval(calipso_histBsct)
     387        9288 :        histBsct = calipso_histBsct
     388             :     endif
     389        9288 :     if (latlid)      then
     390           0 :        xmax = maxval(atlid_histBsct)
     391           0 :        histBsct = atlid_histBsct
     392             :     endif
     393        9288 :     if (lgrlidar532) then
     394           0 :        xmax = maxval(grLidar532_histBsct)
     395           0 :        histBsct = grLidar532_histBsct
     396             :     endif
     397             :        
     398             :     ! Compute LIDAR scattering ratio
     399        9288 :     if (use_vgrid) then
     400      102168 :        do ic = 1, ncol
     401    62128080 :           pnorm_c = pnormFlip(:,ic,:)
     402             :           where ((pnorm_c .lt. xmax) .and. (betamolFlip(:,1,:) .lt. xmax) .and.          &
     403    62128080 :                 (betamolFlip(:,1,:) .gt. 0.0 ))
     404             :              x3d_c = pnorm_c/betamolFlip(:,1,:)
     405             :           elsewhere
     406             :              x3d_c = R_UNDEF
     407             :           end where
     408    62137368 :           x3d(:,ic,:) = x3d_c
     409             :        enddo
     410        9288 :        if (lcalipso) then
     411             :           ! Diagnose cloud fractions for subcolumn lidar scattering ratios
     412             :           CALL COSP_CLDFRAC(npoints,ncol,llm,ncat,nphase,tmpFlip,x3d,pnormFlip,pnorm_perpFlip,&
     413             :                pplayFlip,S_att,S_cld,S_cld_att,R_UNDEF,lidarcld,cldlayer,lidarcldphase,&
     414        9288 :                cldlayerphase,lidarcldtmp)                         
     415             : 
     416             :           ! Calipso opaque cloud diagnostics
     417             :           CALL COSP_OPAQ(npoints,ncol,llm,ntype,tmpFlip,x3d,S_att,S_cld,R_UNDEF,lidarcldtype, &
     418        9288 :                cldtype,cldtypetemp,cldtypemeanz,cldtypemeanzse,cldthinemis,vgrid_z,surfelev)
     419             :        endif
     420        9288 :        if (latlid) then
     421             :           CALL COSP_CLDFRAC_NOPHASE(npoints,ncol,llm,ncat,x3d,pnormFlip,pplayFlip,  &
     422           0 :                S_att_atlid,S_cld_atlid,S_cld_att_atlid,R_UNDEF,lidarcld,cldlayer)   
     423             :        endif
     424        9288 :        if (lgrLidar532) then
     425             :           CALL COSP_CLDFRAC_NOPHASE(npoints,ncol,llm,ncat,x3d,pnormFlip,pplayFlip,  &
     426           0 :                S_att,S_cld,S_cld_att,R_UNDEF,lidarcld,cldlayer)
     427             :        endif
     428             :     else
     429           0 :        do ic = 1, ncol
     430           0 :           pnorm_c = pnorm(:,ic,:)
     431           0 :           where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
     432             :              x3d_c = pnorm_c/pmol
     433             :           elsewhere
     434             :              x3d_c = R_UNDEF
     435             :           end where
     436           0 :           x3d(:,ic,:) = x3d_c
     437             :        enddo
     438           0 :        if (lcalipso) then
     439             :           ! Diagnose cloud fractions for subcolumn lidar scattering ratios
     440             :           CALL COSP_CLDFRAC(npoints,ncol,nlevels,ncat,nphase,tmp,x3d,pnorm,pnorm_perp,pplay,&
     441             :                S_att,S_cld,S_cld_att,R_UNDEF,lidarcld,cldlayer,lidarcldphase,  &
     442           0 :                cldlayerphase,lidarcldtmp)
     443             :           ! Calipso opaque cloud diagnostics
     444             :           CALL COSP_OPAQ(npoints,ncol,nlevels,ntype,tmp,x3d,S_att,S_cld,R_UNDEF,lidarcldtype, &
     445           0 :                cldtype,cldtypetemp,cldtypemeanz,cldtypemeanzse,cldthinemis,vgrid_z,surfelev)
     446             :        endif
     447           0 :        if (latlid) then
     448             :           CALL COSP_CLDFRAC_NOPHASE(npoints,ncol,nlevels,ncat,x3d,pnorm,pplay,  &
     449           0 :                S_att_atlid,S_cld_atlid,S_cld_att_atlid, R_UNDEF,lidarcld,cldlayer)
     450             :        endif
     451           0 :        if (lgrlidar532) then
     452             :           CALL COSP_CLDFRAC_NOPHASE(npoints,ncol,nlevels,ncat,x3d,pnorm,pplay,      &
     453           0 :                S_att,S_cld,S_cld_att,R_UNDEF,lidarcld,cldlayer)
     454             :        endif
     455             :     endif
     456             : 
     457             :     ! CFADs
     458        9288 :     if (ok_lidar_cfad) then
     459             :        ! CFADs of subgrid-scale lidar scattering ratios
     460      155088 :        do i=1,Npoints
     461     5987088 :           do j=1,llm
     462   151777800 :              cfad2(i,:,j) = hist1D(ncol,x3d(i,:,j),SR_BINS,histBsct)
     463             :           enddo
     464             :        enddo
     465    93433608 :        where(cfad2 .ne. R_UNDEF) cfad2=cfad2/ncol
     466             :     endif 
     467             :     
     468             :     ! Unit conversions
     469     6212808 :     where(lidarcld /= R_UNDEF)      lidarcld      = lidarcld*100._wp
     470      629640 :     where(cldlayer /= R_UNDEF)      cldlayer      = cldlayer*100._wp
     471        9288 :     if (lcalipso) then
     472      155088 :        where(cldtype(:,1) /= R_UNDEF)  cldtype(:,1)  = cldtype(:,1)*100._wp
     473      155088 :        where(cldtype(:,2) /= R_UNDEF)  cldtype(:,2)  = cldtype(:,2)*100._wp
     474     3796416 :        where(cldlayerphase /= R_UNDEF) cldlayerphase = cldlayerphase*100._wp
     475    37295424 :        where(lidarcldphase /= R_UNDEF) lidarcldphase = lidarcldphase*100._wp
     476    24869808 :        where(lidarcldtype /= R_UNDEF)  lidarcldtype  = lidarcldtype*100._wp
     477    31073328 :        where(lidarcldtmp /= R_UNDEF)   lidarcldtmp   = lidarcldtmp*100._wp
     478             :     endif
     479       65016 :   end subroutine lidar_column
     480             : 
     481             :   ! ######################################################################################
     482             :   ! The subroutines below compute the attenuated backscatter signal and the lidar 
     483             :   ! backscatter coefficients using eq (1) from doi:0094-8276/08/2008GL034207
     484             :   ! ######################################################################################
     485      287928 :   subroutine cmp_backsignal(nlev,npoints,beta,tau,pnorm)
     486             :     ! INPUTS
     487             :     integer, intent(in) :: nlev,npoints
     488             :     real(wp),intent(in),dimension(npoints,nlev) :: beta,tau
     489             : 
     490             :     ! OUTPUTS
     491             :     real(wp),intent(out),dimension(npoints,nlev) :: pnorm
     492             : 
     493             :     ! Internal Variables
     494      575856 :     real(wp), dimension(npoints) :: tautot_lay
     495             :     integer :: k
     496             : 
     497             :     ! Uppermost layer 
     498     4807728 :     pnorm(:,1) = beta(:,1) / (2._wp*tau(:,1)) * (1._wp-exp(-2._wp*tau(:,1)))
     499             : 
     500             :     ! Other layers
     501    24185952 :     do k=2,nlev
     502   399041424 :        tautot_lay(:) = tau(:,k)-tau(:,k-1) 
     503   399329352 :        WHERE (tautot_lay(:) .gt. 0.)
     504             :           pnorm(:,k) = beta(:,k)*EXP(-2._wp*tau(:,k-1)) /&
     505             :                (2._wp*tautot_lay(:))*(1._wp-EXP(-2._wp*tautot_lay(:)))
     506             :        ELSEWHERE
     507             :           ! This must never happen, but just in case, to avoid div. by 0
     508             :           pnorm(:,k) = beta(:,k) * EXP(-2._wp*tau(:,k-1))
     509             :        END WHERE
     510             : 
     511             :     END DO
     512      287928 :   end subroutine cmp_backsignal
     513             : 
     514      185760 :   subroutine cmp_beta(nlev,npoints,pnorm,tau,beta)
     515             :     ! INPUTS
     516             :     integer, intent(in) :: nlev,npoints
     517             :     real(wp),intent(in),dimension(npoints,nlev) :: pnorm,tau
     518             : 
     519             :     ! OUTPUTS
     520             :     real(wp),intent(out),dimension(npoints,nlev) :: beta
     521             : 
     522             :     ! Internal Variables
     523      371520 :     real(wp), dimension(npoints) :: tautot_lay
     524             :     integer :: k
     525             :     real(wp) :: epsrealwp
     526             : 
     527      185760 :     epsrealwp = epsilon(1._wp)
     528     3101760 :     beta(:,1) = pnorm(:,1) * (2._wp*tau(:,1))/(1._wp-exp(-2._wp*tau(:,1)))
     529    15603840 :     do k=2,nlev
     530   257446080 :        tautot_lay(:) = tau(:,k)-tau(:,k-1)       
     531  1225743840 :        WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. epsrealwp )
     532             :           WHERE (tautot_lay(:) .gt. 0.)
     533             :              beta(:,k) = pnorm(:,k)/ EXP(-2._wp*tau(:,k-1))* &
     534             :                   (2._wp*tautot_lay(:))/(1._wp-exp(-2._wp*tautot_lay(:)))
     535             :           ELSEWHERE
     536             :              beta(:,k)=pnorm(:,k)/EXP(-2._wp*tau(:,k-1))
     537             :           END WHERE
     538             :        ELSEWHERE
     539             :           beta(:,k)=pnorm(:,k)/epsrealwp
     540             :        END WHERE
     541             :     ENDDO
     542             : 
     543      185760 :   end subroutine cmp_beta
     544             :     ! ####################################################################################
     545             :     ! SUBROUTINE cosp_cldfrac
     546             :     ! Conventions: Ncat must be equal to 4
     547             :     ! ####################################################################################
     548        9288 :     SUBROUTINE COSP_CLDFRAC(Npoints,Ncolumns,Nlevels,Ncat,Nphase,tmp,x,ATB,ATBperp,      &
     549        9288 :                                pplay,S_att,S_cld,S_cld_att,undef,lidarcld,cldlayer,      &
     550        9288 :                                lidarcldphase,cldlayerphase,lidarcldtemp)
     551             :     ! Parameters
     552             :     integer,parameter :: Ntemp=40 ! indice of the temperature vector
     553             :     real(wp),parameter,dimension(Ntemp+1) :: &
     554             :        tempmod = [0.0,   183.15,186.15,189.15,192.15,195.15,198.15,201.15,204.15,207.15, &
     555             :                   210.15,213.15,216.15,219.15,222.15,225.15,228.15,231.15,234.15,237.15, &
     556             :                   240.15,243.15,246.15,249.15,252.15,255.15,258.15,261.15,264.15,267.15, &
     557             :                   270.15,273.15,276.15,279.15,282.15,285.15,288.15,291.15,294.15,297.15, &
     558             :                   473.15]
     559             :          
     560             :     ! Polynomial coefficient of the phase discrimination line used to separate liquid from ice
     561             :     ! (Cesana and Chepfer, JGR, 2013)
     562             :     ! ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50 + ATB*epsilon50 + zeta50
     563             :     real(wp),parameter :: &
     564             :        alpha50   = 9.0322e+15_wp,  & !
     565             :        beta50    = -2.1358e+12_wp, & !
     566             :        gamma50   = 173.3963e06_wp, & !
     567             :        delta50   = -3.9514e03_wp,  & !
     568             :        epsilon50 = 0.2559_wp,      & !
     569             :        zeta50    = -9.4776e-07_wp    ! 
     570             :        
     571             :         ! Inputs
     572             :     integer,intent(in) :: &
     573             :        Npoints,  & ! Number of gridpoints
     574             :        Ncolumns, & ! Number of subcolumns
     575             :        Nlevels,  & ! Number of vertical levels
     576             :        Ncat,     & ! Number of cloud layer types
     577             :        Nphase      ! Number of cloud layer phase types
     578             :                        ! [ice,liquid,undefined,false ice,false liquid,Percent of ice]
     579             :     real(wp),intent(in) :: &
     580             :        S_att,    & !
     581             :        S_cld,    & !
     582             :        S_cld_att,& ! New threshold for undefine cloud phase detection
     583             :        undef       ! Undefined value
     584             :     real(wp),intent(in),dimension(Npoints,Ncolumns,Nlevels) :: &
     585             :        x,        & ! 
     586             :        ATB,      & ! 3D attenuated backscatter
     587             :        ATBperp     ! 3D attenuated backscatter (perpendicular)
     588             :     real(wp),intent(in),dimension(Npoints,Nlevels) :: &
     589             :        tmp,      & ! Temperature   
     590             :        pplay       ! Pressure
     591             : 
     592             :         ! Outputs
     593             :     real(wp),intent(out),dimension(Npoints,Ntemp,5) :: &
     594             :        lidarcldtemp  ! 3D Temperature 1=tot,2=ice,3=liq,4=undef,5=ice/ice+liq
     595             :     real(wp),intent(out),dimension(Npoints,Nlevels,Nphase) :: &
     596             :        lidarcldphase ! 3D cloud phase fraction
     597             :     real(wp),intent(out),dimension(Npoints,Nlevels) :: &
     598             :        lidarcld      ! 3D cloud fraction
     599             :     real(wp),intent(out),dimension(Npoints,Ncat) :: &
     600             :        cldlayer      ! Low, middle, high, total cloud fractions
     601             :     real(wp),intent(out),dimension(Npoints,Ncat,Nphase) :: &
     602             :        cldlayerphase ! Low, middle, high, total cloud fractions for ice liquid and undefine phase    
     603             :     
     604             :     ! Local variables
     605             :     integer  :: &
     606             :        ip, k, iz, ic, ncol, nlev, i, itemp, toplvlsat 
     607             :     real(wp) :: &
     608             :        p1,checktemp, ATBperp_tmp,checkcldlayerphase, checkcldlayerphase2
     609             :     real(wp),dimension(Npoints,Nlevels) :: &
     610       18576 :        nsub,lidarcldphasetmp   
     611             :     real(wp),dimension(Npoints,Ntemp) :: &
     612       18576 :        sumlidarcldtemp,lidarcldtempind
     613             :     real(wp),dimension(Npoints,Ncolumns,Ncat) :: &
     614       18576 :        cldlay,nsublay   
     615             :     real(wp),dimension(Npoints,Ncat) :: &
     616       18576 :        nsublayer,cldlayerphasetmp,cldlayerphasesum
     617             :     real(wp),dimension(Npoints,Ncolumns,Nlevels) :: &   
     618       18576 :        tmpi, & ! Temperature of ice cld
     619       18576 :        tmpl, & ! Temperature of liquid cld
     620       18576 :        tmpu, & ! Temperature of undef cld
     621       18576 :        cldy, & ! 
     622       18576 :        srok    !
     623             :     real(wp),dimension(Npoints,Ncolumns,Ncat,Nphase) :: &
     624        9288 :        cldlayphase ! subgrided low mid high phase cloud fraction
     625             :              
     626             :     ! ####################################################################################
     627             :         ! 1) Initialize    
     628             :     ! ####################################################################################
     629     6212808 :     lidarcld              = 0._wp
     630     6212808 :     nsub                  = 0._wp
     631     6249960 :     cldlay                = 0._wp
     632     6249960 :     nsublay               = 0._wp
     633       65016 :     ATBperp_tmp           = 0._wp
     634    37286136 :     lidarcldphase(:,:,:)  = 0._wp
     635    37509048 :     cldlayphase(:,:,:,:)  = 0._wp
     636     3787128 :     cldlayerphase(:,:,:)  = 0._wp
     637    62416008 :     tmpi(:,:,:)           = 0._wp
     638    62416008 :     tmpl(:,:,:)           = 0._wp
     639    62416008 :     tmpu(:,:,:)           = 0._wp
     640      629640 :     cldlayerphasesum(:,:) = 0._wp
     641    31073328 :     lidarcldtemp(:,:,:)   = 0._wp
     642     6212808 :     lidarcldtempind(:,:)  = 0._wp
     643     6212808 :     sumlidarcldtemp(:,:)  = 0._wp
     644     6212808 :     lidarcldphasetmp(:,:) = 0._wp
     645      380808 :     toplvlsat             = 0
     646             : 
     647             :     ! ####################################################################################
     648             :     ! 2) Cloud detection
     649             :     ! ####################################################################################
     650      380808 :     do k=1,Nlevels
     651             :        ! Cloud detection at subgrid-scale:
     652    62406720 :        where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
     653             :           cldy(:,:,k)=1._wp
     654             :        elsewhere
     655      371520 :           cldy(:,:,k)=0._wp
     656             :        endwhere
     657             :        
     658             :        ! Number of usefull sub-columns:
     659    62416008 :        where ((x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
     660             :           srok(:,:,k)=1._wp
     661             :        elsewhere
     662             :           srok(:,:,k)=0._wp
     663             :        endwhere
     664             :     enddo    
     665             :     
     666             :     ! ####################################################################################
     667             :     ! 3) Grid-box 3D cloud fraction and layered cloud fractions(ISCCP pressure categories)
     668             :     ! ####################################################################################
     669     6212808 :     lidarcld = 0._wp
     670     6212808 :     nsub     = 0._wp
     671     6249960 :     cldlay   = 0._wp
     672     6249960 :     nsublay  = 0._wp
     673      380808 :     do k=1,Nlevels
     674     4096008 :        do ic = 1, Ncolumns
     675    62406720 :           do ip = 1, Npoints
     676             :           
     677             :              ! Computation of the cloud fraction as a function of the temperature instead
     678             :              ! of height, for ice,liquid and all clouds
     679    58320000 :              if(srok(ip,ic,k).gt.0.)then
     680  2314522611 :                 do itemp=1,Ntemp
     681  2314522611 :                    if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
     682    56451771 :                       lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1._wp
     683             :                    endif
     684             :                 enddo
     685             :              endif
     686             :              
     687    58320000 :              if(cldy(ip,ic,k).eq.1.)then
     688    74709708 :                 do itemp=1,Ntemp 
     689    74709708 :                    if( (tmp(ip,k) .ge. tempmod(itemp)).and.(tmp(ip,k) .lt. tempmod(itemp+1)) )then
     690     1822188 :                       lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1._wp
     691             :                    endif
     692             :                 enddo
     693             :              endif
     694             : 
     695    58320000 :              iz=1
     696    58320000 :              p1 = pplay(ip,k)
     697    58320000 :              if ( p1.gt.0. .and. p1.lt.(440._wp*100._wp)) then ! high clouds
     698             :                 iz=3
     699    22459490 :              else if(p1.ge.(440._wp*100._wp) .and. p1.lt.(680._wp*100._wp)) then ! mid clouds
     700             :                 iz=2
     701             :              endif
     702             :              
     703    58320000 :              cldlay(ip,ic,iz) = MAX(cldlay(ip,ic,iz),cldy(ip,ic,k))
     704    58320000 :              cldlay(ip,ic,4)  = MAX(cldlay(ip,ic,4),cldy(ip,ic,k))
     705    58320000 :              lidarcld(ip,k)   = lidarcld(ip,k) + cldy(ip,ic,k)
     706             :              
     707    58320000 :              nsublay(ip,ic,iz) = MAX(nsublay(ip,ic,iz),srok(ip,ic,k))
     708    58320000 :              nsublay(ip,ic,4)  = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
     709    62035200 :              nsub(ip,k)        = nsub(ip,k) + srok(ip,ic,k)
     710             :              
     711             :           enddo
     712             :        enddo
     713             :     enddo   
     714             :     
     715             :     ! Grid-box 3D cloud fraction
     716    24823368 :     where ( nsub(:,:).gt.0.0 )
     717             :        lidarcld(:,:) = lidarcld(:,:)/nsub(:,:)
     718             :     elsewhere
     719             :        lidarcld(:,:) = undef
     720             :     endwhere
     721             :     
     722             :     ! Layered cloud fractions
     723      629640 :     cldlayer  = 0._wp
     724      629640 :     nsublayer = 0._wp
     725       46440 :     do iz = 1, Ncat
     726      417960 :        do ic = 1, Ncolumns
     727     6203520 :           cldlayer(:,iz)  = cldlayer(:,iz)  + cldlay(:,ic,iz)
     728     6240672 :           nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
     729             :        enddo
     730             :     enddo
     731     2490696 :     where (nsublayer(:,:) .gt. 0.0)
     732             :        cldlayer(:,:) = cldlayer(:,:)/nsublayer(:,:)
     733             :     elsewhere
     734             :        cldlayer(:,:) = undef
     735             :     endwhere
     736             :               
     737             :     ! ####################################################################################
     738             :     ! 4) Grid-box 3D cloud Phase
     739             :     ! ####################################################################################
     740             :     
     741             :     ! ####################################################################################
     742             :     ! 4.1) For Cloudy pixels with 8.16km < z < 19.2km
     743             :     ! ####################################################################################
     744      102168 :     do ncol=1,Ncolumns
     745     1560168 :        do i=1,Npoints          
     746    34992000 :           do nlev=1,23 ! from 19.2km until 8.16km
     747    33534000 :                p1 = pplay(1,nlev)
     748             : 
     749             :              ! Avoid zero values
     750    34992000 :              if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
     751             :                 ! Computation of the ATBperp along the phase discrimination line
     752             :                 ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
     753             :                      (ATB(i,ncol,nlev)**3)*gamma50 + (ATB(i,ncol,nlev)**2)*delta50 + &
     754      727332 :                      ATB(i,ncol,nlev)*epsilon50 + zeta50     
     755             :                 ! ########################################################################
     756             :                 ! 4.1.a) Ice: ATBperp above the phase discrimination line
     757             :                 ! ########################################################################
     758      727332 :                 if((ATBperp(i,ncol,nlev)-ATBperp_tmp) .ge. 0.)then ! Ice clouds
     759             : 
     760             :                    ! ICE with temperature above 273,15°K = Liquid (false ice)
     761      713691 :                    if(tmp(i,nlev) .gt. 273.15) then ! Temperature above 273,15 K
     762             :                      ! Liquid: False ice corrected by the temperature to Liquid
     763           0 :                       lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp ! False ice detection ==> added to Liquid
     764             :                                     
     765           0 :                       tmpl(i,ncol,nlev)       = tmp(i,nlev)
     766           0 :                       lidarcldphase(i,nlev,5) = lidarcldphase(i,nlev,5)+1._wp ! Keep the information "temperature criterium used"                      
     767             :                                                                               ! to classify the phase cloud
     768           0 :                       cldlayphase(i,ncol,4,2) = 1. ! tot cloud
     769           0 :                       if (p1 .gt. 0. .and. p1.lt.(440._wp*100._wp)) then ! high cloud
     770           0 :                          cldlayphase(i,ncol,3,2) = 1._wp
     771           0 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then ! mid cloud
     772           0 :                          cldlayphase(i,ncol,2,2) = 1._wp
     773             :                       else ! low cloud
     774           0 :                          cldlayphase(i,ncol,1,2) = 1._wp
     775             :                       endif
     776           0 :                       cldlayphase(i,ncol,4,5) = 1._wp ! tot cloud
     777             :                       ! High cloud
     778           0 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then 
     779           0 :                          cldlayphase(i,ncol,3,5) = 1._wp
     780             :                       ! Middle cloud
     781           0 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     782           0 :                          cldlayphase(i,ncol,2,5) = 1._wp
     783             :                       ! Low cloud
     784             :                       else 
     785           0 :                          cldlayphase(i,ncol,1,5) = 1._wp
     786             :                       endif
     787             :                    else
     788             :                       ! ICE with temperature below 273,15°K
     789      713691 :                       lidarcldphase(i,nlev,1) = lidarcldphase(i,nlev,1)+1._wp
     790      713691 :                       tmpi(i,ncol,nlev)       = tmp(i,nlev)
     791      713691 :                       cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud 
     792             :                       ! High cloud
     793      713691 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then 
     794      713691 :                          cldlayphase(i,ncol,3,1) = 1._wp
     795             :                       ! Middle cloud   
     796           0 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then 
     797           0 :                          cldlayphase(i,ncol,2,1) = 1._wp
     798             :                       ! Low cloud
     799             :                       else
     800           0 :                          cldlayphase(i,ncol,1,1) = 1._wp
     801             :                       endif
     802             :                    endif
     803             :                 ! ########################################################################
     804             :                 ! 4.1.b) Liquid: ATBperp below the phase discrimination line
     805             :                 ! ########################################################################
     806             :                 else
     807             :                    ! Liquid with temperature above 231,15°K
     808       13641 :                    if(tmp(i,nlev) .gt. 231.15_wp) then
     809       13641 :                       lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp
     810       13641 :                       tmpl(i,ncol,nlev)       = tmp(i,nlev)
     811       13641 :                       cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
     812             :                       ! High cloud
     813       13641 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     814       13641 :                          cldlayphase(i,ncol,3,2) = 1._wp
     815             :                       ! Middle cloud   
     816           0 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     817           0 :                          cldlayphase(i,ncol,2,2) = 1._wp
     818             :                       ! Low cloud   
     819             :                       else
     820           0 :                          cldlayphase(i,ncol,1,2) = 1._wp
     821             :                       endif
     822             :                    else
     823             :                       ! Liquid with temperature below 231,15°K = Ice (false liquid)
     824           0 :                       tmpi(i,ncol,nlev)       = tmp(i,nlev)
     825           0 :                       lidarcldphase(i,nlev,1) = lidarcldphase(i,nlev,1)+1._wp ! false liquid detection ==> added to ice
     826           0 :                       lidarcldphase(i,nlev,4) = lidarcldphase(i,nlev,4)+1._wp
     827           0 :                       cldlayphase(i,ncol,4,4) = 1._wp ! tot cloud
     828             :                       ! High cloud
     829           0 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     830           0 :                          cldlayphase(i,ncol,3,4) = 1._wp
     831             :                       ! Middle cloud   
     832           0 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     833           0 :                          cldlayphase(i,ncol,2,4) = 1._wp
     834             :                       ! Low cloud
     835             :                       else
     836           0 :                          cldlayphase(i,ncol,1,4) = 1._wp
     837             :                       endif
     838           0 :                       cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
     839             :                       ! High cloud
     840           0 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     841           0 :                          cldlayphase(i,ncol,3,1) = 1._wp
     842             :                       ! Middle cloud   
     843           0 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     844           0 :                          cldlayphase(i,ncol,2,1) = 1._wp
     845             :                       ! Low cloud   
     846             :                       else
     847           0 :                          cldlayphase(i,ncol,1,1) = 1._wp
     848             :                       endif
     849             :                    endif
     850             :                 endif ! end of discrimination condition
     851             :              endif ! end of cloud condition
     852             :           enddo ! end of altitude loop
     853             : 
     854             :           ! ##############################################################################
     855             :           ! 4.2) For Cloudy pixels with 0km < z < 8.16km
     856             :           ! ##############################################################################
     857             :           toplvlsat = 0
     858    25063207 :           do nlev=24,Nlevels! from 8.16km until 0km
     859    23813634 :              p1 = pplay(i,nlev)
     860             : 
     861    25063207 :              if((cldy(i,ncol,nlev) .eq. 1.) .and. (ATBperp(i,ncol,nlev) .gt. 0.) )then
     862             :                 ! Computation of the ATBperp of the phase discrimination line
     863             :                 ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
     864             :                      (ATB(i,ncol,nlev)**3)*gamma50 + (ATB(i,ncol,nlev)**2)*delta50 + &
     865     1013833 :                      ATB(i,ncol,nlev)*epsilon50 + zeta50
     866             :                 ! ########################################################################
     867             :                 ! 4.2.a) Ice: ATBperp above the phase discrimination line
     868             :                 ! ########################################################################
     869             :                 ! ICE with temperature above 273,15°K = Liquid (false ice)
     870     1013833 :                 if((ATBperp(i,ncol,nlev)-ATBperp_tmp) .ge. 0.)then ! Ice clouds
     871      627324 :                    if(tmp(i,nlev) .gt. 273.15)then
     872        6098 :                       lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp ! false ice ==> liq
     873        6098 :                       tmpl(i,ncol,nlev)       = tmp(i,nlev)
     874        6098 :                       lidarcldphase(i,nlev,5) = lidarcldphase(i,nlev,5)+1._wp
     875        6098 :                       cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
     876             :                       ! High cloud
     877        6098 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then 
     878           0 :                          cldlayphase(i,ncol,3,2) = 1._wp
     879             :                       ! Middle cloud   
     880        6098 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then 
     881        2386 :                          cldlayphase(i,ncol,2,2) = 1._wp
     882             :                       ! Low cloud
     883             :                       else 
     884        3712 :                          cldlayphase(i,ncol,1,2) = 1._wp
     885             :                       endif
     886             :                       
     887        6098 :                       cldlayphase(i,ncol,4,5) = 1. ! tot cloud
     888             :                       ! High cloud
     889        6098 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     890           0 :                          cldlayphase(i,ncol,3,5) = 1._wp
     891             :                       ! Middle cloud   
     892        6098 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     893        2386 :                          cldlayphase(i,ncol,2,5) = 1._wp
     894             :                       ! Low cloud   
     895             :                       else
     896        3712 :                          cldlayphase(i,ncol,1,5) = 1._wp
     897             :                       endif
     898             :                    else
     899             :                       ! ICE with temperature below 273,15°K
     900      621226 :                       lidarcldphase(i,nlev,1) = lidarcldphase(i,nlev,1)+1._wp
     901      621226 :                      tmpi(i,ncol,nlev)       = tmp(i,nlev)
     902      621226 :                       cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
     903             :                       ! High cloud
     904      621226 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     905      113927 :                          cldlayphase(i,ncol,3,1) = 1._wp
     906             :                       ! Middle cloud   
     907      507299 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt.(680._wp*100._wp)) then
     908      391208 :                          cldlayphase(i,ncol,2,1) = 1._wp
     909             :                       ! Low cloud   
     910             :                       else
     911      116091 :                          cldlayphase(i,ncol,1,1) = 1._wp
     912             :                       endif
     913             :                    endif
     914             :                    
     915             :                 ! ########################################################################
     916             :                 ! 4.2.b) Liquid: ATBperp below the phase discrimination line
     917             :                 ! ########################################################################
     918             :                 else
     919             :                    ! Liquid with temperature above 231,15°K
     920      386509 :                    if(tmp(i,nlev) .gt. 231.15)then
     921      386509 :                       lidarcldphase(i,nlev,2) = lidarcldphase(i,nlev,2)+1._wp
     922      386509 :                       tmpl(i,ncol,nlev)       = tmp(i,nlev)
     923      386509 :                       cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
     924             :                       ! High cloud
     925      386509 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     926        9796 :                          cldlayphase(i,ncol,3,2) = 1._wp
     927             :                       ! Middle cloud   
     928      376713 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     929       89625 :                          cldlayphase(i,ncol,2,2) = 1._wp
     930             :                       ! Low cloud   
     931             :                       else
     932      287088 :                          cldlayphase(i,ncol,1,2) = 1._wp
     933             :                       endif
     934             :                    else
     935             :                       ! Liquid with temperature below 231,15°K = Ice (false liquid)
     936           0 :                       tmpi(i,ncol,nlev)       = tmp(i,nlev)
     937           0 :                       lidarcldphase(i,nlev,1) = lidarcldphase(i,nlev,1)+1._wp ! false liq ==> ice
     938           0 :                       lidarcldphase(i,nlev,4) = lidarcldphase(i,nlev,4)+1._wp ! false liq ==> ice
     939           0 :                       cldlayphase(i,ncol,4,4) = 1._wp ! tot cloud
     940             :                       ! High cloud
     941           0 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     942           0 :                          cldlayphase(i,ncol,3,4) = 1._wp
     943             :                       ! Middle   
     944           0 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     945           0 :                          cldlayphase(i,ncol,2,4) = 1._wp
     946             :                       ! Low cloud   
     947             :                       else
     948           0 :                          cldlayphase(i,ncol,1,4) = 1._wp
     949             :                       endif
     950             :                       
     951           0 :                       cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
     952             :                       ! High cloud
     953           0 :                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     954           0 :                          cldlayphase(i,ncol,3,1) = 1._wp
     955             :                       ! Middle cloud   
     956           0 :                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     957           0 :                          cldlayphase(i,ncol,2,1) = 1._wp
     958             :                       ! Low cloud   
     959             :                       else
     960           0 :                          cldlayphase(i,ncol,1,1) = 1._wp
     961             :                       endif
     962             :                    endif
     963             :                 endif ! end of discrimination condition
     964             :                 
     965     1013833 :                 toplvlsat=0
     966             :                 
     967             :                 ! Find the level of the highest cloud with SR>30
     968     1013833 :                 if(x(i,ncol,nlev) .gt. S_cld_att) then ! SR > 30.
     969      208427 :                     toplvlsat = nlev+1
     970      208427 :                     goto 99
     971             :                 endif
     972             :              endif ! end of cloud condition
     973             :           enddo ! end of altitude loop
     974             : 99        continue
     975             :           
     976             :           ! ##############################################################################
     977             :           ! Undefined phase: For a cloud located below another cloud with SR>30
     978             :           ! see Cesana and Chepfer 2013 Sect.III.2
     979             :           ! ##############################################################################
     980     1458000 :           if(toplvlsat.ne.0) then
     981     1180793 :              do nlev = toplvlsat,Nlevels
     982      972366 :                 p1 = pplay(i,nlev)
     983     1180793 :                 if(cldy(i,ncol,nlev).eq.1.)then
     984       81023 :                    lidarcldphase(i,nlev,3) = lidarcldphase(i,nlev,3)+1._wp
     985       81023 :                    tmpu(i,ncol,nlev)       = tmp(i,nlev)
     986       81023 :                    cldlayphase(i,ncol,4,3) = 1._wp ! tot cloud
     987             :                    ! High cloud
     988       81023 :                    if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     989         120 :                       cldlayphase(i,ncol,3,3) = 1._wp
     990             :                    ! Middle cloud   
     991       80903 :                    else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     992       29066 :                       cldlayphase(i,ncol,2,3) = 1._wp
     993             :                    ! Low cloud   
     994             :                    else
     995       51837 :                       cldlayphase(i,ncol,1,3) = 1._wp
     996             :                    endif
     997             :                 endif
     998             :              enddo
     999             :           endif
    1000     1550880 :           toplvlsat=0
    1001             :        enddo
    1002             :     enddo
    1003             :      
    1004             :     ! ####################################################################################
    1005             :     ! Computation of final cloud phase diagnosis
    1006             :     ! ####################################################################################
    1007             : 
    1008             :     ! Compute the Ice percentage in cloud = ice/(ice+liq) as a function of the occurrences
    1009     6212808 :     lidarcldphasetmp(:,:) = lidarcldphase(:,:,1)+lidarcldphase(:,:,2);
    1010     6212808 :     WHERE (lidarcldphasetmp(:,:) .gt. 0.)
    1011             :        lidarcldphase(:,:,6)=lidarcldphase(:,:,1)/lidarcldphasetmp(:,:)
    1012             :     ELSEWHERE
    1013        9288 :        lidarcldphase(:,:,6) = undef
    1014             :     ENDWHERE
    1015             :     
    1016             :     ! Compute Phase 3D Cloud Fraction
    1017             :     !WHERE (nsub(:,Nlevels:1:-1) .gt. 0.0 )
    1018    99293472 :     WHERE (nsub(:,:) .gt. 0.0 )  
    1019             :        lidarcldphase(:,:,1)=lidarcldphase(:,:,1)/nsub(:,:)
    1020             :        lidarcldphase(:,:,2)=lidarcldphase(:,:,2)/nsub(:,:)
    1021        9288 :        lidarcldphase(:,:,3)=lidarcldphase(:,:,3)/nsub(:,:)
    1022        9288 :        lidarcldphase(:,:,4)=lidarcldphase(:,:,4)/nsub(:,:)
    1023        9288 :        lidarcldphase(:,:,5)=lidarcldphase(:,:,5)/nsub(:,:)
    1024             :     ELSEWHERE
    1025             :        lidarcldphase(:,:,1) = undef
    1026             :        lidarcldphase(:,:,2) = undef
    1027             :        lidarcldphase(:,:,3) = undef
    1028             :        lidarcldphase(:,:,4) = undef
    1029             :        lidarcldphase(:,:,5) = undef
    1030             :     ENDWHERE
    1031             : 
    1032             :     ! Compute Phase low mid high cloud fractions
    1033       46440 :     do iz = 1, Ncat
    1034      157896 :        do i=1,Nphase-3
    1035     1263168 :           do ic = 1, Ncolumns
    1036    18610560 :              cldlayerphase(:,iz,i)  = cldlayerphase(:,iz,i)  + cldlayphase(:,ic,iz,i)
    1037    18722016 :              cldlayerphasesum(:,iz) = cldlayerphasesum(:,iz) + cldlayphase(:,ic,iz,i)
    1038             :           enddo
    1039             :        enddo
    1040             :     enddo
    1041       46440 :     do iz = 1, Ncat
    1042      120744 :        do i=4,5
    1043      854496 :           do ic = 1, Ncolumns
    1044    12481344 :              cldlayerphase(:,iz,i) = cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)
    1045             :           enddo
    1046             :        enddo
    1047             :     enddo
    1048             :     
    1049             :     ! Compute the Ice percentage in cloud = ice/(ice+liq)
    1050      629640 :     cldlayerphasetmp(:,:)=cldlayerphase(:,:,1)+cldlayerphase(:,:,2)
    1051      629640 :     WHERE (cldlayerphasetmp(:,:).gt. 0.)
    1052             :        cldlayerphase(:,:,6)=cldlayerphase(:,:,1)/cldlayerphasetmp(:,:)
    1053             :     ELSEWHERE
    1054             :        cldlayerphase(:,:,6) = undef
    1055             :     ENDWHERE
    1056             :     
    1057       55728 :     do i=1,Nphase-1
    1058     3157488 :        WHERE ( cldlayerphasesum(:,:).gt.0.0 )
    1059       46440 :           cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:)
    1060             :        ENDWHERE
    1061             :     enddo
    1062             :     
    1063      155088 :     do i=1,Npoints
    1064      738288 :        do iz=1,Ncat
    1065      583200 :           checkcldlayerphase=0.
    1066      583200 :           checkcldlayerphase2=0.
    1067      729000 :           if (cldlayerphasesum(i,iz) .gt. 0.0 )then
    1068      552352 :              do ic=1,Nphase-3
    1069      552352 :                 checkcldlayerphase = checkcldlayerphase+cldlayerphase(i,iz,ic)
    1070             :              enddo
    1071      138088 :              checkcldlayerphase2 = cldlayer(i,iz)-checkcldlayerphase
    1072      138088 :              if((checkcldlayerphase2 .gt. 0.01) .or. (checkcldlayerphase2 .lt. -0.01) ) print *, checkcldlayerphase,cldlayer(i,iz)
    1073             :           endif
    1074             :        enddo
    1075             :     enddo
    1076             :     
    1077       55728 :     do i=1,Nphase-1
    1078     3157488 :        WHERE (nsublayer(:,:) .eq. 0.0)
    1079       46440 :           cldlayerphase(:,:,i) = undef
    1080             :        ENDWHERE
    1081             :     enddo
    1082             :  
    1083             :     ! Compute Phase 3D as a function of temperature
    1084      380808 :     do nlev=1,Nlevels
    1085     4096008 :        do ncol=1,Ncolumns
    1086    62406720 :           do i=1,Npoints
    1087  2394835200 :              do itemp=1,Ntemp
    1088  2391120000 :                 if(tmpi(i,ncol,nlev).gt.0.)then
    1089    53396680 :                    if((tmpi(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpi(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    1090     1334917 :                       lidarcldtemp(i,itemp,2)=lidarcldtemp(i,itemp,2)+1._wp
    1091             :                    endif
    1092  2279403320 :                 elseif(tmpl(i,ncol,nlev) .gt. 0.)then
    1093    16249920 :                    if((tmpl(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpl(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    1094      406248 :                       lidarcldtemp(i,itemp,3)=lidarcldtemp(i,itemp,3)+1._wp
    1095             :                    endif
    1096  2263153400 :                 elseif(tmpu(i,ncol,nlev) .gt. 0.)then
    1097     3240920 :                    if((tmpu(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpu(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    1098       81023 :                       lidarcldtemp(i,itemp,4)=lidarcldtemp(i,itemp,4)+1._wp
    1099             :                    endif
    1100             :                 endif
    1101             :              enddo
    1102             :           enddo
    1103             :        enddo
    1104             :     enddo
    1105             :     
    1106             :     ! Check temperature cloud fraction
    1107      155088 :     do i=1,Npoints
    1108     5987088 :        do itemp=1,Ntemp
    1109     5977800 :           checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4)
    1110             :           !if(checktemp .NE. lidarcldtemp(i,itemp,1))then
    1111             :           !   print *, i,itemp
    1112             :           !   print *, lidarcldtemp(i,itemp,1:4)
    1113             :           !endif
    1114             :           
    1115             :        enddo
    1116             :     enddo
    1117             :     
    1118             :     ! Compute the Ice percentage in cloud = ice/(ice+liq)
    1119     6212808 :     sumlidarcldtemp(:,:)=lidarcldtemp(:,:,2)+lidarcldtemp(:,:,3)    
    1120     6212808 :     WHERE(sumlidarcldtemp(:,:) .gt. 0.)
    1121             :        lidarcldtemp(:,:,5)=lidarcldtemp(:,:,2)/sumlidarcldtemp(:,:)
    1122             :     ELSEWHERE
    1123             :        lidarcldtemp(:,:,5)=undef
    1124             :     ENDWHERE
    1125             :     
    1126       46440 :     do i=1,4
    1127    99339912 :        WHERE(lidarcldtempind(:,:) .gt. 0.)
    1128       37152 :           lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
    1129             :        ELSEWHERE
    1130             :           lidarcldtemp(:,:,i) = undef
    1131             :        ENDWHERE
    1132             :     enddo
    1133             :     
    1134        9288 :     RETURN
    1135             :   END SUBROUTINE COSP_CLDFRAC
    1136             :   
    1137             :   ! ####################################################################################
    1138             :   ! SUBROUTINE cosp_cldfrac_nophase
    1139             :   ! Conventions: Ncat must be equal to 4
    1140             :   ! ####################################################################################
    1141           0 :   SUBROUTINE COSP_CLDFRAC_NOPHASE(Npoints,Ncolumns,Nlevels,Ncat,x,ATB,pplay,      &
    1142           0 :        S_att,S_cld,S_cld_att,undef,lidarcld,cldlayer)
    1143             :     
    1144             :     ! Inputs
    1145             :     integer,intent(in) :: &
    1146             :          Npoints,  & ! Number of gridpoints
    1147             :          Ncolumns, & ! Number of subcolumns
    1148             :          Nlevels,  & ! Number of vertical levels
    1149             :          Ncat        ! Number of cloud layer types
    1150             :     real(wp),intent(in) :: &
    1151             :          S_att,    & !
    1152             :          S_cld,    & !
    1153             :          S_cld_att,& ! New threshold for undefine cloud phase detection
    1154             :          undef       ! Undefined value
    1155             :     real(wp),intent(in),dimension(Npoints,Ncolumns,Nlevels) :: &
    1156             :          x,        & ! 
    1157             :          ATB         ! 3D attenuated backscatter
    1158             :     real(wp),intent(in),dimension(Npoints,Nlevels) :: &
    1159             :          pplay       ! Pressure
    1160             :     
    1161             :     ! Outputs
    1162             :     real(wp),intent(out),dimension(Npoints,Nlevels) :: &
    1163             :          lidarcld      ! 3D cloud fraction
    1164             :     real(wp),intent(out),dimension(Npoints,Ncat) :: &
    1165             :          cldlayer      ! Low, middle, high, total cloud fractions
    1166             :     
    1167             :     ! Local variables
    1168             :     integer  :: &
    1169             :          ip, k, iz, ic, ncol, nlev, i
    1170             :     real(wp) :: &
    1171             :          p1
    1172             :     real(wp),dimension(Npoints,Nlevels) :: &
    1173           0 :          nsub
    1174             :     real(wp),dimension(Npoints,Ncolumns,Ncat) :: &
    1175           0 :          cldlay,nsublay   
    1176             :     real(wp),dimension(Npoints,Ncat) :: &
    1177           0 :          nsublayer
    1178             :     real(wp),dimension(Npoints,Ncolumns,Nlevels) :: &   
    1179           0 :          cldy, & ! 
    1180           0 :          srok    !
    1181             :     
    1182             :     ! ####################################################################################
    1183             :     ! 1) Initialize    
    1184             :     ! ####################################################################################
    1185           0 :     lidarcld           = 0._wp
    1186           0 :     nsub               = 0._wp
    1187           0 :     cldlay             = 0._wp
    1188           0 :     nsublay            = 0._wp
    1189             :     
    1190             :     ! ####################################################################################
    1191             :     ! 2) Cloud detection
    1192             :     ! ####################################################################################
    1193           0 :     do k=1,Nlevels
    1194             :        ! Cloud detection at subgrid-scale:
    1195           0 :        where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    1196             :           cldy(:,:,k)=1._wp
    1197             :        elsewhere
    1198           0 :           cldy(:,:,k)=0._wp
    1199             :        endwhere
    1200             :        
    1201             :        ! Number of usefull sub-columns:
    1202           0 :        where ((x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
    1203             :           srok(:,:,k)=1._wp
    1204             :        elsewhere
    1205             :           srok(:,:,k)=0._wp
    1206             :        endwhere
    1207             :     enddo    
    1208             : 
    1209             :     ! ####################################################################################
    1210             :     ! 3) Grid-box 3D cloud fraction and layered cloud fractions(ISCCP pressure categories)
    1211             :     ! ####################################################################################
    1212           0 :     do k=1,Nlevels
    1213           0 :        do ic = 1, Ncolumns
    1214           0 :           do ip = 1, Npoints
    1215             : 
    1216           0 :              iz=1
    1217           0 :              p1 = pplay(ip,k)
    1218           0 :              if ( p1.gt.0. .and. p1.lt.(440._wp*100._wp)) then ! high clouds
    1219             :                 iz=3
    1220           0 :              else if(p1.ge.(440._wp*100._wp) .and. p1.lt.(680._wp*100._wp)) then ! mid clouds
    1221             :                 iz=2
    1222             :              endif
    1223             :              
    1224           0 :              cldlay(ip,ic,iz) = MAX(cldlay(ip,ic,iz),cldy(ip,ic,k))
    1225           0 :              cldlay(ip,ic,4)  = MAX(cldlay(ip,ic,4),cldy(ip,ic,k))
    1226           0 :              lidarcld(ip,k)   = lidarcld(ip,k) + cldy(ip,ic,k)
    1227             :              
    1228           0 :              nsublay(ip,ic,iz) = MAX(nsublay(ip,ic,iz),srok(ip,ic,k))
    1229           0 :              nsublay(ip,ic,4)  = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
    1230           0 :              nsub(ip,k)        = nsub(ip,k) + srok(ip,ic,k)
    1231             :              
    1232             :           enddo
    1233             :        enddo
    1234             :     enddo   
    1235             :     
    1236             :     ! Grid-box 3D cloud fraction
    1237           0 :     where ( nsub(:,:).gt.0.0 )
    1238             :        lidarcld(:,:) = lidarcld(:,:)/nsub(:,:)
    1239             :     elsewhere
    1240             :        lidarcld(:,:) = undef
    1241             :     endwhere
    1242             :     
    1243             :     ! Layered cloud fractions
    1244           0 :     cldlayer  = 0._wp
    1245           0 :     nsublayer = 0._wp
    1246           0 :     do iz = 1, Ncat
    1247           0 :        do ic = 1, Ncolumns
    1248           0 :           cldlayer(:,iz)  = cldlayer(:,iz)  + cldlay(:,ic,iz)
    1249           0 :           nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
    1250             :        enddo
    1251             :     enddo
    1252           0 :     where (nsublayer(:,:) .gt. 0.0)
    1253             :        cldlayer(:,:) = cldlayer(:,:)/nsublayer(:,:)
    1254             :     elsewhere
    1255             :        cldlayer(:,:) = undef
    1256             :     endwhere
    1257             : 
    1258           0 :     RETURN
    1259             :   END SUBROUTINE COSP_CLDFRAC_NOPHASE
    1260             : 
    1261             :     ! ####################################################################################
    1262             :     ! SUBROUTINE cosp_opaq
    1263             :     ! Conventions: Ntype must be equal to 3
    1264             :     ! ####################################################################################
    1265        9288 :     SUBROUTINE COSP_OPAQ(Npoints,Ncolumns,Nlevels,Ntype,tmp,x,S_att,S_cld,undef,lidarcldtype,   &
    1266        9288 :                          cldtype,cldtypetemp,cldtypemeanz,cldtypemeanzse,cldthinemis,vgrid_z,   &
    1267        9288 :                          surfelev)
    1268             : 
    1269             :     ! Local parameter
    1270             :     real(wp),parameter  :: &
    1271             :        S_att_opaq = 0.06_wp, & ! Fully Attenuated threshold (Guzman et al. 2017, JGR-Atmospheres)
    1272             :        eta = 0.6_wp            ! Multiple-scattering factor (Vaillant de Guelis et al. 2017a, AMT)
    1273             : 
    1274             :         ! Inputs
    1275             :     integer,intent(in) :: &
    1276             :        Npoints,  & ! Number of gridpoints
    1277             :        Ncolumns, & ! Number of subcolumns
    1278             :        Nlevels,  & ! Number of vertical levels
    1279             :        Ntype       ! Number of OPAQ cloud types (opaque, thin clouds and z_opaque)
    1280             :     real(wp),intent(in) :: &
    1281             :        S_att,    & ! Fully Attenuated legacy threshold
    1282             :        S_cld,    & ! Cloud detection threshold
    1283             :        undef       ! Undefined value
    1284             :     real(wp),intent(in),dimension(Nlevels) :: &
    1285             :        vgrid_z     ! mid-level vertical profile altitude (subcolumns)
    1286             :     real(wp),intent(in),dimension(Npoints,Ncolumns,Nlevels) :: &
    1287             :        x           ! SR profiles (subcolumns)
    1288             :     real(wp),intent(in),dimension(Npoints,Nlevels) :: &
    1289             :        tmp         ! Temperature profiles
    1290             :     real(wp),intent(in),dimension(Npoints) :: &
    1291             :        surfelev    ! Surface Elevation (SE)
    1292             : 
    1293             :         ! Outputs
    1294             :     real(wp),intent(out),dimension(Npoints,Nlevels,Ntype+1) :: &
    1295             :        lidarcldtype   ! 3D OPAQ product fraction (opaque clouds, thin clouds, z_opaque, opacity)
    1296             :     real(wp),intent(out),dimension(Npoints,Ntype) :: &
    1297             :        cldtype,     & ! Opaque/thin cloud covers + z_opaque altitude
    1298             :        cldtypetemp    ! Opaque and thin clouds + z_opaque temperature
    1299             :     real(wp),intent(out),dimension(Npoints,2) :: &
    1300             :        cldtypemeanz   ! Opaque and thin clouds altitude
    1301             :     real(wp),intent(out),dimension(Npoints,3) :: & 
    1302             :        cldtypemeanzse ! Opaque, thin clouds and z_opaque altitude with respect to SE
    1303             :     real(wp),intent(out),dimension(Npoints) :: &
    1304             :        cldthinemis    ! Thin clouds emissivity
    1305             :    
    1306             :     ! Local variables
    1307             :     integer  :: &
    1308             :        ip, k, zopac, ic, iz, z_top, z_base, topcloud
    1309             :     real(wp)  :: &
    1310             :        srmean, srcount, trans2, tau_app, tau_vis, tau_ir, cloudemis
    1311             :     real(wp),dimension(Npoints) :: &
    1312       18576 :        count_emis
    1313             :     real(wp),dimension(Npoints,Nlevels) :: &
    1314       18576 :        nsub, nsubopaq 
    1315             :     real(wp),dimension(Npoints,Ncolumns,Ntype+1) :: & ! Opaque, thin, z_opaque and all cloud cover
    1316       18576 :        cldlay, nsublay   
    1317             :     real(wp),dimension(Npoints,Ntype) :: &
    1318       18576 :        nsublayer
    1319             :     real(wp),dimension(Npoints,Ncolumns,Nlevels) :: &   
    1320       18576 :        cldy,     & ! 
    1321       18576 :        cldyopaq, & ! 
    1322       18576 :        srok,     & !
    1323        9288 :        srokopaq    !
    1324             : 
    1325             :     ! ####################################################################################
    1326             :         ! 1) Initialize    
    1327             :     ! ####################################################################################
    1328      474552 :     cldtype(:,:)          = 0._wp
    1329      474552 :     cldtypetemp(:,:)      = 0._wp
    1330      319464 :     cldtypemeanz(:,:)     = 0._wp
    1331      474552 :     cldtypemeanzse(:,:)   = 0._wp
    1332      155088 :     cldthinemis(:)        = 0._wp
    1333      155088 :     count_emis(:)         = 0._wp
    1334    24860520 :     lidarcldtype(:,:,:)   = 0._wp
    1335     6212808 :     nsub                  = 0._wp
    1336     6212808 :     nsubopaq              = 0._wp
    1337     6249960 :     cldlay                = 0._wp
    1338     6249960 :     nsublay               = 0._wp
    1339      474552 :     nsublayer             = 0._wp
    1340             : 
    1341             :     ! ####################################################################################
    1342             :     ! 2) Cloud detection and Fully attenuated layer detection
    1343             :     ! ####################################################################################
    1344      380808 :     do k=1,Nlevels
    1345             :        ! Cloud detection at subgrid-scale:
    1346    62406720 :        where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
    1347             :           cldy(:,:,k)=1._wp
    1348             :        elsewhere
    1349      371520 :           cldy(:,:,k)=0._wp
    1350             :        endwhere
    1351             :        ! Fully attenuated layer detection at subgrid-scale:
    1352    62406720 :        where ( (x(:,:,k) .lt. S_att_opaq) .and. (x(:,:,k) .ge. 0.) .and. (x(:,:,k) .ne. undef) )
    1353             :           cldyopaq(:,:,k)=1._wp
    1354             :        elsewhere
    1355             :           cldyopaq(:,:,k)=0._wp
    1356             :        endwhere
    1357             : 
    1358             : 
    1359             :        ! Number of usefull sub-column layers:
    1360    62406720 :        where ( (x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
    1361             :           srok(:,:,k)=1._wp
    1362             :        elsewhere
    1363             :           srok(:,:,k)=0._wp
    1364             :        endwhere
    1365             :        ! Number of usefull sub-columns layers for z_opaque 3D fraction:
    1366    62416008 :        where ( (x(:,:,k) .ge. 0.) .and. (x(:,:,k) .ne. undef) )
    1367             :           srokopaq(:,:,k)=1._wp
    1368             :        elsewhere
    1369             :           srokopaq(:,:,k)=0._wp
    1370             :        endwhere
    1371             :     enddo
    1372             : 
    1373             :     ! ####################################################################################
    1374             :     ! 3) Grid-box 3D OPAQ product fraction and cloud type cover (opaque/thin) + mean z_opaque
    1375             :     ! ####################################################################################
    1376             : 
    1377      380808 :     do k=1,Nlevels
    1378     4096008 :        do ic = 1, Ncolumns
    1379    62406720 :           do ip = 1, Npoints
    1380             : 
    1381    58320000 :              cldlay(ip,ic,1)   = MAX(cldlay(ip,ic,1),cldyopaq(ip,ic,k)) ! Opaque cloud
    1382    58320000 :              cldlay(ip,ic,4)   = MAX(cldlay(ip,ic,4),cldy(ip,ic,k))     ! All cloud
    1383             : 
    1384    58320000 :              nsublay(ip,ic,1)  = MAX(nsublay(ip,ic,1),srok(ip,ic,k))
    1385    58320000 :              nsublay(ip,ic,2)  = MAX(nsublay(ip,ic,2),srok(ip,ic,k))
    1386             : !             nsublay(ip,ic,4)  = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
    1387    58320000 :              nsub(ip,k)        = nsub(ip,k) + srok(ip,ic,k)
    1388    62035200 :              nsubopaq(ip,k)    = nsubopaq(ip,k) + srokopaq(ip,ic,k)
    1389             : 
    1390             :           enddo
    1391             :        enddo
    1392             :     enddo   
    1393             : 
    1394             : ! OPAQ variables
    1395      102168 :      do ic = 1, Ncolumns
    1396     1560168 :         do ip = 1, Npoints
    1397             : 
    1398             :      ! Declaring non-opaque cloudy profiles as thin cloud profiles
    1399     1458000 :            if ( cldlay(ip,ic,4).gt. 0. .and. cldlay(ip,ic,1) .eq. 0. ) then
    1400      222099 :               cldlay(ip,ic,2)  =  1._wp
    1401             :            endif
    1402             : 
    1403             :      ! Filling in 3D and 2D variables
    1404             : 
    1405             :      ! Opaque cloud profiles
    1406     1458000 :            if ( cldlay(ip,ic,1) .eq. 1. ) then
    1407             :               zopac = 0._wp
    1408             :               z_top = 0._wp
    1409    11472160 :               do k=1,Nlevels-1
    1410             :      ! Declaring z_opaque altitude and opaque cloud fraction for 3D and 2D variables
    1411             :      ! From SFC-2-TOA ( actually from vgrid_z(SFC+1) = vgrid_z(Nlevels-1) )
    1412    11185356 :                  if ( cldy(ip,ic,Nlevels-k) .eq. 1. .and. zopac .eq. 0. ) then
    1413      286804 :                     lidarcldtype(ip,Nlevels-k + 1,3) = lidarcldtype(ip,Nlevels-k + 1,3) + 1._wp
    1414      286804 :                     cldlay(ip,ic,3)                  = vgrid_z(Nlevels-k+1)      ! z_opaque altitude
    1415      286804 :                     nsublay(ip,ic,3)                 = 1._wp
    1416      286804 :                     zopac = Nlevels-k+1                        ! z_opaque vertical index on vgrid_z
    1417             :                  endif
    1418    11472160 :                  if ( cldy(ip,ic,Nlevels-k) .eq. 1. ) then
    1419     1116559 :                     lidarcldtype(ip,Nlevels-k ,1)    = lidarcldtype(ip,Nlevels-k ,1) + 1._wp
    1420     1116559 :                     z_top = Nlevels-k    ! top cloud layer vertical index on vgrid_z
    1421             :                  endif
    1422             :               enddo
    1423             :      ! Summing opaque cloud mean temperatures and altitudes
    1424             :      ! as defined in Vaillant de Guelis et al. 2017a, AMT
    1425      286804 :               if (zopac .ne. 0) then 
    1426      286804 :                  cldtypetemp(ip,1) = cldtypetemp(ip,1) + ( tmp(ip,zopac) + tmp(ip,z_top) )/2.
    1427      286804 :                  cldtypetemp(ip,3) = cldtypetemp(ip,3) + tmp(ip,zopac)                 ! z_opaque
    1428      286804 :                  cldtypemeanz(ip,1) = cldtypemeanz(ip,1) + ( vgrid_z(zopac) + vgrid_z(z_top) )/2.
    1429      286804 :                  cldtypemeanzse(ip,1) = cldtypemeanzse(ip,1) + (( vgrid_z(zopac) + vgrid_z(z_top) )/2.) - surfelev(ip)
    1430      286804 :                  cldtypemeanzse(ip,3) = cldtypemeanzse(ip,3) + ( vgrid_z(zopac) - surfelev(ip) )
    1431             :               else
    1432           0 :                  cldlay(ip,ic,1) = 0
    1433             :               endif
    1434             :            endif
    1435             : 
    1436             :      ! Thin cloud profiles
    1437     1550880 :            if ( cldlay(ip,ic,2) .eq. 1. ) then
    1438             :               topcloud = 0._wp
    1439             :               z_top = 0._wp
    1440             :               z_base = 0._wp
    1441     9106059 :               do k=1,Nlevels
    1442             :      ! Declaring thin cloud fraction for 3D variable
    1443             :      ! From TOA-2-SFC
    1444     8883960 :                  if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 1. ) then
    1445      483530 :                     lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1._wp
    1446      483530 :                     z_base = k ! bottom cloud layer
    1447             :                  endif
    1448     9106059 :                  if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 0. ) then
    1449      222099 :                     lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1._wp
    1450      222099 :                     z_top = k  ! top cloud layer
    1451      222099 :                     z_base = k ! bottom cloud layer
    1452      222099 :                     topcloud = 1._wp
    1453             :                  endif
    1454             :               enddo
    1455             :      ! Computing mean emissivity using layers below the bottom cloud layer to the surface
    1456      222099 :               srmean = 0._wp
    1457      222099 :               srcount = 0._wp
    1458      222099 :               cloudemis = 0._wp
    1459     2597328 :               do k=z_base+1,Nlevels
    1460     2597328 :                  if (  (x(ip,ic,k) .gt. S_att_opaq) .and. (x(ip,ic,k) .lt. 1.0) .and. (x(ip,ic,k) .ne. undef)  ) then
    1461     1453252 :                     srmean = srmean + x(ip,ic,k)
    1462     1453252 :                     srcount = srcount + 1.
    1463             :                  endif
    1464             :               enddo
    1465             :               ! If clear sky layers exist below bottom cloud layer
    1466      222099 :               if ( srcount .gt. 0. ) then
    1467      148799 :                  trans2 = srmean/srcount              ! thin cloud transmittance**2
    1468      148799 :                  tau_app = -(log(trans2))/2.          ! apparent cloud optical depth
    1469      148799 :                  tau_vis = tau_app/eta                ! cloud visible optical depth (multiple scat.)
    1470      148799 :                  tau_ir = tau_vis/2.                  ! approx. relation between visible and IR ODs
    1471      148799 :                  cloudemis = 1. - exp(-tau_ir)        ! no diffusion in IR considered : emis = 1-T
    1472      148799 :                  count_emis(ip) = count_emis(ip) + 1.
    1473             :               endif
    1474             :      ! Summing thin cloud mean temperatures and altitudes
    1475             :      ! as defined in Vaillant de Guelis et al. 2017a, AMT
    1476      222099 :               cldtypetemp(ip,2) = cldtypetemp(ip,2) + ( tmp(ip,z_base) + tmp(ip,z_top) )/2.
    1477      222099 :               cldtypemeanz(ip,2) = cldtypemeanz(ip,2) + ( vgrid_z(z_base) + vgrid_z(z_top) )/2.
    1478      222099 :               cldtypemeanzse(ip,2) = cldtypemeanzse(ip,2) + (( vgrid_z(z_base) + vgrid_z(z_top) )/2.) - surfelev(ip)
    1479      222099 :               cldthinemis(ip) = cldthinemis(ip) + cloudemis
    1480             :            endif
    1481             : 
    1482             :        enddo
    1483             :     enddo   
    1484             : 
    1485             :     ! 3D cloud types fraction (opaque=1 and thin=2 clouds)
    1486    43452504 :     where ( nsub(:,:) .gt. 0. )
    1487        9288 :        lidarcldtype(:,:,1) = lidarcldtype(:,:,1)/nsub(:,:)
    1488        9288 :        lidarcldtype(:,:,2) = lidarcldtype(:,:,2)/nsub(:,:)
    1489             :     elsewhere
    1490             :        lidarcldtype(:,:,1) = undef
    1491             :        lidarcldtype(:,:,2) = undef
    1492             :     endwhere
    1493             :     ! 3D z_opaque fraction (=3)
    1494    31045464 :     where ( nsubopaq(:,:) .gt. 0. )
    1495        9288 :        lidarcldtype(:,:,3) = lidarcldtype(:,:,3)/nsubopaq(:,:)
    1496             :     elsewhere
    1497             :        lidarcldtype(:,:,3) = undef
    1498        9288 :        lidarcldtype(:,:,4) = undef !declaring undef for opacity as well
    1499             :     endwhere
    1500             :     ! 3D opacity fraction (=4) !Summing z_opaque fraction from TOA(k=1) to SFC(k=Nlevels)
    1501      155088 :        lidarcldtype(:,1,4) = lidarcldtype(:,1,3) !top layer equal to 3D z_opaque fraction
    1502      155088 :     do ip = 1, Npoints
    1503     5841288 :         do k = 2, Nlevels
    1504     5832000 :             if ( (lidarcldtype(ip,k,3) .ne. undef) .and. (lidarcldtype(ip,k-1,4) .ne. undef) ) then
    1505     5633969 :                 lidarcldtype(ip,k,4) = lidarcldtype(ip,k,3) + lidarcldtype(ip,k-1,4)
    1506             :             else
    1507       52231 :                 lidarcldtype(ip,k,4) = undef
    1508             :             endif
    1509             :         enddo
    1510             :     enddo
    1511             : 
    1512             :     ! Layered cloud types (opaque, thin and z_opaque 2D variables)
    1513             : 
    1514       37152 :     do iz = 1, Ntype
    1515      315792 :        do ic = 1, Ncolumns
    1516     4652640 :           cldtype(:,iz)  = cldtype(:,iz)  + cldlay(:,ic,iz)
    1517     4680504 :           nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
    1518             :        enddo
    1519             :     enddo
    1520             : 
    1521             :     ! Mean temperature and altitude
    1522     2351376 :     where (cldtype(:,1) .gt. 0.)
    1523             :        cldtypetemp(:,1) = cldtypetemp(:,1)/cldtype(:,1) ! opaque cloud temp
    1524        9288 :        cldtypetemp(:,3) = cldtypetemp(:,3)/cldtype(:,1) ! z_opaque
    1525             :        cldtypemeanz(:,1) = cldtypemeanz(:,1)/cldtype(:,1) ! opaque cloud alt
    1526             :        cldtypemeanzse(:,1) = cldtypemeanzse(:,1)/cldtype(:,1) ! opaque cloud alt - SE 
    1527             :        cldtypemeanzse(:,3) = cldtypemeanzse(:,3)/cldtype(:,1) ! z_opaque - SE 
    1528             :     elsewhere
    1529             :        cldtypetemp(:,1) = undef
    1530             :        cldtypetemp(:,3) = undef
    1531             :        cldtypemeanz(:,1) = undef
    1532             :        cldtypemeanzse(:,1) = undef
    1533             :        cldtypemeanzse(:,3) = undef
    1534             :     endwhere
    1535             : 
    1536     1467288 :     where (cldtype(:,2) .gt. 0.) ! thin cloud
    1537             :        cldtypetemp(:,2) = cldtypetemp(:,2)/cldtype(:,2)
    1538             :        cldtypemeanz(:,2) = cldtypemeanz(:,2)/cldtype(:,2)
    1539             :        cldtypemeanzse(:,2) = cldtypemeanzse(:,2)/cldtype(:,2)
    1540             :     elsewhere
    1541             :        cldtypetemp(:,2) = undef
    1542             :        cldtypemeanz(:,2) = undef
    1543             :        cldtypemeanzse(:,2) = undef
    1544             :     endwhere
    1545             : 
    1546             :     ! Mean thin cloud emissivity
    1547      592488 :     where (count_emis(:) .gt. 0.) ! thin cloud
    1548             :        cldthinemis(:) = cldthinemis(:)/count_emis(:)
    1549             :     elsewhere
    1550             :        cldthinemis(:) = undef
    1551             :     endwhere
    1552             : 
    1553     1870344 :     where (nsublayer(:,:) .gt. 0.)
    1554             :        cldtype(:,:) = cldtype(:,:)/nsublayer(:,:)
    1555             :     elsewhere
    1556             :        cldtype(:,:) = undef
    1557             :     endwhere
    1558             : 
    1559        9288 :   END SUBROUTINE COSP_OPAQ
    1560             : 
    1561             : end module mod_lidar_simulator

Generated by: LCOV version 1.14