source: LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90 @ 2056

Last change on this file since 2056 was 2056, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes r1997:2055 into testing branch
  • 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 Revi
File size: 9.4 KB
Line 
1! $Id: readaerosol_optic_rrtm.F90 2056 2014-06-11 13:46:46Z fairhead $
2!
3SUBROUTINE readaerosol_optic_rrtm(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  USE phys_local_var_mod, only: sconcso4,sconcoa,sconcbc,sconcss,sconcdust, &
17      concso4,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  include "clesphys.h"
21
22! Input arguments
23!****************************************************************************************
24  LOGICAL, INTENT(IN)                      :: debut
25  LOGICAL, INTENT(IN)                      :: new_aod
26  INTEGER, INTENT(IN)                      :: flag_aerosol
27  INTEGER, INTENT(IN)                      :: itap
28  REAL, INTENT(IN)                         :: rjourvrai
29  REAL, INTENT(IN)                         :: pdtphys
30  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
31  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
32  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
33  REAL, DIMENSION(klon,klev), INTENT(IN)   :: rhcl   ! humidite relative ciel clair
34  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
35
36! Output arguments
37!****************************************************************************************
38  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
39  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
40  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
41  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
42  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
43!  REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT)       :: tausum_aero
44!  REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT)  :: tau3d_aero
45!--correction minibug OB
46  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)       :: tausum_aero
47  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
48
49! Local variables
50!****************************************************************************************
51  REAL, DIMENSION(klon)        :: aerindex ! POLDER aerosol index
52  REAL, DIMENSION(klon,klev)   :: sulfate  ! SO4 aerosol concentration [ug/m3]
53  REAL, DIMENSION(klon,klev)   :: bcsol    ! BC soluble concentration [ug/m3]
54  REAL, DIMENSION(klon,klev)   :: bcins    ! BC insoluble concentration [ug/m3]
55  REAL, DIMENSION(klon,klev)   :: pomsol   ! POM soluble concentration [ug/m3]
56  REAL, DIMENSION(klon,klev)   :: pomins   ! POM insoluble concentration [ug/m3]
57  REAL, DIMENSION(klon,klev)   :: cidust    ! DUST aerosol concentration  [ug/m3]
58  REAL, DIMENSION(klon,klev)   :: sscoarse  ! SS Coarse concentration [ug/m3]
59  REAL, DIMENSION(klon,klev)   :: sssupco   ! SS Super Coarse concentration [ug/m3]
60  REAL, DIMENSION(klon,klev)   :: ssacu     ! SS Acumulation concentration [ug/m3]
61  REAL, DIMENSION(klon,klev)   :: sulfate_pi
62  REAL, DIMENSION(klon,klev)   :: bcsol_pi
63  REAL, DIMENSION(klon,klev)   :: bcins_pi
64  REAL, DIMENSION(klon,klev)   :: pomsol_pi
65  REAL, DIMENSION(klon,klev)   :: pomins_pi
66  REAL, DIMENSION(klon,klev)   :: cidust_pi
67  REAL, DIMENSION(klon,klev)   :: sscoarse_pi
68  REAL, DIMENSION(klon,klev)   :: sssupco_pi
69  REAL, DIMENSION(klon,klev)   :: ssacu_pi
70  REAL, DIMENSION(klon,klev)   :: pdel
71  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer
72  REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer_pi !RAF 
73!  REAL, DIMENSION(klon,naero_tot)      :: fractnat_allaer !RAF delete??
74
75  INTEGER :: k, i
76 
77!****************************************************************************************
78! 1) Get aerosol mass
79!   
80!****************************************************************************************
81! Read and interpolate sulfate
82  IF ( flag_aerosol .EQ. 1 .OR. &
83       flag_aerosol .EQ. 6 ) THEN
84
85     CALL readaerosol_interp(id_ASSO4M, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4)
86  ELSE
87     sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0.
88     loadso4=0.
89  END IF
90
91! Read and interpolate bcsol and bcins
92  IF ( flag_aerosol .EQ. 2 .OR. &
93       flag_aerosol .EQ. 6 ) THEN
94
95     ! Get bc aerosol distribution
96     CALL readaerosol_interp(id_ASBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
97     CALL readaerosol_interp(id_AIBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
98     loadbc(:)=load_tmp1(:)+load_tmp2(:)
99  ELSE
100     bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
101     bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
102     loadbc=0.
103  END IF
104
105
106! Read and interpolate pomsol and pomins
107  IF ( flag_aerosol .EQ. 3 .OR. &
108       flag_aerosol .EQ. 6 ) THEN
109
110     CALL readaerosol_interp(id_ASPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
111     CALL readaerosol_interp(id_AIPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
112     loadoa(:)=load_tmp3(:)+load_tmp4(:)
113  ELSE
114     pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
115     pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
116     loadoa=0.
117  END IF
118
119
120! Read and interpolate csssm, ssssm, assssm
121  IF (flag_aerosol .EQ. 4 .OR. &
122      flag_aerosol .EQ. 6 ) THEN
123
124      CALL readaerosol_interp(id_SSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)
125      CALL readaerosol_interp(id_CSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)
126      CALL readaerosol_interp(id_ASSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)
127     loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
128  ELSE
129     sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0.
130     ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0.
131     sssupco(:,:)  = 0. ; sssupco_pi = 0.
132     loadss=0.
133  ENDIF
134
135! Read and interpolate cidustm
136  IF (flag_aerosol .EQ. 5 .OR.  &
137      flag_aerosol .EQ. 6 ) THEN
138
139      CALL readaerosol_interp(id_CIDUSTM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
140
141  ELSE
142      cidust(:,:) = 0. ; cidust_pi(:,:) = 0.
143      loaddust=0.
144  ENDIF
145
146!
147! Store all aerosols in one variable
148!
149  m_allaer(:,:,id_ASBCM)  = bcsol(:,:)        ! ASBCM
150  m_allaer(:,:,id_ASPOMM) = pomsol(:,:)       ! ASPOMM
151  m_allaer(:,:,id_ASSO4M) = sulfate(:,:)      ! ASSO4M (= SO4)
152  m_allaer(:,:,id_CSSO4M) = 0.                ! CSSO4M
153  m_allaer(:,:,id_SSSSM)  = sssupco(:,:)      ! SSSSM
154  m_allaer(:,:,id_CSSSM)  = sscoarse(:,:)     ! CSSSM
155  m_allaer(:,:,id_ASSSM)  = ssacu(:,:)        ! ASSSM
156  m_allaer(:,:,id_CIDUSTM)= cidust(:,:)       ! CIDUSTM
157  m_allaer(:,:,id_AIBCM)  = bcins(:,:)        ! AIBCM
158  m_allaer(:,:,id_AIPOMM) = pomins(:,:)       ! AIPOMM
159
160!RAF
161  m_allaer_pi(:,:,1)  = bcsol_pi(:,:)        ! ASBCM pre-ind
162  m_allaer_pi(:,:,2)  = pomsol_pi(:,:)       ! ASPOMM pre-ind
163  m_allaer_pi(:,:,3)  = sulfate_pi(:,:)      ! ASSO4M (= SO4) pre-ind
164  m_allaer_pi(:,:,4)  = 0.                   ! CSSO4M pre-ind
165  m_allaer_pi(:,:,5)  = sssupco_pi(:,:)      ! SSSSM pre-ind
166  m_allaer_pi(:,:,6)  = sscoarse_pi(:,:)     ! CSSSM pre-ind
167  m_allaer_pi(:,:,7)  = ssacu_pi(:,:)        ! ASSSM pre-ind
168  m_allaer_pi(:,:,8)  = cidust_pi(:,:)       ! CIDUSTM pre-ind
169  m_allaer_pi(:,:,9)  = bcins_pi(:,:)        ! AIBCM pre-ind
170  m_allaer_pi(:,:,10) = pomins_pi(:,:)       ! AIPOMM pre-ind
171
172!
173! Calculate the total mass of all soluble aersosols
174!
175  mass_solu_aero(:,:)    = sulfate(:,:)    + bcsol(:,:)    + pomsol(:,:) !   + &
176!       sscoarse(:,:)    + ssacu(:,:)    + sssupco(:,:)
177  mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) ! + &
178!       sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_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  CALL aeropt_6bands_rrtm( &
191          pdel, m_allaer, pdtphys, rhcl, &
192          tau_aero, piz_aero, cg_aero,   &
193          m_allaer_pi, flag_aerosol, &
194          pplay, t_seri, presnivs)
195     
196     ! aeropt_5wv only for validation and diagnostics.
197     CALL aeropt_5wv_rrtm(                    &
198          pdel, m_allaer,                &
199          pdtphys, rhcl, aerindex,       &
200          flag_aerosol, pplay, t_seri,   &
201          tausum_aero, tau3d_aero )
202
203! Diagnostics calculation for CMIP5 protocol
204  sconcso4(:)=m_allaer(:,1,id_ASSO4M)*1.e-9
205  sconcoa(:)=(m_allaer(:,1,id_ASPOMM)+m_allaer(:,1,id_AIPOMM))*1.e-9
206  sconcbc(:)=(m_allaer(:,1,id_ASBCM)+m_allaer(:,1,id_AIBCM))*1.e-9
207  sconcss(:)=(m_allaer(:,1,id_ASSSM)+m_allaer(:,1,id_CSSSM)+m_allaer(:,1,id_SSSSM))*1.e-9
208  sconcdust(:)=m_allaer(:,1,id_CIDUSTM)*1.e-9
209  concso4(:,:)=m_allaer(:,:,id_ASSO4M)*1.e-9
210  concoa(:,:)=(m_allaer(:,:,id_ASPOMM)+m_allaer(:,:,id_AIPOMM))*1.e-9
211  concbc(:,:)=(m_allaer(:,:,id_ASBCM)+m_allaer(:,:,id_AIBCM))*1.e-9
212  concss(:,:)=(m_allaer(:,:,id_ASSSM)+m_allaer(:,:,id_CSSSM)+m_allaer(:,:,id_SSSSM))*1.e-9
213  concdust(:,:)=m_allaer(:,:,id_CIDUSTM)*1.e-9
214
215END SUBROUTINE readaerosol_optic_rrtm
Note: See TracBrowser for help on using the repository browser.