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

Last change on this file since 5267 was 5246, checked in by abarral, 4 days ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)
File size: 10.5 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  IMPLICIT none
13  !
14  INCLUDE "chem.h"
15  INCLUDE "dimensions.h"
16  !INCLUDE "dimphy.h"
17  INCLUDE "YOMCST.h"
18  !
19  ! Arguments:
20  !
21  !======================== 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  !============================== 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  !===================== 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   ! REAL ss_a(nb_lambda,int,nbtr-1)
53   ! 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  !
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  !
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   ! IF (rh.gt.40.) THEN
135   !     RH_num=5   ! Added by NHL temporarily
136   !     print *,'TEMPORARY CASE'
137   ! ENDIF
138  DELTA=(rh-RH_tab(RH_num))/(RH_tab(RH_num+1)-RH_tab(RH_num))
139
140
141  !*******************************************************************
142                    ! AOD at 550 NM
143  !*******************************************************************
144    alpha_acc=ss_acc550(RH_num) + DELTA*(ss_acc550(RH_num+1)- &
145          ss_acc550(RH_num))              !--m2/g
146  !nhl_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
160  !nhl_test TOTAL AOD IS NOW AOD COARSE MODE ONLY
161  !nhl_test        ztaue550(i)=ztaue550(i)+(
162  !nhl_test     .                 ss_ssalt550(RH_num)*tr_seri(i,k,3)+
163  !nhl_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
179  !*******************************************************************
180  !                   AOD at 670 NM
181  !*******************************************************************
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
210  !*******************************************************************
211                    ! AOD at 865 NM
212  !*******************************************************************
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
240  !
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)
249  !
250  RETURN
251END SUBROUTINE aeropt_spl
Note: See TracBrowser for help on using the repository browser.