Context Navigation

callradite.F @ 1242

Last change on this file since 1242 was 1226, checked in by aslmd, 11 years ago
LMDZ.MARS : Replaced comcstfi and planete includes by modules.
File size: 21.1 KB

Rev	Line
[38]	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,
[520]	4	& tauref,tau,aerosol,tauscaling,taucloudtes,rdust,rice,
	5	& nuice,co2ice)
[38]	6
[1047]	7	use dimradmars_mod, only: ndomainsz, nflev, nsun, nir
	8	use yomlw_h, only: gcp, nlaylte
[1226]	9	USE comcstfi_h
[1047]	10	IMPLICIT NONE
[38]	11	c=======================================================================
	12	c subject:
	13	c --------
	14	c Subroutine designed to call the main canonic
	15	c radiative transfer subroutine "lwmain" et "swmain"
	16	c to compute radiative heating and cooling rate and
	17	c radiative fluxes to the surface.
	18	c
	19	c These calculations are only valid on the part of the atmosphere
	20	c where Local Thermal Equilibrium (NLTE) is verified. In practice
	21	c The calculations are only performed for the first "nlaylte"
	22	c parameters (nlaylte is calculated by subroutine "nlthermeq"
[1047]	23	c and stored in module "yomlw_h").
[38]	24	c
	25	c The purpose of this subroutine is to:
	26	c 1) Make some initial calculation at first call
	27	c 2) Split the calculation in several sub-grid
	28	c ("sub-domain") to save memory and
	29	c be able run on a workstation at high resolution
[1047]	30	c The sub-grid size is defined in dimradmars_mod
[38]	31	c 3) Compute the 3D scattering parameters depending on the
	32	c size distribution of the different tracers (added by JBM)
	33	c 4) call "lwmain" and "swmain"
	34	c
	35	c
	36	c authors:
	37	c ------
	38	c Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
	39	c
	40	c
	41	c 3D scattering scheme user's guide (J.-B. Madeleine)
	42	c ---------------------------------
	43	c
	44	c This routine has been modified to take into account 3D, time
	45	c dependent scattering properties of the aerosols.
	46	c---- The look-up tables that contain the scattering parameters
	47	c of a given tracer, for different sizes, are read by SUAER.F90.
	48	c The names of the corresponding ASCII files have to be set in
	49	c this subroutine (file_id variable), and files must be in the
	50	c directory specified in datafile.h. Please make sure that the
	51	c ASCII files are correctly written, and that the range
	52	c of particle sizes is consistent with what you would expect.
	53	c---- SUAER.F90 is in charge of reading the ASCII files and averaging
	54	c the scattering parameters in each GCM channel, using the three last
	55	c equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
	56	c---- These look-up tables, loaded during the firstcall, are then
	57	c constantly used by the subroutine "aeroptproperties.F" to compute,
	58	c online, the 3D scattering parameters, based on the size distribution
	59	c (reffrad and nueffrad) of the different tracers, in each grid box.
	60	c These 3D size distributions are loaded by the "updatereffrad.F"
	61	c subroutine. A log-normal distribution is then assumed in
	62	c "aeroptproperties.F", along with a Gauss-Legendre integration.
	63	c---- The optical depth at the visible reference wavelength (set in
	64	c SUAER.F90, after the file_id variable) is then computed by
	65	c the subroutine "aeropacity.F", by using the size and spatial
	66	c distribution of the corresponding tracer. This connection has to
	67	c be implemented in "aeropacity.F" when adding a new tracer. To do so,
	68	c one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
	69	c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
	70	c "gVIS3d" (same in the infrared) are finally used by lwmain.F and
	71	c swmain.F to solve the radiative transfer equation.
	72	c
	73	c changes:
	74	c -------
	75	c
	76	c > SRL 7/2000
	77	c
	78	c This version has been modified to only calculate radiative tendencies
