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

Last change on this file since 1270 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
RevLine 
[1179]1! $Id$
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
[1150]16  IMPLICIT NONE
17
18! Input arguments
[1179]19!****************************************************************************************
[1150]20  LOGICAL, INTENT(IN)                      :: debut
21  LOGICAL, INTENT(IN)                      :: new_aod
22  INTEGER, INTENT(IN)                      :: flag_aerosol
[1237]23  INTEGER, INTENT(IN)                      :: itap
[1150]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
[1221]30  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
[1150]31
32! Output arguments
[1179]33!****************************************************************************************
[1183]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
[1181]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
[1150]41
42! Local variables
[1179]43!****************************************************************************************
[1150]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]
[1181]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]
[1150]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
[1181]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
[1150]63  REAL, DIMENSION(klon,klev)   :: pdel
[1181]64  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer
[1246]65  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer_pi !RAF 
66!  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer !RAF delete??
[1150]67
[1179]68  INTEGER :: k, i
[1150]69 
[1179]70!****************************************************************************************
71! 1) Get aerosol mass
72!   
73!****************************************************************************************
74! Read and interpolate sulfate
[1150]75  IF ( flag_aerosol .EQ. 1 .OR. &
76       flag_aerosol .EQ. 6 ) THEN
77
[1237]78     CALL readaerosol_interp(id_ASSO4M, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi)
[1179]79  ELSE
80     sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0.
81  END IF
[1150]82
[1179]83! Read and interpolate bcsol and bcins
[1150]84  IF ( flag_aerosol .EQ. 2 .OR. &
[1181]85       flag_aerosol .EQ. 6 ) THEN
[1150]86
87     ! Get bc aerosol distribution
[1237]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 )
[1179]90  ELSE
91     bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
92     bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
93  END IF
[1150]94
95
[1179]96! Read and interpolate pomsol and pomins
[1150]97  IF ( flag_aerosol .EQ. 3 .OR. &
98       flag_aerosol .EQ. 6 ) THEN
99
[1237]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)
[1179]102  ELSE
103     pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
104     pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
105  END IF
[1150]106
107
[1181]108! Read and interpolate csssm, ssssm, assssm
109  IF (flag_aerosol .EQ. 4 .OR. &
110      flag_aerosol .EQ. 6 ) THEN
111
[1237]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)
[1181]115
116  ELSE
117     sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
[1221]118     ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0.
119     sssupco(:,:)  = 0. ; sssupco_pi = 0.
[1181]120  ENDIF
121
122! Read and interpolate cidustm
123  IF (flag_aerosol .EQ. 5 .OR.  &
124      flag_aerosol .EQ. 6 ) THEN
125
[1237]126      CALL readaerosol_interp(id_CIDUSTM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi)
[1181]127
128  ELSE
129      cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
130  ENDIF
131
132!
[1179]133! Store all aerosols in one variable
[1150]134!
[1221]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
[1150]145
[1246]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
[1150]158!
[1183]159! Calculate the total mass of all soluble aersosols
[1150]160!
[1246]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(:,:)
[1179]165
166!****************************************************************************************
167! 2) Calculate optical properties for the aerosols
168!
169!****************************************************************************************
[1150]170  DO k = 1, klev
[1179]171     DO i = 1, klon
172        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
173     END DO
[1150]174  END DO
175
[1179]176  IF (new_aod) THEN
177
[1246]178! RAF delete??     fractnat_allaer(:,:) = 0.
179! RAF fractnat_allaer -> m_allaer_pi
180
181     CALL aeropt_2bands( &
[1150]182          pdel, m_allaer, pdtphys, rhcl, &
183          tau_aero, piz_aero, cg_aero,   &
[1246]184          m_allaer_pi, flag_aerosol, &
[1221]185          pplay, t_seri, presnivs)
[1179]186     
187     ! aeropt_5wv only for validation and diagnostics.
[1237]188     CALL aeropt_5wv(                    &
189          pdel, m_allaer,                &
190          pdtphys, rhcl, aerindex,       &
191          flag_aerosol, pplay, t_seri,   &
[1221]192          tausum_aero, tau3d_aero, presnivs)
[1179]193  ELSE
[1150]194
[1179]195     CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
[1221]196          tau_aero(:,:,id_ASSO4M,:), piz_aero(:,:,id_ASSO4M,:), cg_aero(:,:,id_ASSO4M,:), aerindex)
[1179]197     
198  END IF
199
200END SUBROUTINE readaerosol_optic
Note: See TracBrowser for help on using the repository browser.