1 | SUBROUTINE aeropt_spl(zdz, tr_seri, RHcl, |
---|
2 | . id_prec, id_fine, id_coss, id_codu, id_scdu, |
---|
3 | . ztaue550,ztaue670,ztaue865, |
---|
4 | . taue550_tr2,taue670_tr2,taue865_tr2, |
---|
5 | . taue550_ss,taue670_ss,taue865_ss, |
---|
6 | . taue550_dust,taue670_dust,taue865_dust, |
---|
7 | . taue550_dustsco,taue670_dustsco,taue865_dustsco) |
---|
8 | c |
---|
9 | USE dimphy |
---|
10 | USE infotrac |
---|
11 | IMPLICIT none |
---|
12 | c |
---|
13 | #include "chem.h" |
---|
14 | #include "dimensions.h" |
---|
15 | c #include "dimphy.h" |
---|
16 | #include "YOMCST.h" |
---|
17 | c |
---|
18 | c Arguments: |
---|
19 | c |
---|
20 | c======================== INPUT ================================== |
---|
21 | REAL zdz(klon,klev) |
---|
22 | REAL tr_seri(klon,klev,nbtr) ! masse of tracer |
---|
23 | REAL RHcl(klon,klev) ! humidite relativen ciel clair |
---|
24 | INTEGER id_prec, id_fine, id_coss, id_codu, id_scdu |
---|
25 | c============================== OUTPUT ================================= |
---|
26 | REAL ztaue550(klon) ! epaisseur optique aerosol 550 nm |
---|
27 | REAL ztaue670(klon) ! epaisseur optique aerosol 670 nm |
---|
28 | REAL ztaue865(klon) ! epaisseur optique aerosol 865 nm |
---|
29 | REAL taue550_tr2(klon) ! epaisseur optique aerosol 550 nm, diagnostic |
---|
30 | REAL taue670_tr2(klon) ! epaisseur optique aerosol 670 nm, diagnostic |
---|
31 | REAL taue865_tr2(klon) ! epaisseur optique aerosol 865 nm, diagnostic |
---|
32 | REAL taue550_ss(klon) ! epaisseur optique aerosol 550 nm, diagnostic |
---|
33 | REAL taue670_ss(klon) ! epaisseur optique aerosol 670 nm, diagnostic |
---|
34 | REAL taue865_ss(klon) ! epaisseur optique aerosol 865 nm, diagnostic |
---|
35 | REAL taue550_dust(klon) ! epaisseur optique aerosol 550 nm, diagnostic |
---|
36 | REAL taue670_dust(klon) ! epaisseur optique aerosol 670 nm, diagnostic |
---|
37 | REAL taue865_dust(klon) ! epaisseur optique aerosol 865 nm, diagnostic |
---|
38 | REAL taue550_dustsco(klon) ! epaisseur optique aerosol 550 nm, diagnostic |
---|
39 | REAL taue670_dustsco(klon) ! epaisseur optique aerosol 670 nm, diagnostic |
---|
40 | REAL taue865_dustsco(klon) ! epaisseur optique aerosol 865 nm, diagnostic |
---|
41 | c===================== LOCAL VARIABLES =========================== |
---|
42 | INTEGER nb_lambda,nbre_RH |
---|
43 | PARAMETER (nb_lambda=3,nbre_RH=12) |
---|
44 | INTEGER i, k, RH_num |
---|
45 | REAL rh, RH_MAX, DELTA, RH_tab(nbre_RH) |
---|
46 | PARAMETER (RH_MAX=95.) |
---|
47 | INTEGER rh_int |
---|
48 | PARAMETER (rh_int=12) |
---|
49 | c REAL ss_a(nb_lambda,rh_int,nbtr-1) |
---|
50 | c DATA ss_a/72*1./ |
---|
51 | REAL ss_dust(nb_lambda), ss_acc550(rh_int), alpha_acc |
---|
52 | REAL ss_dustsco(nb_lambda) |
---|
53 | REAL ss_acc670(rh_int), ss_acc865(rh_int) |
---|
54 | REAL ss_ssalt550(rh_int) |
---|
55 | REAL ss_ssalt670(rh_int), ss_ssalt865(rh_int) |
---|
56 | REAL burden_ss(klon) |
---|
57 | DATA ss_acc550 /3.135,3.135,3.135, 3.135, 4.260, 4.807, |
---|
58 | . 5.546,6.651,8.641,10.335,13.534,22.979/ |
---|
59 | DATA ss_acc670 /2.220,2.220,2.220, 2.220, 3.048, 3.460, |
---|
60 | . 4.023,4.873,6.426, 7.761,10.322,18.079/ |
---|
61 | DATA ss_acc865 /1.329,1.329,1.329, 1.329, 1.855, 2.124, |
---|
62 | . 2.494,3.060,4.114, 5.033, 6.831,12.457/ |
---|
63 | !old4tracers DATA ss_dust/0.564, 0.614, 0.700/ !for bin 0.5-10um |
---|
64 | ! DATA ss_dust/0.553117, 0.610185, 0.7053460 / !for bin 0.5-3um radius |
---|
65 | ! DATA ss_dustsco/0.1014, 0.102156, 0.1035538 / !for bin 3-15um radius |
---|
66 | !20140902 DATA ss_dust/0.5345737, 0.5878828, 0.6772957/ !for bin 0.5-3um radius |
---|
67 | !20140902 DATA ss_dustsco/0.1009634, 0.1018700, 0.1031178/ !for bin 3-15um radius |
---|
68 | !3days DATA ss_dust/0.4564216, 0.4906738, 0.5476248/ !for bin 0.5-3um radius |
---|
69 | !3days DATA ss_dustsco/0.1015022, 0.1024051, 0.1036622/ !for bin 3-15um radius |
---|
70 | !JE20140911 DATA ss_dust/0.5167768,0.5684330,0.6531643/ !for bin 0.5-3um radius |
---|
71 | !JE20140911 DATA ss_dustsco/0.1003391,0.1012288,0.1024651/ !for bin 3-15um radius |
---|
72 | !JE20140915 DATA ss_dust/0.3188754,0.3430106,0.3829019/ !for bin 0.5-5um radius |
---|
73 | !JE20140915 DATA ss_dustsco/8.0582686E-02,8.1255026E-02,8.1861295E-02/ !for bin 5-15um radius |
---|
74 | DATA ss_dust/0.5167768,0.5684330,0.6531643/ !for bin 0.5-3um radius |
---|
75 | DATA ss_dustsco/0.1003391,0.1012288,0.1024651/ !for bin 3-15um radius |
---|
76 | |
---|
77 | |
---|
78 | DATA ss_ssalt550/0.182,0.182,0.182,0.182,0.366,0.430, |
---|
79 | . 0.484,0.551,0.648,0.724,0.847,1.218/ !for bin 0.5-20 um, fit_v2 |
---|
80 | DATA ss_ssalt670/0.193,0.193,0.193,0.193,0.377,0.431, |
---|
81 | . 0.496,0.587,0.693,0.784,0.925,1.257/ !for bin 0.5-20 um |
---|
82 | DATA ss_ssalt865/0.188,0.188,0.188,0.188,0.384,0.443, |
---|
83 | . 0.502,0.580,0.699,0.799,0.979,1.404/ !for bin 0.5-20 um |
---|
84 | |
---|
85 | DATA RH_tab/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./ |
---|
86 | c |
---|
87 | DO i=1, klon |
---|
88 | ztaue550(i)=0.0 |
---|
89 | ztaue670(i)=0.0 |
---|
90 | ztaue865(i)=0.0 |
---|
91 | taue550_tr2(i)=0.0 |
---|
92 | taue670_tr2(i)=0.0 |
---|
93 | taue865_tr2(i)=0.0 |
---|
94 | taue550_ss(i)=0.0 |
---|
95 | taue670_ss(i)=0.0 |
---|
96 | taue865_ss(i)=0.0 |
---|
97 | taue550_dust(i)=0.0 |
---|
98 | taue670_dust(i)=0.0 |
---|
99 | taue865_dust(i)=0.0 |
---|
100 | taue550_dustsco(i)=0.0 |
---|
101 | taue670_dustsco(i)=0.0 |
---|
102 | taue865_dustsco(i)=0.0 |
---|
103 | burden_ss(i)=0.0 |
---|
104 | ENDDO |
---|
105 | |
---|
106 | DO k=1, klev |
---|
107 | DO i=1, klon |
---|
108 | c |
---|
109 | rh=MIN(RHcl(i,k)*100.,RH_MAX) |
---|
110 | RH_num = INT( rh/10. + 1.) |
---|
111 | IF (rh.gt.85.) RH_num=10 |
---|
112 | IF (rh.gt.90.) RH_num=11 |
---|
113 | c IF (rh.gt.40.) THEN |
---|
114 | c RH_num=5 ! Added by NHL temporarily |
---|
115 | c print *,'TEMPORARY CASE' |
---|
116 | c ENDIF |
---|
117 | DELTA=(rh-RH_tab(RH_num))/(RH_tab(RH_num+1)-RH_tab(RH_num)) |
---|
118 | |
---|
119 | |
---|
120 | c******************************************************************* |
---|
121 | c AOD at 550 NM |
---|
122 | c******************************************************************* |
---|
123 | alpha_acc=ss_acc550(RH_num) + DELTA*(ss_acc550(RH_num+1)- |
---|
124 | . ss_acc550(RH_num)) !--m2/g |
---|
125 | cnhl_test TOTAL AOD |
---|
126 | ztaue550(i)=ztaue550(i)+(alpha_acc*tr_seri(i,k,id_fine)+ |
---|
127 | . ss_ssalt550(RH_num)*tr_seri(i,k,id_coss)+ |
---|
128 | . ss_dust(1)*tr_seri(i,k,id_codu)+ |
---|
129 | . ss_dustsco(1)*tr_seri(i,k,id_scdu) )*zdz(i,k)*1.e6 |
---|
130 | cnhl_test TOTAL AOD IS NOW AOD COARSE MODE ONLY |
---|
131 | cnhl_test ztaue550(i)=ztaue550(i)+( |
---|
132 | cnhl_test . ss_ssalt550(RH_num)*tr_seri(i,k,3)+ |
---|
133 | cnhl_test . ss_dust(1)*tr_seri(i,k,4))*zdz(i,k)*1.e6 |
---|
134 | |
---|
135 | taue550_tr2(i)=taue550_tr2(i)+alpha_acc*tr_seri(i,k,id_fine)* |
---|
136 | . zdz(i,k)*1.e6 |
---|
137 | taue550_ss(i)=taue550_ss(i)+ |
---|
138 | . ss_ssalt550(RH_num)*tr_seri(i,k,id_coss)* |
---|
139 | . zdz(i,k)*1.e6 |
---|
140 | taue550_dust(i)=taue550_dust(i)+ss_dust(1)*tr_seri(i,k,id_codu)* |
---|
141 | . zdz(i,k)*1.e6 |
---|
142 | taue550_dustsco(i)=taue550_dustsco(i)+ |
---|
143 | . ss_dustsco(1)*tr_seri(i,k,id_scdu)* |
---|
144 | . zdz(i,k)*1.e6 |
---|
145 | ! print *,'taue550_ss = ',SUM(taue550_ss),MINVAL(taue550_ss), |
---|
146 | ! . MAXVAL(taue550_ss) |
---|
147 | |
---|
148 | c******************************************************************* |
---|
149 | c AOD at 670 NM |
---|
150 | c******************************************************************* |
---|
151 | alpha_acc=ss_acc670(RH_num) + DELTA*(ss_acc670(RH_num+1)- |
---|
152 | . ss_acc670(RH_num)) !--m2/g |
---|
153 | ztaue670(i)=ztaue670(i)+(alpha_acc*tr_seri(i,k,id_fine)+ |
---|
154 | . ss_ssalt670(RH_num)*tr_seri(i,k,id_coss)+ |
---|
155 | . ss_dust(2)*tr_seri(i,k,id_codu)+ |
---|
156 | . ss_dustsco(2)*tr_seri(i,k,id_scdu))*zdz(i,k)*1.e6 |
---|
157 | taue670_tr2(i)=taue670_tr2(i)+alpha_acc*tr_seri(i,k,id_fine)* |
---|
158 | . zdz(i,k)*1.e6 |
---|
159 | taue670_ss(i)=taue670_ss(i)+ |
---|
160 | . ss_ssalt670(RH_num)*tr_seri(i,k,id_coss)* |
---|
161 | . zdz(i,k)*1.e6 |
---|
162 | taue670_dust(i)=taue670_dust(i)+ss_dust(2)*tr_seri(i,k,id_codu)* |
---|
163 | . zdz(i,k)*1.e6 |
---|
164 | taue670_dustsco(i)=taue550_dustsco(i)+ |
---|
165 | . ss_dustsco(2)*tr_seri(i,k,id_scdu)* |
---|
166 | . zdz(i,k)*1.e6 |
---|
167 | |
---|
168 | c******************************************************************* |
---|
169 | c AOD at 865 NM |
---|
170 | c******************************************************************* |
---|
171 | alpha_acc=ss_acc865(RH_num) + DELTA*(ss_acc865(RH_num+1)- |
---|
172 | . ss_acc865(RH_num)) !--m2/g |
---|
173 | ztaue865(i)=ztaue865(i)+(alpha_acc*tr_seri(i,k,id_fine)+ |
---|
174 | . ss_ssalt865(RH_num)*tr_seri(i,k,id_coss)+ |
---|
175 | . ss_dust(3)*tr_seri(i,k,id_codu)+ |
---|
176 | . ss_dustsco(3)*tr_seri(i,k,id_scdu))*zdz(i,k)*1.e6 |
---|
177 | taue865_tr2(i)=taue865_tr2(i)+alpha_acc*tr_seri(i,k,id_fine)* |
---|
178 | . zdz(i,k)*1.e6 |
---|
179 | taue865_ss(i)=taue865_ss(i)+ |
---|
180 | . ss_ssalt865(RH_num)*tr_seri(i,k,id_coss)* |
---|
181 | . zdz(i,k)*1.e6 |
---|
182 | taue865_dust(i)=taue865_dust(i)+ss_dust(3)*tr_seri(i,k,id_codu)* |
---|
183 | . zdz(i,k)*1.e6 |
---|
184 | taue865_dustsco(i)=taue550_dustsco(i)+ |
---|
185 | . ss_dustsco(3)*tr_seri(i,k,id_scdu)* |
---|
186 | . zdz(i,k)*1.e6 |
---|
187 | |
---|
188 | |
---|
189 | c |
---|
190 | burden_ss(i)=burden_ss(i)+tr_seri(i,k,id_coss)*1.e6*1.e3*zdz(i,k) |
---|
191 | ENDDO !-loop on klev |
---|
192 | ENDDO !-loop on klon |
---|
193 | ! print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)), |
---|
194 | ! . MAXVAL(tr_seri(:,:,3)) |
---|
195 | ! print *,'taue550_ss = ',SUM(taue550_ss),MINVAL(taue550_ss), |
---|
196 | ! . MAXVAL(taue550_ss) |
---|
197 | c |
---|
198 | RETURN |
---|
199 | END |
---|