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

Last change on this file since 2284 was 2180, checked in by acozic, 10 years ago

After checking I reload commit 2169 and 2170
  • 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.0 KB
RevLine 
[2004]1! $Id: readaerosol_optic_rrtm.F90 2180 2015-01-16 13:15:03Z jyg $
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 
[2180]86
[2146]87  integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
88  integer :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
[2004]89  INTEGER :: k, i
90
[2146]91  !--air density
92  zrho(:,:)=pplay(:,:)/t_seri(:,:)/RD                     !--kg/m3
[2004]93
[2146]94  !****************************************************************************************
95  ! 1) Get aerosol mass
96  !   
97  !****************************************************************************************
98  !
99  !
100  IF (aerosol_couple) THEN   !--we get aerosols from tr_seri array from INCA
101     !
102     !--copy fields from INCA tr_seri
103     !--convert to ug m-3 unit for consistency with offline fields
104     !
105     do i=1,nbtr
[2180]106        select case(trim(solsym(i)))
[2146]107           case ("ASBCM")
108              id_ASBCM = i
109           case ("ASPOMM")
110              id_ASPOMM = i
111           case ("ASSO4M")
112              id_ASSO4M = i
113           case ("ASMSAM")
114              id_ASMSAM = i
115           case ("CSSO4M")
116              id_CSSO4M = i
117           case ("CSMSAM")
118              id_CSMSAM = i
119           case ("SSSSM")
120              id_SSSSM = i
121           case ("CSSSM")
122              id_CSSSM = i
123           case ("ASSSM")
124              id_ASSSM = i
125           case ("CIDUSTM")
126              id_CIDUSTM = i
127           case ("AIBCM")
128              id_AIBCM = i
129           case ("AIPOMM")
130              id_AIPOMM = i
131           case ("ASNO3M")
132              id_ASNO3M = i
133           case ("CSNO3M")
134              id_CSNO3M = i
135           case ("CINO3M")
136              id_CINO3M = i
137           end select
138     enddo
[2004]139
140
[2146]141     bcsol(:,:)        =   tr_seri(:,:,id_ASBCM)                         *zrho(:,:)*1.e9  ! ASBCM
142     pomsol(:,:)       =   tr_seri(:,:,id_ASPOMM)                        *zrho(:,:)*1.e9  ! ASPOMM
143     sulfacc(:,:)      =  (tr_seri(:,:,id_ASSO4M)+tr_seri(:,:,id_ASMSAM))*zrho(:,:)*1.e9  ! ASSO4M (=SO4) + ASMSAM (=MSA)
144     sulfcoarse(:,:)   =  (tr_seri(:,:,id_CSSO4M)+tr_seri(:,:,id_CSMSAM))*zrho(:,:)*1.e9  ! CSSO4M (=SO4) + CSMSAM (=MSA)
145     sssupco(:,:)      =   tr_seri(:,:,id_SSSSM)                         *zrho(:,:)*1.e9  ! SSSSM
146     sscoarse(:,:)     =   tr_seri(:,:,id_CSSSM)                         *zrho(:,:)*1.e9  ! CSSSM
147     ssacu(:,:)        =   tr_seri(:,:,id_ASSSM)                         *zrho(:,:)*1.e9  ! ASSSM
148     cidust(:,:)       =   tr_seri(:,:,id_CIDUSTM)                       *zrho(:,:)*1.e9  ! CIDUSTM
149     bcins(:,:)        =   tr_seri(:,:,id_AIBCM)                         *zrho(:,:)*1.e9  ! AIBCM
150     pomins(:,:)       =   tr_seri(:,:,id_AIPOMM)                        *zrho(:,:)*1.e9  ! AIPOMM
151     nitracc(:,:)      =   tr_seri(:,:,id_ASNO3M)                        *zrho(:,:)*1.e9  ! ASNO3M
152     nitrcoarse(:,:)   =   tr_seri(:,:,id_CSNO3M)                        *zrho(:,:)*1.e9  ! CSNO3M
153     nitrinscoarse(:,:)=   tr_seri(:,:,id_CINO3M)                        *zrho(:,:)*1.e9  ! CINO3M
154     !
155     bcsol_pi(:,:)        =   0.0 ! ASBCM pre-ind
156     pomsol_pi(:,:)       =   0.0 ! ASPOMM pre-ind
157     sulfacc_pi(:,:)      =   0.0 ! ASSO4M (=SO4) + ASMSAM (=MSA) pre-ind
158     sulfcoarse_pi(:,:)   =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
159     sssupco_pi(:,:)      =   0.0 ! SSSSM pre-ind
160     sscoarse_pi(:,:)     =   0.0 ! CSSSM pre-ind
161     ssacu_pi(:,:)        =   0.0 ! ASSSM pre-ind
162     cidust_pi(:,:)       =   0.0 ! CIDUSTM pre-ind
163     bcins_pi(:,:)        =   0.0 ! AIBCM pre-ind
164     pomins_pi(:,:)       =   0.0 ! AIPOMM pre-ind
165     nitracc_pi(:,:)      =   0.0 ! ASNO3M pre-ind
166     nitrcoarse_pi(:,:)   =   0.0 ! CSNO3M pre-ind
167     nitrinscoarse_pi(:,:)=   0.0 ! CINO3M
168     !
169  ELSE !--not aerosol_couple
170     !
171     ! Read and interpolate sulfate
172     IF ( flag_aerosol .EQ. 1 .OR. &
173          flag_aerosol .EQ. 6 ) THEN
[2004]174
[2146]175        CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4)
176     ELSE
177        sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0.
178        loadso4=0.
179     END IF
[2004]180
[2146]181     ! Read and interpolate bcsol and bcins
182     IF ( flag_aerosol .EQ. 2 .OR. &
183          flag_aerosol .EQ. 6 ) THEN
[2004]184
[2146]185        ! Get bc aerosol distribution
186        CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
187        CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
188        loadbc(:)=load_tmp1(:)+load_tmp2(:)
189     ELSE
190        bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
191        bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
192        loadbc=0.
193     END IF
[2004]194
195
[2146]196     ! Read and interpolate pomsol and pomins
197     IF ( flag_aerosol .EQ. 3 .OR. &
198          flag_aerosol .EQ. 6 ) THEN
[2004]199
[2146]200        CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
201        CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
202        loadoa(:)=load_tmp3(:)+load_tmp4(:)
203     ELSE
204        pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
205        pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
206        loadoa=0.
207     END IF
[2004]208
209
[2146]210     ! Read and interpolate csssm, ssssm, assssm
211     IF (flag_aerosol .EQ. 4 .OR. &
212          flag_aerosol .EQ. 6 ) THEN
[2004]213
[2148]214        CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys,rjourvrai, &
215        debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
216        CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys,rjourvrai, &
217        debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
218        CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys, rjourvrai, &
219        debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
[2146]220        loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
221     ELSE
222        sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
223        ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0.
224        sssupco(:,:)  = 0. ; sssupco_pi = 0.
225        loadss=0.
226     ENDIF
[2004]227
[2146]228     ! Read and interpolate cidustm
229     IF (flag_aerosol .EQ. 5 .OR.  &
230          flag_aerosol .EQ. 6 ) THEN
[2004]231
[2146]232        CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
233
234     ELSE
235        cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
236        loaddust=0.
237     ENDIF
238     !
239     sulfcoarse(:,:)      =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA)
240     sulfcoarse_pi(:,:)   =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
241     !
242     !--placeholder for offline nitrate   
243     !
244     nitracc(:,:)         =   0.0
245     nitracc_pi(:,:)      =   0.0
246     nitrcoarse(:,:)      =   0.0
247     nitrcoarse_pi(:,:)   =   0.0
248     nitrinscoarse(:,:)   =   0.0
249     nitrinscoarse_pi(:,:)=   0.0
250
251  ENDIF !--not aerosol_couple
252
253  !
254  ! Store all aerosols in one variable
255  !
256  m_allaer(:,:,id_ASBCM_phy)  = bcsol(:,:)        ! ASBCM
257  m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:)       ! ASPOMM
258  m_allaer(:,:,id_ASSO4M_phy) = sulfacc(:,:)      ! ASSO4M (= SO4)
259  m_allaer(:,:,id_CSSO4M_phy) = sulfcoarse(:,:)   ! CSSO4M
260  m_allaer(:,:,id_SSSSM_phy)  = sssupco(:,:)      ! SSSSM
261  m_allaer(:,:,id_CSSSM_phy)  = sscoarse(:,:)     ! CSSSM
262  m_allaer(:,:,id_ASSSM_phy)  = ssacu(:,:)        ! ASSSM
263  m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:)       ! CIDUSTM
264  m_allaer(:,:,id_AIBCM_phy)  = bcins(:,:)        ! AIBCM
265  m_allaer(:,:,id_ASNO3M_phy) = nitracc(:,:)      ! ASNO3M
266  m_allaer(:,:,id_CSNO3M_phy) = nitrcoarse(:,:)   ! CSNO3M
267  m_allaer(:,:,id_CINO3M_phy) = nitrinscoarse(:,:)! CINO3M
268  m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:)       ! AIPOMM
269  m_allaer(:,:,id_STRAT_phy)  = 0.0
270
271  !RAF
272  m_allaer_pi(:,:,id_ASBCM_phy)  = bcsol_pi(:,:)        ! ASBCM pre-ind
273  m_allaer_pi(:,:,id_ASPOMM_phy) = pomsol_pi(:,:)       ! ASPOMM pre-ind
274  m_allaer_pi(:,:,id_ASSO4M_phy) = sulfacc_pi(:,:)      ! ASSO4M (= SO4) pre-ind
275  m_allaer_pi(:,:,id_CSSO4M_phy) = sulfcoarse_pi(:,:)   ! CSSO4M pre-ind
276  m_allaer_pi(:,:,id_SSSSM_phy)  = sssupco_pi(:,:)      ! SSSSM pre-ind
277  m_allaer_pi(:,:,id_CSSSM_phy)  = sscoarse_pi(:,:)     ! CSSSM pre-ind
278  m_allaer_pi(:,:,id_ASSSM_phy)  = ssacu_pi(:,:)        ! ASSSM pre-ind
279  m_allaer_pi(:,:,id_CIDUSTM_phy)= cidust_pi(:,:)       ! CIDUSTM pre-ind
280  m_allaer_pi(:,:,id_AIBCM_phy)  = bcins_pi(:,:)        ! AIBCM pre-ind
281  m_allaer_pi(:,:,id_ASNO3M_phy) = nitracc_pi(:,:)      ! ASNO3M pre-ind
282  m_allaer_pi(:,:,id_CSNO3M_phy) = nitrcoarse_pi(:,:)   ! CSNO3M pre-ind
283  m_allaer_pi(:,:,id_CINO3M_phy) = nitrinscoarse_pi(:,:)! CINO3M pre-ind
284  m_allaer_pi(:,:,id_AIPOMM_phy) = pomins_pi(:,:)       ! AIPOMM pre-ind
285  m_allaer_pi(:,:,id_STRAT_phy)  = 0.0
286
287  !
288  ! Calculate the total mass of all soluble aersosols
289  ! to be revisited for AR6
290  mass_solu_aero(:,:)    = sulfacc(:,:)    + bcsol(:,:)    + pomsol(:,:)   + nitracc(:,:)   ! + &
291  !                           sscoarse(:,:)    + ssacu(:,:)    + sssupco(:,:)
292  mass_solu_aero_pi(:,:) = sulfacc_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + nitracc_pi(:,:) ! + &
293  !                           sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:)
294
295  !****************************************************************************************
296  ! 2) Calculate optical properties for the aerosols
297  !
298  !****************************************************************************************
[2004]299  DO k = 1, klev
300     DO i = 1, klon
301        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
302     END DO
303  END DO
304
[2146]305  ! aeropt_6bands for rrtm
[2004]306  CALL aeropt_6bands_rrtm( &
[2146]307       pdel, m_allaer, pdtphys, rhcl, &
308       tau_aero, piz_aero, cg_aero,   &
309       m_allaer_pi, flag_aerosol, &
310       zrho )
[2004]311
[2146]312  ! aeropt_5wv only for validation and diagnostics
313  CALL aeropt_5wv_rrtm(                    &
314       pdel, m_allaer,                &
315       pdtphys, rhcl, aerindex,       &
316       flag_aerosol, pplay, t_seri,   &
317       tausum_aero, tau3d_aero )
[2004]318
[2146]319  ! Diagnostics calculation for CMIP5 protocol
320  sconcso4(:)  =m_allaer(:,1,id_ASSO4M_phy)*1.e-9
321  sconcno3(:)  =(m_allaer(:,1,id_ASNO3M_phy)+m_allaer(:,1,id_CSNO3M_phy)+m_allaer(:,1,id_CINO3M_phy))*1.e-9
322  sconcoa(:)   =(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
323  sconcbc(:)   =(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
324  sconcss(:)   =(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
325  sconcdust(:) =m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
326  concso4(:,:) =m_allaer(:,:,id_ASSO4M_phy)*1.e-9
327  concno3(:,:) =(m_allaer(:,:,id_ASNO3M_phy)+m_allaer(:,:,id_CSNO3M_phy)+m_allaer(:,:,id_CINO3M_phy))*1.e-9
328  concoa(:,:)  =(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
329  concbc(:,:)  =(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
330  concss(:,:)  =(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
331  concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
332
[2004]333END SUBROUTINE readaerosol_optic_rrtm
Note: See TracBrowser for help on using the repository browser.