source: LMDZ6/trunk/libf/phylmd/Dust/splaeropt_6bands_rrtm.F90 @ 3956

Last change on this file since 3956 was 3770, checked in by asima, 4 years ago

Update variable name : absvisaer --> abs550aer
File size: 10.6 KB
Line 
1!
2! $Id: splaeropt_6bands_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $
3!
4SUBROUTINE SPLAEROPT_6BANDS_RRTM ( &
5     zdm, tr_seri, RHcl,           &
6     tau_allaer, piz_allaer, cg_allaer )
7
8  USE dimphy
9  USE aero_mod
10  USE infotrac_phy
11  USE phys_local_var_mod, ONLY: abs550aer
12
13  ! Olivier Boucher Jan 2017
14  ! based on Mie routines on ciclad CMIP6
15  !
16  IMPLICIT NONE
17
18  INCLUDE "clesphys.h"
19  !
20  ! Input arguments:
21  !
22  REAL, DIMENSION(klon,klev),     INTENT(IN)  :: zdm        !--hauteur des couches en kg/m2
23  REAL, DIMENSION(klon,klev),     INTENT(IN)  :: RHcl       ! humidite relative ciel clair
24  REAL, DIMENSION(klon,klev,nbtr),INTENT(IN)  :: tr_seri
25  !
26  ! Output arguments:
27  ! 2= total aerosols
28  ! 1= natural aerosols
29  !
30  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: tau_allaer ! epaisseur optique aerosol
31  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: piz_allaer ! single scattering albedo aerosol
32  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: cg_allaer  ! asymmetry parameter aerosol
33  !
34  ! Local
35  !
36  LOGICAL :: soluble
37  INTEGER :: i, k, irh, itr, inu
38  INTEGER :: aerindex, spsol, spinsol
39  INTEGER :: RH_num(klon,klev)
40
41  INTEGER, PARAMETER :: naero_soluble=2    ! 1- accumulation soluble; 2- coarse soluble
42  INTEGER, PARAMETER :: naero_insoluble=2  ! 1- coarse dust; 2- supercoarse dust
43  INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble
44
45  INTEGER, PARAMETER :: nbre_RH=12
46  REAL,PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
47  REAL, PARAMETER :: RH_MAX=95.
48  REAL :: delta(klon,klev), rh(klon,klev)
49  REAL :: tau_ae2b_int   ! Intermediate computation of epaisseur optique aerosol
50  REAL :: piz_ae2b_int   ! Intermediate computation of Single scattering albedo
51  REAL :: cg_ae2b_int    ! Intermediate computation of Assymetry parameter
52  REAL :: fact_RH(nbre_RH), tmp_var
53  !
54  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) ::  tau_ae
55  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) ::  piz_ae
56  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) ::  cg_ae
57  !
58  ! Proprietes optiques
59  !
60  REAL:: alpha_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble)   !--unit m2/g aer
61  REAL:: alpha_aeri_6bands(nbands_sw_rrtm,naero_insoluble)         !--unit m2/g aer
62  REAL:: cg_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble)      !--unitless
63  REAL:: cg_aeri_6bands(nbands_sw_rrtm,naero_insoluble)            !--unitless
64  REAL:: piz_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble)     !--unitless
65  REAL:: piz_aeri_6bands(nbands_sw_rrtm,naero_insoluble)           !--unitless
66  !
67  REAL, PARAMETER :: tau_min = 1.e-8
68  CHARACTER*20 modname
69
70!***************************************************************************
71!--the order of the soluble   species has to follow the spsol   index below
72!--the order of the insoluble species has to follow the spinsol index below
73
74  DATA alpha_aers_6bands/  &
75       ! accumulation (sulfate+2% bc) mode soluble
76  5.212, 5.212, 5.212, 5.212, 6.973, 7.581, 8.349, 9.400,11.078,12.463,14.857,20.837, &
77  4.906, 4.906, 4.906, 4.906, 6.568, 7.195, 7.989, 9.088,10.869,12.354,14.951,21.545, &
78  3.940, 3.940, 3.940, 3.940, 5.291, 5.861, 6.591, 7.620, 9.332,10.791,13.410,20.370, &
79  2.292, 2.292, 2.292, 2.292, 3.105, 3.493, 3.996, 4.724, 5.978, 7.084, 9.146,15.067, &
80  0.762, 0.762, 0.762, 0.762, 1.050, 1.201, 1.401, 1.699, 2.232, 2.721, 3.675, 6.678, &
81  0.090, 0.090, 0.090, 0.090, 0.122, 0.141, 0.166, 0.204, 0.275, 0.344, 0.484, 0.973, &
82        ! coarse seasalt
83  0.547, 0.657, 0.705, 0.754, 0.817, 0.896, 1.008, 1.169, 1.456, 1.724, 2.199, 3.358, &
84  0.566, 0.679, 0.727, 0.776, 0.840, 0.920, 1.032, 1.196, 1.492, 1.760, 2.238, 3.416, &
85  0.596, 0.714, 0.764, 0.816, 0.882, 0.965, 1.081, 1.250, 1.552, 1.828, 2.310, 3.509, &
86  0.644, 0.771, 0.825, 0.880, 0.951, 1.040, 1.164, 1.345, 1.666, 1.957, 2.462, 3.700, &
87  0.640, 0.772, 0.829, 0.887, 0.965, 1.061, 1.198, 1.398, 1.758, 2.085, 2.658, 4.031, &
88  0.452, 0.562, 0.609, 0.659, 0.728, 0.813, 0.938, 1.125, 1.471, 1.797, 2.384, 3.855  /
89
90  DATA alpha_aeri_6bands/  &
91       ! coarse dust insoluble
92  0.594, 0.610, 0.619, 0.762, 0.791, 0.495, &
93       ! supercoarse dust insoluble
94  0.151, 0.152, 0.155, 0.159, 0.168, 0.167  /
95
96  DATA cg_aers_6bands/ &
97       ! accumulation (sulfate+2% bc) mode soluble
98  0.692, 0.692, 0.692, 0.692, 0.735, 0.739, 0.744, 0.749, 0.755, 0.759, 0.765, 0.772, &
99  0.690, 0.690, 0.690, 0.690, 0.736, 0.740, 0.746, 0.752, 0.760, 0.765, 0.771, 0.779, &
100  0.678, 0.678, 0.678, 0.678, 0.727, 0.733, 0.740, 0.748, 0.759, 0.766, 0.775, 0.787, &
101  0.641, 0.641, 0.641, 0.641, 0.692, 0.700, 0.710, 0.721, 0.736, 0.746, 0.760, 0.781, &
102  0.553, 0.553, 0.553, 0.553, 0.603, 0.615, 0.627, 0.643, 0.664, 0.678, 0.699, 0.735, &
103  0.343, 0.343, 0.343, 0.343, 0.386, 0.399, 0.414, 0.433, 0.460, 0.480, 0.510, 0.569, &
104       ! seasalt coarse Soluble
105  0.754, 0.770, 0.776, 0.781, 0.784, 0.791, 0.797, 0.805, 0.815, 0.822, 0.828, 0.840, &
106  0.736, 0.753, 0.759, 0.765, 0.771, 0.778, 0.785, 0.793, 0.804, 0.811, 0.820, 0.831, &
107  0.716, 0.735, 0.742, 0.748, 0.754, 0.762, 0.769, 0.778, 0.789, 0.796, 0.807, 0.819, &
108  0.704, 0.725, 0.733, 0.739, 0.745, 0.752, 0.759, 0.768, 0.778, 0.784, 0.792, 0.803, &
109  0.716, 0.737, 0.744, 0.751, 0.756, 0.763, 0.770, 0.777, 0.786, 0.790, 0.795, 0.800, &
110  0.688, 0.730, 0.741, 0.751, 0.761, 0.771, 0.782, 0.795, 0.810, 0.820, 0.833, 0.849  /
111
112  DATA cg_aeri_6bands/ &
113       ! coarse dust insoluble
114  0.801, 0.779, 0.709, 0.698, 0.710, 0.687, &
115       ! super coarse dust insoluble
116  0.862, 0.871, 0.852, 0.799, 0.758, 0.651  /
117
118  DATA piz_aers_6bands/&
119       ! accumulation (sulfate+2% bc) mode soluble
120  0.941, 0.941, 0.941, 0.941, 0.958, 0.961, 0.965, 0.969, 0.974, 0.977, 0.981, 0.987, &
121  0.941, 0.941, 0.941, 0.941, 0.959, 0.963, 0.967, 0.971, 0.976, 0.979, 0.983, 0.988, &
122  0.953, 0.953, 0.953, 0.953, 0.967, 0.971, 0.974, 0.978, 0.982, 0.984, 0.988, 0.992, &
123  0.955, 0.955, 0.955, 0.955, 0.969, 0.972, 0.976, 0.980, 0.984, 0.986, 0.989, 0.994, &
124  0.936, 0.936, 0.936, 0.936, 0.955, 0.961, 0.966, 0.972, 0.978, 0.982, 0.987, 0.993, &
125  0.792, 0.792, 0.792, 0.792, 0.848, 0.867, 0.887, 0.907, 0.931, 0.944, 0.960, 0.980, &
126       ! seasalt coarse soluble
127  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.001, 1.000, &
128  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
129  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
130  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
131  0.994, 0.994, 0.995, 0.995, 0.995, 0.995, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, &
132  0.976, 0.867, 0.837, 0.814, 0.796, 0.774, 0.754, 0.735, 0.713, 0.702, 0.690, 0.675  /
133
134  DATA piz_aeri_6bands/ &
135       ! coarse dust insoluble
136  0.866, 0.875, 0.915, 0.977, 0.993, 0.971, &
137       ! super coarse dust insoluble
138  0.789, 0.749, 0.791, 0.918, 0.970, 0.909  /
139!
140  spsol = 0
141  spinsol = 0
142
143  modname='splaeropt_6bands_rrt'
144
145  IF (NSW.NE.nbands_sw_rrtm) THEN
146     CALL abort_physic(modname,'Erreur NSW doit etre egal a 6 pour cette routine',1)
147  ENDIF
148
149  DO irh=1,nbre_RH-1
150    fact_RH(irh)=1./(RH_tab(irh+1)-RH_tab(irh))
151  ENDDO
152   
153  DO k=1, klev
154    DO i=1, klon
155      rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
156      RH_num(i,k) = INT(rh(i,k)/10. + 1.)
157      IF (rh(i,k).GT.85.) RH_num(i,k)=10
158      IF (rh(i,k).GT.90.) RH_num(i,k)=11
159      delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
160    ENDDO
161  ENDDO
162
163  tau_ae(:,:,:,:)=0.
164  piz_ae(:,:,:,:)=0.
165  cg_ae(:,:,:,:)=0.
166   
167  DO itr=1, nbtr
168
169    IF (tname(itr+nqo)=='PREC') THEN       !--precursor
170      CYCLE
171    ELSE IF (tname(itr+nqo)=='FINE') THEN  !--fine mode accumulation mode
172      soluble=.TRUE.
173      spsol=1
174      aerindex=1
175    ELSE IF (tname(itr+nqo)=='COSS') THEN  !--coarse mode sea salt
176      soluble=.TRUE.
177      spsol=2
178      aerindex=2
179    ELSE IF (tname(itr+nqo)=='CODU') THEN  !--coarse mode dust
180      soluble=.FALSE.
181      spinsol=1
182      aerindex=3
183    ELSE IF (tname(itr+nqo)=='SCDU') THEN  !--super coarse mode dust
184      soluble=.FALSE.
185      spinsol=2
186      aerindex=4
187    ELSE
188       CALL abort_physic(modname,'I cannot do aerosol optics for '//tname(itr+nqo),1)
189    ENDIF
190
191    IF (soluble) THEN ! For aerosol soluble components
192
193         DO k=1, klev
194           DO i=1, klon
195
196             tmp_var=tr_seri(i,k,itr)*zdm(i,k) !-- g/m2
197
198             DO inu=1,NSW
199
200               tau_ae2b_int= alpha_aers_6bands(RH_num(i,k),inu,spsol)+ &
201                             delta(i,k)* (alpha_aers_6bands(RH_num(i,k)+1,inu,spsol) - &
202                             alpha_aers_6bands(RH_num(i,k),inu,spsol))
203                   
204               piz_ae2b_int = piz_aers_6bands(RH_num(i,k),inu,spsol) + &
205                              delta(i,k)* (piz_aers_6bands(RH_num(i,k)+1,inu,spsol) - &
206                              piz_aers_6bands(RH_num(i,k),inu,spsol))
207                   
208               cg_ae2b_int = cg_aers_6bands(RH_num(i,k),inu,spsol) + &
209                             delta(i,k)* (cg_aers_6bands(RH_num(i,k)+1,inu,spsol) - &
210                             cg_aers_6bands(RH_num(i,k),inu,spsol))
211
212               tau_ae(i,k,aerindex,inu)    = tmp_var*tau_ae2b_int
213               piz_ae(i,k,aerindex,inu)    = piz_ae2b_int
214               cg_ae(i,k,aerindex,inu)     = cg_ae2b_int
215
216             ENDDO
217           ENDDO
218         ENDDO
219
220    ELSE    ! For all aerosol insoluble components
221
222       DO k=1, klev
223         DO i=1, klon
224
225           tmp_var=tr_seri(i,k,itr)*zdm(i,k) !-- g/m2
226
227           DO inu=1,NSW
228             tau_ae2b_int = alpha_aeri_6bands(inu,spinsol)
229             piz_ae2b_int = piz_aeri_6bands(inu,spinsol)
230             cg_ae2b_int = cg_aeri_6bands(inu,spinsol)
231
232             tau_ae(i,k,aerindex,inu) = tmp_var*tau_ae2b_int
233             piz_ae(i,k,aerindex,inu) = piz_ae2b_int
234             cg_ae(i,k,aerindex,inu)= cg_ae2b_int
235           ENDDO
236         ENDDO
237       ENDDO
238
239     ENDIF ! soluble / insoluble
240
241  ENDDO  ! nbtr
242
243!--all (natural + anthropogenic) aerosol
244  tau_allaer(:,:,2,:)=SUM(tau_ae(:,:,1:naero,:),dim=3)
245  tau_allaer(:,:,2,:)=MAX(tau_allaer(:,:,2,:),tau_min)
246
247  piz_allaer(:,:,2,:)=SUM(tau_ae(:,:,1:naero,:)*piz_ae(:,:,1:naero,:),dim=3)/tau_allaer(:,:,2,:)
248  piz_allaer(:,:,2,:)=MIN(MAX(piz_allaer(:,:,2,:),0.01),1.0)
249  WHERE (tau_allaer(:,:,2,:).LE.tau_min) piz_allaer(:,:,2,:)=1.0
250
251  cg_allaer(:,:,2,:)=SUM(tau_ae(:,:,1:naero,:)*piz_ae(:,:,1:naero,:)*cg_ae(:,:,1:naero,:),dim=3)/  &
252                     (tau_allaer(:,:,2,:)*piz_allaer(:,:,2,:))
253  cg_allaer(:,:,2,:)=MIN(MAX(cg_allaer(:,:,2,:),0.0),1.0)
254
255!--no aerosol
256  tau_allaer(:,:,1,:)=tau_min
257  piz_allaer(:,:,1,:)=1.0
258  cg_allaer(:,:,1,:)=0.0
259
260!--waveband 2 and all aerosol (third index = 2)
261  inu=2
262  abs550aer(:)=SUM((1-piz_allaer(:,:,2,inu))*tau_allaer(:,:,2,inu),dim=2)
263
264END SUBROUTINE SPLAEROPT_6BANDS_RRTM
Note: See TracBrowser for help on using the repository browser.