Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

aeropt_spl.F @ 2720

Last change on this file since 2720 was 2641, checked in by Laurent Fairhead, 8 years ago
Merged trunk changes r2593:2640 into testing branch
File size: 11.4 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format