1 | |
---|
2 | |
---|
3 | |
---|
4 | |
---|
5 | |
---|
6 | |
---|
7 | |
---|
8 | |
---|
9 | |
---|
10 | |
---|
11 | |
---|
12 | !$Id: cloud_mod.F90 104 2008-12-23 10:28:51Z acosce $ |
---|
13 | !! ========================================================================= |
---|
14 | !! INCA - INteraction with Chemistry and Aerosols |
---|
15 | !! |
---|
16 | !! Copyright Laboratoire des Sciences du Climat et de l'Environnement (LSCE) |
---|
17 | !! Unite mixte CEA-CNRS-UVSQ |
---|
18 | !! |
---|
19 | !! Contributors to this INCA subroutine: |
---|
20 | !! |
---|
21 | !! Stacy Walters, NCAR, stacy@ucar.edu |
---|
22 | !! |
---|
23 | !! Anne Cozic, LSCE, anne.cozic@cea.fr |
---|
24 | !! Yann Meurdesoif, LSCE, yann.meurdesoif@cea.fr |
---|
25 | !! |
---|
26 | !! This software is a computer program whose purpose is to simulate the |
---|
27 | !! atmospheric gas phase and aerosol composition. The model is designed to be |
---|
28 | !! used within a transport model or a general circulation model. This version |
---|
29 | !! of INCA was designed to be coupled to the LMDz GCM. LMDz-INCA accounts |
---|
30 | !! for emissions, transport (resolved and sub-grid scale), photochemical |
---|
31 | !! transformations, and scavenging (dry deposition and washout) of chemical |
---|
32 | !! species and aerosols interactively in the GCM. Several versions of the INCA |
---|
33 | !! model are currently used depending on the envisaged applications with the |
---|
34 | !! chemistry-climate model. |
---|
35 | !! |
---|
36 | !! This software is governed by the CeCILL license under French law and |
---|
37 | !! abiding by the rules of distribution of free software. You can use, |
---|
38 | !! modify and/ or redistribute the software under the terms of the CeCILL |
---|
39 | !! license as circulated by CEA, CNRS and INRIA at the following URL |
---|
40 | !! "http://www.cecill.info". |
---|
41 | !! |
---|
42 | !! As a counterpart to the access to the source code and rights to copy, |
---|
43 | !! modify and redistribute granted by the license, users are provided only |
---|
44 | !! with a limited warranty and the software's author, the holder of the |
---|
45 | !! economic rights, and the successive licensors have only limited |
---|
46 | !! liability. |
---|
47 | !! |
---|
48 | !! In this respect, the user's attention is drawn to the risks associated |
---|
49 | !! with loading, using, modifying and/or developing or reproducing the |
---|
50 | !! software by the user in light of its specific status of free software, |
---|
51 | !! that may mean that it is complicated to manipulate, and that also |
---|
52 | !! therefore means that it is reserved for developers and experienced |
---|
53 | !! professionals having in-depth computer knowledge. Users are therefore |
---|
54 | !! encouraged to load and test the software's suitability as regards their |
---|
55 | !! requirements in conditions enabling the security of their systems and/or |
---|
56 | !! data to be ensured and, more generally, to use and operate it in the |
---|
57 | !! same conditions as regards security. |
---|
58 | !! |
---|
59 | !! The fact that you are presently reading this means that you have had |
---|
60 | !! knowledge of the CeCILL license and that you accept its terms. |
---|
61 | !! ========================================================================= |
---|
62 | |
---|
63 | |
---|
64 | SUBROUTINE CLOUD_MOD( zen_angle ,& |
---|
65 | clouds ,& |
---|
66 | lwc ,& |
---|
67 | delp ,& |
---|
68 | srf_alb ,& |
---|
69 | eff_alb ,& |
---|
70 | cld_mult ) |
---|
71 | !----------------------------------------------------------------------- |
---|
72 | ! ... Cloud alteration factors for photorates and albedo |
---|
73 | ! Stacy Walters, NCAR, 1998. |
---|
74 | !----------------------------------------------------------------------- |
---|
75 | USE PHT_TABLES, ONLY : jdim, alpha |
---|
76 | USE INCA_DIM |
---|
77 | IMPLICIT NONE |
---|
78 | |
---|
79 | |
---|
80 | REAL, PARAMETER :: gi = 1./9.80616 |
---|
81 | |
---|
82 | !----------------------------------------------------------------------- |
---|
83 | ! ... Dummy arguments |
---|
84 | !----------------------------------------------------------------------- |
---|
85 | REAL, INTENT(in) :: zen_angle ! zenith angle |
---|
86 | REAL, INTENT(in) :: srf_alb ! surface albedo |
---|
87 | REAL, INTENT(in) :: clouds(PLEV) ! cloud fraction |
---|
88 | REAL, INTENT(in) :: lwc(PLEV) ! liquid water content (mass mr) |
---|
89 | REAL, INTENT(in) :: delp(PLEV) ! del press about midpoint in pascals |
---|
90 | REAL, INTENT(out) :: eff_alb(PLEV) ! effective albedo |
---|
91 | REAL, INTENT(out) :: cld_mult(jdim,PLEV) !photolysis mult factor |
---|
92 | |
---|
93 | !----------------------------------------------------------------------- |
---|
94 | ! ... Local variables |
---|
95 | !----------------------------------------------------------------------- |
---|
96 | INTEGER :: k, m |
---|
97 | REAL :: coschi |
---|
98 | REAL :: del_lwp(PLEV) |
---|
99 | REAL :: del_tau(PLEV) |
---|
100 | REAL :: above_tau(PLEV) |
---|
101 | REAL :: below_tau(PLEV) |
---|
102 | REAL :: above_cld(PLEV) |
---|
103 | REAL :: below_cld(PLEV) |
---|
104 | REAL :: above_tra(PLEV) |
---|
105 | REAL :: below_tra(PLEV) |
---|
106 | REAL :: fac1(PLEV) |
---|
107 | REAL :: fac2(PLEV) |
---|
108 | REAL :: fac3(PLEV) |
---|
109 | |
---|
110 | !--------------------------------------------------------- |
---|
111 | ! ... Modify lwc for cloud fraction and form |
---|
112 | ! liquid water path for each layer |
---|
113 | !--------------------------------------------------------- |
---|
114 | where( clouds(:) /= 0. ) |
---|
115 | del_lwp(:) = gi * lwc(:) * delp(:) * 1.e3 / clouds(:) |
---|
116 | elsewhere |
---|
117 | del_lwp(:) = 0. |
---|
118 | endwhere |
---|
119 | !--------------------------------------------------------- |
---|
120 | ! ... Form tau for each model layer |
---|
121 | !--------------------------------------------------------- |
---|
122 | where( clouds(:) /= 0. ) |
---|
123 | del_tau(:) = del_lwp(:) *.155 * clouds(:)**1.5 |
---|
124 | elsewhere |
---|
125 | del_tau(:) = 0. |
---|
126 | end where |
---|
127 | !--------------------------------------------------------- |
---|
128 | ! ... Form integrated tau from top down |
---|
129 | !--------------------------------------------------------- |
---|
130 | above_tau(1) = 0. |
---|
131 | do k = 1,PLEVM |
---|
132 | above_tau(k+1) = del_tau(k) + above_tau(k) |
---|
133 | end do |
---|
134 | !--------------------------------------------------------- |
---|
135 | ! ... Form integrated tau from bottom up |
---|
136 | !--------------------------------------------------------- |
---|
137 | below_tau(PLEV) = 0. |
---|
138 | do k = PLEVM,1,-1 |
---|
139 | below_tau(k) = del_tau(k+1) + below_tau(k+1) |
---|
140 | end do |
---|
141 | !--------------------------------------------------------- |
---|
142 | ! ... Form vertically averaged cloud cover above and below |
---|
143 | !--------------------------------------------------------- |
---|
144 | above_cld(1) = 0. |
---|
145 | do k = 1,PLEVM |
---|
146 | above_cld(k+1) = clouds(k) * del_tau(k) + above_cld(k) |
---|
147 | end do |
---|
148 | do k = 2,PLEV |
---|
149 | if( above_tau(k) /= 0. ) then |
---|
150 | above_cld(k) = above_cld(k) / above_tau(k) |
---|
151 | else |
---|
152 | above_cld(k) = above_cld(k-1) |
---|
153 | end if |
---|
154 | end do |
---|
155 | below_cld(PLEV) = 0. |
---|
156 | do k = PLEVM,1,-1 |
---|
157 | below_cld(k) = clouds(k+1) * del_tau(k+1) + below_cld(k+1) |
---|
158 | end do |
---|
159 | do k = PLEVM,1,-1 |
---|
160 | if( below_tau(k) /= 0. ) then |
---|
161 | below_cld(k) = below_cld(k) / below_tau(k) |
---|
162 | else |
---|
163 | below_cld(k) = below_cld(k+1) |
---|
164 | end if |
---|
165 | end do |
---|
166 | !--------------------------------------------------------- |
---|
167 | ! ... Modify above_tau and below_tau |
---|
168 | !--------------------------------------------------------- |
---|
169 | where( above_cld(2:PLEV) /= 0. ) |
---|
170 | above_tau(2:PLEV) = above_tau(2:PLEV) / above_cld(2:PLEV) |
---|
171 | end where |
---|
172 | where( below_cld(:PLEVM) /= 0. ) |
---|
173 | below_tau(:PLEVM) = below_tau(:PLEVM) / below_cld(:PLEVM) |
---|
174 | end where |
---|
175 | where( above_tau(2:PLEV) < 5. ) |
---|
176 | above_cld(2:PLEV) = 0. |
---|
177 | end where |
---|
178 | where( below_tau(:PLEVM) < 5. ) |
---|
179 | below_cld(:PLEVM) = 0. |
---|
180 | end where |
---|
181 | !--------------------------------------------------------- |
---|
182 | ! ... Form transmission factors |
---|
183 | !--------------------------------------------------------- |
---|
184 | above_tra(:) = (5. - EXP(-above_tau(:))) & |
---|
185 | /(4. + 0.42 * above_tau(:)) |
---|
186 | below_tra(:) = (5. - EXP(-below_tau(:))) & |
---|
187 | /(4. + 0.42 * below_tau(:)) |
---|
188 | !--------------------------------------------------------- |
---|
189 | ! ... Correction factors |
---|
190 | !--------------------------------------------------------- |
---|
191 | eff_alb(:) = srf_alb |
---|
192 | coschi = MAX( COS( zen_angle ),.5 ) |
---|
193 | where( del_lwp(:)*.155 < 5. ) |
---|
194 | fac1(:) = 0. |
---|
195 | elsewhere |
---|
196 | fac1(:) = 1.4 * coschi - 1. |
---|
197 | end where |
---|
198 | fac2(:) = MIN( 0.,1.6*coschi*above_tra(:) - 1. ) |
---|
199 | fac3(:) = MAX( 0.,(1.-below_tra(:))*coschi) |
---|
200 | |
---|
201 | DO m = 1, jdim |
---|
202 | cld_mult(m,:) = MAX (.05, 1. + fac1(:) * clouds(:) & |
---|
203 | + fac2(:) * above_cld(:) & |
---|
204 | + alpha(m) * fac3(:) * below_cld(:) ) |
---|
205 | END DO |
---|
206 | |
---|
207 | END SUBROUTINE CLOUD_MOD |
---|