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

Last change on this file since 2139 was 2003, checked in by Laurent Fairhead, 11 years ago

Nouvelle version qui inclut les effets des aérosols et propose les mêmes diagnostics des effets
directs et indirects que l'ancienne version du rayonnement.
OB

New RRTM version that includes the effects of aerosols and outputs the same direct and indirect effects
diagnostics as the old version
OB
  • 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.7 KB
RevLine 
[1179]1! $Id: readaerosol_optic.F90 2003 2014-04-04 12:51:02Z 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
[1337]16  USE phys_local_var_mod, only: sconcso4,sconcoa,sconcbc,sconcss,sconcdust, &
17      concso4,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
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
[1337]84     CALL readaerosol_interp(id_ASSO4M, 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
[1337]95     CALL readaerosol_interp(id_ASBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
96     CALL readaerosol_interp(id_AIBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
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
[1337]109     CALL readaerosol_interp(id_ASPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
110     CALL readaerosol_interp(id_AIPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
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
[1337]123      CALL readaerosol_interp(id_SSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
124      CALL readaerosol_interp(id_CSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
125      CALL readaerosol_interp(id_ASSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
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
[1337]138      CALL readaerosol_interp(id_CIDUSTM, 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!
[1221]148  m_allaer(:,:,id_ASBCM)  = bcsol(:,:)        ! ASBCM
149  m_allaer(:,:,id_ASPOMM) = pomsol(:,:)       ! ASPOMM
150  m_allaer(:,:,id_ASSO4M) = sulfate(:,:)      ! ASSO4M (= SO4)
151  m_allaer(:,:,id_CSSO4M) = 0.                ! CSSO4M
152  m_allaer(:,:,id_SSSSM)  = sssupco(:,:)      ! SSSSM
153  m_allaer(:,:,id_CSSSM)  = sscoarse(:,:)     ! CSSSM
154  m_allaer(:,:,id_ASSSM)  = ssacu(:,:)        ! ASSSM
155  m_allaer(:,:,id_CIDUSTM)= cidust(:,:)       ! CIDUSTM
156  m_allaer(:,:,id_AIBCM)  = bcins(:,:)        ! AIBCM
157  m_allaer(:,:,id_AIPOMM) = 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, &
[1221]209          tau_aero(:,:,id_ASSO4M,:), piz_aero(:,:,id_ASSO4M,:), cg_aero(:,:,id_ASSO4M,:), aerindex)
[1179]210     
211  END IF
212
[1337]213
214! Diagnostics calculation for CMIP5 protocol
215  sconcso4(:)=m_allaer(:,1,id_ASSO4M)*1.e-9
216  sconcoa(:)=(m_allaer(:,1,id_ASPOMM)+m_allaer(:,1,id_AIPOMM))*1.e-9
217  sconcbc(:)=(m_allaer(:,1,id_ASBCM)+m_allaer(:,1,id_AIBCM))*1.e-9
218  sconcss(:)=(m_allaer(:,1,id_ASSSM)+m_allaer(:,1,id_CSSSM)+m_allaer(:,1,id_SSSSM))*1.e-9
219  sconcdust(:)=m_allaer(:,1,id_CIDUSTM)*1.e-9
220  concso4(:,:)=m_allaer(:,:,id_ASSO4M)*1.e-9
221  concoa(:,:)=(m_allaer(:,:,id_ASPOMM)+m_allaer(:,:,id_AIPOMM))*1.e-9
222  concbc(:,:)=(m_allaer(:,:,id_ASBCM)+m_allaer(:,:,id_AIBCM))*1.e-9
223  concss(:,:)=(m_allaer(:,:,id_ASSSM)+m_allaer(:,:,id_CSSSM)+m_allaer(:,:,id_SSSSM))*1.e-9
224  concdust(:,:)=m_allaer(:,:,id_CIDUSTM)*1.e-9
225
226
[1179]227END SUBROUTINE readaerosol_optic
Note: See TracBrowser for help on using the repository browser.