source: LMDZ6/trunk/libf/phylmd/readaerosol_optic.F90 @ 3999

Last change on this file since 3999 was 3630, checked in by Laurent Fairhead, 5 years ago

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