source: LMDZ6/trunk/libf/phylmd/cosp2/parasol.F90 @ 5069

Last change on this file since 5069 was 3358, checked in by idelkadi, 6 years ago

Implementation de la nouvelle version COSPv2 dans LMDZ.
Pour compiler avec makelmdz_fcma utiliser l'option "-cosp2 true"

File size: 7.9 KB
Line 
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! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
36module 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
42contains
43  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         tautot_S,             & ! Cloud optical thickness, from TOA to surface
71         frac_taucol_liq,      & !
72         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    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    rlumA_mod(1:npoints,1:5) = 0._wp
90    rlumB_mod(1:npoints,1:5) = 0._wp
91
92    r_norm(1:PARASOL_NREFL)=1._wp/ cos(pi/180._wp*PARASOL_SZA(1:PARASOL_NREFL))
93   
94    tautot_S_liq(1:npoints) = max(tautot_S_liq(1:npoints),PARASOL_TAU(1))
95    tautot_S_ice(1:npoints) = max(tautot_S_ice(1:npoints),PARASOL_TAU(1))
96    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    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    tautot_S(1:npoints)=MIN(tautot_S(1:npoints),PARASOL_TAU(PARASOL_NTAU))
107   
108    ! Linear interpolation   
109    DO ny=1,PARASOL_NTAU-1
110       ! Microphysics A (liquid clouds)
111       aA(1:PARASOL_NREFL,ny) = (rlumA(1:PARASOL_NREFL,ny+1)-rlumA(1:PARASOL_NREFL,ny))/(PARASOL_TAU(ny+1)-PARASOL_TAU(ny))
112       bA(1:PARASOL_NREFL,ny) = rlumA(1:PARASOL_NREFL,ny) - aA(1:PARASOL_NREFL,ny)*PARASOL_TAU(ny)
113       ! Microphysics B (ice clouds)
114       aB(1:PARASOL_NREFL,ny) = (rlumB(1:PARASOL_NREFL,ny+1)-rlumB(1:PARASOL_NREFL,ny))/(PARASOL_TAU(ny+1)-PARASOL_TAU(ny))
115       bB(1:PARASOL_NREFL,ny) = rlumB(1:PARASOL_NREFL,ny) - aB(1:PARASOL_NREFL,ny)*PARASOL_TAU(ny)
116    ENDDO
117   
118    DO it=1,PARASOL_NREFL
119       DO ny=1,PARASOL_NTAU-1
120          WHERE (tautot_S(1:npoints) .ge. PARASOL_TAU(ny).and. &
121                 tautot_S(1:npoints) .le. PARASOL_TAU(ny+1))
122             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    DO it=1,PARASOL_NREFL
129       refl(1:npoints,it) = frac_taucol_liq(1:npoints) * rlumA_mod(1:npoints,it) &
130            + frac_taucol_ice(1:npoints) * rlumB_mod(1:npoints,it)
131       ! Normalized radiance -> reflectance:
132       refl(1:npoints,it) = refl(1:npoints,it) * r_norm(it)
133    ENDDO
134   
135    RETURN
136  END SUBROUTINE parasol_subcolumn
137  ! ######################################################################################
138  ! SUBROUTINE parasol_gridbox
139  ! ######################################################################################
140  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    parasolrefl(:,:) = 0._wp
161    do k = 1, nrefl
162       do ic = 1, ncol
163          parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
164       enddo
165    enddo
166   
167    do k = 1, nrefl
168       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            + (1._wp - MAX(1._wp-land(:),0.0))*R_UNDEF
173    enddo
174  end subroutine parasol_column
175
176end module mod_parasol
Note: See TracBrowser for help on using the repository browser.