source: LMDZ6/branches/blowing_snow/libf/phylmd/Dust/aeropt_spl.F

Last change on this file was 2630, checked in by fhourdin, 8 years ago

Importation du modèle d'aérosols de Boucher, Escribano et al.
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)
9c
10      USE dimphy
11      USE infotrac
12      IMPLICIT none
13c
14#include "chem.h"
15#include "dimensions.h"
16c #include "dimphy.h"
17#include "YOMCST.h"
18c
19c Arguments:
20c
21c======================== 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
27c============================== 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
43c===================== 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
52c      REAL ss_a(nb_lambda,int,nbtr-1)
53c      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./
90c
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
129c     
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
134c      IF (rh.gt.40.) THEN
135c          RH_num=5   ! Added by NHL temporarily
136c          print *,'TEMPORARY CASE'
137c      ENDIF
138      DELTA=(rh-RH_tab(RH_num))/(RH_tab(RH_num+1)-RH_tab(RH_num))
139
140
141c*******************************************************************
142c                       AOD at 550 NM
143c*******************************************************************
144        alpha_acc=ss_acc550(RH_num) + DELTA*(ss_acc550(RH_num+1)-
145     .            ss_acc550(RH_num))              !--m2/g
146cnhl_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)+auxreal*zdz(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
160cnhl_test TOTAL AOD IS NOW AOD COARSE MODE ONLY
161cnhl_test        ztaue550(i)=ztaue550(i)+(                     
162cnhl_test     .                 ss_ssalt550(RH_num)*tr_seri(i,k,3)+
163cnhl_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_acc*tr_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
179c*******************************************************************
180c                       AOD at 670 NM
181c*******************************************************************
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)+auxreal*zdz(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_acc*tr_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
210c*******************************************************************
211c                       AOD at 865 NM
212c*******************************************************************
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)+auxreal*zdz(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_acc*tr_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
240c
241      IF(id_coss>0)  burden_ss(i)=burden_ss(i)
242     .                +tr_seri(i,k,id_coss)*1.e6*1.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)
249c
250      RETURN
251      END
Note: See TracBrowser for help on using the repository browser.