Context Navigation

callradite_mod.F @ 2514

Last change on this file since 2514 was 2494, checked in by cmathe, 4 years ago

Mars GCM:
co2_ice as scatterer in radiative transfert. Need co2clouds and

activeco2ice .eqv. True. Files involved:

aeropacity_mod.F
callradite_mod.F
physiq_mod.F
updatereffrad_mod.F
suaer.F90

determine co2_ice density from temperature. Used in riceco2 computation.

Files involved:

co2cloud.F90
improvedco2clouds_mod.F90
updaterad.F90
updatereffrad_mod.F

co2condens_mod4micro.F: variable initialization
initracer.F: add nuiceco2_ref = 0.2
phyredem.F: remove co2_ice from qsurf since co2_ice => co2ice
watercloud_mod.F: tiny typo

File size: 23.1 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,
12	$ taucloudtes,rdust,rice,nuice,riceco2,nuiceco2,co2ice,
13	$ rstormdust,rtopdust,totstormfract,clearatm,dsords,dsotop,
14	$ alpha_hmons,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(OUT) :: dust_rad_adjust(ngrid) ! Radiative adjustment
180	! factor for dust
181	REAL,INTENT(IN) :: albedo(ngrid,2),emis(ngrid)
182	REAL,INTENT(IN) :: ls,zday
183
184	REAL,INTENT(IN) :: pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
185	REAL,INTENT(IN) :: pt(ngrid,nlayer)
186	REAL,INTENT(IN) :: tsurf(ngrid)
187	REAL,INTENT(IN) :: dist_sol,mu0(ngrid),fract(ngrid)
188	REAL,INTENT(OUT) :: dtlw(ngrid,nlayer),dtsw(ngrid,nlayer)
189	REAL,INTENT(OUT) :: fluxsurf_lw(ngrid), fluxtop_lw(ngrid)
190	REAL,INTENT(OUT) :: fluxsurf_sw(ngrid,2), fluxtop_sw(ngrid,2)
191	REAL,INTENT(OUT) :: tau_pref_scenario(ngrid) ! prescribed dust column
192	! visible opacity at odpref from scenario
193	REAL,INTENT(OUT) :: tau_pref_gcm(ngrid) ! computed dust column
194	! visible opacity at odpref in the GCM
195	REAL,INTENT(OUT) :: tau(ngrid,naerkind)
196	REAL,INTENT(OUT) :: taucloudtes(ngrid)! Cloud opacity at infrared
197	! reference wavelength using
198	! Qabs instead of Qext
199	! (direct comparison with TES)
200	REAL,INTENT(OUT) :: aerosol(ngrid,nlayer,naerkind)
201	REAL,INTENT(INOUT) :: dsodust(ngrid,nlayer)
202	REAL,INTENT(OUT) :: rdust(ngrid,nlayer) ! Dust geometric mean radius (m)
203	REAL,INTENT(OUT) :: rice(ngrid,nlayer) ! Ice geometric mean radius (m)
204	REAL,INTENT(OUT) :: nuice(ngrid,nlayer) ! Estimated effective variance
205	double precision,INTENT(OUT) :: riceco2(ngrid,nlayer) ! CO2 ice mean radius(m)
206	REAL,INTENT(OUT) :: nuiceco2(ngrid,nlayer) ! Effective variance
207	REAL,INTENT(IN) :: co2ice(ngrid) ! co2 ice surface layer (kg.m-2)
208
209	c rocket dust storm
210	LOGICAL,INTENT(IN) :: clearatm ! true for background dust
211	REAL,INTENT(IN) :: totstormfract(ngrid) ! dust storm mesh fraction
212	REAL,INTENT(OUT) :: rstormdust(ngrid,nlayer) ! Storm dust geometric mean radius (m)
213	REAL,INTENT(OUT) :: dsords(ngrid,nlayer) ! density scaled opacity for rocket dust storm dust
214
215	c entrainment by slope wind
216	LOGICAL, INTENT(IN) :: nohmons ! true for background dust
217	REAL, INTENT(IN) :: alpha_hmons(ngrid) ! sub-grid scale topography mesh fraction
218	REAL,INTENT(OUT) :: rtopdust(ngrid,nlayer) ! Topdust geometric mean radius (m)
219	REAL,INTENT(OUT) :: dsotop(ngrid,nlayer) ! density scaled opacity for topmons dust
220
221	c sub-grid scale water ice clouds
222	LOGICAL,INTENT(IN) :: clearsky
223	REAL,INTENT(IN) :: totcloudfrac(ngrid)
224
225	c
226	c Local variables :
227	c -----------------
228
229	INTEGER j,l,ig,n,ich
230	INTEGER aer_count,iaer
231	INTEGER jd,ig0,nd
232
233	real cste_mars ! solar constant on Mars (Wm-2)
234	REAL ptlev(ngrid,nlayer+1)
235
236	INTEGER :: ndomain
237
238	c Thermal IR net radiative budget (W m-2)
239
240	real znetrad(ndomainsz,nflev)
241
242	real zfluxd_sw(ndomainsz,nflev+1,2)
243	real zfluxu_sw(ndomainsz,nflev+1,2)
244
245	REAL zplev(ndomainsz,nflev+1)
246	REAL zztlev(ndomainsz,nflev+1)
247	REAL zplay(ndomainsz,nflev)
248	REAL zt(ndomainsz,nflev)
249	REAL zaerosol(ndomainsz,nflev,naerkind)
250	REAL zalbedo(ndomainsz,2)
251	REAL zdp(ndomainsz,nflev)
252	REAL zdt0(ndomainsz)
253
254	REAL zzdtlw(ndomainsz,nflev)
255	REAL zzdtsw(ndomainsz,nflev)
256	REAL zzflux(ndomainsz,6)
257	real zrmuz
258
259	REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
260	REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
261	REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
262
263	REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
264	REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
265	REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
266
267	c Aerosol size distribution
268	REAL :: reffrad(ngrid,nlayer,naerkind)
269	REAL :: nueffrad(ngrid,nlayer,naerkind)
270	c Aerosol optical properties
271	REAL :: QVISsQREF3d(ngrid,nlayer,nsun,naerkind)
272	REAL :: omegaVIS3d(ngrid,nlayer,nsun,naerkind)
273	REAL :: gVIS3d(ngrid,nlayer,nsun,naerkind)
274
275	REAL :: QIRsQREF3d(ngrid,nlayer,nir,naerkind)
276	REAL :: omegaIR3d(ngrid,nlayer,nir,naerkind)
277	REAL :: gIR3d(ngrid,nlayer,nir,naerkind)
278
279	REAL :: QREFvis3d(ngrid,nlayer,naerkind)
280	! QREFvis3d : Extinction efficiency at the VISible reference wavelength
281	REAL :: QREFir3d(ngrid,nlayer,naerkind)
282	! QREFir3d : Extinction efficiency at the InfraRed reference wavelength
283
284	REAL :: omegaREFvis3d(ngrid,nlayer,naerkind)
285	REAL :: omegaREFir3d(ngrid,nlayer,naerkind)
286
287	c local saved variables
288	c ---------------------
289
290	real zco2 ! volume fraction of CO2 in Mars atmosphere
291	DATA zco2/0.95/
292	SAVE zco2
293
294	LOGICAL firstcall
295	DATA firstcall/.true./
296	SAVE firstcall
297
298	c----------------------------------------------------------------------
299
300	c Initialisation
301	c --------------
302
303	! compute ndomain
304	! AS: moved out of firstcall to allow nesting+evoluting domain
305	! ------------------------------------------------------------
306	ndomain= (ngrid-1) / ndomainsz + 1
307
308	IF (firstcall) THEN
309
310	write(,) 'Splitting radiative calculations: ',
311	$ ' ngrid,ndomainsz,ndomain',
312	$ ngrid,ndomainsz,ndomain
313
314	c Assign a number to the different scatterers
315	c -------------------------------------------
316
317	iaer_dust_conrath=0
318	iaer_dust_doubleq=0
319	iaer_dust_submicron=0
320	iaer_h2o_ice=0
321	iaer_co2_ice=0
322	iaer_stormdust_doubleq=0
323	iaer_topdust_doubleq=0
324
325	aer_count=0
326	if (.NOT.active) then
327	do iaer=1,naerkind
328	if (name_iaer(iaer).eq."dust_conrath") then
329	iaer_dust_conrath = iaer
330	aer_count = aer_count + 1
331	endif
332	enddo
333	endif
334	if (doubleq.AND.active) then
335	do iaer=1,naerkind
336	if (name_iaer(iaer).eq."dust_doubleq") then
337	iaer_dust_doubleq = iaer
338	aer_count = aer_count + 1
339	endif
340	enddo
341	endif
342	if (submicron.AND.active) then
343	do iaer=1,naerkind
344	if (name_iaer(iaer).eq."dust_submicron") then
345	iaer_dust_submicron = iaer
346	aer_count = aer_count + 1
347	endif
348	enddo
349	endif
350	if (water.AND.activice) then
351	do iaer=1,naerkind
352	if (name_iaer(iaer).eq."h2o_ice") then
353	iaer_h2o_ice = iaer
354	aer_count = aer_count + 1
355	endif
356	enddo
357	endif
358	if (co2clouds.AND.activeco2ice) then
359	do iaer=1,naerkind
360	if (name_iaer(iaer).eq."co2_ice") then
361	iaer_co2_ice = iaer
362	aer_count = aer_count + 1
363	endif
364	enddo
365	endif
366	if (rdstorm.AND.active) then
367	do iaer=1,naerkind
368	if (name_iaer(iaer).eq."stormdust_doubleq") then
369	iaer_stormdust_doubleq = iaer
370	aer_count = aer_count + 1
371	endif
372	enddo
373	end if
374	if (slpwind.AND.active) then
375	do iaer=1,naerkind
376	if (name_iaer(iaer).eq."topdust_doubleq") then
377	iaer_topdust_doubleq = iaer
378	aer_count = aer_count + 1
379	endif
380	enddo
381	end if
382
383	c Check that we identified all tracers:
384	if (aer_count.ne.naerkind) then
385	write(,) "callradite: found only ",aer_count," scatterers"
386	write(,) " expected ",naerkind
387	write(,) "please make sure that the number of"
388	write(,) "scatterers in scatterers.h, the names"
389	write(,) "in callradite.F, and the flags in"
390	write(,) "callphys.def are all consistent!"
391	do iaer=1,naerkind
392	write(,)' ',iaer,' ',trim(name_iaer(iaer))
393	enddo
394	call abort_physic("callradite","incoherent scatterers",1)
395	else
396	write(,) "callradite: found all scatterers, namely:"
397	do iaer=1,naerkind
398	write(,)' ',iaer,' ',trim(name_iaer(iaer))
399	enddo
400	endif
401	c -------------------------------------------
402
403	gcp = g/cpp
404
405	c Loading the optical properties in external look-up tables:
406	CALL SUAER
407	! CALL SULW ! this step is now done in ini_yomlw_h
408
409	if (ngrid .EQ. 1) then
410	if (ndomainsz .NE. 1) then
411	print*
412	print*,'ATTENTION !!!'
413	print*,'pour tourner en 1D, '
414	print*,'fixer ndomainsz=1 dans phymars/dimradmars_h'
415	print*
416	call exit(1)
417	endif
418	endif
419
420	firstcall=.false.
421	END IF
422
423	c Computing aerosol optical properties and opacity
424	c ------------------------------------------------
425	c Updating aerosol size distributions:
426	CALL updatereffrad(ngrid,nlayer,
427	& rdust,rstormdust,rtopdust,rice,nuice,
428	& reffrad,nueffrad, riceco2, nuiceco2,
429	& pq,tauscaling,tau,pplay, pt)
430	c Computing 3D scattering parameters:
431	gVIS3d(:,:,:,:) = 0.
432	CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
433	& QVISsQREF3d,omegaVIS3d,gVIS3d,
434	& QIRsQREF3d,omegaIR3d,gIR3d,
435	& QREFvis3d,QREFir3d,
436	& omegaREFvis3d,omegaREFir3d)
437	c Computing aerosol optical depth in each layer:
438	CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
439	& pq,pt,tauscaling,dust_rad_adjust,tau_pref_scenario,
440	& tau_pref_gcm,tau,taucloudtes,aerosol,dsodust,reffrad,
441	& QREFvis3d,QREFir3d,omegaREFir3d,
442	& totstormfract,clearatm,dsords,dsotop,
443	& alpha_hmons,nohmons,
444	& clearsky,totcloudfrac)
445	c Starting loop on sub-domain
446	c ----------------------------
447	zgVIS3d(:,:,:,:) = 0.
448	zfluxd_sw(:,:,:) = 0.
449	zfluxu_sw(:,:,:) = 0.
450	zQVISsQREF3d(:,:,:,:) = 0.
451	zomegaVIS3d(:,:,:,:) = 0.
452	DO jd=1,ndomain
453	ig0=(jd-1)*ndomainsz
454	if (jd.eq.ndomain) then
455	nd=ngrid-ig0
456	else
457	nd=ndomainsz
458	endif
459
460	c Spliting input variable in sub-domain input variables
461	c ---------------------------------------------------
462
463	do l=1,nlaylte
464	do ig = 1,nd
465	do iaer = 1, naerkind
466	do ich = 1, nsun
467	zQVISsQREF3d(ig,l,ich,iaer) =
468	& QVISsQREF3d(ig0+ig,l,ich,iaer)
469	zomegaVIS3d(ig,l,ich,iaer) =
470	& omegaVIS3d(ig0+ig,l,ich,iaer)
471	zgVIS3d(ig,l,ich,iaer) =
472	& gVIS3d(ig0+ig,l,ich,iaer)
473	enddo
474	do ich = 1, nir
475	zQIRsQREF3d(ig,l,ich,iaer) =
476	& QIRsQREF3d(ig0+ig,l,ich,iaer)
477	zomegaIR3d(ig,l,ich,iaer) =
478	& omegaIR3d(ig0+ig,l,ich,iaer)
479	zgIR3d(ig,l,ich,iaer) =
480	& gIR3d(ig0+ig,l,ich,iaer)
481	enddo
482	enddo
483	enddo
484	enddo
485	zplev(:,:) = 0.
486	do l=1,nlaylte+1
487	do ig = 1,nd
488	zplev(ig,l) = pplev(ig0+ig,l)
489	enddo
490	enddo
491	zdp(:,:) = 0.
492
493	do l=1,nlaylte
494	do ig = 1,nd
495	zplay(ig,l) = pplay(ig0+ig,l)
496	zt(ig,l) = pt(ig0+ig,l)
497	c Thickness of each layer (Pa) :
498	zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
499	enddo
500	enddo
501	zaerosol(:,:,:) = 0.
502	do n=1,naerkind
503	do l=1,nlaylte
504	do ig=1,nd
505	zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
506	enddo
507	enddo
508	enddo
509	zalbedo(:,:) = 0.
510	do j=1,2
511	do ig = 1,nd
512	zalbedo(ig,j) = albedo(ig0+ig,j)
513	enddo
514	enddo
515
516	c Intermediate levels: (computing tlev)
517	c ---------------------------------------
518	c Extrapolation for the air temperature above the surface
519	DO ig=1,nd
520	zztlev(ig,1)=zt(ig,1)+
521	s (zplev(ig,1)-zplay(ig,1))*
522	s (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
523
524	zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
525	ENDDO
526
527	DO l=2,nlaylte
528	DO ig=1, nd
529	zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l))
530	ENDDO
531	ENDDO
532
533	DO ig=1, nd
534	zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
535	ENDDO
536
537
538	c Longwave ("lw") radiative transfer (= thermal infrared)
539	c -------------------------------------------------------
540	call lwmain (ig0,icount,nd,nflev
541	. ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
542	. ,zaerosol,zzdtlw
543	. ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
544	. ,znetrad
545	& ,zQIRsQREF3d,zomegaIR3d,zgIR3d
546	& ,co2ice(ig0+1))
547
548	c Shortwave ("sw") radiative transfer (= solar radiation)
549	c -------------------------------------------------------
550	c Mars solar constant (W m-2)
551	c 1370 W.m-2 is the solar constant at 1 AU.
552	cste_mars=1370./(dist_sol*dist_sol)
553	zzdtsw(:,:) = 0.
554	call swmain ( nd, nflev,
555	S cste_mars, zalbedo,
556	S mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
557	S zzdtsw, zfluxd_sw, zfluxu_sw,
558	& zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
559	c ------------------------------------------------------------
560	c Un-spliting output variable from sub-domain input variables
561	c ------------------------------------------------------------
562
563	do l=1,nlaylte
564	do ig = 1,nd
565	dtlw(ig0+ig,l) = zzdtlw(ig,l)
566	dtsw(ig0+ig,l) = zzdtsw(ig,l)
567	enddo
568	enddo
569
570	ptlev(:, :) = 0.
571	do l=1,nlaylte+1
572	do ig = 1,nd
573	ptlev(ig0+ig,l) = zztlev(ig,l)
574	enddo
575	enddo
576
577	do ig = 1,nd
578	fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
579	fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
580	fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
581	fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
582	enddo
583
584	ENDDO ! (boucle jd=1, ndomain)
585
586	c Zero tendencies for any remaining layers between nlaylte and nlayer
587	if (nlayer.gt.nlaylte) then
588	do l = nlaylte+1, nlayer
589	do ig = 1, ngrid
590	dtlw(ig, l) = 0.
591	dtsw(ig, l) = 0.
592	enddo
593	enddo
594	endif
595	c Output for debugging if lwrite=T
596	c --------------------------------
597	c Write all nlayer layers, even though only nlaylte layers may have
598	c non-zero tendencies.
599
600	IF(lwrite) THEN
601	PRINT*,'Diagnotique for the radiation'
602	PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
603	PRINT*,albedo(igout,1),emis(igout),mu0(igout),
604	s fract(igout), fluxsurf_lw(igout),
605	$ fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
606	PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
607	PRINT*,'daysec',daysec
608	DO l=1,nlayer
609	PRINT*,pt(igout,l),ptlev(igout,l),
610	s pplay(igout,l),pplev(igout,l),
611	s dtsw(igout,l),dtlw(igout,l)
612	ENDDO
613	ENDIF
614
615
616	END SUBROUTINE callradite
617
618	END MODULE callradite_mod

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

Download in other formats:

Original Format