source: LMDZ5/trunk/libf/phylmd/Dust/splaeropt_5wv_rrtm.F90 @ 2867

Last change on this file since 2867 was 2753, checked in by oboucher, 8 years ago

Adding aerosol properties to Dust version

File size: 6.1 KB
Line 
1!
2! $Id: splaeropt_5wv_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $
3!
4
5SUBROUTINE SPLAEROPT_5WV_RRTM(  &
6   zdm, zdh, tr_seri, RHcl,     &
7   tausum, tau )
8
9  USE DIMPHY
10  USE aero_mod
11  USE infotrac_phy
12  USE phys_local_var_mod, ONLY: od550aer,od865aer,ec550aer,od550lt1aer
13  !
14  ! Olivier Boucher Jan 2017
15  ! Based on Mie routines on ciclad CMIP6
16  !
17  IMPLICIT NONE
18  !
19  ! Input arguments:
20  !
21  REAL, DIMENSION(klon,klev), INTENT(IN)   :: zdh      !--m
22  REAL, DIMENSION(klon,klev), INTENT(IN)   :: zdm      !--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  !
28  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)      :: tausum
29  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau
30  !
31  ! Local
32  !
33  INTEGER, PARAMETER :: las = nwave_sw
34  LOGICAL :: soluble
35 
36  INTEGER :: i, k, m, itr, irh, aerindex
37  INTEGER :: spsol, spinsol, la
38  INTEGER :: RH_num(klon,klev)
39  INTEGER, PARAMETER :: la443 = 1
40  INTEGER, PARAMETER :: la550 = 2
41  INTEGER, PARAMETER :: la670 = 3
42  INTEGER, PARAMETER :: la765 = 4
43  INTEGER, PARAMETER :: la865 = 5
44  INTEGER, PARAMETER :: nbre_RH=12
45  INTEGER, PARAMETER :: naero_soluble=2
46  INTEGER, PARAMETER :: naero_insoluble=2
47  INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble
48
49  REAL, PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
50  REAL, PARAMETER :: RH_MAX=95.
51  REAL :: delta(klon,klev), rh(klon,klev)
52  REAL :: tau_ae5wv_int   ! Intermediate computation of epaisseur optique aerosol
53  REAL :: zrho
54  CHARACTER*20 modname
55 
56  ! Soluble components 1-accumulation mode soluble; 2- seasalt coarse
57  REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble)   ! Ext. coeff. ** m2/g
58  ! Insoluble components 1- Dust: 2- BC; 3- POM
59  REAL :: alpha_aeri_5wv(las,naero_insoluble)         ! Ext. coeff. ** m2/g
60  !
61  ! Proprietes optiques
62  !
63  REAL :: fact_RH(nbre_RH)
64
65! From here on we look at the optical parameters at 5 wavelengths: 
66! 443nm, 550, 670, 765 and 865 nm
67!                                   le 12 AVRIL 2006
68
69 DATA alpha_aers_5wv/ &
70                           ! accumulation mode (sulfate+2% bc) soluble
71       4.632, 4.632, 4.632, 4.632, 6.206, 6.827, 7.616, 8.716,10.514,12.025,14.688,21.539, &
72       3.981, 3.981, 3.981, 3.981, 5.346, 5.923, 6.662, 7.704, 9.437,10.914,13.562,20.591, &
73       3.265, 3.265, 3.265, 3.265, 4.400, 4.909, 5.565, 6.500, 8.081, 9.449,11.943,18.791, &
74       2.761, 2.761, 2.761, 2.761, 3.731, 4.182, 4.767, 5.606, 7.041, 8.294,10.610,17.118, &
75       2.307, 2.307, 2.307, 2.307, 3.129, 3.522, 4.034, 4.774, 6.052, 7.180, 9.286,15.340, &
76
77                           ! seasalt seasalt Coarse Soluble (CS)     
78       0.576, 0.690, 0.738, 0.789, 0.855, 0.935, 1.046, 1.212, 1.512, 1.785, 2.258, 3.449, &
79       0.595, 0.713, 0.763, 0.814, 0.880, 0.963, 1.079, 1.248, 1.550, 1.826, 2.306, 3.507, &
80       0.617, 0.738, 0.789, 0.842, 0.911, 0.996, 1.113, 1.286, 1.592, 1.871, 2.369, 3.562, &
81       0.632, 0.755, 0.808, 0.862, 0.931, 1.018, 1.140, 1.316, 1.626, 1.909, 2.409, 3.622, &
82       0.645, 0.771, 0.825, 0.880, 0.951, 1.039, 1.164, 1.344, 1.661, 1.948, 2.455, 3.682  /
83
84  DATA alpha_aeri_5wv/ &
85                                 ! coarse dust insoluble
86       0.605, 0.611, 0.661, 0.714, 0.760, &
87                                 ! super coarse insoluble
88       0.153, 0.156, 0.158, 0.157, 0.161 /
89  !
90  ! Initialisations
91  tausum(:,:,:)=0.
92  tau(:,:,:,:)=0.
93
94  modname='splaeropt_5wv_rrtm'
95
96  IF (naero.GT.naero_tot) THEN
97    CALL abort_physic(modname,'Too many aerosol types',1)
98  ENDIF
99
100  DO irh=1,nbre_RH-1
101    fact_RH(irh)=1./(RH_tab(irh+1)-RH_tab(irh))
102  ENDDO
103   
104  DO k=1, klev
105    DO i=1, klon
106      rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
107      RH_num(i,k) = INT( rh(i,k)/10. + 1.)
108      IF (rh(i,k).GT.85.) RH_num(i,k)=10
109      IF (rh(i,k).GT.90.) RH_num(i,k)=11
110      delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
111    ENDDO
112  ENDDO
113
114  DO itr=1,nbtr    !--loop over tracers 
115
116    IF (tname(itr+nqo)=='PREC') THEN       !--fine mode accumulation mode
117      CYCLE
118    ELSE IF (tname(itr+nqo)=='FINE') THEN  !--fine mode accumulation mode
119      soluble=.TRUE.
120      spsol=1
121      aerindex=1
122    ELSE IF (tname(itr+nqo)=='COSS') THEN  !--coarse mode sea salt
123      soluble=.TRUE.
124      spsol=2
125      aerindex=2
126    ELSE IF (tname(itr+nqo)=='CODU') THEN  !--coarse mode dust
127      soluble=.FALSE.
128      spinsol=1
129      aerindex=3
130    ELSE IF (tname(itr+nqo)=='SCDU') THEN  !--super coarse mode dust
131      soluble=.FALSE.
132      spinsol=2
133      aerindex=4
134    ELSE
135       CALL abort_physic(modname,'I cannot do aerosol optics for '//tname(itr+nqo),1)
136    ENDIF
137
138    DO la=1,las
139
140      !--only 550 and 865 nm are used
141      IF (la.NE.la550.AND.la.NE.la865) CYCLE
142
143      IF (soluble) THEN  !--soluble aerosol with RH dependence
144
145        DO k=1, klev
146          DO i=1, klon
147            tau_ae5wv_int = alpha_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
148                           (alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - &
149                            alpha_aers_5wv(RH_num(i,k),la,spsol))
150            tau(i,k,la,aerindex) = tr_seri(i,k,itr)*zdm(i,k)*tau_ae5wv_int
151            tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
152          ENDDO
153        ENDDO
154
155      ELSE               !--cases of insoluble aerosol
156
157        DO k=1, klev
158          DO i=1, klon
159            tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
160            tau(i,k,la,aerindex) = tr_seri(i,k,itr)*zdm(i,k)*tau_ae5wv_int
161            tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex)
162          ENDDO
163        ENDDO
164
165      ENDIF
166
167    ENDDO   ! Boucle sur les longueurs d'onde
168  ENDDO     ! Boucle sur les masses de traceurs
169
170!--AOD calculations for diagnostics
171  od550aer(:)=SUM(tausum(:,la550,1:naero),dim=2)
172  od865aer(:)=SUM(tausum(:,la865,1:naero),dim=2)
173
174!--extinction coefficient for diagnostic
175  ec550aer(:,:)=SUM(tau(:,:,la550,1:naero),dim=3)/zdh(:,:)
176
177!--aod for particles lower than 1 micron
178  od550lt1aer(:)=tausum(:,la550,1)+tausum(:,la550,2)*0.3+tausum(:,la550,3)*0.2
179
180END SUBROUTINE SPLAEROPT_5WV_RRTM
Note: See TracBrowser for help on using the repository browser.