Context Navigation

diff_oldgcm_oldmeso_checked @ 35

Last change on this file since 35 was 35, checked in by aslmd, 15 years ago
LMD_MM_MARS: travail de preparation a un dossier libf commun avec LMDZ.MARS
File size: 63.3 KB

Line
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