Context Navigation

callradite_mod.F @ 2628

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

Mars GCM:
Big changes on mountain top dust flows for GCM6:

the scheme now activates only in grid meshes that contain a mountain among a hard-written list, instead of every meshes. This is done to prevent strong artificial reinjections of dust in places that don't present huge converging slopes enabling the concentration of dust (ex: Valles Marineris, Hellas). Topdust is now also detrained as soon as it leaves the column it originated from.
the list of the 19 allowed mountains is used by the subroutine topmons_setup in module topmons_mod, to compute a logical array contains_mons(ngrid). alpha_hmons and hsummit are also set up once and for all by this subroutine, which is called in physiq_mod's firstcall.
contains_mons, alpha_hmons and hsummit are now saved variables of the module surfdat_h, and are called as such and not as arguments in the subroutines using them.
the logical flag "slpwind" and the comments in the code have also been updated to the new terminology "mountain top dust flows", accordingly to ticket #71. The new flag read in callphys.def is "topflows".

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

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

Download in other formats:

Original Format