source: LMDZ6/trunk/libf/phylmd/cospv2/parasol.F90 @ 4249

! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! Copyright (c) 2009, Centre National de la Recherche Scientifique
! All rights reserved.
!
! Redistribution and use in source and binary forms, with or without modification, are 
! permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice, this list of 
!    conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice, this list
!    of conditions and the following disclaimer in the documentation and/or other 
!    materials provided with the distribution.
!
! 3. Neither the name of the copyright holder nor the names of its contributors may be 
!    used to endorse or promote products derived from this software without specific prior
!    written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY 
! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 
! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL 
! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT 
! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! History
! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne : 
! - optimization for vectorization
! Version 2.0 (October 2008)
! Version 2.1 (December 2008)
! May 2015 - D. Swales - Modified for COSPv2.0
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
module mod_parasol
  USE COSP_KINDS,          ONLY: wp
  USE COSP_MATH_CONSTANTS, ONLY: pi
  use mod_cosp_config,     ONLY: R_UNDEF,PARASOL_NREFL,PARASOL_NTAU,PARASOL_TAU,PARASOL_SZA,rlumA,rlumB
  implicit none

contains
  SUBROUTINE parasol_subcolumn(npoints,nrefl,tautot_S_liq,tautot_S_ice,refl)
    ! ##########################################################################
    ! Purpose: To compute Parasol reflectance signal from model-simulated profiles 
    !          of cloud water and cloud fraction in each sub-column of each model 
    !          gridbox.
    !
    !
    ! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne : 
    ! - optimization for vectorization
    !
    ! Version 2.0 (October 2008)
    ! Version 2.1 (December 2008)
    ! ##########################################################################
    
    ! INPUTS
    INTEGER,intent(in) :: &
         npoints,              & ! Number of horizontal gridpoints
         nrefl                   ! Number of angles for which the reflectance is computed
    REAL(WP),intent(inout),dimension(npoints) :: &
         tautot_S_liq,         & ! Liquid water optical thickness, from TOA to SFC
         tautot_S_ice            ! Ice water optical thickness, from TOA to SFC
    ! OUTPUTS
    REAL(WP),intent(inout),dimension(npoints,nrefl) :: &
         refl                    ! Parasol reflectances
    
    ! LOCAL VARIABLES
    REAL(WP),dimension(npoints) :: &
         tautot_S,             & ! Cloud optical thickness, from TOA to surface
         frac_taucol_liq,      & !
         frac_taucol_ice         !
    
    ! Look up table variables:
    INTEGER                            :: ny,it 
    REAL(WP),dimension(PARASOL_NREFL)         :: r_norm
    REAL(WP),dimension(PARASOL_NREFL,PARASOL_NTAU-1) :: aa,ab,ba,bb
    REAL(WP),dimension(npoints,5)      :: rlumA_mod,rlumB_mod
    
    !--------------------------------------------------------------------------------
    ! Lum_norm=f(PARASOL_SZA,tau_cloud) derived from adding-doubling calculations
    !        valid ONLY ABOVE OCEAN (albedo_sfce=5%)
    !        valid only in one viewing direction (theta_v=30�, phi_s-phi_v=320�)
    !        based on adding-doubling radiative transfer computation
    !        for PARASOL_TAU values (0 to 100) and for PARASOL_SZA values (0 to 80)
    !        for 2 scattering phase functions: liquid spherical, ice non spherical
    
    ! Initialize
    rlumA_mod(1:npoints,1:5) = 0._wp
    rlumB_mod(1:npoints,1:5) = 0._wp

    r_norm(1:PARASOL_NREFL)=1._wp/ cos(pi/180._wp*PARASOL_SZA(1:PARASOL_NREFL))
    
    tautot_S_liq(1:npoints) = max(tautot_S_liq(1:npoints),PARASOL_TAU(1))
    tautot_S_ice(1:npoints) = max(tautot_S_ice(1:npoints),PARASOL_TAU(1))
    tautot_S(1:npoints)     = tautot_S_ice(1:npoints) + tautot_S_liq(1:npoints)

    ! Relative fraction of the opt. thick due to liquid or ice clouds
    WHERE (tautot_S(1:npoints) .gt. 0.)
       frac_taucol_liq(1:npoints) = tautot_S_liq(1:npoints) / tautot_S(1:npoints)
       frac_taucol_ice(1:npoints) = tautot_S_ice(1:npoints) / tautot_S(1:npoints)
    ELSEWHERE
       frac_taucol_liq(1:npoints) = 1._wp
       frac_taucol_ice(1:npoints) = 0._wp
    END WHERE
    tautot_S(1:npoints)=MIN(tautot_S(1:npoints),PARASOL_TAU(PARASOL_NTAU))
    
    ! Linear interpolation    
    DO ny=1,PARASOL_NTAU-1
       ! Microphysics A (liquid clouds) 
       aA(1:PARASOL_NREFL,ny) = (rlumA(1:PARASOL_NREFL,ny+1)-rlumA(1:PARASOL_NREFL,ny))/(PARASOL_TAU(ny+1)-PARASOL_TAU(ny))
       bA(1:PARASOL_NREFL,ny) = rlumA(1:PARASOL_NREFL,ny) - aA(1:PARASOL_NREFL,ny)*PARASOL_TAU(ny)
       ! Microphysics B (ice clouds)
       aB(1:PARASOL_NREFL,ny) = (rlumB(1:PARASOL_NREFL,ny+1)-rlumB(1:PARASOL_NREFL,ny))/(PARASOL_TAU(ny+1)-PARASOL_TAU(ny))
       bB(1:PARASOL_NREFL,ny) = rlumB(1:PARASOL_NREFL,ny) - aB(1:PARASOL_NREFL,ny)*PARASOL_TAU(ny)
    ENDDO
    
    DO it=1,PARASOL_NREFL
       DO ny=1,PARASOL_NTAU-1
          WHERE (tautot_S(1:npoints) .ge. PARASOL_TAU(ny).and. &
                 tautot_S(1:npoints) .le. PARASOL_TAU(ny+1))
             rlumA_mod(1:npoints,it) = aA(it,ny)*tautot_S(1:npoints) + bA(it,ny)
             rlumB_mod(1:npoints,it) = aB(it,ny)*tautot_S(1:npoints) + bB(it,ny)
          END WHERE
       END DO
    END DO
    
    DO it=1,PARASOL_NREFL
       refl(1:npoints,it) = frac_taucol_liq(1:npoints) * rlumA_mod(1:npoints,it) &
            + frac_taucol_ice(1:npoints) * rlumB_mod(1:npoints,it)
       ! Normalized radiance -> reflectance: 
       refl(1:npoints,it) = refl(1:npoints,it) * r_norm(it)
    ENDDO
    
    RETURN
  END SUBROUTINE parasol_subcolumn
  ! ######################################################################################
  ! SUBROUTINE parasol_gridbox
  ! ######################################################################################
  subroutine parasol_column(npoints,nrefl,ncol,land,refl,parasolrefl)

    ! Inputs
    integer,intent(in) :: &
         npoints, & ! Number of horizontal grid points
         ncol,    & ! Number of subcolumns
         nrefl      ! Number of solar zenith angles for parasol reflectances
    real(wp),intent(in),dimension(npoints) :: &
         land       ! Landmask [0 - Ocean, 1 - Land]
    real(wp),intent(in),dimension(npoints,ncol,nrefl) :: &
         refl       ! Subgrid parasol reflectance ! parasol

    ! Outputs
    real(wp),intent(out),dimension(npoints,nrefl) :: &
         parasolrefl   ! Grid-averaged parasol reflectance

    ! Local variables
    integer :: k,ic

    ! Compute grid-box averaged Parasol reflectances
    parasolrefl(:,:) = 0._wp
    do k = 1, nrefl
       do ic = 1, ncol
          parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
       enddo
    enddo
    
    do k = 1, nrefl
       parasolrefl(:,k) = parasolrefl(:,k) / float(ncol)
       ! if land=1 -> parasolrefl=R_UNDEF
       ! if land=0 -> parasolrefl=parasolrefl
       parasolrefl(:,k) = parasolrefl(:,k) * MAX(1._wp-land(:),0.0) &
            + (1._wp - MAX(1._wp-land(:),0.0))*R_UNDEF
    enddo
  end subroutine parasol_column

end module mod_parasol