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

Last change on this file since 5284 was 5274, checked in by abarral, 3 days ago

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