source: LMDZ4/trunk/libf/phylmd/readaerosol_optic.F90 @ 1291

Last change on this file since 1291 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210
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.