source: LMDZ5/trunk/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90 @ 2172

Last change on this file since 2172 was 2171, checked in by acozic, 10 years ago

There are some commits that we must not do just before holiday .... so be back to rev 2168

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:keywords set to Author Date Id Revi
File size: 15.2 KB
RevLine 
[2004]1! $Id: readaerosol_optic_rrtm.F90 2171 2014-12-19 15:21:08Z jescribano $
2!
[2146]3SUBROUTINE readaerosol_optic_rrtm(debut, aerosol_couple,  &
4     new_aod, flag_aerosol, itap, rjourvrai, &
[2004]5     pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
[2146]6     tr_seri, mass_solu_aero, mass_solu_aero_pi, &
[2004]7     tau_aero, piz_aero, cg_aero, &
8     tausum_aero, tau3d_aero )
9
[2146]10  ! This routine will :
11  ! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol
12  ! 2) calculate the optical properties for the aerosols
13  !
14
[2004]15  USE dimphy
16  USE aero_mod
[2146]17  USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
18       concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
19       load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7
20
21  USE infotrac
22
[2004]23  IMPLICIT NONE
24  include "clesphys.h"
[2146]25  include "YOMCST.h"
[2004]26
[2146]27
28  ! Input arguments
29  !****************************************************************************************
[2004]30  LOGICAL, INTENT(IN)                      :: debut
[2146]31  LOGICAL, INTENT(IN)                      :: aerosol_couple
[2004]32  LOGICAL, INTENT(IN)                      :: new_aod
33  INTEGER, INTENT(IN)                      :: flag_aerosol
34  INTEGER, INTENT(IN)                      :: itap
35  REAL, INTENT(IN)                         :: rjourvrai
36  REAL, INTENT(IN)                         :: pdtphys
37  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
38  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
39  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
40  REAL, DIMENSION(klon,klev), INTENT(IN)   :: rhcl   ! humidite relative ciel clair
41  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
[2146]42  REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri ! concentration tracer
[2004]43
[2146]44  ! Output arguments
45  !****************************************************************************************
[2004]46  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
47  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
48  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
49  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
50  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
51  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)       :: tausum_aero
52  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
53
[2146]54  ! Local variables
55  !****************************************************************************************
56  REAL, DIMENSION(klon)        :: aerindex      ! POLDER aerosol index
57  REAL, DIMENSION(klon,klev)   :: sulfacc       ! SO4 accumulation concentration [ug/m3]
58  REAL, DIMENSION(klon,klev)   :: sulfcoarse    ! SO4 coarse concentration [ug/m3]
59  REAL, DIMENSION(klon,klev)   :: bcsol         ! BC soluble concentration [ug/m3]
60  REAL, DIMENSION(klon,klev)   :: bcins         ! BC insoluble concentration [ug/m3]
61  REAL, DIMENSION(klon,klev)   :: pomsol        ! POM soluble concentration [ug/m3]
62  REAL, DIMENSION(klon,klev)   :: pomins        ! POM insoluble concentration [ug/m3]
63  REAL, DIMENSION(klon,klev)   :: cidust        ! DUST aerosol concentration  [ug/m3]
64  REAL, DIMENSION(klon,klev)   :: sscoarse      ! SS Coarse concentration [ug/m3]
65  REAL, DIMENSION(klon,klev)   :: sssupco       ! SS Super Coarse concentration [ug/m3]
66  REAL, DIMENSION(klon,klev)   :: ssacu         ! SS Acumulation concentration [ug/m3]
67  REAL, DIMENSION(klon,klev)   :: nitracc       ! nitrate accumulation concentration [ug/m3]
68  REAL, DIMENSION(klon,klev)   :: nitrcoarse    ! nitrate coarse concentration [ug/m3]
69  REAL, DIMENSION(klon,klev)   :: nitrinscoarse ! nitrate insoluble coarse concentration [ug/m3]
70  REAL, DIMENSION(klon,klev)   :: sulfacc_pi
71  REAL, DIMENSION(klon,klev)   :: sulfcoarse_pi
[2004]72  REAL, DIMENSION(klon,klev)   :: bcsol_pi
73  REAL, DIMENSION(klon,klev)   :: bcins_pi
74  REAL, DIMENSION(klon,klev)   :: pomsol_pi
75  REAL, DIMENSION(klon,klev)   :: pomins_pi
76  REAL, DIMENSION(klon,klev)   :: cidust_pi
77  REAL, DIMENSION(klon,klev)   :: sscoarse_pi
78  REAL, DIMENSION(klon,klev)   :: sssupco_pi
79  REAL, DIMENSION(klon,klev)   :: ssacu_pi
[2146]80  REAL, DIMENSION(klon,klev)   :: nitracc_pi
81  REAL, DIMENSION(klon,klev)   :: nitrcoarse_pi
82  REAL, DIMENSION(klon,klev)   :: nitrinscoarse_pi
83  REAL, DIMENSION(klon,klev)   :: pdel, zrho
84  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
85  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF 
[2171]86  !  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer !RAF delete??
87  character(len=8), dimension(nbtr) :: tracname
[2146]88  integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
89  integer :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
[2004]90  INTEGER :: k, i
91
[2146]92  !--air density
93  zrho(:,:)=pplay(:,:)/t_seri(:,:)/RD                     !--kg/m3
[2004]94
[2146]95  !****************************************************************************************
96  ! 1) Get aerosol mass
97  !   
98  !****************************************************************************************
99  !
100  !
101  IF (aerosol_couple) THEN   !--we get aerosols from tr_seri array from INCA
102     !
103     !--copy fields from INCA tr_seri
104     !--convert to ug m-3 unit for consistency with offline fields
105     !
[2171]106#ifdef INCA
107     call tracinca_name(tracname)
108#endif
109
[2146]110     do i=1,nbtr
[2171]111        select case(trim(tracname(i)))
[2146]112           case ("ASBCM")
113              id_ASBCM = i
114           case ("ASPOMM")
115              id_ASPOMM = i
116           case ("ASSO4M")
117              id_ASSO4M = i
118           case ("ASMSAM")
119              id_ASMSAM = i
120           case ("CSSO4M")
121              id_CSSO4M = i
122           case ("CSMSAM")
123              id_CSMSAM = i
124           case ("SSSSM")
125              id_SSSSM = i
126           case ("CSSSM")
127              id_CSSSM = i
128           case ("ASSSM")
129              id_ASSSM = i
130           case ("CIDUSTM")
131              id_CIDUSTM = i
132           case ("AIBCM")
133              id_AIBCM = i
134           case ("AIPOMM")
135              id_AIPOMM = i
136           case ("ASNO3M")
137              id_ASNO3M = i
138           case ("CSNO3M")
139              id_CSNO3M = i
140           case ("CINO3M")
141              id_CINO3M = i
142           end select
143     enddo
[2004]144
145
[2146]146     bcsol(:,:)        =   tr_seri(:,:,id_ASBCM)                         *zrho(:,:)*1.e9  ! ASBCM
147     pomsol(:,:)       =   tr_seri(:,:,id_ASPOMM)                        *zrho(:,:)*1.e9  ! ASPOMM
148     sulfacc(:,:)      =  (tr_seri(:,:,id_ASSO4M)+tr_seri(:,:,id_ASMSAM))*zrho(:,:)*1.e9  ! ASSO4M (=SO4) + ASMSAM (=MSA)
149     sulfcoarse(:,:)   =  (tr_seri(:,:,id_CSSO4M)+tr_seri(:,:,id_CSMSAM))*zrho(:,:)*1.e9  ! CSSO4M (=SO4) + CSMSAM (=MSA)
150     sssupco(:,:)      =   tr_seri(:,:,id_SSSSM)                         *zrho(:,:)*1.e9  ! SSSSM
151     sscoarse(:,:)     =   tr_seri(:,:,id_CSSSM)                         *zrho(:,:)*1.e9  ! CSSSM
152     ssacu(:,:)        =   tr_seri(:,:,id_ASSSM)                         *zrho(:,:)*1.e9  ! ASSSM
153     cidust(:,:)       =   tr_seri(:,:,id_CIDUSTM)                       *zrho(:,:)*1.e9  ! CIDUSTM
154     bcins(:,:)        =   tr_seri(:,:,id_AIBCM)                         *zrho(:,:)*1.e9  ! AIBCM
155     pomins(:,:)       =   tr_seri(:,:,id_AIPOMM)                        *zrho(:,:)*1.e9  ! AIPOMM
156     nitracc(:,:)      =   tr_seri(:,:,id_ASNO3M)                        *zrho(:,:)*1.e9  ! ASNO3M
157     nitrcoarse(:,:)   =   tr_seri(:,:,id_CSNO3M)                        *zrho(:,:)*1.e9  ! CSNO3M
158     nitrinscoarse(:,:)=   tr_seri(:,:,id_CINO3M)                        *zrho(:,:)*1.e9  ! CINO3M
159     !
160     bcsol_pi(:,:)        =   0.0 ! ASBCM pre-ind
161     pomsol_pi(:,:)       =   0.0 ! ASPOMM pre-ind
162     sulfacc_pi(:,:)      =   0.0 ! ASSO4M (=SO4) + ASMSAM (=MSA) pre-ind
163     sulfcoarse_pi(:,:)   =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
164     sssupco_pi(:,:)      =   0.0 ! SSSSM pre-ind
165     sscoarse_pi(:,:)     =   0.0 ! CSSSM pre-ind
166     ssacu_pi(:,:)        =   0.0 ! ASSSM pre-ind
167     cidust_pi(:,:)       =   0.0 ! CIDUSTM pre-ind
168     bcins_pi(:,:)        =   0.0 ! AIBCM pre-ind
169     pomins_pi(:,:)       =   0.0 ! AIPOMM pre-ind
170     nitracc_pi(:,:)      =   0.0 ! ASNO3M pre-ind
171     nitrcoarse_pi(:,:)   =   0.0 ! CSNO3M pre-ind
172     nitrinscoarse_pi(:,:)=   0.0 ! CINO3M
173     !
174  ELSE !--not aerosol_couple
175     !
176     ! Read and interpolate sulfate
177     IF ( flag_aerosol .EQ. 1 .OR. &
178          flag_aerosol .EQ. 6 ) THEN
[2004]179
[2146]180        CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4)
181     ELSE
182        sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0.
183        loadso4=0.
184     END IF
[2004]185
[2146]186     ! Read and interpolate bcsol and bcins
187     IF ( flag_aerosol .EQ. 2 .OR. &
188          flag_aerosol .EQ. 6 ) THEN
[2004]189
[2146]190        ! Get bc aerosol distribution
191        CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
192        CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
193        loadbc(:)=load_tmp1(:)+load_tmp2(:)
194     ELSE
195        bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
196        bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
197        loadbc=0.
198     END IF
[2004]199
200
[2146]201     ! Read and interpolate pomsol and pomins
202     IF ( flag_aerosol .EQ. 3 .OR. &
203          flag_aerosol .EQ. 6 ) THEN
[2004]204
[2146]205        CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
206        CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
207        loadoa(:)=load_tmp3(:)+load_tmp4(:)
208     ELSE
209        pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
210        pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
211        loadoa=0.
212     END IF
[2004]213
214
[2146]215     ! Read and interpolate csssm, ssssm, assssm
216     IF (flag_aerosol .EQ. 4 .OR. &
217          flag_aerosol .EQ. 6 ) THEN
[2004]218
[2148]219        CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys,rjourvrai, &
220        debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
221        CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys,rjourvrai, &
222        debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
223        CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys, rjourvrai, &
224        debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
[2146]225        loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
226     ELSE
227        sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
228        ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0.
229        sssupco(:,:)  = 0. ; sssupco_pi = 0.
230        loadss=0.
231     ENDIF
[2004]232
[2146]233     ! Read and interpolate cidustm
234     IF (flag_aerosol .EQ. 5 .OR.  &
235          flag_aerosol .EQ. 6 ) THEN
[2004]236
[2146]237        CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
238
239     ELSE
240        cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
241        loaddust=0.
242     ENDIF
243     !
244     sulfcoarse(:,:)      =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA)
245     sulfcoarse_pi(:,:)   =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
246     !
247     !--placeholder for offline nitrate   
248     !
249     nitracc(:,:)         =   0.0
250     nitracc_pi(:,:)      =   0.0
251     nitrcoarse(:,:)      =   0.0
252     nitrcoarse_pi(:,:)   =   0.0
253     nitrinscoarse(:,:)   =   0.0
254     nitrinscoarse_pi(:,:)=   0.0
255
256  ENDIF !--not aerosol_couple
257
258  !
259  ! Store all aerosols in one variable
260  !
261  m_allaer(:,:,id_ASBCM_phy)  = bcsol(:,:)        ! ASBCM
262  m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:)       ! ASPOMM
263  m_allaer(:,:,id_ASSO4M_phy) = sulfacc(:,:)      ! ASSO4M (= SO4)
264  m_allaer(:,:,id_CSSO4M_phy) = sulfcoarse(:,:)   ! CSSO4M
265  m_allaer(:,:,id_SSSSM_phy)  = sssupco(:,:)      ! SSSSM
266  m_allaer(:,:,id_CSSSM_phy)  = sscoarse(:,:)     ! CSSSM
267  m_allaer(:,:,id_ASSSM_phy)  = ssacu(:,:)        ! ASSSM
268  m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:)       ! CIDUSTM
269  m_allaer(:,:,id_AIBCM_phy)  = bcins(:,:)        ! AIBCM
270  m_allaer(:,:,id_ASNO3M_phy) = nitracc(:,:)      ! ASNO3M
271  m_allaer(:,:,id_CSNO3M_phy) = nitrcoarse(:,:)   ! CSNO3M
272  m_allaer(:,:,id_CINO3M_phy) = nitrinscoarse(:,:)! CINO3M
273  m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:)       ! AIPOMM
274  m_allaer(:,:,id_STRAT_phy)  = 0.0
275
276  !RAF
277  m_allaer_pi(:,:,id_ASBCM_phy)  = bcsol_pi(:,:)        ! ASBCM pre-ind
278  m_allaer_pi(:,:,id_ASPOMM_phy) = pomsol_pi(:,:)       ! ASPOMM pre-ind
279  m_allaer_pi(:,:,id_ASSO4M_phy) = sulfacc_pi(:,:)      ! ASSO4M (= SO4) pre-ind
280  m_allaer_pi(:,:,id_CSSO4M_phy) = sulfcoarse_pi(:,:)   ! CSSO4M pre-ind
281  m_allaer_pi(:,:,id_SSSSM_phy)  = sssupco_pi(:,:)      ! SSSSM pre-ind
282  m_allaer_pi(:,:,id_CSSSM_phy)  = sscoarse_pi(:,:)     ! CSSSM pre-ind
283  m_allaer_pi(:,:,id_ASSSM_phy)  = ssacu_pi(:,:)        ! ASSSM pre-ind
284  m_allaer_pi(:,:,id_CIDUSTM_phy)= cidust_pi(:,:)       ! CIDUSTM pre-ind
285  m_allaer_pi(:,:,id_AIBCM_phy)  = bcins_pi(:,:)        ! AIBCM pre-ind
286  m_allaer_pi(:,:,id_ASNO3M_phy) = nitracc_pi(:,:)      ! ASNO3M pre-ind
287  m_allaer_pi(:,:,id_CSNO3M_phy) = nitrcoarse_pi(:,:)   ! CSNO3M pre-ind
288  m_allaer_pi(:,:,id_CINO3M_phy) = nitrinscoarse_pi(:,:)! CINO3M pre-ind
289  m_allaer_pi(:,:,id_AIPOMM_phy) = pomins_pi(:,:)       ! AIPOMM pre-ind
290  m_allaer_pi(:,:,id_STRAT_phy)  = 0.0
291
292  !
293  ! Calculate the total mass of all soluble aersosols
294  ! to be revisited for AR6
295  mass_solu_aero(:,:)    = sulfacc(:,:)    + bcsol(:,:)    + pomsol(:,:)   + nitracc(:,:)   ! + &
296  !                           sscoarse(:,:)    + ssacu(:,:)    + sssupco(:,:)
297  mass_solu_aero_pi(:,:) = sulfacc_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + nitracc_pi(:,:) ! + &
298  !                           sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:)
299
300  !****************************************************************************************
301  ! 2) Calculate optical properties for the aerosols
302  !
303  !****************************************************************************************
[2004]304  DO k = 1, klev
305     DO i = 1, klon
306        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
307     END DO
308  END DO
309
[2146]310  ! aeropt_6bands for rrtm
[2004]311  CALL aeropt_6bands_rrtm( &
[2146]312       pdel, m_allaer, pdtphys, rhcl, &
313       tau_aero, piz_aero, cg_aero,   &
314       m_allaer_pi, flag_aerosol, &
315       zrho )
[2004]316
[2146]317  ! aeropt_5wv only for validation and diagnostics
318  CALL aeropt_5wv_rrtm(                    &
319       pdel, m_allaer,                &
320       pdtphys, rhcl, aerindex,       &
321       flag_aerosol, pplay, t_seri,   &
322       tausum_aero, tau3d_aero )
[2004]323
[2146]324  ! Diagnostics calculation for CMIP5 protocol
325  sconcso4(:)  =m_allaer(:,1,id_ASSO4M_phy)*1.e-9
326  sconcno3(:)  =(m_allaer(:,1,id_ASNO3M_phy)+m_allaer(:,1,id_CSNO3M_phy)+m_allaer(:,1,id_CINO3M_phy))*1.e-9
327  sconcoa(:)   =(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
328  sconcbc(:)   =(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
329  sconcss(:)   =(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
330  sconcdust(:) =m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
331  concso4(:,:) =m_allaer(:,:,id_ASSO4M_phy)*1.e-9
332  concno3(:,:) =(m_allaer(:,:,id_ASNO3M_phy)+m_allaer(:,:,id_CSNO3M_phy)+m_allaer(:,:,id_CINO3M_phy))*1.e-9
333  concoa(:,:)  =(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
334  concbc(:,:)  =(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
335  concss(:,:)  =(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
336  concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
337
[2004]338END SUBROUTINE readaerosol_optic_rrtm
Note: See TracBrowser for help on using the repository browser.