[1047]	79	c over layers 1..NFLEV (set in dimradmars_mod). Returns zero for higher
[38]	80	c layers, if any.
	81	c In other routines, nlayermx -> nflev.
	82	c Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
	83	c
	84	c > J.-B. Madeleine 10W12
	85	c This version uses the variable's splitting, which can be usefull
	86	c when performing very high resolution simulation like LES.
	87	c
	88	c ----------
	89	c Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
[1047]	90	c set in dimradmars_mod
[38]	91	c Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
[1047]	92	c set in dimradmars_mod
[38]	93	c
	94	c input:
	95	c -----
	96	c icount counter of call to subroutine physic by gcm
	97	c ngrid number of gridpoint of horizontal grid
	98	c nlayer Number of layer
	99	c nq Number of tracer
	100	c ls Solar longitude (Ls) , radian
	101	c zday Date (time since Ls=0, in martian days)
	102	c pq(ngrid,nlayer,nq) Advected fields
	103	c
	104	c albedo (ngrid,2) hemispheric surface albedo
	105	c albedo (i,1) : mean albedo for solar band#1
	106	c (see below)
	107	c albedo (i,2) : mean albedo for solar band#2
	108	c (see below)
	109	c emis Thermal IR surface emissivity (no unit)
[1047]	110	c mu0(ngrid) cos of solar zenith angle
[38]	111	c (=1 when sun at zenith)
	112	c pplay(ngrid,nlayer) pressure (Pa) in the middle of each layer
	113	c pplev(ngrid,nlayer+1) pressure (Pa) at boundaries of each layer
	114	c pt(ngrid,nlayer) atmospheric temperature in each layer (K)
	115	c tsurf(ngrid) surface temperature (K)
[1047]	116	c fract(ngrid) day fraction of the time interval
[38]	117	c =1 during the full day ; =0 during the night
	118	c declin latitude of subsolar point
	119	c dist_sol sun-Mars distance (AU)
	120	c igout coordinate of analysed point for debugging
	121	c reffrad(ngrid,nlayer,naerkind) Aerosol effective radius
	122	c nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
	123
	124	c
	125	c output:
	126	c -------
	127	c dtlw (ngrid,nlayer) longwave (IR) heating rate (K/s)
	128	c dtsw(ngrid,nlayer) shortwave (Solar) heating rate (K/s)
	129	c fluxsurf_lw(ngrid) surface downward flux tota LW (thermal IR) (W.m-2)
	130	c fluxsurf_sw(ngrid,1) surface downward flux SW for solar band#1 (W.m-2)
	131	c fluxsurf_sw(ngrid,2) surface downward flux SW for solar band#2 (W.m-2)
	132	c
	133	c fluxtop_lw(ngrid) outgoing upward flux tota LW (thermal IR) (W.m-2)
	134	c fluxtop_sw(ngrid,1) outgoing upward flux SW for solar band#1 (W.m-2)
	135	c fluxtop_sw(ngrid,2) outgoing upward flux SW for solar band#2 (W.m-2)
	136
[627]	137	c tauref Prescribed mean column optical depth at 610 Pa
[38]	138	c tau Column total visible dust optical depth at each point
	139	c aerosol(ngrid,nlayer,naerkind) aerosol extinction optical depth
	140	c at reference wavelength "longrefvis" set
[1047]	141	c in dimradmars_h , in each layer, for one of
[38]	142	c the "naerkind" kind of aerosol optical
	143	c properties.
	144
	145	c=======================================================================
	146	c
	147	c Declarations :
	148	c -------------
	149	c
[1047]	150	!#include "dimensions.h"
	151	!#include "dimphys.h"
	152	!#include "dimradmars.h"
