source: LMDZ6/branches/Optimisation_LMDZ/libf/phylmd/readaerosol_optic.F90 @ 5408

Last change on this file since 5408 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
Line 
1! $Id: readaerosol_optic.F90 3630 2020-02-10 10:04:40Z evignon $
2!
3SUBROUTINE readaerosol_optic(debut, flag_aerosol, itap, rjourvrai, &
4     pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
5     mass_solu_aero, mass_solu_aero_pi, &
6     tau_aero, piz_aero, cg_aero, &
7     tausum_aero, tau3d_aero )
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!
13 
14  USE dimphy
15  USE aero_mod
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, &
18      load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7
19  IMPLICIT NONE
20
21! Input arguments
22!****************************************************************************************
23  LOGICAL, INTENT(IN)                      :: debut
24  INTEGER, INTENT(IN)                      :: flag_aerosol
25  INTEGER, INTENT(IN)                      :: itap
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
32  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
33
34! Output arguments
35!****************************************************************************************
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
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
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
46
47! Local variables
48!****************************************************************************************
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]
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]
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
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
68  REAL, DIMENSION(klon,klev)   :: pdel
69  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
70  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF 
71!  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer !RAF delete??
72
73  INTEGER :: k, i
74 
75!****************************************************************************************
76! 1) Get aerosol mass
77!   
78!****************************************************************************************
79! Read and interpolate sulfate
80  IF ( flag_aerosol .EQ. 1 .OR. &
81       flag_aerosol .EQ. 6 ) THEN
82
83     CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4)
84  ELSE
85     sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0.
86     loadso4=0.
87  END IF
88
89! Read and interpolate bcsol and bcins
90  IF ( flag_aerosol .EQ. 2 .OR. &
91       flag_aerosol .EQ. 6 ) THEN
92
93     ! Get bc aerosol distribution
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)
96     loadbc(:)=load_tmp1(:)+load_tmp2(:)
97  ELSE
98     bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
99     bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
100     loadbc=0.
101  END IF
102
103
104! Read and interpolate pomsol and pomins
105  IF ( flag_aerosol .EQ. 3 .OR. &
106       flag_aerosol .EQ. 6 ) THEN
107
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(:)
111  ELSE
112     pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
113     pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
114     loadoa=0.
115  END IF
116
117
118! Read and interpolate csssm, ssssm, assssm
119  IF (flag_aerosol .EQ. 4 .OR. &
120      flag_aerosol .EQ. 6 ) THEN
121
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(:)
126  ELSE
127      sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
128      ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0.
129      sssupco(:,:)  = 0. ; sssupco_pi = 0.
130      loadss=0.
131  ENDIF
132
133! Read and interpolate cidustm
134  IF (flag_aerosol .EQ. 5 .OR.  &
135      flag_aerosol .EQ. 6 ) THEN
136
137      CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
138  ELSE
139      cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
140      loaddust=0.
141  ENDIF
142
143!
144! Store all aerosols in one variable
145!
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
156  m_allaer(:,:,id_ASNO3M_phy) = 0.0
157  m_allaer(:,:,id_CSNO3M_phy) = 0.0
158  m_allaer(:,:,id_CINO3M_phy) = 0.0
159
160!RAF
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
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
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
174!
175! Calculate the total mass of all soluble aersosols
176!
177  mass_solu_aero(:,:)    = sulfate(:,:)    + bcsol(:,:)    + pomsol(:,:) + ssacu(:,:)
178  mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + ssacu_pi(:,:)
179
180!****************************************************************************************
181! 2) Calculate optical properties for the aerosols
182!
183!****************************************************************************************
184  DO k = 1, klev
185     DO i = 1, klon
186        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
187     END DO
188  END DO
189
190! RAF delete??     fractnat_allaer(:,:) = 0.
191! RAF fractnat_allaer -> m_allaer_pi
192
193     CALL aeropt_2bands( &
194          pdel, m_allaer, pdtphys, rhcl, &
195          tau_aero, piz_aero, cg_aero,   &
196          m_allaer_pi, flag_aerosol, &
197          pplay, t_seri, presnivs)
198     
199     ! aeropt_5wv only for validation and diagnostics.
200     CALL aeropt_5wv(                    &
201          pdel, m_allaer,                &
202          pdtphys, rhcl, aerindex,       &
203          flag_aerosol, pplay, t_seri,   &
204          tausum_aero, tau3d_aero, presnivs)
205
206! Diagnostics calculation for CMIP5 protocol
207  sconcso4(:)=m_allaer(:,1,id_ASSO4M_phy)*1.e-9
208  sconcno3(:)=m_allaer(:,1,id_ASNO3M_phy)*1.e-9
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
214  concno3(:,:)=m_allaer(:,:,id_ASNO3M_phy)*1.e-9
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
219
220END SUBROUTINE readaerosol_optic
Note: See TracBrowser for help on using the repository browser.