source: LMDZ4/branches/LMDZ4-dev-20091210/libf/phylmd/readaerosol_optic.F90

Last change on this file was 1246, checked in by Laurent Fairhead, 15 years ago
  • En deconnectant les aérosols (ok_ade=ok_aie=n) on a les mêmes

résultats avant et après les modifs.

  • preindustrial readin fields are used to compute natural aerosol fields

to allow for clean double calls to radiation

  • full forcing diagnostics (NAT, ANT, ZERO, Cloud forcing, CS,AS) are

activated with lev_histmth 4, If lev_histmth is not 4, the call to the
radiation is minimized, for efficiency, but ade and aie are computed and
applied (however for species wise forcing one would need to do
difference runs) (still quite a bit new forcing info, requires probably

some more explanation)

  • there is a hardcoded key in sw_aeroAR4.F90 which lets you choose to use the zero aerosol, or natural aerosol perturbation acting on the meteorology, but still would put out the full forcing diagnostics.
  • aod fields from offline aerosol fields are also output in histmth for

all aerosol tracers read in and available for evaluation

  • aeropt contains the ss humidity correction from nicolas&yves
File size: 8.3 KB
Line 
1! $Id$
2!
3SUBROUTINE readaerosol_optic(debut, new_aod, 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  IMPLICIT NONE
17
18! Input arguments
19!****************************************************************************************
20  LOGICAL, INTENT(IN)                      :: debut
21  LOGICAL, INTENT(IN)                      :: new_aod
22  INTEGER, INTENT(IN)                      :: flag_aerosol
23  INTEGER, INTENT(IN)                      :: itap
24  REAL, INTENT(IN)                         :: rjourvrai
25  REAL, INTENT(IN)                         :: pdtphys
26  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
27  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
28  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
29  REAL, DIMENSION(klon,klev), INTENT(IN)   :: rhcl   ! humidite relative ciel clair
30  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
31
32! Output arguments
33!****************************************************************************************
34  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
35  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
36  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
37  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
38  REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
39  REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT)       :: tausum_aero
40  REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT)  :: tau3d_aero
41
42! Local variables
43!****************************************************************************************
44  REAL, DIMENSION(klon)        :: aerindex ! POLDER aerosol index
45  REAL, DIMENSION(klon,klev)   :: sulfate  ! SO4 aerosol concentration [ug/m3]
46  REAL, DIMENSION(klon,klev)   :: bcsol    ! BC soluble concentration [ug/m3]
47  REAL, DIMENSION(klon,klev)   :: bcins    ! BC insoluble concentration [ug/m3]
48  REAL, DIMENSION(klon,klev)   :: pomsol   ! POM soluble concentration [ug/m3]
49  REAL, DIMENSION(klon,klev)   :: pomins   ! POM insoluble concentration [ug/m3]
50  REAL, DIMENSION(klon,klev)   :: cidust    ! DUST aerosol concentration  [ug/m3]
51  REAL, DIMENSION(klon,klev)   :: sscoarse  ! SS Coarse concentration [ug/m3]
52  REAL, DIMENSION(klon,klev)   :: sssupco   ! SS Super Coarse concentration [ug/m3]
53  REAL, DIMENSION(klon,klev)   :: ssacu     ! SS Acumulation concentration [ug/m3]
54  REAL, DIMENSION(klon,klev)   :: sulfate_pi
55  REAL, DIMENSION(klon,klev)   :: bcsol_pi
56  REAL, DIMENSION(klon,klev)   :: bcins_pi
57  REAL, DIMENSION(klon,klev)   :: pomsol_pi
58  REAL, DIMENSION(klon,klev)   :: pomins_pi
59  REAL, DIMENSION(klon,klev)   :: cidust_pi
60  REAL, DIMENSION(klon,klev)   :: sscoarse_pi
61  REAL, DIMENSION(klon,klev)   :: sssupco_pi
62  REAL, DIMENSION(klon,klev)   :: ssacu_pi
63  REAL, DIMENSION(klon,klev)   :: pdel
64  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer
65  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer_pi !RAF 
66!  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer !RAF delete??
67
68  INTEGER :: k, i
69 
70!****************************************************************************************
71! 1) Get aerosol mass
72!   
73!****************************************************************************************
74! Read and interpolate sulfate
75  IF ( flag_aerosol .EQ. 1 .OR. &
76       flag_aerosol .EQ. 6 ) THEN
77
78     CALL readaerosol_interp(id_ASSO4M, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi)
79  ELSE
80     sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0.
81  END IF
82
83! Read and interpolate bcsol and bcins
84  IF ( flag_aerosol .EQ. 2 .OR. &
85       flag_aerosol .EQ. 6 ) THEN
86
87     ! Get bc aerosol distribution
88     CALL readaerosol_interp(id_ASBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi )
89     CALL readaerosol_interp(id_AIBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi )
90  ELSE
91     bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
92     bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
93  END IF
94
95
96! Read and interpolate pomsol and pomins
97  IF ( flag_aerosol .EQ. 3 .OR. &
98       flag_aerosol .EQ. 6 ) THEN
99
100     CALL readaerosol_interp(id_ASPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi)
101     CALL readaerosol_interp(id_AIPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi)
102  ELSE
103     pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
104     pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
105  END IF
106
107
108! Read and interpolate csssm, ssssm, assssm
109  IF (flag_aerosol .EQ. 4 .OR. &
110      flag_aerosol .EQ. 6 ) THEN
111
112      CALL readaerosol_interp(id_SSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi)
113      CALL readaerosol_interp(id_CSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi)
114      CALL readaerosol_interp(id_ASSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi)
115
116  ELSE
117     sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
118     ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0.
119     sssupco(:,:)  = 0. ; sssupco_pi = 0.
120  ENDIF
121
122! Read and interpolate cidustm
123  IF (flag_aerosol .EQ. 5 .OR.  &
124      flag_aerosol .EQ. 6 ) THEN
125
126      CALL readaerosol_interp(id_CIDUSTM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi)
127
128  ELSE
129      cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
130  ENDIF
131
132!
133! Store all aerosols in one variable
134!
135  m_allaer(:,:,id_ASBCM)  = bcsol(:,:)        ! ASBCM
136  m_allaer(:,:,id_ASPOMM) = pomsol(:,:)       ! ASPOMM
137  m_allaer(:,:,id_ASSO4M) = sulfate(:,:)      ! ASSO4M (= SO4)
138  m_allaer(:,:,id_CSSO4M) = 0.                ! CSSO4M
139  m_allaer(:,:,id_SSSSM)  = sssupco(:,:)      ! SSSSM
140  m_allaer(:,:,id_CSSSM)  = sscoarse(:,:)     ! CSSSM
141  m_allaer(:,:,id_ASSSM)  = ssacu(:,:)        ! ASSSM
142  m_allaer(:,:,id_CIDUSTM)= cidust(:,:)       ! CIDUSTM
143  m_allaer(:,:,id_AIBCM)  = bcins(:,:)        ! AIBCM
144  m_allaer(:,:,id_AIPOMM) = pomins(:,:)       ! AIPOMM
145
146!RAF
147  m_allaer_pi(:,:,1)  = bcsol_pi(:,:)        ! ASBCM pre-ind
148  m_allaer_pi(:,:,2)  = pomsol_pi(:,:)       ! ASPOMM pre-ind
149  m_allaer_pi(:,:,3)  = sulfate_pi(:,:)      ! ASSO4M (= SO4) pre-ind
150  m_allaer_pi(:,:,4)  = 0.                ! CSSO4M pre-ind
151  m_allaer_pi(:,:,5)  = sssupco_pi(:,:)      ! SSSSM pre-ind
152  m_allaer_pi(:,:,6)  = sscoarse_pi(:,:)     ! CSSSM pre-ind
153  m_allaer_pi(:,:,7)  = ssacu_pi(:,:)        ! ASSSM pre-ind
154  m_allaer_pi(:,:,8)  = cidust_pi(:,:)       ! CIDUSTM pre-ind
155  m_allaer_pi(:,:,9)  = bcins_pi(:,:)        ! AIBCM pre-ind
156  m_allaer_pi(:,:,10) = pomins_pi(:,:)       ! AIPOMM pre-ind
157
158!
159! Calculate the total mass of all soluble aersosols
160!
161  mass_solu_aero(:,:)    = sulfate(:,:)    + bcsol(:,:)    + pomsol(:,:) !   + &
162!       sscoarse(:,:)    + ssacu(:,:)    + sssupco(:,:)
163  mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) ! + &
164!       sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:)
165
166!****************************************************************************************
167! 2) Calculate optical properties for the aerosols
168!
169!****************************************************************************************
170  DO k = 1, klev
171     DO i = 1, klon
172        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
173     END DO
174  END DO
175
176  IF (new_aod) THEN
177
178! RAF delete??     fractnat_allaer(:,:) = 0.
179! RAF fractnat_allaer -> m_allaer_pi
180
181     CALL aeropt_2bands( &
182          pdel, m_allaer, pdtphys, rhcl, &
183          tau_aero, piz_aero, cg_aero,   &
184          m_allaer_pi, flag_aerosol, &
185          pplay, t_seri, presnivs)
186     
187     ! aeropt_5wv only for validation and diagnostics.
188     CALL aeropt_5wv(                    &
189          pdel, m_allaer,                &
190          pdtphys, rhcl, aerindex,       &
191          flag_aerosol, pplay, t_seri,   &
192          tausum_aero, tau3d_aero, presnivs)
193  ELSE
194
195     CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
196          tau_aero(:,:,id_ASSO4M,:), piz_aero(:,:,id_ASSO4M,:), cg_aero(:,:,id_ASSO4M,:), aerindex)
197     
198  END IF
199
200END SUBROUTINE readaerosol_optic
Note: See TracBrowser for help on using the repository browser.