LCOV - code coverage report
Current view: top level - physics/cosp2/src/src/simulator/parasol - parasol.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 37 37 100.0 %
Date: 2025-03-13 19:12:29 Functions: 2 2 100.0 %

          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             : ! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne : 
      31             : ! - optimization for vectorization
      32             : ! Version 2.0 (October 2008)
      33             : ! Version 2.1 (December 2008)
      34             : ! May 2015 - D. Swales - Modified for COSPv2.0
      35             : ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      36             : module mod_parasol
      37             :   USE COSP_KINDS,          ONLY: wp
      38             :   USE COSP_MATH_CONSTANTS, ONLY: pi
      39             :   use mod_cosp_config,     ONLY: R_UNDEF,PARASOL_NREFL,PARASOL_NTAU,PARASOL_TAU,PARASOL_SZA,rlumA,rlumB
      40             :   implicit none
      41             : 
      42             : contains
      43       92880 :   SUBROUTINE parasol_subcolumn(npoints,nrefl,tautot_S_liq,tautot_S_ice,refl)
      44             :     ! ##########################################################################
      45             :     ! Purpose: To compute Parasol reflectance signal from model-simulated profiles 
      46             :     !          of cloud water and cloud fraction in each sub-column of each model 
      47             :     !          gridbox.
      48             :     !
      49             :     !
      50             :     ! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne : 
      51             :     ! - optimization for vectorization
      52             :     !
      53             :     ! Version 2.0 (October 2008)
      54             :     ! Version 2.1 (December 2008)
      55             :     ! ##########################################################################
      56             :     
      57             :     ! INPUTS
      58             :     INTEGER,intent(in) :: &
      59             :          npoints,              & ! Number of horizontal gridpoints
      60             :          nrefl                   ! Number of angles for which the reflectance is computed
      61             :     REAL(WP),intent(inout),dimension(npoints) :: &
      62             :          tautot_S_liq,         & ! Liquid water optical thickness, from TOA to SFC
      63             :          tautot_S_ice            ! Ice water optical thickness, from TOA to SFC
      64             :     ! OUTPUTS
      65             :     REAL(WP),intent(inout),dimension(npoints,nrefl) :: &
      66             :          refl                    ! Parasol reflectances
      67             :     
      68             :     ! LOCAL VARIABLES
      69             :     REAL(WP),dimension(npoints) :: &
      70      185760 :          tautot_S,             & ! Cloud optical thickness, from TOA to surface
      71      185760 :          frac_taucol_liq,      & !
      72      185760 :          frac_taucol_ice         !
      73             :     
      74             :     ! Look up table variables:
      75             :     INTEGER                            :: ny,it 
      76             :     REAL(WP),dimension(PARASOL_NREFL)         :: r_norm
      77             :     REAL(WP),dimension(PARASOL_NREFL,PARASOL_NTAU-1) :: aa,ab,ba,bb
      78       92880 :     REAL(WP),dimension(npoints,5)      :: rlumA_mod,rlumB_mod
      79             :     
      80             :     !--------------------------------------------------------------------------------
      81             :     ! Lum_norm=f(PARASOL_SZA,tau_cloud) derived from adding-doubling calculations
      82             :     !        valid ONLY ABOVE OCEAN (albedo_sfce=5%)
      83             :     !        valid only in one viewing direction (theta_v=30�, phi_s-phi_v=320�)
      84             :     !        based on adding-doubling radiative transfer computation
      85             :     !        for PARASOL_TAU values (0 to 100) and for PARASOL_SZA values (0 to 80)
      86             :     !        for 2 scattering phase functions: liquid spherical, ice non spherical
      87             :     
      88             :     ! Initialize
      89     7847280 :     rlumA_mod(1:npoints,1:5) = 0._wp
      90     7847280 :     rlumB_mod(1:npoints,1:5) = 0._wp
      91             : 
      92       92880 :     r_norm(1:PARASOL_NREFL)=1._wp/ cos(pi/180._wp*PARASOL_SZA(1:PARASOL_NREFL))
      93             :     
      94     1550880 :     tautot_S_liq(1:npoints) = max(tautot_S_liq(1:npoints),PARASOL_TAU(1))
      95     1550880 :     tautot_S_ice(1:npoints) = max(tautot_S_ice(1:npoints),PARASOL_TAU(1))
      96     1550880 :     tautot_S(1:npoints)     = tautot_S_ice(1:npoints) + tautot_S_liq(1:npoints)
      97             : 
      98             :     ! Relative fraction of the opt. thick due to liquid or ice clouds
      99     7754400 :     WHERE (tautot_S(1:npoints) .gt. 0.)
     100             :        frac_taucol_liq(1:npoints) = tautot_S_liq(1:npoints) / tautot_S(1:npoints)
     101             :        frac_taucol_ice(1:npoints) = tautot_S_ice(1:npoints) / tautot_S(1:npoints)
     102             :     ELSEWHERE
     103             :        frac_taucol_liq(1:npoints) = 1._wp
     104             :        frac_taucol_ice(1:npoints) = 0._wp
     105             :     END WHERE
     106     1550880 :     tautot_S(1:npoints)=MIN(tautot_S(1:npoints),PARASOL_TAU(PARASOL_NTAU))
     107             :     
     108             :     ! Linear interpolation    
     109      650160 :     DO ny=1,PARASOL_NTAU-1
     110             :        ! Microphysics A (liquid clouds) 
     111     3900960 :        aA(1:PARASOL_NREFL,ny) = (rlumA(1:PARASOL_NREFL,ny+1)-rlumA(1:PARASOL_NREFL,ny))/(PARASOL_TAU(ny+1)-PARASOL_TAU(ny))
     112     3343680 :        bA(1:PARASOL_NREFL,ny) = rlumA(1:PARASOL_NREFL,ny) - aA(1:PARASOL_NREFL,ny)*PARASOL_TAU(ny)
     113             :        ! Microphysics B (ice clouds)
     114     3343680 :        aB(1:PARASOL_NREFL,ny) = (rlumB(1:PARASOL_NREFL,ny+1)-rlumB(1:PARASOL_NREFL,ny))/(PARASOL_TAU(ny+1)-PARASOL_TAU(ny))
     115     3436560 :        bB(1:PARASOL_NREFL,ny) = rlumB(1:PARASOL_NREFL,ny) - aB(1:PARASOL_NREFL,ny)*PARASOL_TAU(ny)
     116             :     ENDDO
     117             :     
     118      557280 :     DO it=1,PARASOL_NREFL
     119     3343680 :        DO ny=1,PARASOL_NTAU-1
     120     2786400 :           WHERE (tautot_S(1:npoints) .ge. PARASOL_TAU(ny).and. &
     121   140043600 :                  tautot_S(1:npoints) .le. PARASOL_TAU(ny+1))
     122     2786400 :              rlumA_mod(1:npoints,it) = aA(it,ny)*tautot_S(1:npoints) + bA(it,ny)
     123             :              rlumB_mod(1:npoints,it) = aB(it,ny)*tautot_S(1:npoints) + bB(it,ny)
     124             :           END WHERE
     125             :        END DO
     126             :     END DO
     127             :     
     128      557280 :     DO it=1,PARASOL_NREFL
     129      464400 :        refl(1:npoints,it) = frac_taucol_liq(1:npoints) * rlumA_mod(1:npoints,it) &
     130     8683200 :             + frac_taucol_ice(1:npoints) * rlumB_mod(1:npoints,it)
     131             :        ! Normalized radiance -> reflectance: 
     132     7847280 :        refl(1:npoints,it) = refl(1:npoints,it) * r_norm(it)
     133             :     ENDDO
     134             :     
     135       92880 :     RETURN
     136             :   END SUBROUTINE parasol_subcolumn
     137             :   ! ######################################################################################
     138             :   ! SUBROUTINE parasol_gridbox
     139             :   ! ######################################################################################
     140        9288 :   subroutine parasol_column(npoints,nrefl,ncol,land,refl,parasolrefl)
     141             : 
     142             :     ! Inputs
     143             :     integer,intent(in) :: &
     144             :          npoints, & ! Number of horizontal grid points
     145             :          ncol,    & ! Number of subcolumns
     146             :          nrefl      ! Number of solar zenith angles for parasol reflectances
     147             :     real(wp),intent(in),dimension(npoints) :: &
     148             :          land       ! Landmask [0 - Ocean, 1 - Land]
     149             :     real(wp),intent(in),dimension(npoints,ncol,nrefl) :: &
     150             :          refl       ! Subgrid parasol reflectance ! parasol
     151             : 
     152             :     ! Outputs
     153             :     real(wp),intent(out),dimension(npoints,nrefl) :: &
     154             :          parasolrefl   ! Grid-averaged parasol reflectance
     155             : 
     156             :     ! Local variables
     157             :     integer :: k,ic
     158             : 
     159             :     ! Compute grid-box averaged Parasol reflectances
     160      784728 :     parasolrefl(:,:) = 0._wp
     161       55728 :     do k = 1, nrefl
     162      520128 :        do ic = 1, ncol
     163     7800840 :           parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
     164             :        enddo
     165             :     enddo
     166             :     
     167       55728 :     do k = 1, nrefl
     168      775440 :        parasolrefl(:,k) = parasolrefl(:,k) / float(ncol)
     169             :        ! if land=1 -> parasolrefl=R_UNDEF
     170             :        ! if land=0 -> parasolrefl=parasolrefl
     171             :        parasolrefl(:,k) = parasolrefl(:,k) * MAX(1._wp-land(:),0.0) &
     172      784728 :             + (1._wp - MAX(1._wp-land(:),0.0))*R_UNDEF
     173             :     enddo
     174        9288 :   end subroutine parasol_column
     175             : 
     176             : end module mod_parasol

Generated by: LCOV version 1.14