source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/aeropt_spl.f90 @ 5113

Last change on this file since 5113 was 5105, checked in by abarral, 2 months ago

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