Context Navigation

aeropt_spl_F_20140902 @ 2196

Last change on this file since 2196 was 2175, checked in by jescribano, 10 years ago
SPLA code included for first time
File size: 8.6 KB

Line
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	DATA ss_dust/0.5345737, 0.5878828, 0.6772957/ !for bin 0.5-3um radius
67	DATA ss_dustsco/0.1009634, 0.1018700, 0.1031178/ !for bin 3-15um radius
68	DATA ss_ssalt550/0.182,0.182,0.182,0.182,0.366,0.430,
69	. 0.484,0.551,0.648,0.724,0.847,1.218/ !for bin 0.5-20 um, fit_v2
70	DATA ss_ssalt670/0.193,0.193,0.193,0.193,0.377,0.431,
71	. 0.496,0.587,0.693,0.784,0.925,1.257/ !for bin 0.5-20 um
72	DATA ss_ssalt865/0.188,0.188,0.188,0.188,0.384,0.443,
73	. 0.502,0.580,0.699,0.799,0.979,1.404/ !for bin 0.5-20 um
74
75	DATA RH_tab/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./
76	c
77	DO i=1, klon
78	ztaue550(i)=0.0
79	ztaue670(i)=0.0
80	ztaue865(i)=0.0
81	taue550_tr2(i)=0.0
82	taue670_tr2(i)=0.0
83	taue865_tr2(i)=0.0
84	taue550_ss(i)=0.0
85	taue670_ss(i)=0.0
86	taue865_ss(i)=0.0
87	taue550_dust(i)=0.0
88	taue670_dust(i)=0.0
89	taue865_dust(i)=0.0
90	taue550_dustsco(i)=0.0
91	taue670_dustsco(i)=0.0
92	taue865_dustsco(i)=0.0
93	burden_ss(i)=0.0
94	ENDDO
95
96	DO k=1, klev
97	DO i=1, klon
98	c
99	rh=MIN(RHcl(i,k)*100.,RH_MAX)
100	RH_num = INT( rh/10. + 1.)
101	IF (rh.gt.85.) RH_num=10
102	IF (rh.gt.90.) RH_num=11
103	c IF (rh.gt.40.) THEN
104	c RH_num=5 ! Added by NHL temporarily
105	c print *,'TEMPORARY CASE'
106	c ENDIF
107	DELTA=(rh-RH_tab(RH_num))/(RH_tab(RH_num+1)-RH_tab(RH_num))
108
109
110	c*******************************************************************
111	c AOD at 550 NM
112	c*******************************************************************
113	alpha_acc=ss_acc550(RH_num) + DELTA*(ss_acc550(RH_num+1)-
114	. ss_acc550(RH_num)) !--m2/g
115	cnhl_test TOTAL AOD
116	ztaue550(i)=ztaue550(i)+(alpha_acc*tr_seri(i,k,id_fine)+
117	. ss_ssalt550(RH_num)*tr_seri(i,k,id_coss)+
118	. ss_dust(1)*tr_seri(i,k,id_codu)+
119	. ss_dustsco(1)tr_seri(i,k,id_scdu) )zdz(i,k)*1.e6
120	cnhl_test TOTAL AOD IS NOW AOD COARSE MODE ONLY
121	cnhl_test ztaue550(i)=ztaue550(i)+(
122	cnhl_test . ss_ssalt550(RH_num)*tr_seri(i,k,3)+
123	cnhl_test . ss_dust(1)tr_seri(i,k,4))zdz(i,k)*1.e6
124
125	taue550_tr2(i)=taue550_tr2(i)+alpha_acctr_seri(i,k,id_fine)
126	. zdz(i,k)*1.e6
127	taue550_ss(i)=taue550_ss(i)+
128	. ss_ssalt550(RH_num)tr_seri(i,k,id_coss)
129	. zdz(i,k)*1.e6
130	taue550_dust(i)=taue550_dust(i)+ss_dust(1)tr_seri(i,k,id_codu)
131	. zdz(i,k)*1.e6
132	taue550_dustsco(i)=taue550_dustsco(i)+
133	. ss_dustsco(1)tr_seri(i,k,id_scdu)
134	. zdz(i,k)*1.e6
135	! print *,'taue550_ss = ',SUM(taue550_ss),MINVAL(taue550_ss),
136	! . MAXVAL(taue550_ss)
137
138	c*******************************************************************
139	c AOD at 670 NM
140	c*******************************************************************
141	alpha_acc=ss_acc670(RH_num) + DELTA*(ss_acc670(RH_num+1)-
142	. ss_acc670(RH_num)) !--m2/g
143	ztaue670(i)=ztaue670(i)+(alpha_acc*tr_seri(i,k,id_fine)+
144	. ss_ssalt670(RH_num)*tr_seri(i,k,id_coss)+
145	. ss_dust(2)*tr_seri(i,k,id_codu)+
146	. ss_dustsco(2)tr_seri(i,k,id_scdu))zdz(i,k)*1.e6
147	taue670_tr2(i)=taue670_tr2(i)+alpha_acctr_seri(i,k,id_fine)
148	. zdz(i,k)*1.e6
149	taue670_ss(i)=taue670_ss(i)+
150	. ss_ssalt670(RH_num)tr_seri(i,k,id_coss)
151	. zdz(i,k)*1.e6
152	taue670_dust(i)=taue670_dust(i)+ss_dust(2)tr_seri(i,k,id_codu)
153	. zdz(i,k)*1.e6
154	taue670_dustsco(i)=taue550_dustsco(i)+
155	. ss_dustsco(2)tr_seri(i,k,id_scdu)
156	. zdz(i,k)*1.e6
157
158	c*******************************************************************
159	c AOD at 865 NM
160	c*******************************************************************
161	alpha_acc=ss_acc865(RH_num) + DELTA*(ss_acc865(RH_num+1)-
162	. ss_acc865(RH_num)) !--m2/g
163	ztaue865(i)=ztaue865(i)+(alpha_acc*tr_seri(i,k,id_fine)+
164	. ss_ssalt865(RH_num)*tr_seri(i,k,id_coss)+
165	. ss_dust(3)*tr_seri(i,k,id_codu)+
166	. ss_dustsco(3)tr_seri(i,k,id_scdu))zdz(i,k)*1.e6
167	taue865_tr2(i)=taue865_tr2(i)+alpha_acctr_seri(i,k,id_fine)
168	. zdz(i,k)*1.e6
169	taue865_ss(i)=taue865_ss(i)+
170	. ss_ssalt865(RH_num)tr_seri(i,k,id_coss)
171	. zdz(i,k)*1.e6
172	taue865_dust(i)=taue865_dust(i)+ss_dust(3)tr_seri(i,k,id_codu)
173	. zdz(i,k)*1.e6
174	taue865_dustsco(i)=taue550_dustsco(i)+
175	. ss_dustsco(3)tr_seri(i,k,id_scdu)
176	. zdz(i,k)*1.e6
177
178
179	c
180	burden_ss(i)=burden_ss(i)+tr_seri(i,k,id_coss)1.e61.e3*zdz(i,k)
181	ENDDO !-loop on klev
182	ENDDO !-loop on klon
183	! print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)),
184	! . MAXVAL(tr_seri(:,:,3))
185	! print *,'taue550_ss = ',SUM(taue550_ss),MINVAL(taue550_ss),
186	! . MAXVAL(taue550_ss)
187	c
188	RETURN
189	END

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

Download in other formats:

Original Format