Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

diff_oldgcm_oldmeso_checked @ 44

Last change on this file since 44 was 42, checked in by aslmd, 15 years ago
LMD_MM_MARS: tests avec physique completement commune avec le GCM nouvelle physique
File size: 63.3 KB

Rev	Line
[42]	1	Only in oldmeso: .svn
	2	diff --ignore-blank-lines --context=3 -r oldgcm/aeropacity.F oldmeso/aeropacity.F
	3	*** oldgcm/aeropacity.F Thu Sep 30 19:55:34 2010
	4	--- oldmeso/aeropacity.F Tue Jan 25 16:49:09 2011
	5	***************
	6	* 115,120 **
	7	--- 115,132 ----
	8	INTEGER,SAVE :: i_ice=0 ! water ice
	9	CHARACTER(LEN=20) :: tracername ! to temporarly store text
	10
	11	+ c **********************************************************
	12	+ c Declaration special local dust storm TASI
	13	+ logical localstorm
	14	+ real taulocref,ztoploc,radloc,lonloc,latloc
	15	+ integer ltoploc
	16	+ real tauloc ! diagnostic only
	17	+ c **********************************************************
	18	+
	19	+
	20	+
	21	+
	22	+
	23	call zerophys(ngrid*naerkind,tau)
	24
	25	! identify tracers
	26	***************
	27	* 297,302 **
	28	--- 309,362 ----
	29	ENDDO
	30	ENDDO
	31
	32	+ c ***************************************************************
	33	+ c SPECIAL LOCAL DUST STORM TASI
	34	+ c We modify only aerosol calculated above where the local dust storm is
	35	+
	36	+ localstorm = .true.
	37	+ if (localstorm) then
	38	+ taulocref = 2 !10 ! ref optical depth of the local dust storm
	39	+ ztoploc = 11 ! target pseudo-altitude of local storm (km)
	40	+ radloc = 4. ! radius of dust storm (degree)
	41	+ lonloc=-3 ! center longitude of storm (deg)
	42	+ latloc=-2. ! center latitude of storm (deg)
	43	+
	44	+ DO ig=1,ngrid
	45	+ c Where is the dust storm:
	46	+ if (((lati(ig)180./pi-latloc)*2
	47	+ & + (long(ig)180./pi -lonloc)2).le.(radloc*2))then
	48	+ c Computing where is the top level of the localstorm
	49	+ DO l=nlayer,1,-1
	50	+ ltoploc=l+1
	51	+ if(-10*log(pplev(ig,l)/pplev(ig,1)).lt.ztoploc)goto 88
	52	+ END DO
	53	+ 88 continue
	54	+ DO l=1,ltoploc-1
	55	+ aerosol(ig,l,1)=max(aerosol(ig,l,1),
	56	+ & taulocref* (pplev(ig,l)-pplev(ig,l+1))
	57	+ & /(pplev(ig,1)-pplev(ig,ltoploc)))
	58	+ END DO
	59	+
	60	+ c diagnostic
	61	+ write(,)
	62	+ write(,) 'lat,lon',lati(ig)180./pi,long(ig)180./pi
	63	+ write(,) 'true dustorm top pseudo-height (km) = ',
	64	+ & -10*log(pplev(ig,ltoploc)/pplev(ig,1))
	65	+ c tauloc=0.
	66	+ c DO l=1,nlayer
	67	+ c tauloc = tauloc + aerosol(ig,l,1)
	68	+ c write(,) 'below ',
	69	+ c & -10*log(pplev(ig,l+1)/pplev(ig,1)),
	70	+ c & 'km, tau=', tauloc
	71	+ c ENDDO
	72	+
	73	+ endif
	74	+ END DO
	75	+ endif
	76	+ c ***************************************************************
	77	+
	78	+
	79	+
	80	CALL zerophys(ngrid,taudustvis)
	81	CALL zerophys(ngrid,taudusttes)
	82	DO l=1,nlayer
	83	***************
	84	* 431,440 **
	85	ENDDO
	86	c 3. Outputs
	87	IF (ngrid.NE.1) THEN
	88	! CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
	89	! & ' ',2,taucloudtes)
	90	! CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
	91	! & ' ',2,taucloudtes)
	92	ELSE
	93	CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
	94	ENDIF
	95	--- 491,500 ----
	96	ENDDO
	97	c 3. Outputs
	98	IF (ngrid.NE.1) THEN
	99	! ! CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
	100	! ! & ' ',2,taucloudtes)
	101	! ! CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
	102	! ! & ' ',2,taucloudtes)
	103	ELSE
	104	CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
	105	ENDIF
	106	Only in oldgcm: aeropacity.F.old
	107	diff --ignore-blank-lines --context=3 -r oldgcm/aeropacity.F~ oldmeso/aeropacity.F~
	108	*** oldgcm/aeropacity.F~ Tue Feb 2 15:41:20 2010
	109	--- oldmeso/aeropacity.F~ Tue Jan 25 16:49:10 2011
	110	***************
	111	* 2,7 **
	112	--- 2,9 ----
	113	& tauref,tau,aerosol,reffrad,
	114	& QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
	115
	116	+ ! to use 'getin'
	117	+ USE ioipsl_getincom
	118	IMPLICIT NONE
	119	c=======================================================================
	120	c subject:
	121	***************
	122	* 160,165 **
	123	--- 162,171 ----
	124	WRITE(,) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
	125	ENDDO
	126
	127	+ ! load value of tauvis from callphys.def (if given there,
	128	+ ! otherwise default value read from starfi.nc file will be used)
	129	+ call getin("tauvis",tauvis)
	130	+
	131	firstcall=.false.
	132
	133	END IF
	134	***************
	135	* 178,186 **
	136
	137	c Vertical column optical depth at 700.Pa
	138	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	139	! IF(iaervar.eq.1) THEN
	140	do ig=1, ngridmx
	141	! tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste as read in starfi
	142	end do
	143	ELSE IF (iaervar.eq.2) THEN ! << "Viking" Scenario>>
	144
	145	--- 184,193 ----
	146
	147	c Vertical column optical depth at 700.Pa
	148	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	149	! IF(iaervar.eq.1) THEN
	150	do ig=1, ngridmx
	151	! tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
	152	! ! or read in starfi
	153	end do
	154	ELSE IF (iaervar.eq.2) THEN ! << "Viking" Scenario>>
	155
	156	***************
	157	* 301,310 **
	158	IF (ngrid.NE.1) THEN
	159	! CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR',
	160	! & ' ',2,taudusttes)
	161	! IF (callstats) THEN
	162	! CALL wstats(ngridmx,'taudustTES','dust abs IR',
	163	! & ' ',2,taudusttes)
	164	! ENDIF
	165	ELSE
	166	CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU')
	167	ENDIF
	168	--- 309,316 ----
	169	IF (ngrid.NE.1) THEN
	170	! CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR',
	171	! & ' ',2,taudusttes)
	172	! ! CALL wstats(ngridmx,'taudustTES','dust abs IR',
	173	! ! & ' ',2,taudusttes)
	174	ELSE
	175	CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU')
	176	ENDIF
	177	***************
	178	* 420,431 **
	179	ENDDO
	180	c 3. Outputs
	181	IF (ngrid.NE.1) THEN
	182	! CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
	183	! & ' ',2,taucloudtes)
	184	! IF (callstats) THEN
	185	! CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
	186	! & ' ',2,taucloudtes)
	187	! ENDIF
	188	ELSE
	189	CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
	190	ENDIF
	191	--- 426,435 ----
	192	ENDDO
	193	c 3. Outputs
	194	IF (ngrid.NE.1) THEN
	195	! ! CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
	196	! ! & ' ',2,taucloudtes)
	197	! ! CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
	198	! ! & ' ',2,taucloudtes)
	199	ELSE
	200	CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
	201	ENDIF
	202	Only in oldgcm: aeroptproperties.F.old
	203	Only in oldmeso: assim_aeropacity.F
	204	Only in oldmeso: assim_readtesassim.F90
	205	Only in oldgcm: calldrag_noro.F
	206	diff --ignore-blank-lines --context=3 -r oldgcm/callkeys.h oldmeso/callkeys.h
	207	*** oldgcm/callkeys.h Tue Feb 2 15:41:20 2010
	208	--- oldmeso/callkeys.h Tue Jan 25 15:17:44 2011
	209	***************
	210	* 39,44 **
	211	--- 39,45 ----
	212	real alphan
	213	real solarcondate
	214
	215	+ integer ecri_phys
	216	integer iddist
	217	integer iaervar
	218	integer iradia
	219	***************
	220	* 52,57 **
	221	--- 53,59 ----
	222	integer dustbin
	223	logical active,doubleq,lifting,callddevil,scavenging
	224	logical sedimentation,activice,water,caps
	225	+ !!! plus besoin de iceparty ??
	226	logical photochem
	227	integer nqchem_min
	228
	229	diff --ignore-blank-lines --context=3 -r oldgcm/callradite.F oldmeso/callradite.F
	230	*** oldgcm/callradite.F Tue Feb 2 15:41:20 2010
	231	--- oldmeso/callradite.F Tue Jan 25 16:49:09 2011
	232	***************
	233	* 20,28 **
	234	c
	235	c The purpose of this subroutine is to:
	236	c 1) Make some initial calculation at first call
	237	! c 2) Compute the 3D scattering parameters depending on the
	238	c size distribution of the different tracers (added by JBM)
	239	! c 3) call "lwmain" and "swmain"
	240	c
	241	c
	242	c authors:
	243	--- 20,32 ----
	244	c
	245	c The purpose of this subroutine is to:
	246	c 1) Make some initial calculation at first call
	247	! c 2) Split the calculation in several sub-grid
	248	! c ("sub-domain") to save memory and
	249	! c be able run on a workstation at high resolution
	250	! c The sub-grid size is defined in dimradmars.h
	251	! c 3) Compute the 3D scattering parameters depending on the
	252	c size distribution of the different tracers (added by JBM)
	253	! c 4) call "lwmain" and "swmain"
	254	c
	255	c
	256	c authors:
	257	***************
	258	* 73,81 **
	259	c In other routines, nlayermx -> nflev.
	260	c Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
	261	c
	262	! c > J.-B. Madeleine 09W30
	263	! c
	264	! c Removed the variable's splitting, which is now obsolete.
	265	c
	266	c ----------
	267	c Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
	268	--- 77,85 ----
	269	c In other routines, nlayermx -> nflev.
	270	c Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
	271	c
	272	! c > J.-B. Madeleine 10W12
	273	! c This version uses the variable's splitting, which can be usefull
	274	! c when performing very high resolution simulation like LES.
	275	c
	276	c ----------
	277	c Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
	278	***************
	279	* 174,191 **
	280	c Local variables :
	281	c -----------------
	282
	283	! INTEGER j,l,ig,n
	284
	285	real cste_mars ! solar constant on Mars (Wm-2)
	286	REAL ptlev(ngridmx,nlayermx+1)
	287	! REAL dp(ngrid,nflev)
	288	! REAL dt0(ngrid)
	289
	290	c Thermal IR net radiative budget (W m-2)
	291
	292	! REAL netrad(ngrid,nflev)
	293	! REAL fluxd_sw(ngrid,nflev+1,2)
	294	! REAL fluxu_sw(ngrid,nflev+1,2)
	295
	296	c Aerosol size distribution
	297	REAL :: reffrad(ngrid,nlayer,naerkind)
	298	--- 178,220 ----
	299	c Local variables :
	300	c -----------------
	301
	302	! INTEGER j,l,ig,n,ich,iaer
	303	! INTEGER jd,ig0,nd
	304
	305	real cste_mars ! solar constant on Mars (Wm-2)
	306	REAL ptlev(ngridmx,nlayermx+1)
	307	!
	308	! INTEGER ndomain
	309	! parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
	310
	311	c Thermal IR net radiative budget (W m-2)
	312
	313	! real znetrad(ndomainsz,nflev)
	314	!
	315	! real zfluxd_sw(ndomainsz,nflev+1,2)
	316	! real zfluxu_sw(ndomainsz,nflev+1,2)
	317	!
	318	! REAL zplev(ndomainsz,nflev+1)
	319	! REAL zztlev(ndomainsz,nflev+1)
	320	! REAL zplay(ndomainsz,nflev)
	321	! REAL zt(ndomainsz,nflev)
	322	! REAL zaerosol(ndomainsz,nflev,naerkind)
	323	! REAL zalbedo(ndomainsz,2)
	324	! REAL zdp(ndomainsz,nflev)
	325	! REAL zdt0(ndomainsz)
	326	!
	327	! REAL zzdtlw(ndomainsz,nflev)
	328	! REAL zzdtsw(ndomainsz,nflev)
	329	! REAL zzflux(ndomainsz,6)
	330	! real zrmuz
	331	!
	332	! REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
	333	! REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
	334	! REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
	335	!
	336	! REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
	337	! REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
	338	! REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
	339
	340	c Aerosol size distribution
	341	REAL :: reffrad(ngrid,nlayer,naerkind)
	342	***************
	343	* 249,254 **
	344	--- 278,296 ----
	345	CALL SUAER
	346	CALL SULW
	347
	348	+ write(,) 'Splitting radiative calculations: ',
	349	+ $ ' ngridmx,ngrid,ndomainsz,ndomain',
	350	+ $ ngridmx,ngrid,ndomainsz,ndomain
	351	+ if (ngridmx .EQ. 1) then
	352	+ if (ndomainsz .NE. 1) then
	353	+ print*
	354	+ print*,'ATTENTION !!!'
	355	+ print*,'pour tourner en 1D, '
	356	+ print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
	357	+ print*
	358	+ call exit(1)
	359	+ endif
	360	+ endif
	361	firstcall=.false.
	362	END IF
	363
	364	***************
	365	* 273,315 **
	366	& tauref,tau,aerosol,reffrad,
	367	& QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
	368
	369	do l=1,nlaylte
	370	! do ig = 1, ngrid
	371	c Thickness of each layer (Pa) :
	372	! dp(ig,l)= pplev(ig,l) - pplev(ig,l+1)
	373	enddo
	374	enddo
	375
	376	c Intermediate levels: (computing tlev)
	377	c ---------------------------------------
	378	c Extrapolation for the air temperature above the surface
	379	! DO ig=1, ngrid
	380	! ptlev(ig,1)=pt(ig,1)+
	381	! s (pplev(ig,1)-pplay(ig,1))*
	382	! s (pt(ig,1)-pt(ig,2))/(pplay(ig,1)-pplay(ig,2))
	383
	384	! dt0(ig) = tsurf(ig) - ptlev(ig,1)
	385	ENDDO
	386
	387	DO l=2,nlaylte
	388	! DO ig=1, ngrid
	389	! ptlev(ig,l)=0.5*(pt(ig,l-1)+pt(ig,l))
	390	ENDDO
	391	ENDDO
	392
	393	! DO ig=1, ngrid
	394	! ptlev(ig,nlaylte+1)=pt(ig,nlaylte)
	395	ENDDO
	396
	397
	398	c Longwave ("lw") radiative transfer (= thermal infrared)
	399	c -------------------------------------------------------
	400	! call lwmain (icount,ngrid,nflev
	401	! . ,dp,dt0,emis,pplev,ptlev,pt
	402	! . ,aerosol,dtlw
	403	! . ,fluxsurf_lw,fluxtop_lw
	404	! . ,netrad
	405	! & ,QIRsQREF3d,omegaIR3d,gIR3d)
	406
	407	c Shortwave ("sw") radiative transfer (= solar radiation)
	408	c -------------------------------------------------------
	409	--- 315,416 ----
	410	& tauref,tau,aerosol,reffrad,
	411	& QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
	412
	413	+ c Starting loop on sub-domain
	414	+ c ----------------------------
	415	+
	416	+ DO jd=1,ndomain
	417	+ ig0=(jd-1)*ndomainsz
	418	+ if (jd.eq.ndomain) then
	419	+ nd=ngridmx-ig0
	420	+ else
	421	+ nd=ndomainsz
	422	+ endif
	423	+
	424	+ c Spliting input variable in sub-domain input variables
	425	+ c ---------------------------------------------------
	426	+
	427	+ do l=1,nlaylte
	428	+ do ig = 1,nd
	429	+ do iaer = 1, naerkind
	430	+ do ich = 1, nsun
	431	+ zQVISsQREF3d(ig,l,ich,iaer) =
	432	+ & QVISsQREF3d(ig0+ig,l,ich,iaer)
	433	+ zomegaVIS3d(ig,l,ich,iaer) =
	434	+ & omegaVIS3d(ig0+ig,l,ich,iaer)
	435	+ zgVIS3d(ig,l,ich,iaer) =
	436	+ & gVIS3d(ig0+ig,l,ich,iaer)
	437	+ enddo
	438	+ do ich = 1, nir
	439	+ zQIRsQREF3d(ig,l,ich,iaer) =
	440	+ & QIRsQREF3d(ig0+ig,l,ich,iaer)
	441	+ zomegaIR3d(ig,l,ich,iaer) =
	442	+ & omegaIR3d(ig0+ig,l,ich,iaer)
	443	+ zgIR3d(ig,l,ich,iaer) =
	444	+ & gIR3d(ig0+ig,l,ich,iaer)
	445	+ enddo
	446	+ enddo
	447	+ enddo
	448	+ enddo
	449	+
	450	+ do l=1,nlaylte+1
	451	+ do ig = 1,nd
	452	+ zplev(ig,l) = pplev(ig0+ig,l)
	453	+ enddo
	454	+ enddo
	455	+
	456	do l=1,nlaylte
	457	! do ig = 1,nd
	458	! zplay(ig,l) = pplay(ig0+ig,l)
	459	! zt(ig,l) = pt(ig0+ig,l)
	460	c Thickness of each layer (Pa) :
	461	! zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
	462	enddo
	463	enddo
	464
	465	+ do n=1,naerkind
	466	+ do l=1,nlaylte
	467	+ do ig=1,nd
	468	+ zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
	469	+ enddo
	470	+ enddo
	471	+ enddo
	472	+
	473	+ do j=1,2
	474	+ do ig = 1,nd
	475	+ zalbedo(ig,j) = albedo(ig0+ig,j)
	476	+ enddo
	477	+ enddo
	478	+
	479	c Intermediate levels: (computing tlev)
	480	c ---------------------------------------
	481	c Extrapolation for the air temperature above the surface
	482	! DO ig=1,nd
	483	! zztlev(ig,1)=zt(ig,1)+
	484	! s (zplev(ig,1)-zplay(ig,1))*
	485	! s (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
	486
	487	! zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
	488	ENDDO
	489
	490	DO l=2,nlaylte
	491	! DO ig=1, nd
	492	! zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l))
	493	ENDDO
	494	ENDDO
	495
	496	! DO ig=1, nd
	497	! zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
	498	ENDDO
	499
	500
	501	c Longwave ("lw") radiative transfer (= thermal infrared)
	502	c -------------------------------------------------------
	503	! call lwmain (ig0,icount,nd,nflev
	504	! . ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
	505	! . ,zaerosol,zzdtlw
	506	! . ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
	507	! . ,znetrad
	508	! & ,zQIRsQREF3d,zomegaIR3d,zgIR3d)
	509
	510	c Shortwave ("sw") radiative transfer (= solar radiation)
	511	c -------------------------------------------------------
	512	***************
	513	* 317,337 **
	514	c 1370 W.m-2 is the solar constant at 1 AU.
	515	cste_mars=1370./(dist_sol*dist_sol)
	516
	517	! call swmain ( ngrid, nflev,
	518	! S cste_mars, albedo,
	519	! S mu0, dp, pplev, aerosol, fract,
	520	! S dtsw, fluxd_sw, fluxu_sw,
	521	! & QVISsQREF3d,omegaVIS3d,gVIS3d)
	522
	523	c ------------------------------------------------------------
	524
	525	! do ig = 1, ngrid
	526	! fluxsurf_sw(ig,1) = fluxd_sw(ig,1,1)
	527	! fluxsurf_sw(ig,2) = fluxd_sw(ig,1,2)
	528	! fluxtop_sw(ig,1) = fluxu_sw(ig,nlaylte+1,1)
	529	! fluxtop_sw(ig,2) = fluxu_sw(ig,nlaylte+1,2)
	530	enddo
	531
	532	c Zero tendencies for any remaining layers between nlaylte and nlayer
	533	if (nlayer.gt.nlaylte) then
	534	do l = nlaylte+1, nlayer
	535	--- 418,455 ----
	536	c 1370 W.m-2 is the solar constant at 1 AU.
	537	cste_mars=1370./(dist_sol*dist_sol)
	538
	539	! call swmain ( nd, nflev,
	540	! S cste_mars, zalbedo,
	541	! S mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
	542	! S zzdtsw, zfluxd_sw, zfluxu_sw,
	543	! & zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
	544
	545	c ------------------------------------------------------------
	546	+ c Un-spliting output variable from sub-domain input variables
	547	+ c ------------------------------------------------------------
	548	+
	549	+ do l=1,nlaylte
	550	+ do ig = 1,nd
	551	+ dtlw(ig0+ig,l) = zzdtlw(ig,l)
	552	+ dtsw(ig0+ig,l) = zzdtsw(ig,l)
	553	+ enddo
	554	+ enddo
	555
	556	! do l=1,nlaylte+1
	557	! do ig = 1,nd
	558	! ptlev(ig0+ig,l) = zztlev(ig,l)
	559	! enddo
	560	enddo
	561
	562	+ do ig = 1,nd
	563	+ fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
	564	+ fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
	565	+ fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
	566	+ fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
	567	+ enddo
	568	+
	569	+ ENDDO ! (boucle jd=1, ndomain)
	570	+
	571	c Zero tendencies for any remaining layers between nlaylte and nlayer
	572	if (nlayer.gt.nlaylte) then
	573	do l = nlaylte+1, nlayer
	574	Only in oldgcm: callradite.F.old
	575	Only in oldmeso: callradite.F~
	576	diff --ignore-blank-lines --context=3 -r oldgcm/datafile.h oldmeso/datafile.h
	577	*** oldgcm/datafile.h Thu Sep 23 18:53:00 2010
	578	--- oldmeso/datafile.h Mon Jan 24 12:16:55 2011
	579	***************
	580	* 4,11 **
	581	! Address of the directory containing tables of data needed by the GCM
	582
	583	character (len=100) :: datafile
	584	! ! data datafile /'/u/forget/WWW/datagcm/datafile'/
	585	! !! data datafile /'/home/forget/datafile'/
	586	! data datafile /'/d2/emlmd/work_TASI/dust_scenarios_new/flush/LMDZ.&
	587	! &MARS.BETA/datafile'/
	588	!-----------------------------------------------------------------------
	589	--- 4,10 ----
	590	! Address of the directory containing tables of data needed by the GCM
	591
	592	character (len=100) :: datafile
	593	! !! path to WRF data
	594	! data datafile /'/u/forget/WWW/datagcm/datafile'/
	595	! ! data datafile /'/d5/aslmd/LMD_MM_MARS_DATA/dust'/
	596	!-----------------------------------------------------------------------
	597	Only in oldmeso: diff.cmd
	598	Only in oldmeso: diff.cmd~
	599	Only in oldmeso: diff.log
	600	Only in oldmeso: diff.log.h
	601	diff --ignore-blank-lines --context=3 -r oldgcm/dimphys.h oldmeso/dimphys.h
	602	*** oldgcm/dimphys.h Tue Feb 2 15:41:20 2010
	603	--- oldmeso/dimphys.h Tue Jan 25 16:49:09 2011
	604	***************
	605	* 1,12 **
	606	!-----------------------------------------------------------------------
	607	! INCLUDE 'dimphys.h'
	608
	609	! ! ngridmx : number of horizontal grid points
	610	! ! note: the -1/jjm term will be 0; unless jj=1
	611	! integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)
	612	! ! nlayermx : number of atmospheric layers
	613	! integer, parameter :: nlayermx = llm
	614	! ! nsoilmx : number of subterranean layers
	615	! !EM: old soil routine: integer, parameter :: nsoilmx = 10
	616	! integer, parameter :: nsoilmx = 18
	617	!-----------------------------------------------------------------------
	618	--- 1,13 ----
	619	!-----------------------------------------------------------------------
	620	! INCLUDE 'dimphys.h'
	621
	622	!
	623	! INTEGER, parameter :: wiim=60
	624	! INTEGER, parameter :: wjjm=60
	625	! INTEGER, PARAMETER :: ngridmx=3600
	626	! INTEGER, parameter :: nlayermx=60
	627	! INTEGER, PARAMETER :: nsoilmx=10
	628	!
	629	!-----------------------------------------------------------------------
	630	+
	631	+
	632	diff --ignore-blank-lines --context=3 -r oldgcm/dimradmars.h oldmeso/dimradmars.h
	633	*** oldgcm/dimradmars.h Tue Feb 2 15:41:20 2010
	634	--- oldmeso/dimradmars.h Tue Jan 25 16:49:09 2011
	635	***************
	636	* 8,17 **
	637
	638	! nflev: number of vertical layer
	639	! ndlon,ndlo2: number of horizontal points
	640
	641	! INTEGER NFLEV,NDLON,NDLO2
	642
	643	! parameter (NFLEV=nlayermx,NDLON=ngridmx)
	644	parameter (NDLO2=NDLON)
	645
	646	! Number of kind of tracer radiative properties
	647	--- 8,24 ----
	648
	649	! nflev: number of vertical layer
	650	! ndlon,ndlo2: number of horizontal points
	651	+ ! Splitting of horizontal grid
	652	+ ! NDLO2 et ndomainsz pour le decoupage de l'appel a la physique
	653	+ ! ATTENTION: Il faut 1 < ndomainsz =< ngridmx
	654
	655	! INTEGER NFLEV,NDLON,NDLO2,ndomainsz
	656
	657	! ! parameter (ndomainsz=ngridmx)
	658	! parameter (ndomainsz=(ngridmx-1)/20 + 1)
	659	! ! parameter (ndomainsz=(ngridmx-1)/5 + 1)
	660	!
	661	! parameter (NFLEV=nlayermx,NDLON=ndomainsz) ! avec decoupage
	662	parameter (NDLO2=NDLON)
	663
	664	! Number of kind of tracer radiative properties
	665	Only in oldgcm: drag_noro.F
	666	diff --ignore-blank-lines --context=3 -r oldgcm/dustlift.F oldmeso/dustlift.F
	667	*** oldgcm/dustlift.F Tue Feb 2 15:41:20 2010
	668	--- oldmeso/dustlift.F Tue Jan 25 16:49:09 2011
	669	***************
	670	* 1,4 **
	671	! SUBROUTINE dustlift(ngrid,nlay,nq,rho,pcdh_true,pcdh,co2ice,
	672	$ dqslift)
	673	IMPLICIT NONE
	674
	675	--- 1,5 ----
	676	! SUBROUTINE dustlift(ngrid,nlay,nq,rho,
	677	! $ pcdh_true,pcdh,co2ice,
	678	$ dqslift)
	679	IMPLICIT NONE
	680
	681	***************
	682	* 41,47 **
	683	REAL ust,us
	684	REAL stress_seuil
	685	SAVE stress_seuil
	686	! DATA stress_seuil/0.0225/ ! stress seuil soulevement (N.m2)
	687
	688
	689	c ---------------------------------
	690	--- 42,69 ----
	691	REAL ust,us
	692	REAL stress_seuil
	693	SAVE stress_seuil
	694	! c DATA stress_seuil/0.0225/ ! stress seuil soulevement (N.m2)
	695	! !****WRF
	696	! !****WRF: additional ASCII file to define dust opacity
	697	! REAL alpha
	698	! INTEGER ierr
	699	! OPEN(99,file='stress.def',status='old',form='formatted'
	700	! . ,iostat=ierr)
	701	! IF(ierr.NE.0) THEN
	702	! stress_seuil = 0.0225
	703	! alpha = 1.
	704	! write(,) 'No file stress.def - set ', stress_seuil, alpha
	705	! !stop
	706	! ELSE
	707	! READ(99,*) stress_seuil
	708	! READ(99,*) alpha
	709	! write(,) 'definir seuil stress : ', stress_seuil, alpha
	710	! CLOSE(99)
	711	! ENDIF
	712	! alpha_lift(1) = alpha
	713	! !****WRF
	714	! !****WRF
	715	!
	716
	717
	718	c ---------------------------------
	719	Only in oldmeso: gr_fi_dyn.F
	720	Only in oldgcm: gwprofil.F
	721	Only in oldgcm: gwstress.F
	722	Only in oldgcm: inifis.F
	723	Only in oldgcm: inifis.F~
	724	diff --ignore-blank-lines --context=3 -r oldgcm/initracer.F oldmeso/initracer.F
	725	*** oldgcm/initracer.F Thu Feb 4 10:47:02 2010
	726	--- oldmeso/initracer.F Tue Jan 25 16:49:09 2011
	727	***************
	728	* 43,50 **
	729	#include "advtrac.h"
	730	#include "comgeomfi.h"
	731	#include "watercap.h"
	732	! #include "chimiedata.h"
	733	!
	734
	735	real qsurf(ngridmx,nqmx) ! tracer on surface (e.g. kg.m-2)
	736	real co2ice(ngridmx) ! co2 ice mass on surface (e.g. kg.m-2)
	737	--- 43,49 ----
	738	#include "advtrac.h"
	739	#include "comgeomfi.h"
	740	#include "watercap.h"
	741	! #include "chimiedata.h"
	742
	743	real qsurf(ngridmx,nqmx) ! tracer on surface (e.g. kg.m-2)
	744	real co2ice(ngridmx) ! co2 ice mass on surface (e.g. kg.m-2)
	745	***************
	746	* 436,443 **
	747	Qext(iq)=0.
	748	alpha_lift(iq) =0.
	749	alpha_devil(iq)=0.
	750	! qextrhor(iq)= 0.
	751	! endif
	752	enddo ! do iq=1,nqmx
	753	endif
	754
	755	--- 435,442 ----
	756	Qext(iq)=0.
	757	alpha_lift(iq) =0.
	758	alpha_devil(iq)=0.
	759	! qextrhor(iq)= 0.
	760	! endif
	761	enddo ! do iq=1,nqmx
	762	endif
	763
	764	***************
	765	* 448,454 **
	766	Qext(igcm_h2o_vap)=0.
	767	alpha_lift(igcm_h2o_vap) =0.
	768	alpha_devil(igcm_h2o_vap)=0.
	769	! qextrhor(igcm_h2o_vap)= 0.
	770
	771	c "Dryness coefficient" controlling the evaporation and
	772	c sublimation from the ground water ice (close to 1)
	773	--- 447,453 ----
	774	Qext(igcm_h2o_vap)=0.
	775	alpha_lift(igcm_h2o_vap) =0.
	776	alpha_devil(igcm_h2o_vap)=0.
	777	! qextrhor(igcm_h2o_vap)= 0.
	778
	779	c "Dryness coefficient" controlling the evaporation and
	780	c sublimation from the ground water ice (close to 1)
	781	Only in oldmeso: jb_phymars
	782	diff --ignore-blank-lines --context=3 -r oldgcm/lwflux.F oldmeso/lwflux.F
	783	*** oldgcm/lwflux.F Tue Feb 2 15:41:20 2010
	784	--- oldmeso/lwflux.F Tue Jan 25 16:49:09 2011
	785	***************
	786	* 1,4 **
	787	! subroutine lwflux (kdlon,kflev,dp
	788	. ,bsurf,btop,blev,blay,dbsublay
	789	. ,tlay, tlev, dt0 ! pour sortie dans g2d uniquement
	790	. ,emis
	791	--- 1,4 ----
	792	! subroutine lwflux (ig0,kdlon,kflev,dp
	793	. ,bsurf,btop,blev,blay,dbsublay
	794	. ,tlay, tlev, dt0 ! pour sortie dans g2d uniquement
	795	. ,emis
	796	***************
	797	* 26,31 **
	798	--- 26,32 ----
	799	c ---------
	800	c inputs:
	801	c -------
	802	+ integer ig0
	803	integer kdlon ! part of ngrid
	804	integer kflev ! part of nlayer
	805
	806	***************
	807	* 62,68 **
	808	c 0.2 local arrays
	809	c ------------
	810
	811	! integer ja,jl,j,i,ig1d,l,ndim
	812	parameter(ndim = ndlon(nuco2+1)(nflev+2)*(nflev+2))
	813	real ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2)
	814
	815	--- 63,69 ----
	816	c 0.2 local arrays
	817	c ------------
	818
	819	! integer ja,jl,j,i,ig1d,ig,l,ndim
	820	parameter(ndim = ndlon(nuco2+1)(nflev+2)*(nflev+2))
	821	real ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2)
	822
	823	***************
	824	* 91,97 **
	825	do ja = 1,nuco2
	826	do jl = 1,kdlon
	827
	828	! ksidb(jl,ja,i,j) = xi(jl,ja,i,j)
	829	. * (blay(jl,ja,j)-blay(jl,ja,i))
	830	c ksidb reciprocity
	831	c -----------------
	832	--- 92,98 ----
	833	do ja = 1,nuco2
	834	do jl = 1,kdlon
	835
	836	! ksidb(jl,ja,i,j) = xi(ig0+jl,ja,i,j)
	837	. * (blay(jl,ja,j)-blay(jl,ja,i))
	838	c ksidb reciprocity
	839	c -----------------
	840	***************
	841	* 110,116 **
	842	do ja = 1,nuco2
	843	do jl = 1,kdlon
	844
	845	! ksidb(jl,ja,i,0) = xi(jl,ja,0,i)
	846	. * (bsurf(jl,ja)-blay(jl,ja,i))
	847	c ksidb reciprocity
	848	c -----------------
	849	--- 111,117 ----
	850	do ja = 1,nuco2
	851	do jl = 1,kdlon
	852
	853	! ksidb(jl,ja,i,0) = xi(ig0+jl,ja,0,i)
	854	. * (bsurf(jl,ja)-blay(jl,ja,i))
	855	c ksidb reciprocity
	856	c -----------------
	857	***************
	858	* 129,135 **
	859	do jl = 1,kdlon
	860
	861	ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0)
	862	! . - xi_ground(jl,ja)
	863	. * (blev(jl,ja,1)-blay(jl,ja,1))
	864
	865	cc ksidb reciprocity
	866	--- 130,136 ----
	867	do jl = 1,kdlon
	868
	869	ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0)
	870	! . - xi_ground(ig0+jl,ja)
	871	. * (blev(jl,ja,1)-blay(jl,ja,1))
	872
	873	cc ksidb reciprocity
	874	***************
	875	* 147,153 **
	876	do ja = 1,nuco2
	877	do jl = 1,kdlon
	878
	879	! ksidb(jl,ja,i,nlaylte+1) = xi(jl,ja,i,nlaylte+1)
	880	. * (-blay(jl,ja,i))
	881	c ksidb reciprocity
	882	c -----------------
	883	--- 148,154 ----
	884	do ja = 1,nuco2
	885	do jl = 1,kdlon
	886
	887	! ksidb(jl,ja,i,nlaylte+1) = xi(ig0+jl,ja,i,nlaylte+1)
	888	. * (-blay(jl,ja,i))
	889	c ksidb reciprocity
	890	c -----------------
	891	***************
	892	* 164,170 **
	893	do ja = 1,nuco2
	894	do jl = 1,kdlon
	895
	896	! ksidb(jl,ja,0,nlaylte+1) = xi(jl,ja,0,nlaylte+1)
	897	. * (-bsurf(jl,ja))
	898
	899	c ksidb reciprocity
	900	--- 165,171 ----
	901	do ja = 1,nuco2
	902	do jl = 1,kdlon
	903
	904	! ksidb(jl,ja,0,nlaylte+1) = xi(ig0+jl,ja,0,nlaylte+1)
	905	. * (-bsurf(jl,ja))
	906
	907	c ksidb reciprocity
	908	***************
	909	* 259,265 **
	910	do jl = 1,kdlon
	911
	912	fluxground(jl) = fluxground(jl)
	913	! . + xi(jl,ja,0,i) * (blay(jl,ja,i))
	914
	915	enddo
	916	enddo
	917	--- 260,266 ----
	918	do jl = 1,kdlon
	919
	920	fluxground(jl) = fluxground(jl)
	921	! . + xi(ig0+jl,ja,0,i) * (blay(jl,ja,i))
	922
	923	enddo
	924	enddo
	925	***************
	926	* 305,311 **
	927	do jl = 1,kdlon
	928	coefu(jl,ja,i,j) =0.
	929	do l=j,nlaylte+1
	930	! coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(jl,ja,l,i)
	931	end do
	932
	933	enddo
	934	--- 306,312 ----
	935	do jl = 1,kdlon
	936	coefu(jl,ja,i,j) =0.
	937	do l=j,nlaylte+1
	938	! coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
	939	end do
	940
	941	enddo
	942	***************
	943	* 333,339 **
	944	do jl = 1,kdlon
	945	coefd(jl,ja,i,j) =0.
	946	do l=0,j-1
	947	! coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(jl,ja,l,i)
	948	end do
	949	enddo
	950	enddo
	951	--- 334,340 ----
	952	do jl = 1,kdlon
	953	coefd(jl,ja,i,j) =0.
	954	do l=0,j-1
	955	! coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
	956	end do
	957	enddo
	958	enddo
	959	***************
	960	* 357,362 **
	961	--- 358,364 ----
	962	c ----------------
	963
	964	c ig1d: point de la grille physique ou on veut faire la sortie
	965	+ c ig0+1: point du decoupage de la grille physique
	966
	967	c#ifdef undim
	968	if (callg2d) then
	969	***************
	970	* 364,370 **
	971	ig1d = ngridmx/2 + 1
	972	c ig1d = ngridmx
	973
	974	! print*, 'Sortie g2d: ig1d =', ig1d
	975
	976	c--------------------------------------------
	977	c Ouverture de g2d.dat
	978	--- 366,376 ----
	979	ig1d = ngridmx/2 + 1
	980	c ig1d = ngridmx
	981
	982	! if ((ig0+1).LE.ig1d .and. ig1d.LE.(ig0+kdlon)
	983	! . .OR. ngridmx.EQ.1 ) then
	984	!
	985	! ig = ig1d-ig0
	986	! print*, 'Sortie g2d: ig1d, ig, ig0', ig1d, ig, ig0
	987
	988	c--------------------------------------------
	989	c Ouverture de g2d.dat
	990	***************
	991	* 403,409 **
	992	do j = 0,nlaylte+1
	993	do i = 0,nlaylte+1
	994	g2d_irec=g2d_irec+1
	995	! reel4 = ksidb(ig1d,ja,i,j)
	996	write(47,rec=g2d_irec) reel4
	997	enddo
	998	enddo
	999	--- 409,415 ----
	1000	do j = 0,nlaylte+1
	1001	do i = 0,nlaylte+1
	1002	g2d_irec=g2d_irec+1
	1003	! reel4 = ksidb(ig,ja,i,j)
	1004	write(47,rec=g2d_irec) reel4
	1005	enddo
	1006	enddo
	1007	***************
	1008	* 412,418 **
	1009	do j = 0,nlaylte+1
	1010	do i = 0,nlaylte+1
	1011	g2d_irec=g2d_irec+1
	1012	! reel4 = ksidb(ig1d,3,i,j)
	1013	write(47,rec=g2d_irec) reel4
	1014	enddo
	1015	enddo
	1016	--- 418,424 ----
	1017	do j = 0,nlaylte+1
	1018	do i = 0,nlaylte+1
	1019	g2d_irec=g2d_irec+1
	1020	! reel4 = ksidb(ig,3,i,j)
	1021	write(47,rec=g2d_irec) reel4
	1022	enddo
	1023	enddo
	1024	***************
	1025	* 423,429 **
	1026
	1027	do j = 1 , nlaylte
	1028	do i = 0 , nlaylte+1
	1029	! dpsgcp(i,j) = dp(ig1d,j) / gcp
	1030	enddo
	1031	enddo
	1032
	1033	--- 429,435 ----
	1034
	1035	do j = 1 , nlaylte
	1036	do i = 0 , nlaylte+1
	1037	! dpsgcp(i,j) = dp(ig,j) / gcp
	1038	enddo
	1039	enddo
	1040
	1041	***************
	1042	* 437,443 **
	1043	c print*,'gcp: ',gcp
	1044	c print*
	1045	c do i = 0 , nlaylte+1
	1046	! c print*,i,'dp: ',dp(ig1d,i)
	1047	c enddo
	1048	c print*
	1049	c do i = 0 , nlaylte+1
	1050	--- 443,449 ----
	1051	c print*,'gcp: ',gcp
	1052	c print*
	1053	c do i = 0 , nlaylte+1
	1054	! c print*,i,'dp: ',dp(ig,i)
	1055	c enddo
	1056	c print*
	1057	c do i = 0 , nlaylte+1
	1058	***************
	1059	* 458,469 **
	1060
	1061	do j = 1 , nlaylte
	1062	do i = 0 , nlaylte+1
	1063	! temp(i,j) = tlay(ig1d,j)
	1064	enddo
	1065	enddo
	1066
	1067	do i = 0 , nlaylte+1
	1068	! temp(i,0) = tlev(ig1d,1)+dt0(ig1d) ! temperature surface
	1069	temp(i,nlaylte+1) = 0. ! temperature espace (=0)
	1070	enddo
	1071
	1072	--- 464,475 ----
	1073
	1074	do j = 1 , nlaylte
	1075	do i = 0 , nlaylte+1
	1076	! temp(i,j) = tlay(ig,j)
	1077	enddo
	1078	enddo
	1079
	1080	do i = 0 , nlaylte+1
	1081	! temp(i,0) = tlev(ig,1)+dt0(ig) ! temperature surface
	1082	temp(i,nlaylte+1) = 0. ! temperature espace (=0)
	1083	enddo
	1084
	1085	***************
	1086	* 475,503 **
	1087	enddo
	1088	enddo
	1089
	1090	! write(76,*) 'ig1d =', ig1d
	1091	write(76,*) 'nlaylte', nlaylte
	1092	write(76,*) 'nflev', nflev
	1093	write(76,*) 'kdlon', kdlon
	1094	write(76,*) 'ndlo2', ndlo2
	1095	write(76,*) 'ndlon', ndlon
	1096	do ja=1,4
	1097	! write(76,*) 'bsurf', ja, bsurf(ig1d,ja)
	1098	! write(76,*) 'btop', ja, btop(ig1d,ja)
	1099
	1100	do j=1,nlaylte+1
	1101	! write(76,*) 'blev', ja, j, blev(ig1d,ja,j)
	1102	enddo
	1103
	1104	do j=1,nlaylte
	1105	! write(76,*) 'blay', ja, j, blay(ig1d,ja,j)
	1106	enddo
	1107
	1108	do j=1,2*nlaylte
	1109	! write(76,*) 'dbsublay', ja, j, dbsublay(ig1d,ja,j)
	1110	enddo
	1111	enddo
	1112
	1113	c************************************************************************
	1114	c#endif
	1115	endif ! callg2d
	1116	--- 481,510 ----
	1117	enddo
	1118	enddo
	1119
	1120	! write(76,*) 'ig1d, ig, ig0', ig1d, ig, ig0
	1121	write(76,*) 'nlaylte', nlaylte
	1122	write(76,*) 'nflev', nflev
	1123	write(76,*) 'kdlon', kdlon
	1124	write(76,*) 'ndlo2', ndlo2
	1125	write(76,*) 'ndlon', ndlon
	1126	do ja=1,4
	1127	! write(76,*) 'bsurf', ja, bsurf(ig,ja)
	1128	! write(76,*) 'btop', ja, btop(ig,ja)
	1129
	1130	do j=1,nlaylte+1
	1131	! write(76,*) 'blev', ja, j, blev(ig,ja,j)
	1132	enddo
	1133
	1134	do j=1,nlaylte
	1135	! write(76,*) 'blay', ja, j, blay(ig,ja,j)
	1136	enddo
	1137
	1138	do j=1,2*nlaylte
	1139	! write(76,*) 'dbsublay', ja, j, dbsublay(ig,ja,j)
	1140	enddo
	1141	enddo
	1142
	1143	+ endif
	1144	c************************************************************************
	1145	c#endif
	1146	endif ! callg2d
	1147	diff --ignore-blank-lines --context=3 -r oldgcm/lwi.F oldmeso/lwi.F
	1148	*** oldgcm/lwi.F Tue Feb 2 15:41:20 2010
	1149	--- oldmeso/lwi.F Tue Jan 25 16:49:09 2011
	1150	***************
	1151	* 1,4 **
	1152	! subroutine lwi (kdlon,kflev
	1153	. ,psi,zdblay,pdp
	1154	. ,newpcolc )
	1155
	1156	--- 1,4 ----
	1157	! subroutine lwi (ig0,kdlon,kflev
	1158	. ,psi,zdblay,pdp
	1159	. ,newpcolc )
	1160
	1161	***************
	1162	* 34,40 **
	1163	c ---------
	1164	c
	1165
	1166	! integer kdlon,kflev
	1167
	1168	real psi(ndlo2,kflev)
	1169	. , zdblay(ndlo2,nir,kflev)
	1170	--- 34,40 ----
	1171	c ---------
	1172	c
	1173
	1174	! integer ig0,kdlon,kflev
	1175
	1176	real psi(ndlo2,kflev)
	1177	. , zdblay(ndlo2,nir,kflev)
	1178	***************
	1179	* 90,103 **
	1180	do jl = 1 , kdlon
	1181	c -------------------
	1182	di(jl,i) = 1 + semit * (g / pdp(jl,i) / cpp) * (
	1183	! . ( xi(jl,1,i,nlaylte+1)
	1184	! . + xi(jl,1,i,i+1)
	1185	! . + xi(jl,1,i,i-1) )
	1186	! . * zdblay(jl,1,i)
	1187	! . + ( xi(jl,2,i,nlaylte+1)
	1188	! . + xi(jl,2,i,i+1)
	1189	! . + xi(jl,2,i,i-1) )
	1190	! . * zdblay(jl,2,i)
	1191	. )
	1192	c -------------------
	1193	enddo
	1194	--- 90,103 ----
	1195	do jl = 1 , kdlon
	1196	c -------------------
	1197	di(jl,i) = 1 + semit * (g / pdp(jl,i) / cpp) * (
	1198	! . ( xi(ig0+jl,1,i,nlaylte+1)
	1199	! . + xi(ig0+jl,1,i,i+1)
	1200	! . + xi(ig0+jl,1,i,i-1) )
	1201	! . * zdblay(jl,1,i)
	1202	! . + ( xi(ig0+jl,2,i,nlaylte+1)
	1203	! . + xi(ig0+jl,2,i,i+1)
	1204	! . + xi(ig0+jl,2,i,i-1) )
	1205	! . * zdblay(jl,2,i)
	1206	. )
	1207	c -------------------
	1208	enddo
	1209	***************
	1210	* 112,123 **
	1211	do jl = 1 , kdlon
	1212	c -------------------
	1213	di(jl,nlaylte) = 1 + semit * (g / pdp(jl,nlaylte) / cpp) * (
	1214	! . ( xi(jl,1,nlaylte,nlaylte+1)
	1215	! . + xi(jl,1,nlaylte,nlaylte-1) )
	1216	! . * zdblay(jl,1,nlaylte)
	1217	! . + ( xi(jl,2,nlaylte,nlaylte+1)
	1218	! . + xi(jl,2,nlaylte,nlaylte-1) )
	1219	! . * zdblay(jl,2,nlaylte)
	1220	. )
	1221	c -------------------
	1222	enddo
	1223	--- 110,121 ----
	1224	do jl = 1 , kdlon
	1225	c -------------------
	1226	di(jl,nlaylte) = 1 + semit * (g / pdp(jl,nlaylte) / cpp) * (
	1227	! . ( xi(ig0+jl,1,nlaylte,nlaylte+1)
	1228	! . + xi(ig0+jl,1,nlaylte,nlaylte-1) )
	1229	! . * zdblay(jl,1,nlaylte)
	1230	! . + ( xi(ig0+jl,2,nlaylte,nlaylte+1)
	1231	! . + xi(ig0+jl,2,nlaylte,nlaylte-1) )
	1232	! . * zdblay(jl,2,nlaylte)
	1233	. )
	1234	c -------------------
	1235	enddo
	1236	***************
	1237	* 132,139 **
	1238	do jl = 1 , kdlon
	1239	c -------------------
	1240	hi(jl,i) = - semit * (g / pdp(jl,i) / cpp) *
	1241	! . ( xi(jl,1,i,i+1) * zdblay(jl,1,i+1)
	1242	! . + xi(jl,2,i,i+1) * zdblay(jl,2,i+1) )
	1243	c -------------------
	1244	enddo
	1245	enddo
	1246	--- 129,136 ----
	1247	do jl = 1 , kdlon
	1248	c -------------------
	1249	hi(jl,i) = - semit * (g / pdp(jl,i) / cpp) *
	1250	! . ( xi(ig0+jl,1,i,i+1) * zdblay(jl,1,i+1)
	1251	! . + xi(ig0+jl,2,i,i+1) * zdblay(jl,2,i+1) )
	1252	c -------------------
	1253	enddo
	1254	enddo
	1255	***************
	1256	* 148,155 **
	1257	do jl = 1 , kdlon
	1258	c -------------------
	1259	bi(jl,i) = - semit * (g / pdp(jl,i) / cpp) *
	1260	! . ( xi(jl,1,i,i-1) * zdblay(jl,1,i-1)
	1261	! . + xi(jl,2,i,i-1) * zdblay(jl,2,i-1) )
	1262	c -------------------
	1263	enddo
	1264	enddo
	1265	--- 145,152 ----
	1266	do jl = 1 , kdlon
	1267	c -------------------
	1268	bi(jl,i) = - semit * (g / pdp(jl,i) / cpp) *
	1269	! . ( xi(ig0+jl,1,i,i-1) * zdblay(jl,1,i-1)
	1270	! . + xi(ig0+jl,2,i,i-1) * zdblay(jl,2,i-1) )
	1271	c -------------------
	1272	enddo
	1273	enddo
	1274	diff --ignore-blank-lines --context=3 -r oldgcm/lwmain.F oldmeso/lwmain.F
	1275	*** oldgcm/lwmain.F Tue Feb 2 15:41:20 2010
	1276	--- oldmeso/lwmain.F Tue Jan 25 16:49:09 2011
	1277	***************
	1278	* 1,4 **
	1279	! subroutine lwmain (icount,kdlon,kflev
	1280	. ,dp,dt0,emis
	1281	. ,plev,tlev,tlay,aerosol,coolrate
	1282	. ,fluxground,fluxtop
	1283	--- 1,4 ----
	1284	! subroutine lwmain (ig0,icount,kdlon,kflev
	1285	. ,dp,dt0,emis
	1286	. ,plev,tlev,tlay,aerosol,coolrate
	1287	. ,fluxground,fluxtop
	1288	***************
	1289	* 25,30 **
	1290	--- 25,31 ----
	1291	c ---------
	1292	c inputs:
	1293	c -------
	1294	+ integer ig0
	1295	integer icount
	1296	integer kdlon ! part of ngrid
	1297	integer kflev ! part of nlayer
	1298	***************
	1299	* 48,56 **
	1300	real fluxtop(ndlo2) ! outgoing upward flux (W/m2) ("OLR")
	1301	real netrad (ndlo2,kflev) ! radiative budget (W/m2)
	1302	c Aerosol optical properties
	1303	! REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
	1304	! REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
	1305	! REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
	1306
	1307	c----------------------------------------------------------------------
	1308	c 0.2 local arrays
	1309	--- 49,57 ----
	1310	real fluxtop(ndlo2) ! outgoing upward flux (W/m2) ("OLR")
	1311	real netrad (ndlo2,kflev) ! radiative budget (W/m2)
	1312	c Aerosol optical properties
	1313	! REAL :: QIRsQREF3d(ndlo2,kflev,nir,naerkind)
	1314	! REAL :: omegaIR3d(ndlo2,kflev,nir,naerkind)
	1315	! REAL :: gIR3d(ndlo2,kflev,nir,naerkind)
	1316
	1317	c----------------------------------------------------------------------
	1318	c 0.2 local arrays
	1319	***************
	1320	* 127,133 **
	1321	if( mod(icount-1,ilwd).eq.0) then
	1322
	1323	c print*, 'CALL of DISTANTS'
	1324	! call lwxd ( kdlon, kflev, emis
	1325	. , aer_t, co2_u, co2_up)
	1326
	1327	endif
	1328	--- 128,134 ----
	1329	if( mod(icount-1,ilwd).eq.0) then
	1330
	1331	c print*, 'CALL of DISTANTS'
	1332	! call lwxd ( ig0, kdlon, kflev, emis
	1333	. , aer_t, co2_u, co2_up)
	1334
	1335	endif
	1336	***************
	1337	* 136,142 **
	1338	if( mod(icount-1,ilwn).eq.0) then
	1339
	1340	c print*, 'CALL of NEIGHBOURS'
	1341	! call lwxn ( kdlon, kflev
	1342	. , dp
	1343	. , aer_t, co2_u, co2_up)
	1344
	1345	--- 137,143 ----
	1346	if( mod(icount-1,ilwn).eq.0) then
	1347
	1348	c print*, 'CALL of NEIGHBOURS'
	1349	! call lwxn ( ig0, kdlon, kflev
	1350	. , dp
	1351	. , aer_t, co2_u, co2_up)
	1352
	1353	***************
	1354	* 146,152 **
	1355	if( mod(icount-1,ilwb).eq.0) then
	1356
	1357	c print*, 'CALL of BOUNDARIES'
	1358	! call lwxb ( kdlon, kflev, emis
	1359	. , aer_t, co2_u, co2_up)
	1360
	1361	endif
	1362	--- 147,153 ----
	1363	if( mod(icount-1,ilwb).eq.0) then
	1364
	1365	c print*, 'CALL of BOUNDARIES'
	1366	! call lwxb ( ig0, kdlon, kflev, emis
	1367	. , aer_t, co2_u, co2_up)
	1368
	1369	endif
	1370	***************
	1371	* 155,161 **
	1372	c 4.0 cooling rate
	1373	c ------------
	1374
	1375	! call lwflux ( kdlon, kflev, dp
	1376	. , bsurf, btop, blev, blay, dbsublay
	1377	. , tlay, tlev, dt0 ! pour sortie dans g2d uniquement
	1378	. , emis
	1379	--- 156,162 ----
	1380	c 4.0 cooling rate
	1381	c ------------
	1382
	1383	! call lwflux ( ig0, kdlon, kflev, dp
	1384	. , bsurf, btop, blev, blay, dbsublay
	1385	. , tlay, tlev, dt0 ! pour sortie dans g2d uniquement
	1386	. , emis
	1387	***************
	1388	* 186,192 **
	1389	c ---------------------------
	1390	c
	1391	c
	1392	! call lwi (kdlon,kflev,netrad,dblay,dp
	1393	. , newcoolrate)
	1394	c
	1395	c Verif que (X sol,space) + somme(X i,sol) = 1
	1396	--- 187,193 ----
	1397	c ---------------------------
	1398	c
	1399	c
	1400	! call lwi (ig0,kdlon,kflev,netrad,dblay,dp
	1401	. , newcoolrate)
	1402	c
	1403	c Verif que (X sol,space) + somme(X i,sol) = 1
	1404	diff --ignore-blank-lines --context=3 -r oldgcm/lwxb.F oldmeso/lwxb.F
	1405	*** oldgcm/lwxb.F Tue Feb 2 15:41:20 2010
	1406	--- oldmeso/lwxb.F Tue Jan 25 16:49:09 2011
	1407	***************
	1408	* 1,4 **
	1409	! subroutine lwxb (kdlon,kflev
	1410	. ,emis
	1411	. ,aer_t,co2_u,co2_up)
	1412
	1413	--- 1,4 ----
	1414	! subroutine lwxb (ig0,kdlon,kflev
	1415	. ,emis
	1416	. ,aer_t,co2_u,co2_up)
	1417
	1418	***************
	1419	* 58,64 **
	1420	c 0.2 local arrays
	1421	c ------------
	1422
	1423	! integer ja,jl,jk
	1424
	1425	real zt_co2 (ndlon,nuco2)
	1426	real zt_aer (ndlon,nuco2)
	1427	--- 58,64 ----
	1428	c 0.2 local arrays
	1429	c ------------
	1430
	1431	! integer ja,jl,jk,ig0
	1432
	1433	real zt_co2 (ndlon,nuco2)
	1434	real zt_aer (ndlon,nuco2)
	1435	***************
	1436	* 170,181 **
	1437	ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
	1438	. - trans_emis(jl,ja,jk+1)
	1439
	1440	! xi(jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk)
	1441	. + ksi_emis(jl,ja,jk)* (1 - emis(jl))
	1442
	1443	c ksi Reciprocity
	1444	c ---------------
	1445	! xi(jl,ja,nlaylte+1,jk) = xi(jl,ja,jk,nlaylte+1)
	1446
	1447	c-------------------------------------------------------------------------
	1448	c 2.2 echange with ground (from "layer" 0 toward layers 1,nlaylte)
	1449	--- 170,181 ----
	1450	ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
	1451	. - trans_emis(jl,ja,jk+1)
	1452
	1453	! xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk)
	1454	. + ksi_emis(jl,ja,jk)* (1 - emis(jl))
	1455
	1456	c ksi Reciprocity
	1457	c ---------------
	1458	! xi(ig0+jl,ja,nlaylte+1,jk) = xi(ig0+jl,ja,jk,nlaylte+1)
	1459
	1460	c-------------------------------------------------------------------------
	1461	c 2.2 echange with ground (from "layer" 0 toward layers 1,nlaylte)
	1462	***************
	1463	* 185,195 **
	1464	ksi(jl,ja,1,jk) = trans(jl,ja,1,jk)
	1465	. - trans(jl,ja,1,jk+1)
	1466
	1467	! xi(jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
	1468
	1469	c ksi Reciprocity
	1470	c ---------------
	1471	! xi(jl,ja,jk,0) = xi(jl,ja,0,jk)
	1472
	1473	c-------------------------------------------------------------------------
	1474	enddo
	1475	--- 185,195 ----
	1476	ksi(jl,ja,1,jk) = trans(jl,ja,1,jk)
	1477	. - trans(jl,ja,1,jk+1)
	1478
	1479	! xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
	1480
	1481	c ksi Reciprocity
	1482	c ---------------
	1483	! xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk)
	1484
	1485	c-------------------------------------------------------------------------
	1486	enddo
	1487	***************
	1488	* 206,216 **
	1489	do jl = 1 , kdlon
	1490
	1491	ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1)
	1492	! xi(jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
	1493
	1494	c ksi Reciprocity
	1495	c ---------------
	1496	! xi(jl,ja,nlaylte+1,0) = xi(jl,ja,0,nlaylte+1)
	1497
	1498	enddo
	1499	enddo
	1500	--- 206,216 ----
	1501	do jl = 1 , kdlon
	1502
	1503	ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1)
	1504	! xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
	1505
	1506	c ksi Reciprocity
	1507	c ---------------
	1508	! xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1)
	1509
	1510	enddo
	1511	enddo
	1512	diff --ignore-blank-lines --context=3 -r oldgcm/lwxd.F oldmeso/lwxd.F
	1513	*** oldgcm/lwxd.F Tue Feb 2 15:41:20 2010
	1514	--- oldmeso/lwxd.F Tue Jan 25 16:49:09 2011
	1515	***************
	1516	* 1,4 **
	1517	! subroutine lwxd (kdlon,kflev,emis
	1518	. ,aer_t,co2_u,co2_up)
	1519
	1520	c----------------------------------------------------------------------
	1521	--- 1,4 ----
	1522	! subroutine lwxd (ig0,kdlon,kflev,emis
	1523	. ,aer_t,co2_u,co2_up)
	1524
	1525	c----------------------------------------------------------------------
	1526	***************
	1527	* 45,50 **
	1528	--- 45,51 ----
	1529	c ---------
	1530	c inputs:
	1531	c -------
	1532	+ integer ig0
	1533	integer kdlon ! part of ngrid
	1534	integer kflev ! part of nalyer
	1535
	1536	***************
	1537	* 218,231 **
	1538	c print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk)
	1539	c endif
	1540
	1541	! xi(jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
	1542	. + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl))
	1543
	1544	c ksi reciprocity
	1545	c ---------------
	1546	ksi(jl,ja,jkk,jk) = ksi(jl,ja,jk,jkk)
	1547	ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk)
	1548	! xi(jl,ja,jkk,jk) = xi(jl,ja,jk,jkk)
	1549
	1550	enddo
	1551	enddo
	1552	--- 219,232 ----
	1553	c print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk)
	1554	c endif
	1555
	1556	! xi(ig0+jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
	1557	. + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl))
	1558
	1559	c ksi reciprocity
	1560	c ---------------
	1561	ksi(jl,ja,jkk,jk) = ksi(jl,ja,jk,jkk)
	1562	ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk)
	1563	! xi(ig0+jl,ja,jkk,jk) = xi(ig0+jl,ja,jk,jkk)
	1564
	1565	enddo
	1566	enddo
	1567	***************
	1568	* 244,250 **
	1569	c . trans_emis(jl,ja,jk,jk+1) - trans_emis(jl,ja,jk+1,jk+1)
	1570	c . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2)
	1571
	1572	! xi_emis(jl,ja,jk) =
	1573	. ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl))
	1574
	1575	enddo
	1576	--- 245,251 ----
	1577	c . trans_emis(jl,ja,jk,jk+1) - trans_emis(jl,ja,jk+1,jk+1)
	1578	c . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2)
	1579
	1580	! xi_emis(ig0+jl,ja,jk) =
	1581	. ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl))
	1582
	1583	enddo
	1584	diff --ignore-blank-lines --context=3 -r oldgcm/lwxn.F oldmeso/lwxn.F
	1585	*** oldgcm/lwxn.F Tue Feb 2 15:41:20 2010
	1586	--- oldmeso/lwxn.F Tue Jan 25 16:49:09 2011
	1587	***************
	1588	* 1,4 **
	1589	! subroutine lwxn ( kdlon,kflev
	1590	. , dp
	1591	. , aer_t,co2_u,co2_up)
	1592
	1593	--- 1,4 ----
	1594	! subroutine lwxn ( ig0,kdlon,kflev
	1595	. , dp
	1596	. , aer_t,co2_u,co2_up)
	1597
	1598	***************
	1599	* 83,88 **
	1600	--- 83,89 ----
	1601	c ---------
	1602	c inputs:
	1603	c -------
	1604	+ integer ig0
	1605	integer kdlon ! part of ngrid
	1606	integer kflev ! part of nalyer
	1607
	1608	***************
	1609	* 342,353 **
	1610
	1611	do ja = 1 ,nuco2
	1612	do jl = 1 , kdlon
	1613	! xi(jl,ja,jk,jk+1) = ksi(jl,ja,jk)
	1614	! . + xi_emis(jl,ja,jk)
	1615
	1616	c ksi reciprocity
	1617	c ---------------
	1618	! xi(jl,ja,jk+1,jk) = xi(jl,ja,jk,jk+1)
	1619	enddo
	1620	enddo
	1621
	1622	--- 343,354 ----
	1623
	1624	do ja = 1 ,nuco2
	1625	do jl = 1 , kdlon
	1626	! xi(ig0+jl,ja,jk,jk+1) = ksi(jl,ja,jk)
	1627	! . + xi_emis(ig0+jl,ja,jk)
	1628
	1629	c ksi reciprocity
	1630	c ---------------
	1631	! xi(ig0+jl,ja,jk+1,jk) = xi(ig0+jl,ja,jk,jk+1)
	1632	enddo
	1633	enddo
	1634
	1635	***************
	1636	* 360,366 **
	1637
	1638	do ja = 1 ,nuco2
	1639	do jl = 1 , kdlon
	1640	! xi_ground(jl,ja)=0.
	1641	enddo
	1642	enddo
	1643
	1644	--- 361,367 ----
	1645
	1646	do ja = 1 ,nuco2
	1647	do jl = 1 , kdlon
	1648	! xi_ground(ig0+jl,ja)=0.
	1649	enddo
	1650	enddo
	1651
	1652	***************
	1653	* 368,374 **
	1654	do ja = 1 ,nuco2
	1655	do jl = 1 , kdlon
	1656
	1657	! xi_ground(jl,ja) = xi_ground(jl,ja)
	1658	. + ( trans(jl,ja,ni+1,ncouche+1)
	1659	. -trans(jl,ja,ni,ncouche+1))
	1660	. * 2 * cb(ni)
	1661	--- 369,375 ----
	1662	do ja = 1 ,nuco2
	1663	do jl = 1 , kdlon
	1664
	1665	! xi_ground(ig0+jl,ja) = xi_ground(ig0+jl,ja)
	1666	. + ( trans(jl,ja,ni+1,ncouche+1)
	1667	. -trans(jl,ja,ni,ncouche+1))
	1668	. * 2 * cb(ni)
	1669	Only in oldmeso: meso_dimphys.h_ref
	1670	Only in oldmeso: meso_dustlift
	1671	Only in oldmeso: meso_inifis.F
	1672	Only in oldmeso: meso_inifis.F~
	1673	Only in oldmeso: meso_newcondens
	1674	Only in oldmeso: meso_physiq.F
	1675	Only in oldmeso: meso_physiq.F~
	1676	Only in oldmeso: meso_testphys1d.F
	1677	diff --ignore-blank-lines --context=3 -r oldgcm/newcondens.F oldmeso/newcondens.F
	1678	*** oldgcm/newcondens.F Tue Feb 2 15:41:20 2010
	1679	--- oldmeso/newcondens.F Tue Jan 25 16:49:10 2011
	1680	***************
	1681	* 423,429 **
	1682	piceco2(ig)=0.
	1683	endif
	1684	ENDDO
	1685	!
	1686	! Set albedo and emissivity of the surface
	1687	! ----------------------------------------
	1688	CALL albedocaps(zls,ngrid,piceco2,psolaralb,emisref)
	1689	--- 423,429 ----
	1690	piceco2(ig)=0.
	1691	endif
	1692	ENDDO
	1693	!
	1694	! Set albedo and emissivity of the surface
	1695	! ----------------------------------------
	1696	CALL albedocaps(zls,ngrid,piceco2,psolaralb,emisref)
	1697	***************
	1698	* 589,618 **
	1699	do iq=1,nqmx
	1700	zqm(nlayer+1,iq)= zq(nlayer,iq)
	1701	enddo
	1702	-
	1703	- c Tendencies on T, U, V, Q
	1704	- c """"""""""""""""""""""""
	1705	- DO l=1,nlayer
	1706
	1707	! c Tendencies on T
	1708	! zdtsig(ig,l) = (1/masse(l)) *
	1709	! & ( zmflux(l)*(ztm(l) - ztc(l))
	1710	! & - zmflux(l+1)*(ztm(l+1) - ztc(l))
	1711	! & + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l)) )
	1712	! pdtc(ig,l) = pdtc(ig,l) + zdtsig(ig,l)
	1713	!
	1714	! c Tendencies on U
	1715	! pduc(ig,l) = (1/masse(l)) *
	1716	! & ( zmflux(l)*(zum(l) - zu(l))
	1717	! & - zmflux(l+1)*(zum(l+1) - zu(l)) )
	1718	!
	1719	!
	1720	! c Tendencies on V
	1721	! pdvc(ig,l) = (1/masse(l)) *
	1722	! & ( zmflux(l)*(zvm(l) - zv(l))
	1723	! & - zmflux(l+1)*(zvm(l+1) - zv(l)) )
	1724	!
	1725	! END DO
	1726
	1727	c Tendencies on Q
	1728	do iq=1,nqmx
	1729	--- 589,622 ----
	1730	do iq=1,nqmx
	1731	zqm(nlayer+1,iq)= zq(nlayer,iq)
	1732	enddo
	1733
	1734	! CCCC
	1735	! CCCC *** WRF comments
	1736	! CCCC
	1737	! c
	1738	! cc Tendencies on T, U, V, Q
	1739	! cc """"""""""""""""""""""""
	1740	! c DO l=1,nlayer
	1741	! c
	1742	! cc Tendencies on T
	1743	! c zdtsig(ig,l) = (1/masse(l)) *
	1744	! c & ( zmflux(l)*(ztm(l) - ztc(l))
	1745	! c & - zmflux(l+1)*(ztm(l+1) - ztc(l))
	1746	! c & + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l)) )
	1747	! c pdtc(ig,l) = pdtc(ig,l) + zdtsig(ig,l)
	1748	! c
	1749	! cc Tendencies on U
	1750	! c pduc(ig,l) = (1/masse(l)) *
	1751	! c & ( zmflux(l)*(zum(l) - zu(l))
	1752	! c & - zmflux(l+1)*(zum(l+1) - zu(l)) )
	1753	! c
	1754	! c
	1755	! cc Tendencies on V
	1756	! c pdvc(ig,l) = (1/masse(l)) *
	1757	! c & ( zmflux(l)*(zvm(l) - zv(l))
	1758	! c & - zmflux(l+1)*(zvm(l+1) - zv(l)) )
	1759	! c
	1760	! c END DO
	1761
	1762	c Tendencies on Q
	1763	do iq=1,nqmx
	1764	Only in oldgcm: newcondens.F.old
	1765	Only in oldmeso: newcondens.F~
	1766	Only in oldmeso: nocompile
	1767	Only in oldgcm: orodrag.F
	1768	Only in oldgcm: orosetup.F
	1769	Only in oldmeso: param_slope.F90
	1770	Only in oldmeso: param_slope_full.F90
	1771	Only in oldgcm: physdem1.F
	1772	Only in oldgcm: physiq.F
	1773	Only in oldgcm: physiq.F.old
	1774	Only in oldgcm: physiq.F~
	1775	Only in oldgcm: readtesassim.F90.old
	1776	Only in oldmeso: slope.h
	1777	Only in oldmeso: splitting
	1778	Only in oldmeso: splitting.tar.gz
	1779	diff --ignore-blank-lines --context=3 -r oldgcm/suaer.F90 oldmeso/suaer.F90
	1780	*** oldgcm/suaer.F90 Tue Feb 2 15:41:20 2010
	1781	--- oldmeso/suaer.F90 Tue Jan 25 16:49:09 2011
	1782	***************
	1783	* 88,103 **
	1784	!---- Please indicate the names of the optical property files below
	1785	! Please also choose the reference wavelengths of each aerosol
	1786	! naerkind=1, visible range:
	1787	! ! file_id(1,1) = 'optprop_dustvis_TM_n50.dat' !M.Wolff
	1788	! file_id(1,1) = 'optprop_dustvis_TM.dat' !M.Wolff TM
	1789	! ! file_id(1,1) = 'optprop_dustvis_MW-MIE.dat' !M.Wolff MIE
	1790	! file_id(1,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell
	1791	! ! file_id(1,1) = 'optprop_dustvis.dat' !Clancy-Lee
	1792	! naerkind=1, infrared:
	1793	! file_id(1,2) = 'optprop_dustir_TM_n50.dat' !M.Wolff
	1794	! file_id(1,2) = 'optprop_dustir_TM.dat' !M.Wolff
	1795	! file_id(1,2) = 'optprop_dustir_MW-MIE.dat' !M.Wolff MIE
	1796	! ! file_id(1,2) = 'optprop_dustir_x0.5.dat' !Toon-Forget
	1797	! naerkind=1, visible range:
	1798	longrefvis(1)=0.67E-6
	1799	! For dust: change readtesassim accordingly;
	1800	--- 88,103 ----
	1801	!---- Please indicate the names of the optical property files below
	1802	! Please also choose the reference wavelengths of each aerosol
	1803	! naerkind=1, visible range:
	1804	! ! file_id(1,1) = 'optprop_dustvis_TM_n50.dat' !M.Wolff !!***WRF: pour faire varier le rayon (experim)
	1805	! file_id(1,1) = 'optprop_dustvis_TM.dat' !M.Wolff TM !!***WRF: PAR DEFAUT
	1806	! ! file_id(1,1) = 'optprop_dustvis_MW-MIE.dat' !M.Wolff MIE !!***WRF: pour test JB
	1807	! file_id(1,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell
	1808	! ! file_id(1,1) = 'optprop_dustvis.dat' !Clancy-Lee
	1809	! naerkind=1, infrared:
	1810	! file_id(1,2) = 'optprop_dustir_TM_n50.dat' !M.Wolff
	1811	! file_id(1,2) = 'optprop_dustir_TM.dat' !M.Wolff
	1812	! file_id(1,2) = 'optprop_dustir_MW-MIE.dat' !M.Wolff MIE
	1813	! ! file_id(1,2) = 'optprop_dustir_x0.5.dat' !Toon-Forget
	1814	! naerkind=1, visible range:
	1815	longrefvis(1)=0.67E-6
	1816	! For dust: change readtesassim accordingly;
	1817	Only in oldgcm: suaer.F90.old
	1818	Only in oldgcm: sugwd.F
	1819	diff --ignore-blank-lines --context=3 -r oldgcm/surfdat.h oldmeso/surfdat.h
	1820	*** oldgcm/surfdat.h Tue Feb 2 15:41:20 2010
	1821	--- oldmeso/surfdat.h Tue Jan 25 16:49:10 2011
	1822	***************
	1823	* 8,13 **
	1824	--- 8,15 ----
	1825	COMMON/surfdatl/TESicealbedo
	1826
	1827	real albedodat ! albedo of bare ground
	1828	+ ! Ehouarn: moved inertiedat to comsoil.h
	1829	+ ! real inertiedat, ! thermal inertia
	1830	real phisfi ! geopotential at ground level
	1831	real albedice ! default albedo for ice (1: North H. 2: South H.)
	1832	real emisice ! ice emissivity; 1:Northern hemisphere 2:Southern hemisphere
	1833	Only in oldgcm: surfdat.h.old
	1834	Only in oldmeso: surfdat.h~
	1835	diff --ignore-blank-lines --context=3 -r oldgcm/swmain.F oldmeso/swmain.F
	1836	*** oldgcm/swmain.F Tue Feb 2 15:41:20 2010
	1837	--- oldmeso/swmain.F Tue Jan 25 16:49:09 2011
	1838	***************
	1839	* 72,80 **
	1840	REAL PFRACT(NDLO2)
	1841	real PFLUXD(NDLON,NFLEV+1,2)
	1842	real PFLUXU(NDLON,NFLEV+1,2)
	1843	! REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
	1844	! REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
	1845	! REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
	1846
	1847	C LOCAL ARRAYS
	1848	C ------------
	1849	--- 72,80 ----
	1850	REAL PFRACT(NDLO2)
	1851	real PFLUXD(NDLON,NFLEV+1,2)
	1852	real PFLUXU(NDLON,NFLEV+1,2)
	1853	! REAL :: QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind)
	1854	! REAL :: omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)
	1855	! REAL :: gVIS3d(NDLO2,KFLEV,nsun,naerkind)
	1856
	1857	C LOCAL ARRAYS
	1858	C ------------
	1859	diff --ignore-blank-lines --context=3 -r oldgcm/swr_toon.F oldmeso/swr_toon.F
	1860	*** oldgcm/swr_toon.F Tue Feb 2 15:41:20 2010
	1861	--- oldmeso/swr_toon.F Tue Jan 25 16:49:10 2011
	1862	***************
	1863	* 253,267 **
	1864	c FM = flux down
	1865	C PRIVATES:
	1866	INTEGER J,NL,NLEV
	1867	! PARAMETER (NL=201)
	1868	! C THIS VALUE (201) MUST BE .GE. 2*NAYER
	1869	REAL*8 BSURF,AP,AM,DENOM,EM,EP,G4
	1870	! REAL*8 W0(NL), COSBAR(NL), DTAU(NL), TAU(NL)
	1871	! REAL*8 LAMDA(NL),XK1(NL),XK2(NL)
	1872	! REAL*8 G1(NL),G2(NL),G3(NL)
	1873	! REAL*8 GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL)
	1874	! REAL*8 E1(NL),E2(NL),E3(NL),E4(NL)
	1875	!
	1876	NLEV = NAYER+1
	1877
	1878	C TURN ON THE DELTA-FUNCTION IF REQUIRED HERE
	1879	--- 253,277 ----
	1880	c FM = flux down
	1881	C PRIVATES:
	1882	INTEGER J,NL,NLEV
	1883	! !!!! AS+JBM 03/2010 BUG BUG si trop niveaux verticaux (LES)
	1884	! !!!! ET PAS BESOIN DE HARDWIRE SALE ICI !
	1885	! !!!! CORRIGER CE BUG AMELIORE EFFICACITE ET FLEXIBILITE
	1886	! !! PARAMETER (NL=201)
	1887	! !! C THIS VALUE (201) MUST BE .GE. 2*NAYER
	1888	REAL*8 BSURF,AP,AM,DENOM,EM,EP,G4
	1889	! !! REAL*8 W0(NL), COSBAR(NL), DTAU(NL), TAU(NL)
	1890	! !! REAL*8 LAMDA(NL),XK1(NL),XK2(NL)
	1891	! !! REAL*8 G1(NL),G2(NL),G3(NL)
	1892	! !! REAL*8 GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL)
	1893	! !! REAL*8 E1(NL),E2(NL),E3(NL),E4(NL)
	1894	! REAL8 W0(2NAYER), COSBAR(2NAYER), DTAU(2NAYER), TAU(2*NAYER)
	1895	! REAL8 LAMDA(2NAYER),XK1(2NAYER),XK2(2NAYER)
	1896	! REAL8 G1(2NAYER),G2(2NAYER),G3(2NAYER)
	1897	! REAL8 GAMA(2NAYER),CP(2NAYER),CM(2NAYER),CPM1(2*NAYER)
	1898	! REAL8 CMM1(2NAYER)
	1899	! REAL8 E1(2NAYER),E2(2NAYER),E3(2NAYER),E4(2*NAYER)
	1900	!
	1901	! NL = 2*NAYER !!! AS+JBM 03/2010
	1902	NLEV = NAYER+1
	1903
	1904	C TURN ON THE DELTA-FUNCTION IF REQUIRED HERE
	1905	***************
	1906	* 381,391 **
	1907
	1908	C DOUBLE PRECISION VERSION OF SOLVER
	1909
	1910	! PARAMETER (NMAX=201)
	1911	IMPLICIT REAL*8 (A-H,O-Z)
	1912	DIMENSION GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL),
	1913	* XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL)
	1914	! DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX)
	1915	C*********************************************************
	1916	C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE *
	1917	C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS *
	1918	--- 391,405 ----
	1919
	1920	C DOUBLE PRECISION VERSION OF SOLVER
	1921
	1922	! cc PARAMETER (NMAX=201)
	1923	! cc AS+JBM 03/2010
	1924	IMPLICIT REAL*8 (A-H,O-Z)
	1925	DIMENSION GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL),
	1926	* XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL)
	1927	! cc AS+JBM 03/2010
	1928	! cc DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX)
	1929	! DIMENSION AF(2NL),BF(2NL),CF(2NL),DF(2NL),XK(2*NL)
	1930	!
	1931	C*********************************************************
	1932	C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE *
	1933	C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS *
	1934	***************
	1935	* 481,490 **
	1936
	1937	C DOUBLE PRECISION VERSION OF TRIDGL
	1938
	1939	! PARAMETER (NMAX=201)
	1940	IMPLICIT REAL*8 (A-H,O-Z)
	1941	DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
	1942	! DIMENSION AS(NMAX),DS(NMAX)
	1943
	1944	C* THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
	1945	C* EQUATIONS. THE FORM OF THE EQUATIONS ARE:
	1946	--- 495,507 ----
	1947
	1948	C DOUBLE PRECISION VERSION OF TRIDGL
	1949
	1950	! cc AS+JBM 03/2010 : OBSOLETE MAINTENANT
	1951	! cc PARAMETER (NMAX=201)
	1952	IMPLICIT REAL*8 (A-H,O-Z)
	1953	DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
	1954	! cc AS+JBM 03/2010 : OBSOLETE MAINTENANT
	1955	! cc DIMENSION AS(NMAX),DS(NMAX)
	1956	! DIMENSION AS(L),DS(L)
	1957
	1958	C* THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
	1959	C* EQUATIONS. THE FORM OF THE EQUATIONS ARE:
	1960	Only in oldgcm: testphys1d.F
	1961	Only in oldmeso: ye
	1962	Only in oldmeso: yeye

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

Download in other formats:

Original Format