Context Navigation

callradite_mod.F @ 2646

Last change on this file since 2646 was 2643, checked in by abierjon, 3 years ago

Mars GCM:
Implementation of the IRabs-to-VISext dust scenario conversion, depending on the GCM effective radius :

new flag 'reff_driven_IRtoVIS_scenario', false by default, must be set to true to use this dynamic conversion (otherwise, the coefficient takes the constant value of 2.6, eqv to reff=1.5um, as before) A specific line is added in deftank/callphys.def.GCM6
this flag requires the 'dustiropacity' to be set to 'tes' to match the IR scenario's wavelength. 'mcs'-like dso diagnostics can only be produced by the use of the post-processing tool util/aeroptical.F90
the variable IRtoVIScoef is computed in aeropacity via the GCM CDOD ratio : tau_pref_gcm_VIS/tau_pref_gcm_IR (only at the first call to callradite during each physical timestep)
change read_dust_scenario into module read_dust_scenario_mod

File size: 23.4 KB

Line
1	MODULE callradite_mod
2
3	IMPLICIT NONE
4
5	CONTAINS
6
7	SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
8	$ emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
9	$ dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,
10	$ fluxtop_sw,tau_pref_scenario,tau_pref_gcm,
11	& tau,aerosol,dsodust,tauscaling,dust_rad_adjust,IRtoVIScoef,
12	$ taucloudtes,rdust,rice,nuice,riceco2,nuiceco2,co2ice,
13	$ rstormdust,rtopdust,totstormfract,clearatm,dsords,dsotop,
14	$ nohmons,clearsky,totcloudfrac)
15
16	use aeropacity_mod, only: aeropacity
17	use updatereffrad_mod, only: updatereffrad
18	use dimradmars_mod, only: ndomainsz, nflev, nsun, nir
19	use dimradmars_mod, only: naerkind, name_iaer,
20	& iaer_dust_conrath,iaer_dust_doubleq,
21	& iaer_dust_submicron, iaer_h2o_ice, iaer_co2_ice,
22	& iaer_stormdust_doubleq,iaer_topdust_doubleq
23	use yomlw_h, only: gcp, nlaylte
24	use comcstfi_h, only: g,cpp
25	use time_phylmdz_mod, only: daysec
26	use lwmain_mod, only: lwmain
27	use swmain_mod, only: swmain
28	use dust_param_mod, only: doubleq, active, submicron
29	IMPLICIT NONE
30	c=======================================================================
31	c subject:
32	c --------
33	c Subroutine designed to call the main canonic
34	c radiative transfer subroutine "lwmain" et "swmain"
35	c to compute radiative heating and cooling rate and
36	c radiative fluxes to the surface.
37	c
38	c These calculations are only valid on the part of the atmosphere
39	c where Local Thermal Equilibrium (LTE) is verified. In practice
40	c the calculations are only performed for the first "nlaylte"
41	c parameters (nlaylte is calculated by subroutine "nlthermeq"
42	c and stored in module "yomlw_h").
43	c
44	c The purpose of this subroutine is to:
45	c 1) Make some initial calculation at first call
46	c 2) Split the calculation in several sub-grid
47	c ("sub-domain") to save memory and
48	c be able run on a workstation at high resolution
49	c The sub-grid size is defined in dimradmars_mod
50	c 3) Compute the 3D scattering parameters depending on the
51	c size distribution of the different tracers (added by JBM)
52	c 4) call "lwmain" and "swmain"
53	c
54	c
55	c authors:
56	c ------
57	c Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
58	c
59	c
60	c 3D scattering scheme user's guide (J.-B. Madeleine)
61	c ---------------------------------
62	c
63	c This routine has been modified to take into account 3D, time
64	c dependent scattering properties of the aerosols.
65	c---- The look-up tables that contain the scattering parameters
66	c of a given tracer, for different sizes, are read by SUAER.F90.
67	c The names of the corresponding ASCII files have to be set in
68	c this subroutine (file_id variable), and files must be in the
69	c directory specified in datafile_mod. Please make sure that the
70	c ASCII files are correctly written, and that the range
71	c of particle sizes is consistent with what you would expect.
72	c---- SUAER.F90 is in charge of reading the ASCII files and averaging
73	c the scattering parameters in each GCM channel, using the three last
74	c equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
75	c---- These look-up tables, loaded during the firstcall, are then
76	c constantly used by the subroutine "aeroptproperties.F" to compute,
77	c online, the 3D scattering parameters, based on the size distribution
78	c (reffrad and nueffrad) of the different tracers, in each grid box.
79	c These 3D size distributions are loaded by the "updatereffrad.F"
80	c subroutine. A log-normal distribution is then assumed in
81	c "aeroptproperties.F", along with a Gauss-Legendre integration.
82	c---- The optical depth at the visible reference wavelength (set in
83	c SUAER.F90, after the file_id variable) is then computed by
84	c the subroutine "aeropacity.F", by using the size and spatial
85	c distribution of the corresponding tracer. This connection has to
86	c be implemented in "aeropacity.F" when adding a new tracer. To do so,
87	c one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
88	c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
89	c "gVIS3d" (same in the infrared) are finally used by lwmain.F and
90	c swmain.F to solve the radiative transfer equation.
91	c
92	c changes:
93	c -------
94	c
95	c > SRL 7/2000
96	c
97	c This version has been modified to only calculate radiative tendencies
98	c over layers 1..NFLEV (set in dimradmars_mod). Returns zero for higher
99	c layers, if any.
100	c In other routines, nlayer -> nflev.
101	c Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
102	c
103	c > J.-B. Madeleine 10W12
104	c This version uses the variable's splitting, which can be usefull
105	c when performing very high resolution simulation like LES.
106	c
107	c ----------
108	c Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
109	c set in dimradmars_mod
110	c Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
111	c set in dimradmars_mod
112	c
113	c input:
114	c -----
115	c icount counter of call to subroutine physic by gcm
116	c ngrid number of gridpoint of horizontal grid
117	c nlayer Number of layer
118	c nq Number of tracer
119	c ls Solar longitude (Ls) , radian
120	c zday Date (time since Ls=0, in martian days)
121	c pq(ngrid,nlayer,nq) Advected fields
122	c
123	c albedo (ngrid,2) hemispheric surface albedo
124	c albedo (i,1) : mean albedo for solar band#1
125	c (see below)
126	c albedo (i,2) : mean albedo for solar band#2
127	c (see below)
128	c emis Thermal IR surface emissivity (no unit)
129	c mu0(ngrid) cos of solar zenith angle
130	c (=1 when sun at zenith)
131	c pplay(ngrid,nlayer) pressure (Pa) in the middle of each layer
132	c pplev(ngrid,nlayer+1) pressure (Pa) at boundaries of each layer
133	c pt(ngrid,nlayer) atmospheric temperature in each layer (K)
134	c tsurf(ngrid) surface temperature (K)
135	c fract(ngrid) day fraction of the time interval
136	c =1 during the full day ; =0 during the night
137	c declin latitude of subsolar point
138	c dist_sol sun-Mars distance (AU)
139	c igout coordinate of analysed point for debugging
140	c reffrad(ngrid,nlayer,naerkind) Aerosol effective radius
141	c nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
142
143	c
144	c output:
145	c -------
146	c dtlw (ngrid,nlayer) longwave (IR) heating rate (K/s)
147	c dtsw(ngrid,nlayer) shortwave (Solar) heating rate (K/s)
148	c fluxsurf_lw(ngrid) surface downward flux tota LW (thermal IR) (W.m-2)
149	c fluxsurf_sw(ngrid,1) surface downward flux SW for solar band#1 (W.m-2)
150	c fluxsurf_sw(ngrid,2) surface downward flux SW for solar band#2 (W.m-2)
151	c
152	c fluxtop_lw(ngrid) outgoing upward flux tota LW (thermal IR) (W.m-2)
153	c fluxtop_sw(ngrid,1) outgoing upward flux SW for solar band#1 (W.m-2)
154	c fluxtop_sw(ngrid,2) outgoing upward flux SW for solar band#2 (W.m-2)
155
156	c tau Column total visible dust optical depth at each point
157	c aerosol(ngrid,nlayer,naerkind) aerosol extinction optical depth
158	c at reference wavelength "longrefvis" set
159	c in dimradmars_h , in each layer, for one of
160	c the "naerkind" kind of aerosol optical
161	c properties.
162	c=======================================================================
163	c
164	c Declarations :
165	c -------------
166	c
167	include "callkeys.h"
168
169	c-----------------------------------------------------------------------
170	c Input/Output
171	c ------------
172	INTEGER,INTENT(IN) :: icount
173	INTEGER,INTENT(IN) :: ngrid,nlayer,nq
174	INTEGER,INTENT(IN) :: igout
175
176	REAL,INTENT(IN) :: pq(ngrid,nlayer,nq)
177	REAL,INTENT(INOUT) :: tauscaling(ngrid) ! Conversion factor for
178	! qdust and Ndust
179	REAL,INTENT(INOUT) :: dust_rad_adjust(ngrid) ! Radiative adjustment
180	! factor for dust
181	REAL,INTENT(INOUT) :: IRtoVIScoef(ngrid) ! conversion coefficient to apply on
182	! scenario absorption IR (9.3um) CDOD
183	! = tau_pref_gcm_VIS / tau_pref_gcm_IR
184	REAL,INTENT(IN) :: albedo(ngrid,2),emis(ngrid)
185	REAL,INTENT(IN) :: ls,zday
186
187	REAL,INTENT(IN) :: pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
188	REAL,INTENT(IN) :: pt(ngrid,nlayer)
189	REAL,INTENT(IN) :: tsurf(ngrid)
190	REAL,INTENT(IN) :: dist_sol,mu0(ngrid),fract(ngrid)
191	REAL,INTENT(OUT) :: dtlw(ngrid,nlayer),dtsw(ngrid,nlayer)
192	REAL,INTENT(OUT) :: fluxsurf_lw(ngrid), fluxtop_lw(ngrid)
193	REAL,INTENT(OUT) :: fluxsurf_sw(ngrid,2), fluxtop_sw(ngrid,2)
194	REAL,INTENT(OUT) :: tau_pref_scenario(ngrid) ! prescribed dust column
195	! visible opacity at odpref from scenario
196	REAL,INTENT(OUT) :: tau_pref_gcm(ngrid) ! computed dust column
197	! visible opacity at odpref in the GCM
198	REAL,INTENT(OUT) :: tau(ngrid,naerkind)
199	REAL,INTENT(OUT) :: taucloudtes(ngrid)! Cloud opacity at infrared
200	! reference wavelength using
201	! Qabs instead of Qext
202	! (direct comparison with TES)
203	REAL,INTENT(OUT) :: aerosol(ngrid,nlayer,naerkind)
204	REAL,INTENT(INOUT) :: dsodust(ngrid,nlayer)
205	REAL,INTENT(OUT) :: rdust(ngrid,nlayer) ! Dust geometric mean radius (m)
206	REAL,INTENT(OUT) :: rice(ngrid,nlayer) ! Ice geometric mean radius (m)
207	REAL,INTENT(OUT) :: nuice(ngrid,nlayer) ! Estimated effective variance
208	double precision,INTENT(OUT) :: riceco2(ngrid,nlayer) ! CO2 ice mean radius(m)
209	REAL,INTENT(OUT) :: nuiceco2(ngrid,nlayer) ! Effective variance
210	REAL,INTENT(IN) :: co2ice(ngrid) ! co2 ice surface layer (kg.m-2)
211
212	c rocket dust storm
213	LOGICAL,INTENT(IN) :: clearatm ! true for background dust
214	REAL,INTENT(IN) :: totstormfract(ngrid) ! dust storm mesh fraction
215	REAL,INTENT(OUT) :: rstormdust(ngrid,nlayer) ! Storm dust geometric mean radius (m)
216	REAL,INTENT(OUT) :: dsords(ngrid,nlayer) ! density scaled opacity for rocket dust storm dust
217
218	c entrainment by mountain top dust flows
219	LOGICAL, INTENT(IN) :: nohmons ! true for background dust
220	REAL,INTENT(OUT) :: rtopdust(ngrid,nlayer) ! Topdust geometric mean radius (m)
221	REAL,INTENT(OUT) :: dsotop(ngrid,nlayer) ! density scaled opacity for topmons dust
222
223	c sub-grid scale water ice clouds
224	LOGICAL,INTENT(IN) :: clearsky
225	REAL,INTENT(IN) :: totcloudfrac(ngrid)
226
227	c
228	c Local variables :
229	c -----------------
230
231	INTEGER j,l,ig,n,ich
232	INTEGER aer_count,iaer
233	INTEGER jd,ig0,nd
234
235	real cste_mars ! solar constant on Mars (Wm-2)
236	REAL ptlev(ngrid,nlayer+1)
237
238	INTEGER :: ndomain
239
240	c Thermal IR net radiative budget (W m-2)
241
242	real znetrad(ndomainsz,nflev)
243
244	real zfluxd_sw(ndomainsz,nflev+1,2)
245	real zfluxu_sw(ndomainsz,nflev+1,2)
246
247	REAL zplev(ndomainsz,nflev+1)
248	REAL zztlev(ndomainsz,nflev+1)
249	REAL zplay(ndomainsz,nflev)
250	REAL zt(ndomainsz,nflev)
251	REAL zaerosol(ndomainsz,nflev,naerkind)
252	REAL zalbedo(ndomainsz,2)
253	REAL zdp(ndomainsz,nflev)
254	REAL zdt0(ndomainsz)
255
256	REAL zzdtlw(ndomainsz,nflev)
257	REAL zzdtsw(ndomainsz,nflev)
258	REAL zzflux(ndomainsz,6)
259	real zrmuz
260
261	REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
262	REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
263	REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
264
265	REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
266	REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
267	REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
268
269	c Aerosol size distribution
270	REAL :: reffrad(ngrid,nlayer,naerkind)
271	REAL :: nueffrad(ngrid,nlayer,naerkind)
272	c Aerosol optical properties
273	REAL :: QVISsQREF3d(ngrid,nlayer,nsun,naerkind)
274	REAL :: omegaVIS3d(ngrid,nlayer,nsun,naerkind)
275	REAL :: gVIS3d(ngrid,nlayer,nsun,naerkind)
276
277	REAL :: QIRsQREF3d(ngrid,nlayer,nir,naerkind)
278	REAL :: omegaIR3d(ngrid,nlayer,nir,naerkind)
279	REAL :: gIR3d(ngrid,nlayer,nir,naerkind)
280
281	REAL :: QREFvis3d(ngrid,nlayer,naerkind)
282	! QREFvis3d : Extinction efficiency at the VISible reference wavelength
283	REAL :: QREFir3d(ngrid,nlayer,naerkind)
284	! QREFir3d : Extinction efficiency at the InfraRed reference wavelength
285
286	REAL :: omegaREFvis3d(ngrid,nlayer,naerkind)
287	REAL :: omegaREFir3d(ngrid,nlayer,naerkind)
288
289	c local saved variables
290	c ---------------------
291
292	real zco2 ! volume fraction of CO2 in Mars atmosphere
293	!$OMP THREADPRIVATE(zco2)
294	DATA zco2/0.95/
295	SAVE zco2
296
297	LOGICAL firstcall
298	!$OMP THREADPRIVATE(firstcall)
299	DATA firstcall/.true./
300	SAVE firstcall
301
302
303
304	c----------------------------------------------------------------------
305
306	c Initialisation
307	c --------------
308
309	! compute ndomain
310	! AS: moved out of firstcall to allow nesting+evoluting domain
311	! ------------------------------------------------------------
312	ndomain= (ngrid-1) / ndomainsz + 1
313
314	IF (firstcall) THEN
315
316	write(,) 'Splitting radiative calculations: ',
317	$ ' ngrid,ndomainsz,ndomain',
318	$ ngrid,ndomainsz,ndomain
319
320	c Assign a number to the different scatterers
321	c -------------------------------------------
322
323	iaer_dust_conrath=0
324	iaer_dust_doubleq=0
325	iaer_dust_submicron=0
326	iaer_h2o_ice=0
327	iaer_co2_ice=0
328	iaer_stormdust_doubleq=0
329	iaer_topdust_doubleq=0
330
331	aer_count=0
332	if (.NOT.active) then
333	do iaer=1,naerkind
334	if (name_iaer(iaer).eq."dust_conrath") then
335	iaer_dust_conrath = iaer
336	aer_count = aer_count + 1
337	endif
338	enddo
339	endif
340	if (doubleq.AND.active) then
341	do iaer=1,naerkind
342	if (name_iaer(iaer).eq."dust_doubleq") then
343	iaer_dust_doubleq = iaer
344	aer_count = aer_count + 1
345	endif
346	enddo
347	endif
348	if (submicron.AND.active) then
349	do iaer=1,naerkind
350	if (name_iaer(iaer).eq."dust_submicron") then
351	iaer_dust_submicron = iaer
352	aer_count = aer_count + 1
353	endif
354	enddo
355	endif
356	if (water.AND.activice) then
357	do iaer=1,naerkind
358	if (name_iaer(iaer).eq."h2o_ice") then
359	iaer_h2o_ice = iaer
360	aer_count = aer_count + 1
361	endif
362	enddo
363	endif
364	if (co2clouds.AND.activeco2ice) then
365	do iaer=1,naerkind
366	if (name_iaer(iaer).eq."co2_ice") then
367	iaer_co2_ice = iaer
368	aer_count = aer_count + 1
369	endif
370	enddo
371	endif
372	if (rdstorm.AND.active) then
373	do iaer=1,naerkind
374	if (name_iaer(iaer).eq."stormdust_doubleq") then
375	iaer_stormdust_doubleq = iaer
376	aer_count = aer_count + 1
377	endif
378	enddo
379	end if
380	if (topflows.AND.active) then
381	do iaer=1,naerkind
382	if (name_iaer(iaer).eq."topdust_doubleq") then
383	iaer_topdust_doubleq = iaer
384	aer_count = aer_count + 1
385	endif
386	enddo
387	end if
388
389	c Check that we identified all tracers:
390	if (aer_count.ne.naerkind) then
391	write(,) "callradite: found only ",aer_count," scatterers"
392	write(,) " expected ",naerkind
393	write(,) "please make sure that the number of"
394	write(,) "scatterers in scatterers.h, the names"
395	write(,) "in callradite.F, and the flags in"
396	write(,) "callphys.def are all consistent!"
397	do iaer=1,naerkind
398	write(,)' ',iaer,' ',trim(name_iaer(iaer))
399	enddo
400	call abort_physic("callradite","incoherent scatterers",1)
401	else
402	write(,) "callradite: found all scatterers, namely:"
403	do iaer=1,naerkind
404	write(,)' ',iaer,' ',trim(name_iaer(iaer))
405	enddo
406	endif
407	c -------------------------------------------
408
409	gcp = g/cpp
410
411
412	c Loading the optical properties in external look-up tables:
413
414	CALL SUAER
415
416	! CALL SULW ! this step is now done in ini_yomlw_h
417
418	if (ngrid .EQ. 1) then
419	if (ndomainsz .NE. 1) then
420	print*
421	print*,'ATTENTION !!!'
422	print*,'pour tourner en 1D, '
423	print*,'fixer ndomainsz=1 dans phymars/dimradmars_h'
424	print*
425	call exit(1)
426	endif
427	endif
428
429	firstcall=.false.
430	END IF
431
432	c Computing aerosol optical properties and opacity
433	c ------------------------------------------------
434	c Updating aerosol size distributions:
435	CALL updatereffrad(ngrid,nlayer,
436	& rdust,rstormdust,rtopdust,rice,nuice,
437	& reffrad,nueffrad, riceco2, nuiceco2,
438	& pq,tauscaling,tau,pplay, pt)
439	c Computing 3D scattering parameters:
440	gVIS3d(:,:,:,:) = 0.
441	CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
442	& QVISsQREF3d,omegaVIS3d,gVIS3d,
443	& QIRsQREF3d,omegaIR3d,gIR3d,
444	& QREFvis3d,QREFir3d,
445	& omegaREFvis3d,omegaREFir3d)
446	c Computing aerosol optical depth in each layer:
447	CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
448	& pq,pt,tauscaling,dust_rad_adjust,IRtoVIScoef,
449	& tau_pref_scenario,tau_pref_gcm,tau,taucloudtes,
450	& aerosol,dsodust,reffrad,
451	& QREFvis3d,QREFir3d,omegaREFir3d,
452	& totstormfract,clearatm,dsords,dsotop,
453	& nohmons,clearsky,totcloudfrac)
454
455	c Starting loop on sub-domain
456	c ----------------------------
457	zgVIS3d(:,:,:,:) = 0.
458	zfluxd_sw(:,:,:) = 0.
459	zfluxu_sw(:,:,:) = 0.
460	zQVISsQREF3d(:,:,:,:) = 0.
461	zomegaVIS3d(:,:,:,:) = 0.
462	DO jd=1,ndomain
463	ig0=(jd-1)*ndomainsz
464	if (jd.eq.ndomain) then
465	nd=ngrid-ig0
466	else
467	nd=ndomainsz
468	endif
469
470	c Spliting input variable in sub-domain input variables
471	c ---------------------------------------------------
472
473	do l=1,nlaylte
474	do ig = 1,nd
475	do iaer = 1, naerkind
476	do ich = 1, nsun
477	zQVISsQREF3d(ig,l,ich,iaer) =
478	& QVISsQREF3d(ig0+ig,l,ich,iaer)
479	zomegaVIS3d(ig,l,ich,iaer) =
480	& omegaVIS3d(ig0+ig,l,ich,iaer)
481	zgVIS3d(ig,l,ich,iaer) =
482	& gVIS3d(ig0+ig,l,ich,iaer)
483	enddo
484	do ich = 1, nir
485	zQIRsQREF3d(ig,l,ich,iaer) =
486	& QIRsQREF3d(ig0+ig,l,ich,iaer)
487	zomegaIR3d(ig,l,ich,iaer) =
488	& omegaIR3d(ig0+ig,l,ich,iaer)
489	zgIR3d(ig,l,ich,iaer) =
490	& gIR3d(ig0+ig,l,ich,iaer)
491	enddo
492	enddo
493	enddo
494	enddo
495	zplev(:,:) = 0.
496	do l=1,nlaylte+1
497	do ig = 1,nd
498	zplev(ig,l) = pplev(ig0+ig,l)
499	enddo
500	enddo
501	zdp(:,:) = 0.
502
503	do l=1,nlaylte
504	do ig = 1,nd
505	zplay(ig,l) = pplay(ig0+ig,l)
506	zt(ig,l) = pt(ig0+ig,l)
507	c Thickness of each layer (Pa) :
508	zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
509	enddo
510	enddo
511	zaerosol(:,:,:) = 0.
512	do n=1,naerkind
513	do l=1,nlaylte
514	do ig=1,nd
515	zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
516	enddo
517	enddo
518	enddo
519	zalbedo(:,:) = 0.
520	do j=1,2
521	do ig = 1,nd
522	zalbedo(ig,j) = albedo(ig0+ig,j)
523	enddo
524	enddo
525
526	c Intermediate levels: (computing tlev)
527	c ---------------------------------------
528	c Extrapolation for the air temperature above the surface
529	DO ig=1,nd
530	zztlev(ig,1)=zt(ig,1)+
531	s (zplev(ig,1)-zplay(ig,1))*
532	s (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
533
534	zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
535	ENDDO
536
537	DO l=2,nlaylte
538	DO ig=1, nd
539	zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l))
540	ENDDO
541	ENDDO
542
543	DO ig=1, nd
544	zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
545	ENDDO
546
547
548	c Longwave ("lw") radiative transfer (= thermal infrared)
549	c -------------------------------------------------------
550	call lwmain (ig0,icount,nd,nflev
551	. ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
552	. ,zaerosol,zzdtlw
553	. ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
554	. ,znetrad
555	& ,zQIRsQREF3d,zomegaIR3d,zgIR3d
556	& ,co2ice(ig0+1))
557
558	c Shortwave ("sw") radiative transfer (= solar radiation)
559	c -------------------------------------------------------
560	c Mars solar constant (W m-2)
561	c 1370 W.m-2 is the solar constant at 1 AU.
562	cste_mars=1370./(dist_sol*dist_sol)
563	zzdtsw(:,:) = 0.
564	call swmain ( nd, nflev,
565	S cste_mars, zalbedo,
566	S mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
567	S zzdtsw, zfluxd_sw, zfluxu_sw,
568	& zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
569	c ------------------------------------------------------------
570	c Un-spliting output variable from sub-domain input variables
571	c ------------------------------------------------------------
572
573	do l=1,nlaylte
574	do ig = 1,nd
575	dtlw(ig0+ig,l) = zzdtlw(ig,l)
576	dtsw(ig0+ig,l) = zzdtsw(ig,l)
577	enddo
578	enddo
579
580	ptlev(:, :) = 0.
581	do l=1,nlaylte+1
582	do ig = 1,nd
583	ptlev(ig0+ig,l) = zztlev(ig,l)
584	enddo
585	enddo
586
587	do ig = 1,nd
588	fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
589	fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
590	fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
591	fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
592	enddo
593
594	ENDDO ! (boucle jd=1, ndomain)
595
596	c Zero tendencies for any remaining layers between nlaylte and nlayer
597	if (nlayer.gt.nlaylte) then
598	do l = nlaylte+1, nlayer
599	do ig = 1, ngrid
600	dtlw(ig, l) = 0.
601	dtsw(ig, l) = 0.
602	enddo
603	enddo
604	endif
605	c Output for debugging if lwrite=T
606	c --------------------------------
607	c Write all nlayer layers, even though only nlaylte layers may have
608	c non-zero tendencies.
609
610	IF(lwrite) THEN
611	PRINT*,'Diagnotique for the radiation'
612	PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
613	PRINT*,albedo(igout,1),emis(igout),mu0(igout),
614	s fract(igout), fluxsurf_lw(igout),
615	$ fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
616	PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
617	PRINT*,'daysec',daysec
618	DO l=1,nlayer
619	PRINT*,pt(igout,l),ptlev(igout,l),
620	s pplay(igout,l),pplev(igout,l),
621	s dtsw(igout,l),dtlw(igout,l)
622	ENDDO
623	ENDIF
624
625
626	END SUBROUTINE callradite
627
628	END MODULE callradite_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format