source: trunk/LMDZ.MARS/libf/phymars/dimradmars_mod.F90

Last change on this file was 2909, checked in by romain.vande, 21 months ago

Mars PEM:
New Boolean options for following orbital parameters of ob_ex_lsp.asc: var_obl, var_ex, var_lsp.
If using evol_orbit_pem=true, you can specify which parameter to follow.
True by default: Do you want to change the parameter XXX during the PEM run as prescribed in ob_ex_lsp.asc.
If false, it is set to constant (to the value of the tab_cntrl in the start)
RV

File size: 10.5 KB
Line 
1module dimradmars_mod
2!   Declaration and settings for radiative transfer calculations
3!   Initializations and allocations are done in phys_state_var_init
4implicit none
5  ! nflev: number of vertical layer
6  ! ndlon,ndlo2: number of horizontal points
7  ! Splitting of horizontal grid
8  ! NDLO2 and ndomainsz for the splitting in the physics call
9  ! WARNING:  One must have  1 < ndomainsz =< ngrid
10  integer,save :: NFLEV !=nlayer   ! with splitting
11  integer,save :: ndomainsz !=(ngrid-1)/20 + 1
12  integer,save :: NDLON !=ndomainsz  ! with splitting
13  integer,save :: NDLO2 !=NDLON
14
15!$OMP THREADPRIVATE(NFLEV,ndomainsz,NDLON,NDLO2)
16
17! Number of kind of tracer radiative properties
18! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
19! naerkind is set by reading callphys.def
20! -- see conf_phys
21! -- value of nsizemax below is comfortably high
22!    but beware in case you add a lot of scatterers
23  INTEGER, SAVE :: naerkind
24
25  ! AS: previously in aerkind.h
26  character*20, SAVE, ALLOCATABLE :: name_iaer(:)  ! name of the scatterers
27
28!$OMP THREADPRIVATE(naerkind,name_iaer)
29
30  integer iaer_dust_conrath ! Typical dust profiles using a
31                            ! Conrath type analytical equation
32  integer iaer_dust_doubleq ! Dust profile is given by the
33                            ! mass mixing ratio of the two-
34                            ! moment scheme method (doubleq)
35  integer iaer_dust_submicron ! Dust profile is given by a
36                              ! submicron population of dust
37                              ! particles
38  integer iaer_stormdust_doubleq ! Storm dust profile is given by the
39                              ! mass mixing ratio of the two moment scheme
40                              ! method (doubleq)
41  integer iaer_topdust_doubleq ! top dust profile is given by the
42                              ! mass mixing ratio of the two moment scheme
43                              ! method (doubleq)
44  integer iaer_h2o_ice ! Water ice particles
45  integer iaer_co2_ice ! CO2 ice particles
46
47  ! AS: was in aeropacity
48  INTEGER,SAVE,ALLOCATABLE :: iaerdust(:)
49
50!$OMP THREADPRIVATE(iaerdust)
51
52  ! AS: was in suaer
53  CHARACTER(LEN=30), SAVE, ALLOCATABLE :: file_id(:,:)
54
55!$OMP THREADPRIVATE(file_id)
56
57! Reference wavelengths used to compute reference optical depth (m)
58! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
59  REAL,SAVE,ALLOCATABLE :: longrefir(:),longrefvis(:)
60!$OMP THREADPRIVATE(longrefir,longrefvis)
61 
62! Definition of spectral intervals at thermal infrared wavelengths (LW)
63! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
64  integer,parameter :: nir=4 ! Total number of thermal IR bands
65  integer,parameter :: nuco2=2 ! number of bands in CO2 bands
66  real,parameter :: long1ir=5.E-6 , long2ir=200.E-6
67  real,parameter :: long1co2=1.E+0 / 865.E+2 , long2co2=1.E+0 / 500.E+2
68
69!  Warning : the "nir" thermal IR bands are not ordered by wavelength:
70!      iir=1 : central 15um CO2 bands     
71!      iir=2 : CO2 band wings    [long1co2-long2co2] MINUS central band
72!      iir=3 : 9 um band [long1ir - long1co2]
73!      iir=4 : Far IR    [long2co2 - long2ir]
74   
75!  Definition of spectral interval at solar wavelengths (SW)
76!  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
77  integer,parameter :: NSUN=2   ! do not change that !
78!  Boundaries of spectral intervals (m) :
79  real,parameter :: long1vis=0.1E-6 , long2vis=0.5E-6 , long3vis=5.E-6
80!  Fraction of solar energy in solar band #1 [long1vis-long2vis] : 0.274490
81!  Fraction of solar energy in solar band #2 [long2vis-long3vis] : 0.725509
82  real,save :: sunfr(2) = (/ 0.274490 , 0.725509 /)
83
84!$OMP THREADPRIVATE(sunfr)
85
86! Maximum number of grain size classes
87! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
88! This parameter has to be set to the maximum number of particle
89!   sizes contained in the optical parameter database; For example,
90!   if only one grain size is used to describe dust, and 30 are used
91!   to describe water-ice crystals in the visible and 15 in the IR,
92!   nsizemax has to be set to 30.
93! If only one grain size is considered for all the aerosols, set
94!   this parameter to 1 and convolution will be turned off during
95!   the radiative calculations.
96
97  integer, parameter :: nsizemax = 60
98! integer, parameter :: nsizemax = 1
99
100! Various initialisation for LW radiative code
101! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
102! npademx : number of Pade coefficients
103! nabsmx : ?
104! nt_pademx : number of temperature intervals for Pade
105
106  integer,parameter :: npademx=4
107  integer,parameter :: nabsmx=2
108  integer,parameter :: nt_pademx=19
109 
110! Solar flux constant at 1AU for slope scheme
111!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
112
113  real, parameter :: flux_1AU = 1370. ! solar constant (W.m-2)
114
115!!
116!! variables
117!!
118  REAL,SAVE,ALLOCATABLE :: dtrad(:,:) ! Net atm. radiative heating rate (K.s-1)
119  REAL,SAVE,ALLOCATABLE :: fluxrad_sky(:,:) ! rad. flux from sky absorbed by surface (W.m-2)
120  REAL,SAVE,ALLOCATABLE :: fluxrad(:,:) ! Net radiative surface flux (W.m-2)
121  REAL,SAVE,ALLOCATABLE :: albedo(:,:,:) ! Surface albedo in each solar band
122  REAL,SAVE,ALLOCATABLE :: totcloudfrac(:) ! total cloud fraction over the column
123! aerosol (dust or ice) extinction optical depth  at reference wavelength
124! "longrefvis" set in dimradmars_mod , for one of the "naerkind"  kind of
125! aerosol optical properties  :
126  REAL,SAVE,ALLOCATABLE :: aerosol(:,:,:)
127  REAL,SAVE,ALLOCATABLE :: nueffdust(:,:) ! Dust effective variance
128
129!$OMP THREADPRIVATE(dtrad,fluxrad_sky,fluxrad,albedo,totcloudfrac,aerosol,      &
130!$OMP                nueffdust)
131
132!! ------------------------------------------------------
133!! AS: what was previously in yomaer
134!   Shortwave
135!   ~~~~~~~~~
136!
137! tauvis: dust optical depth at reference wavelength  ("longrefvis" set
138! in dimradmars_mod : typically longrefvis = 0.67E-6 m, as measured by Viking )
139
140! For the "naerkind" kind of aerosol radiative properties :
141! QVISsQREF  :  Qext / Qext("longrefvis")   <--- For both solar bands
142! omegavis   :  sinle scattering albedo     <--- For both solar bands
143! gvis       :  assymetry factor            <--- For both solar bands
144!
145!   Longwave
146!   ~~~~~~~~
147!
148! For the "naerkind" kind of aerosol radiative properties :
149! QIRsQREF :  Qext / Qext("longrefvis")     <--- For the nir bandes IR
150! omegaIR  :  mean single scattering albedo <--- For the nir bandes IR
151! gIR      :  mean assymetry factor         <--- For the nir bandes IR
152!
153  real,save :: tauvis
154  real,save,allocatable :: QVISsQREF(:,:,:)
155  real,save,allocatable :: omegavis(:,:,:)
156  real,save,allocatable :: gvis(:,:,:)
157  real,save,allocatable :: QIRsQREF(:,:,:)
158  real,save,allocatable :: omegaIR(:,:,:)
159  real,save,allocatable :: gIR(:,:,:)
160
161!$OMP THREADPRIVATE(tauvis,QVISsQREF,omegavis,gvis,QIRsQREF,omegaIR,gIR)
162
163! Actual number of grain size classes in each domain for a
164!   given aerosol:
165  integer,save,allocatable :: nsize(:,:)
166! Particle size axis (depend on the kind of aerosol and the
167!   radiation domain)
168  real,save,allocatable :: radiustab(:,:,:)
169! Extinction coefficient at reference wavelengths;
170!   These wavelengths are defined in dimradmars_mod, and called
171!   longrefvis and longrefir.
172  real,save,allocatable :: QREFvis(:,:)
173  real,save,allocatable :: QREFir(:,:)
174  real,save,allocatable :: omegaREFvis(:,:)
175  real,save,allocatable :: omegaREFir(:,:)
176
177!$OMP THREADPRIVATE(nsize,radiustab,QREFvis,QREFir,omegaREFvis,omegaREFir)
178
179!! ------------------------------------------------------
180
181contains
182
183  subroutine ini_dimradmars_mod(ngrid,nlayer,nslope)
184 
185  implicit none
186 
187  integer,intent(in) :: ngrid ! number of atmospheric columns
188  integer,intent(in) :: nlayer ! number of atmospheric layers
189  integer,intent(in) :: nslope ! number of subgrid scale slopes
190   nflev=nlayer
191!  ndomainsz=ngrid
192   ndomainsz=(ngrid-1)/20 + 1
193!  ndomainsz=(ngrid-1)/5 + 1
194   ndlon=ndomainsz
195   ndlo2=ndlon
196
197   allocate(albedo(ngrid,2,nslope))
198   allocate(dtrad(ngrid,nlayer))
199   allocate(fluxrad_sky(ngrid,nslope))
200   allocate(fluxrad(ngrid,nslope))
201   allocate(nueffdust(ngrid,nlayer))
202   allocate(totcloudfrac(ngrid))
203
204  end subroutine ini_dimradmars_mod
205
206  subroutine end_dimradmars_mod
207
208  implicit none
209
210   if (allocated(albedo))      deallocate(albedo)
211   if (allocated(dtrad))       deallocate(dtrad)
212   if (allocated(fluxrad_sky)) deallocate(fluxrad_sky)
213   if (allocated(fluxrad))     deallocate(fluxrad)
214   if (allocated(nueffdust))   deallocate(nueffdust)
215   if (allocated(totcloudfrac))   deallocate(totcloudfrac)
216
217  end subroutine end_dimradmars_mod
218
219  subroutine ini_dimradmars_mod_slope_var(ngrid,nslope)
220 
221  implicit none
222 
223  integer,intent(in) :: ngrid ! number of atmospheric columns
224  integer,intent(in) :: nslope ! number of subgrid scale slopes
225
226   allocate(albedo(ngrid,2,nslope))
227   allocate(fluxrad_sky(ngrid,nslope))
228   allocate(fluxrad(ngrid,nslope))
229
230  end subroutine ini_dimradmars_mod_slope_var
231
232  subroutine end_dimradmars_mod_slope_var
233
234  implicit none
235
236   if (allocated(albedo))      deallocate(albedo)
237   if (allocated(fluxrad_sky)) deallocate(fluxrad_sky)
238   if (allocated(fluxrad))     deallocate(fluxrad)
239
240  end subroutine end_dimradmars_mod_slope_var
241
242 
243  subroutine ini_scatterers(ngrid,nlayer)
244
245  implicit none
246
247  integer,intent(in) :: ngrid ! number of atmospheric columns
248  integer,intent(in) :: nlayer ! number of atmospheric layers
249
250   !! domain-dependent
251   !! -- only used in physiq_mod & intent(out) in callradite
252   if (allocated(aerosol)) deallocate(aerosol)
253   allocate(aerosol(ngrid,nlayer,naerkind))
254
255   !! not domain-dependent
256   if (.not.allocated(name_iaer)) allocate(name_iaer(naerkind))
257   if (.not.allocated(longrefir)) allocate(longrefir(naerkind))
258   if (.not.allocated(longrefvis)) allocate(longrefvis(naerkind))
259   if (.not.allocated(iaerdust)) allocate(iaerdust(naerkind))
260   if (.not.allocated(file_id)) allocate(file_id(naerkind,2))
261   if (.not.allocated(QVISsQREF)) allocate(QVISsQREF(nsun,naerkind,nsizemax))
262   if (.not.allocated(omegavis)) allocate(omegavis(nsun,naerkind,nsizemax))
263   if (.not.allocated(gvis)) allocate(gvis(nsun,naerkind,nsizemax))
264   if (.not.allocated(QIRsQREF)) allocate(QIRsQREF(nir,naerkind,nsizemax))
265   if (.not.allocated(omegaIR)) allocate(omegaIR(nir,naerkind,nsizemax))
266   if (.not.allocated(gIR)) allocate(gIR(nir,naerkind,nsizemax))
267   if (.not.allocated(nsize)) allocate(nsize(naerkind,2))
268   if (.not.allocated(radiustab)) allocate(radiustab(naerkind,2,nsizemax))
269   if (.not.allocated(QREFvis)) allocate(QREFvis(naerkind,nsizemax))
270   if (.not.allocated(QREFir)) allocate(QREFir(naerkind,nsizemax))
271   if (.not.allocated(omegaREFvis)) allocate(omegaREFvis(naerkind,nsizemax))
272   if (.not.allocated(omegaREFir)) allocate(omegaREFir(naerkind,nsizemax))
273
274  end subroutine ini_scatterers
275
276end module dimradmars_mod
Note: See TracBrowser for help on using the repository browser.