Context Navigation

callradite.F @ 1112

Last change on this file since 1112 was 1047, checked in by emillour, 11 years ago

Mars GCM:

IMPORTANT CHANGE: Removed all reference/use of ngridmx (dimphys.h) in routines (necessary prerequisite to using parallel dynamics); in most cases this just means adding 'ngrid' as routine argument, and making local saved variables allocatable (and allocated at first call). In the process, had to convert many *.h files to equivalent modules: yomaer.h => yomaer_h.F90 , surfdat.h => surfdat_h.F90 , comsaison.h => comsaison_h.F90 , yomlw.h => yomlw_h.F90 , comdiurn.h => comdiurn_h.F90 , dimradmars.h => dimradmars_mod.F90 , comgeomfi.h => comgeomfi_h.F90, comsoil.h => comsoil_h.F90 , slope.h => slope_mod.F90
Also updated EOF routines, everything is now in eofdump_mod.F90
Removed unused routine lectfux.F (in dyn3d)

File size: 21.1 KB

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

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

Download in other formats:

Original Format