[38]	153	#include "callkeys.h"
[1047]	154	!#include "yomlw.h"
	155	! naerkind is set in scatterers.h (built when compiling with makegcm -s #)
	156	#include"scatterers.h"
[38]	157	#include "aerkind.h"
	158
	159	c-----------------------------------------------------------------------
	160	c Input/Output
	161	c ------------
[1047]	162	INTEGER,INTENT(IN) :: icount
	163	INTEGER,INTENT(IN) :: ngrid,nlayer,nq
	164	INTEGER,INTENT(IN) :: igout
[38]	165
[1047]	166	REAL,INTENT(IN) :: pq(ngrid,nlayer,nq)
	167	REAL,INTENT(IN) :: tauscaling(ngrid) ! Conversion factor for
[358]	168	! qdust and Ndust
[1047]	169	REAL,INTENT(IN) :: albedo(ngrid,2),emis(ngrid)
	170	REAL,INTENT(IN) :: ls,zday
[38]	171
[1047]	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)
[38]	179
[1047]	180	REAL,INTENT(OUT) :: tauref(ngrid), tau(ngrid,naerkind)
	181	REAL,INTENT(OUT) :: taucloudtes(ngrid)! Cloud opacity at infrared
[520]	182	! reference wavelength using
	183	! Qabs instead of Qext
	184	! (direct comparison with TES)
[1047]	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)
[353]	190
[38]	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)
[1047]	200	REAL ptlev(ngrid,nlayer+1)
[38]	201
[1047]	202	INTEGER,SAVE :: ndomain
[38]	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
[1047]	237	REAL :: QVISsQREF3d(ngrid,nlayer,nsun,naerkind)
	238	REAL :: omegaVIS3d(ngrid,nlayer,nsun,naerkind)
	239	REAL :: gVIS3d(ngrid,nlayer,nsun,naerkind)
[38]	240
[1047]	241	REAL :: QIRsQREF3d(ngrid,nlayer,nir,naerkind)
	242	REAL :: omegaIR3d(ngrid,nlayer,nir,naerkind)
	243	REAL :: gIR3d(ngrid,nlayer,nir,naerkind)
[38]	244
[1047]	245	REAL :: QREFvis3d(ngrid,nlayer,naerkind)
	246	REAL :: QREFir3d(ngrid,nlayer,naerkind)
[38]	247
[1047]	248	REAL :: omegaREFvis3d(ngrid,nlayer,naerkind)
	249	REAL :: omegaREFir3d(ngrid,nlayer,naerkind)
[38]	250
	251	c local saved variables
	252	c ---------------------
	253
[1047]	254	real,save,allocatable :: pview(:)
[38]	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
[1047]	270	! compute ndomain and allocate local saved arrays
	271	ndomain= (ngrid-1) / ndomainsz + 1
	272	allocate(pview(ngrid))
[38]	273
	274	c Please name the different scatterers here ----------------
	275	c PLEASE MAKE SURE that you set up the right number of
[1047]	276	c scatterers in scatterers.h (naerkind);
[131]	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
[1036]	279	if (nq.gt.1) then
[172]	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
[1036]	285	endif ! of if (nq.gt.1)
[38]	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"
[1047]	335	write(,) "scatterers in scatterers.h, the names"
[38]	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'
[1047]	360	WRITE(,) 'equal to 2 in scatterers.h.'
[38]	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
[1047]	371	! CALL SULW ! this step is now done in ini_yomlw_h
[38]	372
	373	write(,) 'Splitting radiative calculations: ',
[1047]	374	$ ' ngrid,ndomainsz,ndomain',
	375	$ ngrid,ndomainsz,ndomain
	376	if (ngrid .EQ. 1) then
[38]	377	if (ndomainsz .NE. 1) then
	378	print*
	379	print*,'ATTENTION !!!'
	380	print*,'pour tourner en 1D, '
[1047]	381	print*,'fixer ndomainsz=1 dans phymars/dimradmars_h'
[38]	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,
[740]	396	& pq,tauscaling,tau,pplay)
[38]	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,
[520]	407	& pq,tauscaling,tauref,tau,taucloudtes,aerosol,reffrad,
	408	& nueffrad,QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
[38]	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
[1047]	416	nd=ngrid-ig0
[38]	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
[353]	505	& ,zQIRsQREF3d,zomegaIR3d,zgIR3d
	506	& ,co2ice(ig0+1))
[38]	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