source: LMDZ5/trunk/libf/phylmd/readaerosol_optic.F90 @ 2237

Last change on this file since 2237 was 2146, checked in by idelkadi, 10 years ago

Les modifications introduites ont pour but :
1/ d'autoriser le couplage entre INCA-aerosol et les parametrisations de
la nouvelle physique (NP) de LMDZ, en particulier les thermiques et le
transport convectif,
2/ generaliser les routines de calcul de proprietes optiques des
aerosols pour RRTM au cas ou les aerosols sont interactifs
3/ d'inclure les effets LW des aerosols stratospheriques pour RRTM

  • 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 Revision
File size: 9.9 KB
RevLine 
[1179]1! $Id: readaerosol_optic.F90 2146 2014-11-14 20:22:21Z fhourdin $
2!
[1237]3SUBROUTINE readaerosol_optic(debut, new_aod, flag_aerosol, itap, rjourvrai, &
4     pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
[1183]5     mass_solu_aero, mass_solu_aero_pi, &
[1181]6     tau_aero, piz_aero, cg_aero, &
7     tausum_aero, tau3d_aero )
[1179]8
9! This routine will :
10! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol
11! 2) calculate the optical properties for the aerosols
12!
[1150]13 
14  USE dimphy
[1183]15  USE aero_mod
[2146]16  USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
17      concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
[1337]18      load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7
[1150]19  IMPLICIT NONE
20
21! Input arguments
[1179]22!****************************************************************************************
[1150]23  LOGICAL, INTENT(IN)                      :: debut
24  LOGICAL, INTENT(IN)                      :: new_aod
25  INTEGER, INTENT(IN)                      :: flag_aerosol
[1237]26  INTEGER, INTENT(IN)                      :: itap
[1150]27  REAL, INTENT(IN)                         :: rjourvrai
28  REAL, INTENT(IN)                         :: pdtphys
29  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
30  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
31  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
32  REAL, DIMENSION(klon,klev), INTENT(IN)   :: rhcl   ! humidite relative ciel clair
[1221]33  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
[1150]34
35! Output arguments
[1179]36!****************************************************************************************
[1183]37  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
38  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
[1181]39  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
40  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
41  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
[2003]42!  REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT)       :: tausum_aero
43!  REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT)  :: tau3d_aero
44!--correction mini bug OB
45  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)       :: tausum_aero
46  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
[1150]47
48! Local variables
[1179]49!****************************************************************************************
[1150]50  REAL, DIMENSION(klon)        :: aerindex ! POLDER aerosol index
51  REAL, DIMENSION(klon,klev)   :: sulfate  ! SO4 aerosol concentration [ug/m3]
52  REAL, DIMENSION(klon,klev)   :: bcsol    ! BC soluble concentration [ug/m3]
53  REAL, DIMENSION(klon,klev)   :: bcins    ! BC insoluble concentration [ug/m3]
54  REAL, DIMENSION(klon,klev)   :: pomsol   ! POM soluble concentration [ug/m3]
55  REAL, DIMENSION(klon,klev)   :: pomins   ! POM insoluble concentration [ug/m3]
[1181]56  REAL, DIMENSION(klon,klev)   :: cidust    ! DUST aerosol concentration  [ug/m3]
57  REAL, DIMENSION(klon,klev)   :: sscoarse  ! SS Coarse concentration [ug/m3]
58  REAL, DIMENSION(klon,klev)   :: sssupco   ! SS Super Coarse concentration [ug/m3]
59  REAL, DIMENSION(klon,klev)   :: ssacu     ! SS Acumulation concentration [ug/m3]
[1150]60  REAL, DIMENSION(klon,klev)   :: sulfate_pi
61  REAL, DIMENSION(klon,klev)   :: bcsol_pi
62  REAL, DIMENSION(klon,klev)   :: bcins_pi
63  REAL, DIMENSION(klon,klev)   :: pomsol_pi
64  REAL, DIMENSION(klon,klev)   :: pomins_pi
[1181]65  REAL, DIMENSION(klon,klev)   :: cidust_pi
66  REAL, DIMENSION(klon,klev)   :: sscoarse_pi
67  REAL, DIMENSION(klon,klev)   :: sssupco_pi
68  REAL, DIMENSION(klon,klev)   :: ssacu_pi
[1150]69  REAL, DIMENSION(klon,klev)   :: pdel
[1181]70  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer
[1246]71  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer_pi !RAF 
72!  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer !RAF delete??
[1150]73
[1179]74  INTEGER :: k, i
[1150]75 
[1179]76!****************************************************************************************
77! 1) Get aerosol mass
78!   
79!****************************************************************************************
80! Read and interpolate sulfate
[1150]81  IF ( flag_aerosol .EQ. 1 .OR. &
82       flag_aerosol .EQ. 6 ) THEN
83
[2146]84     CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4)
[1179]85  ELSE
86     sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0.
[1337]87     loadso4=0.
[1179]88  END IF
[1150]89
[1179]90! Read and interpolate bcsol and bcins
[1150]91  IF ( flag_aerosol .EQ. 2 .OR. &
[1181]92       flag_aerosol .EQ. 6 ) THEN
[1150]93
94     ! Get bc aerosol distribution
[2146]95     CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
96     CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
[1337]97     loadbc(:)=load_tmp1(:)+load_tmp2(:)
[1179]98  ELSE
99     bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
100     bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
[1337]101     loadbc=0.
[1179]102  END IF
[1150]103
104
[1179]105! Read and interpolate pomsol and pomins
[1150]106  IF ( flag_aerosol .EQ. 3 .OR. &
107       flag_aerosol .EQ. 6 ) THEN
108
[2146]109     CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
110     CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
[1337]111     loadoa(:)=load_tmp3(:)+load_tmp4(:)
[1179]112  ELSE
113     pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
114     pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
[1337]115     loadoa=0.
[1179]116  END IF
[1150]117
118
[1181]119! Read and interpolate csssm, ssssm, assssm
120  IF (flag_aerosol .EQ. 4 .OR. &
121      flag_aerosol .EQ. 6 ) THEN
122
[2146]123      CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
124      CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
125      CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
[1337]126     loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
[1181]127  ELSE
128     sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
[1221]129     ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0.
130     sssupco(:,:)  = 0. ; sssupco_pi = 0.
[1337]131     loadss=0.
[1181]132  ENDIF
133
134! Read and interpolate cidustm
135  IF (flag_aerosol .EQ. 5 .OR.  &
136      flag_aerosol .EQ. 6 ) THEN
137
[2146]138      CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
[1181]139
140  ELSE
141      cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
[1337]142      loaddust=0.
[1181]143  ENDIF
144
145!
[1179]146! Store all aerosols in one variable
[1150]147!
[2146]148  m_allaer(:,:,id_ASBCM_phy)  = bcsol(:,:)        ! ASBCM
149  m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:)       ! ASPOMM
150  m_allaer(:,:,id_ASSO4M_phy) = sulfate(:,:)      ! ASSO4M (= SO4)
151  m_allaer(:,:,id_CSSO4M_phy) = 0.                ! CSSO4M
152  m_allaer(:,:,id_SSSSM_phy)  = sssupco(:,:)      ! SSSSM
153  m_allaer(:,:,id_CSSSM_phy)  = sscoarse(:,:)     ! CSSSM
154  m_allaer(:,:,id_ASSSM_phy)  = ssacu(:,:)        ! ASSSM
155  m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:)       ! CIDUSTM
156  m_allaer(:,:,id_AIBCM_phy)  = bcins(:,:)        ! AIBCM
157  m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:)       ! AIPOMM
[1150]158
[1246]159!RAF
160  m_allaer_pi(:,:,1)  = bcsol_pi(:,:)        ! ASBCM pre-ind
161  m_allaer_pi(:,:,2)  = pomsol_pi(:,:)       ! ASPOMM pre-ind
162  m_allaer_pi(:,:,3)  = sulfate_pi(:,:)      ! ASSO4M (= SO4) pre-ind
163  m_allaer_pi(:,:,4)  = 0.                ! CSSO4M pre-ind
164  m_allaer_pi(:,:,5)  = sssupco_pi(:,:)      ! SSSSM pre-ind
165  m_allaer_pi(:,:,6)  = sscoarse_pi(:,:)     ! CSSSM pre-ind
166  m_allaer_pi(:,:,7)  = ssacu_pi(:,:)        ! ASSSM pre-ind
167  m_allaer_pi(:,:,8)  = cidust_pi(:,:)       ! CIDUSTM pre-ind
168  m_allaer_pi(:,:,9)  = bcins_pi(:,:)        ! AIBCM pre-ind
169  m_allaer_pi(:,:,10) = pomins_pi(:,:)       ! AIPOMM pre-ind
170
[1150]171!
[1183]172! Calculate the total mass of all soluble aersosols
[1150]173!
[1246]174  mass_solu_aero(:,:)    = sulfate(:,:)    + bcsol(:,:)    + pomsol(:,:) !   + &
175!       sscoarse(:,:)    + ssacu(:,:)    + sssupco(:,:)
176  mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) ! + &
177!       sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:)
[1179]178
179!****************************************************************************************
180! 2) Calculate optical properties for the aerosols
181!
182!****************************************************************************************
[1150]183  DO k = 1, klev
[1179]184     DO i = 1, klon
185        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
186     END DO
[1150]187  END DO
188
[1179]189  IF (new_aod) THEN
190
[1246]191! RAF delete??     fractnat_allaer(:,:) = 0.
192! RAF fractnat_allaer -> m_allaer_pi
193
194     CALL aeropt_2bands( &
[1150]195          pdel, m_allaer, pdtphys, rhcl, &
196          tau_aero, piz_aero, cg_aero,   &
[1246]197          m_allaer_pi, flag_aerosol, &
[1221]198          pplay, t_seri, presnivs)
[1179]199     
200     ! aeropt_5wv only for validation and diagnostics.
[1237]201     CALL aeropt_5wv(                    &
202          pdel, m_allaer,                &
203          pdtphys, rhcl, aerindex,       &
204          flag_aerosol, pplay, t_seri,   &
[1221]205          tausum_aero, tau3d_aero, presnivs)
[1179]206  ELSE
[1150]207
[1179]208     CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
[2146]209          tau_aero(:,:,id_ASSO4M_phy,:), piz_aero(:,:,id_ASSO4M_phy,:), cg_aero(:,:,id_ASSO4M_phy,:), aerindex)
[1179]210     
211  END IF
212
[1337]213
214! Diagnostics calculation for CMIP5 protocol
[2146]215  sconcso4(:)=m_allaer(:,1,id_ASSO4M_phy)*1.e-9
216!  sconcno3(:)=m_allaer(:,1,id_ASNO3M_phy)*1.e-9
217  sconcoa(:)=(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
218  sconcbc(:)=(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
219  sconcss(:)=(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
220  sconcdust(:)=m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
221  concso4(:,:)=m_allaer(:,:,id_ASSO4M_phy)*1.e-9
222!  concno3(:,:)=m_allaer(:,:,id_ASNO3M_phy)*1.e-9
223  concoa(:,:)=(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
224  concbc(:,:)=(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
225  concss(:,:)=(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
226  concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
[1337]227
228
[1179]229END SUBROUTINE readaerosol_optic
Note: See TracBrowser for help on using the repository browser.