source: LMDZ6/trunk/libf/phylmd/Dust/aeropt_spl.f90 @ 5445

Last change on this file since 5445 was 5337, checked in by Laurent Fairhead, 5 weeks ago

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