source: LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_optic.F90 @ 5218

Last change on this file since 5218 was 5116, checked in by abarral, 5 months ago

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