Context Navigation

meso_inifis.F @ 89

Last change on this file since 89 was 86, checked in by aslmd, 14 years ago

*
mars + LMD_MM_MARS * Precompilation flag MESOSCALE for better transparency

* in shared phymars between GCM and mesoscale model

M 85 mars/libf/phymars/meso_physiq.F
M 85 mars/libf/phymars/meso_inifis.F
Added a pre-compilation flag MESOSCALE so that the LMDZ.MARS GCM
will compile without stating errors because of mesoscale routines.

M 85 mars/libf/phymars/newcondens.F
M 85 mars/libf/phymars/testphys1d.F
M 85 mars/libf/phymars/dustlift.F
D 85 mars/libf/phymars/meso_testphys1d.F
D 85 mars/libf/phymars/meso_dustlift.F
D 85 mars/libf/phymars/meso_newcondens.F
Now, this MESOSCALE precompilation flag can be used to lower
the number of meso_* routines when adaptations for mesoscale
applications are not very extended.
--> Three meso_* routines were deleted and changes are
now impacted under the MESOSCALE flag in the original GCM routines
--> Completely transparent for GCM compilation since it is devoid
of the -DMESOSCALE option
--> Very good for syncing because changes in dustlift, newcondens
will be directly available in the mesoscale model

M 84 mesoscale/LMD_MM_MARS/makemeso
Changed meso_testphys1d in testphys1d

M 84 mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new/makegcm_pgf
M 84 mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new/makegcm_mpifort
M 84 mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new/makegcm_ifort
M 84 mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new/makegcm_g95
M 84 mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new/makegcm_mpi
Added the option -DMESOSCALE in these scripts

*
LMD_MM_MARS * Various minor changes related to water cycle and plotting routines

* Also included the GW test case

A 0 mesoscale/LMDZ.MARS.new/myGCM/DEFS_JB/callphys.def.orig
M 84 mesoscale/NOTES.txt
D 84 mesoscale/LMD_MM_MARS/SRC/ARWpost/idl
M 84 mesoscale/LMD_MM_MARS/SRC/WRFV2/Registry/Registry.EM
M 84 mesoscale/LMD_MM_MARS/SIMU/gnome_launch.meso
M 85 mesoscale/PLOT/MINIMAL/map_latlon.pro
D 85 mesoscale/PLOT/SPEC/LES/getget.pro
M 85 mesoscale/PLOT/SPEC/MAP/map_uvt.pro
A + - mesoscale/PLOT/SPEC/getget.pro
A 0 mesoscale/PLOT/RESERVE/obsolete
A 0 mesoscale/TESTS/TESTGW.tar.gz
M 84 000-USERS

File size: 25.3 KB

Line
1	SUBROUTINE meso_inifis(ngrid,nlayer,nq,
2	$ wdt,
3	$ wday_ini,wdaysec,
4	$ wappel_phys,wecri_phys,
5	$ plat,plon,parea,
6	$ prad,pg,pr,pcpp,
7	$ womeg,wmugaz,
8	$ wyear_day,wperiheli,waphelie,wperi_day,wobliquit,
9	$ wz0,wemin_turb,wlmixmin,
10	$ wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS,
11	$ wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,
12	$ walbedodat,wphisfi,wvolcapa,
13	$ wzmea,wzstd,wzsig,wzgam,wzthe,
14	$ wtheta,wpsi)
15
16	c=======================================================================
17	c
18	c CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
19	c
20	c ... CHECK THE ****WRF lines
21	c
22	c=======================================================================
23	!
24	!=======================================================================
25	!
26	! purpose:
27	! -------
28	!
29	! Initialisation for the physical parametrisations of the LMD
30	! martian atmospheric general circulation modele.
31	!
32	! author: Frederic Hourdin 15 / 10 /93
33	! -------
34	! modified: Sebastien Lebonnois 11/06/2003 (new callphys.def)
35	! Ehouarn Millour (oct. 2008) tracers are now identified
36	! by their names and may not be contiguously
37	! stored in the q(:,:,:,:) array
38	! E.M. (june 2009) use getin routine to load parameters
39	! adapted to the WRF use - Aymeric Spiga - Jan 2009 - Jan 2007
40	!
41	!
42	! arguments:
43	! ----------
44	!
45	! input:
46	! ------
47	!
48	! ngrid Size of the horizontal grid.
49	! All internal loops are performed on that grid.
50	! nlayer Number of vertical layers.
51	! pdayref Day of reference for the simulation
52	! pday Number of days counted from the North. Spring
53	! equinoxe.
54	!
55	!=======================================================================
56	!
57	!-----------------------------------------------------------------------
58	! declarations:
59	! -------------
60	! to use 'getin'
61	!! **WRF a new stuff to be checked
62	USE ioipsl_getincom
63	IMPLICIT NONE
64	#include "dimensions.h"
65	#include "dimphys.h"
66	#include "planete.h"
67	#include "comcstfi.h"
68	#include "comsaison.h"
69	#include "comdiurn.h"
70	#include "comgeomfi.h"
71	#include "callkeys.h"
72	#include "surfdat.h"
73	#include "dimradmars.h" !!new
74	#include "yomaer.h" !!new -- prob. pour remplir les proprietes
75	#include "datafile.h"
76	#include "meso_slope.h"
77	#include "comsoil.h" !!**WRF -- needed to fill volcapa
78
79	REAL prad,pg,pr,pcpp,pdaysec
80
81	INTEGER ngrid,nlayer,nq
82
83	REAL womeg,wmugaz,wdaysec
84	REAL wyear_day,wperiheli,waphelie,wperi_day,wobliquit
85	REAL wz0,wemin_turb,wlmixmin
86	REAL wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS
87
88	REAL wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS
89	REAL walbedodat(ngrid),wphisfi(ngrid)
90	REAL wzmea(ngrid),wzstd(ngrid),wzsig(ngrid)
91	REAL wzgam(ngrid),wzthe(ngrid)
92	REAL wtheta(ngrid),wpsi(ngrid)
93	REAL wvolcapa
94	REAL wdt
95
96	REAL plat(ngrid),plon(ngrid),parea(ngridmx)
97	integer wday_ini
98	INTEGER ig,ierr
99
100	INTEGER wecri_phys, wappel_phys
101
102	! EXTERNAL iniorbit,orbite
103	EXTERNAL SSUM
104	REAL SSUM
105
106	CHARACTER ch1*12
107	CHARACTER ch80*80
108
109	#ifdef MESOSCALE
110
111	! logical chem, h2o
112
113	! chem = .false.
114	! h2o = .false.
115
116	c ****WRF
117	c
118	c------------------------------------------------------
119	c Fill some parameters in the 'include' files
120	c >> Do part of the job previously done by phyetat0.F
121	c >> Complete list of parameters is found in tabfi.F
122	c------------------------------------------------------
123	c
124	c Values are defined in the module_model_constants.F WRF routine
125	c
126	! in 'comcstfi.h'
127	rad=prad
128	cpp=pcpp
129	g=pg
130	r=pr
131	rcp=r/cpp
132	daysec=wdaysec
133	omeg=womeg
134	mugaz=wmugaz
135	print*,"check: rad,cpp,g,r,rcp,daysec,omeg,mugaz"
136	print*,rad,cpp,g,r,rcp,daysec,omeg,mugaz
137
138	! in 'planet.h'
139	year_day=wyear_day
140	periheli=wperiheli
141	aphelie=waphelie
142	peri_day=wperi_day
143	obliquit=wobliquit
144	z0=wz0
145	emin_turb=wemin_turb
146	lmixmin=wlmixmin
147	print*,"check: year_day,periheli,aphelie,peri_day,obliquit"
148	print*,year_day,periheli,aphelie,peri_day,obliquit
149	print*,"check: z0,emin_turb,lmixmin"
150	print*,z0,emin_turb,lmixmin
151
152	! in 'surfdat.h'
153	emissiv=wemissiv
154	emisice(1)=wemissiceN
155	emisice(2)=wemissiceS
156	albedice(1)=walbediceN
157	albedice(2)=walbediceS
158	iceradius(1)=wiceradiusN
159	iceradius(2)=wiceradiusS
160	dtemisice(1)=wdtemisiceN
161	dtemisice(2)=wdtemisiceS
162	print*,"check: emissiv,emisice,albedice,iceradius,dtemisice"
163	print*,emissiv,emisice,albedice,iceradius,dtemisice
164
165	c
166	c Values are defined in the WPS processing
167	c
168	albedodat(:)=walbedodat(:)
169	!!!!! ***WRF inertiedat was moved, new physics !!
170	!inertiedat(:)=winertiedat(:)
171	phisfi(:)=wphisfi(:)
172	print*,"check: albedodat(1),phisfi(1)"
173	print*,albedodat(1),phisfi(1)
174	print*,"check: albedodat(end),phisfi(end)"
175	print*,albedodat(ngrid),phisfi(ngrid)
176
177	! NB: usually, gravity wave scheme is useless in mesoscale modeling
178	! NB: we however keep the option for coarse grid case ...
179	zmea(:)=wzmea(:)
180	zstd(:)=wzstd(:)
181	zsig(:)=wzsig(:)
182	zgam(:)=wzgam(:)
183	zthe(:)=wzthe(:)
184	print*,"check: gw param"
185	print*,zmea(1),zmea(ngrid)
186	print*,zstd(1),zstd(ngrid)
187	print*,zsig(1),zsig(ngrid)
188	print*,zgam(1),zgam(ngrid)
189	print*,zthe(1),zthe(ngrid)
190
191	!
192	! in meso_slope.h
193	!
194	theta_sl(:)=wtheta(:)
195	psi_sl(:)=wpsi(:)
196	print*,"check: theta_sl(1),psi_sl(1)"
197	print*,theta_sl(1),psi_sl(1)
198	print*,"check: theta_sl(end),psi_sl(end)"
199	print*,theta_sl(ngrid),psi_sl(ngrid)
200
201	!
202	! in comsoil.h
203	!
204	volcapa=wvolcapa
205	print*,"check: volcapa"
206	print*,volcapa
207
208
209	c ****WRF
210
211
212	! rad=prad
213	! daysec=pdaysec
214	! dtphys=ptimestep
215	! cpp=pcpp
216	! g=pg
217	! r=pr
218	! rcp=r/cpp
219
220	! --------------------------------------------------------
221	! The usual Tests
222	! --------------
223	IF (nlayer.NE.nlayermx) THEN
224	PRINT*,'STOP in inifis'
225	PRINT*,'Probleme de dimensions :'
226	PRINT*,'nlayer = ',nlayer
227	PRINT*,'nlayermx = ',nlayermx
228	STOP
229	ENDIF
230
231	IF (ngrid.NE.ngridmx) THEN
232	PRINT*,'STOP in inifis'
233	PRINT*,'Probleme de dimensions :'
234	PRINT*,'ngrid = ',ngrid
235	PRINT*,'ngridmx = ',ngridmx
236	STOP
237	ENDIF
238
239	! --------------------------------------------------------------
240	! Reading the "callphys.def" file controlling some key options
241	! --------------------------------------------------------------
242
243	! check that 'callphys.def' file is around
244	OPEN(99,file='callphys.def',status='old',form='formatted'
245	& ,iostat=ierr)
246	CLOSE(99)
247
248	IF(ierr.EQ.0) THEN
249	PRINT*
250	PRINT*
251	PRINT*,'--------------------------------------------'
252	PRINT*,' inifis: Parameters for the physics (callphys.def)'
253	PRINT*,'--------------------------------------------'
254
255	write(,) "Directory where external input files are:"
256	! NB: default 'datafile' is set in datafile.h
257	call getin("datadir",datafile)
258	write(,) " datafile = ",trim(datafile)
259
260	write(,) "Run with or without tracer transport ?"
261	tracer=.false. ! default value
262	call getin("tracer",tracer)
263	write(,) " tracer = ",tracer
264
265	write(,) "Diurnal cycle ?"
266	write(,) "(if diurnal=False, diurnal averaged solar heating)"
267	diurnal=.true. ! default value
268	call getin("diurnal",diurnal)
269	write(,) " diurnal = ",diurnal
270
271	write(,) "Seasonal cycle ?"
272	write(,) "(if season=False, Ls stays constant, to value ",
273	& "set in 'start'"
274	season=.true. ! default value
275	call getin("season",season)
276	write(,) " season = ",season
277
278	write(,) "Write some extra output to the screen ?"
279	lwrite=.false. ! default value
280	call getin("lwrite",lwrite)
281	write(,) " lwrite = ",lwrite
282
283	write(,) "Save statistics in file stats.nc ?"
284	!callstats=.true. ! default value
285	callstats=.false. ! default value
286	call getin("callstats",callstats)
287	write(,) " callstats = ",callstats
288
289	write(,) "Save EOF profiles in file 'profiles' for ",
290	& "Climate Database?"
291	calleofdump=.false. ! default value
292	call getin("calleofdump",calleofdump)
293	write(,) " calleofdump = ",calleofdump
294
295	write(,) "Dust scenario: 1=constant dust (read from startfi",
296	& " or set as tauvis); 2=Viking scenario; =3 MGS scenario,",
297	& "=4 Mars Year 24 from TES assimilation, ",
298	& "=24,25 or 26 :Mars Year 24,25 or 26 from TES assimilation"
299	iaervar=3 ! default value
300	call getin("iaervar",iaervar)
301	write(,) " iaervar = ",iaervar
302
303	write(,) "Reference (visible) dust opacity at 700 Pa ",
304	& "(matters only if iaervar=1)"
305	! NB: default value of tauvis is set/read in startfi.nc file
306	call getin("tauvis",tauvis)
307	write(,) " tauvis = ",tauvis
308
309	write(,) "Dust vertical distribution:"
310	write(,) "(=1 top set by topdustref parameter;",
311	& " =2 Viking scenario; =3 MGS scenario)"
312	iddist=3 ! default value
313	call getin("iddist",iddist)
314	write(,) " iddist = ",iddist
315
316	write(,) "Dust top altitude (km). (Matters only if iddist=1)"
317	topdustref= 90.0 ! default value
318	call getin("topdustref",topdustref)
319	write(,) " topdustref = ",topdustref
320
321	write(,) "call radiative transfer ?"
322	callrad=.true. ! default value
323	call getin("callrad",callrad)
324	write(,) " callrad = ",callrad
325
326	write(,) "call NLTE radiative schemes ?",
327	& "(matters only if callrad=T)"
328	callnlte=.false. ! default value
329	call getin("callnlte",callnlte)
330	write(,) " callnlte = ",callnlte
331
332	write(,) "call CO2 NIR absorption ?",
333	& "(matters only if callrad=T)"
334	callnirco2=.false. ! default value
335	call getin("callnirco2",callnirco2)
336	write(,) " callnirco2 = ",callnirco2
337
338	write(,) "call turbulent vertical diffusion ?"
339	calldifv=.true. ! default value
340	call getin("calldifv",calldifv)
341	write(,) " calldifv = ",calldifv
342
343	write(,) "call convective adjustment ?"
344	calladj=.true. ! default value
345	call getin("calladj",calladj)
346	write(,) " calladj = ",calladj
347
348
349	write(,) "call CO2 condensation ?"
350	callcond=.true. ! default value
351	call getin("callcond",callcond)
352	write(,) " callcond = ",callcond
353
354	write(,)"call thermal conduction in the soil ?"
355	callsoil=.true. ! default value
356	call getin("callsoil",callsoil)
357	write(,) " callsoil = ",callsoil
358
359
360	write(,)"call Lott's gravity wave/subgrid topography ",
361	& "scheme ?"
362	calllott=.true. ! default value
363	call getin("calllott",calllott)
364	write(,)" calllott = ",calllott
365
366
367	write(,)"rad.transfer is computed every iradia",
368	& " physical timestep"
369	iradia=1 ! default value
370	call getin("iradia",iradia)
371	write(,)" iradia = ",iradia
372
373
374	write(,)"Output of the exchange coefficient mattrix ?",
375	& "(for diagnostics only)"
376	callg2d=.false. ! default value
377	call getin("callg2d",callg2d)
378	write(,)" callg2d = ",callg2d
379
380	write(,)"Rayleigh scattering : (should be .false. for now)"
381	rayleigh=.false.
382	call getin("rayleigh",rayleigh)
383	write(,)" rayleigh = ",rayleigh
384
385
386	! TRACERS:
387
388	write(,)"Transported dust ? (if >0, use 'dustbin' dust bins)"
389	dustbin=0 ! default value
390	call getin("dustbin",dustbin)
391	write(,)" dustbin = ",dustbin
392
393	write(,)"Radiatively active dust ? (matters if dustbin>0)"
394	active=.false. ! default value
395	call getin("active",active)
396	write(,)" active = ",active
397
398	! Test of incompatibility:
399	! if active is used, then dustbin should be > 0
400
401	if (active.and.(dustbin.lt.1)) then
402	print*,'if active is used, then dustbin should > 0'
403	stop
404	endif
405
406	write(,)"use mass and number mixing ratios to predict",
407	& " dust size ?"
408	doubleq=.false. ! default value
409	call getin("doubleq",doubleq)
410	write(,)" doubleq = ",doubleq
411
412	submicron=.false. ! default value
413	call getin("submicron",submicron)
414	write(,)" submicron = ",submicron
415
416	! Test of incompatibility:
417	! if doubleq is used, then dustbin should be 2
418
419	if (doubleq.and.(dustbin.ne.2)) then
420	print*,'if doubleq is used, then dustbin should be 2'
421	stop
422	endif
423	if (doubleq.and.submicron.and.(nqmx.LT.3)) then
424	print*,'If doubleq is used with a submicron tracer,'
425	print*,' then the number of tracers has to be'
426	print*,' larger than 3.'
427	stop
428	endif
429
430	write(,)"dust lifted by GCM surface winds ?"
431	lifting=.false. ! default value
432	call getin("lifting",lifting)
433	write(,)" lifting = ",lifting
434
435	! Test of incompatibility:
436	! if lifting is used, then dustbin should be > 0
437
438	if (lifting.and.(dustbin.lt.1)) then
439	print*,'if lifting is used, then dustbin should > 0'
440	stop
441	endif
442
443	write(,)" dust lifted by dust devils ?"
444	callddevil=.false. !default value
445	call getin("callddevil",callddevil)
446	write(,)" callddevil = ",callddevil
447
448
449	! Test of incompatibility:
450	! if dustdevil is used, then dustbin should be > 0
451
452	if (callddevil.and.(dustbin.lt.1)) then
453	print*,'if dustdevil is used, then dustbin should > 0'
454	stop
455	endif
456
457	write(,)"Dust scavenging by CO2 snowfall ?"
458	scavenging=.false. ! default value
459	call getin("scavenging",scavenging)
460	write(,)" scavenging = ",scavenging
461
462
463	! Test of incompatibility:
464	! if scavenging is used, then dustbin should be > 0
465
466	if (scavenging.and.(dustbin.lt.1)) then
467	print*,'if scavenging is used, then dustbin should > 0'
468	stop
469	endif
470
471	write(,) "Gravitationnal sedimentation ?"
472	sedimentation=.true. ! default value
473	call getin("sedimentation",sedimentation)
474	write(,) " sedimentation = ",sedimentation
475
476	write(,) "Radiatively active transported atmospheric ",
477	& "water ice ?"
478	activice=.false. ! default value
479	call getin("activice",activice)
480	write(,) " activice = ",activice
481
482	write(,) "Compute water cycle ?"
483	water=.false. ! default value
484	call getin("water",water)
485	write(,) " water = ",water
486
487	! Test of incompatibility:
488
489	if (activice.and..not.water) then
490	print*,'if activice is used, water should be used too'
491	stop
492	endif
493
494	if (water.and..not.tracer) then
495	print*,'if water is used, tracer should be used too'
496	stop
497	endif
498
499	! Test of incompatibility:
500
501	write(,) "Permanent water caps at poles ?",
502	& " .true. is RECOMMENDED"
503	write(,) "(with .true., North cap is a source of water ",
504	& "and South pole is a cold trap)"
505	caps=.true. ! default value
506	call getin("caps",caps)
507	write(,) " caps = ",caps
508
509	write(,) "photochemistry: include chemical species"
510	photochem=.false. ! default value
511	call getin("photochem",photochem)
512	write(,) " photochem = ",photochem
513
514
515	! THERMOSPHERE
516
517	write(,) "call thermosphere ?"
518	callthermos=.false. ! default value
519	call getin("callthermos",callthermos)
520	write(,) " callthermos = ",callthermos
521
522
523	write(,) " water included without cycle ",
524	& "(only if water=.false.)"
525	thermoswater=.false. ! default value
526	call getin("thermoswater",thermoswater)
527	write(,) " thermoswater = ",thermoswater
528
529	write(,) "call thermal conduction ?",
530	& " (only if callthermos=.true.)"
531	callconduct=.false. ! default value
532	call getin("callconduct",callconduct)
533	write(,) " callconduct = ",callconduct
534
535	write(,) "call EUV heating ?",
536	& " (only if callthermos=.true.)"
537	calleuv=.false. ! default value
538	call getin("calleuv",calleuv)
539	write(,) " calleuv = ",calleuv
540
541	write(,) "call molecular viscosity ?",
542	& " (only if callthermos=.true.)"
543	callmolvis=.false. ! default value
544	call getin("callmolvis",callmolvis)
545	write(,) " callmolvis = ",callmolvis
546
547	write(,) "call molecular diffusion ?",
548	& " (only if callthermos=.true.)"
549	callmoldiff=.false. ! default value
550	call getin("callmoldiff",callmoldiff)
551	write(,) " callmoldiff = ",callmoldiff
552
553
554	write(,) "call thermospheric photochemistry ?",
555	& " (only if callthermos=.true.)"
556	thermochem=.false. ! default value
557	call getin("thermochem",thermochem)
558	write(,) " thermochem = ",thermochem
559
560	write(,) "date for solar flux calculation:",
561	& " (1985 < date < 2002)"
562	write(,) "(Solar min=1996.4 ave=1993.4 max=1990.6)"
563	solarcondate=1993.4 ! default value
564	call getin("solarcondate",solarcondate)
565	write(,) " solarcondate = ",solarcondate
566
567
568	if (.not.callthermos) then
569	if (thermoswater) then
570	print*,'if thermoswater is set, callthermos must be true'
571	stop
572	endif
573	if (callconduct) then
574	print*,'if callconduct is set, callthermos must be true'
575	stop
576	endif
577	if (calleuv) then
578	print*,'if calleuv is set, callthermos must be true'
579	stop
580	endif
581	if (callmolvis) then
582	print*,'if callmolvis is set, callthermos must be true'
583	stop
584	endif
585	if (callmoldiff) then
586	print*,'if callmoldiff is set, callthermos must be true'
587	stop
588	endif
589	if (thermochem) then
590	print*,'if thermochem is set, callthermos must be true'
591	stop
592	endif
593	endif
594
595	! Test of incompatibility:
596	! if photochem is used, then water should be used too
597
598	if (photochem.and..not.water) then
599	print*,'if photochem is used, water should be used too'
600	stop
601	endif
602
603	! if callthermos is used, then thermoswater should be used too
604	! (if water not used already)
605
606	if (callthermos .and. .not.water) then
607	if (callthermos .and. .not.thermoswater) then
608	print*,'if callthermos is used, water or thermoswater
609	& should be used too'
610	stop
611	endif
612	endif
613
614	PRINT*,'--------------------------------------------'
615	PRINT*
616	PRINT*
617	ELSE
618	write(,)
619	write(,) 'Cannot read file callphys.def. Is it here ?'
620	stop
621	ENDIF
622
623	8000 FORMAT(t5,a12,l8)
624	8001 FORMAT(t5,a12,i8)
625
626
627
628	c ****WRF
629	c*****************************************************
630	c Since it comes from WRF settings, we have to
631	c fill dtphys in the include file
632	c It must be set now, because it is used afterwards
633	c
634	c Opportunity is taken to fill ecri_phys as well
635	c*****************************************************
636	dtphys=wdt*float(wappel_phys)
637	print*,'Physical timestep (s) ',dtphys
638	ecri_phys=wecri_phys
639	print*,'Physical frequency for writing ',ecri_phys
640	c
641	c ****WRF
642
643
644	PRINT*
645	PRINT*,'inifis: daysec',daysec
646	PRINT*
647	PRINT*,'inifis: The radiative transfer is computed:'
648	PRINT*,' each ',iradia,' physical time-step'
649	PRINT,' or each ',iradiadtphys,' seconds'
650	PRINT*
651	! --------------------------------------------------------------
652	! Managing the Longwave radiative transfer
653	! --------------------------------------------------------------
654
655	! In most cases, the run just use the following values :
656	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
657	callemis=.true.
658	! ilwd=10*int(daysec/dtphys) ! bug before 22/10/01
659	ilwd=1
660	ilwn=1 !2
661	ilwb=1 !2
662	linear=.true.
663	ncouche=3
664	alphan=0.4
665	semi=0
666
667	! BUT people working hard on the LW may want to read them in 'radia.def'
668	! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
669
670	OPEN(99,file='radia.def',status='old',form='formatted'
671	. ,iostat=ierr)
672	IF(ierr.EQ.0) THEN
673	write(,) 'inifis: Reading radia.def !!!'
674	READ(99,fmt='(a)') ch1
675	READ(99,*) callemis
676	WRITE(*,8000) ch1,callemis
677
678	READ(99,fmt='(a)') ch1
679	READ(99,*) iradia
680	WRITE(*,8001) ch1,iradia
681
682	READ(99,fmt='(a)') ch1
683	READ(99,*) ilwd
684	WRITE(*,8001) ch1,ilwd
685
686	READ(99,fmt='(a)') ch1
687	READ(99,*) ilwn
688	WRITE(*,8001) ch1,ilwn
689
690	READ(99,fmt='(a)') ch1
691	READ(99,*) linear
692	WRITE(*,8000) ch1,linear
693
694	READ(99,fmt='(a)') ch1
695	READ(99,*) ncouche
696	WRITE(*,8001) ch1,ncouche
697
698	READ(99,fmt='(a)') ch1
699	READ(99,*) alphan
700	WRITE(,) ch1,alphan
701
702	READ(99,fmt='(a)') ch1
703	READ(99,*) ilwb
704	WRITE(*,8001) ch1,ilwb
705
706
707	READ(99,fmt='(a)') ch1
708	READ(99,'(l1)') callg2d
709	WRITE(*,8000) ch1,callg2d
710
711	READ(99,fmt='(a)') ch1
712	READ(99,*) semi
713	WRITE(,) ch1,semi
714	end if
715	CLOSE(99)
716
717	!-----------------------------------------------------------------------
718	! Some more initialization:
719	! ------------------------
720
721	! in 'comgeomfi.h'
722	CALL SCOPY(ngrid,plon,1,long,1)
723	CALL SCOPY(ngrid,plat,1,lati,1)
724	CALL SCOPY(ngrid,parea,1,area,1)
725	totarea=SSUM(ngridmx,area,1)
726
727	! in 'comdiurn.h'
728	DO ig=1,ngrid
729	sinlat(ig)=sin(plat(ig))
730	coslat(ig)=cos(plat(ig))
731	sinlon(ig)=sin(plon(ig))
732	coslon(ig)=cos(plon(ig))
733	ENDDO
734
735	pi=2.*asin(1.) ! NB: pi is a common in comcstfi.h
736
737	! managing the tracers, and tests:
738	! -------------------------------
739	! Ehouarn: removed; as these tests are now done in initracer.F
740	! if(tracer) then
741	!
742	!! when photochem is used, nqchem_min is the rank
743	!! of the first chemical species
744	!
745	!! Ehouarn: nqchem_min is now meaningless and no longer used
746	!! nqchem_min = 1
747	! if (photochem .or. callthermos) then
748	! chem = .true.
749	! end if
750	!
751	! if (water .or. thermoswater) h2o = .true.
752	!
753	!! TESTS
754	!
755	! print*,'inifis: TRACERS:'
756	! write(,) " chem=",chem," h2o=",h2o
757	!! write(,) " doubleq=",doubleq
758	!! write(,) " dustbin=",dustbin
759	!
760	! if ((doubleq).and.(h2o).and.
761	! $ (chem)) then
762	! print*,' 2 dust tracers (doubleq)'
763	! print*,' 1 water vapour tracer'
764	! print*,' 1 water ice tracer'
765	! print*,nqmx-4,' chemistry tracers'
766	! endif
767	!
768	! if ((doubleq).and.(h2o).and.
769	! $ .not.(chem)) then
770	! print*,' 2 dust tracers (doubleq)'
771	! print*,' 1 water vapour tracer'
772	! print*,' 1 water ice tracer'
773	! if (nqmx.LT.4) then
774	! print*,'nqmx should be at least equal to'
775	! print*,'4 with these options.'
776	! stop
777	! endif
778	! endif
779	!
780	! if (.not.(doubleq).and.(h2o).and.
781	! $ (chem)) then
782	! if (dustbin.gt.0) then
783	! print*,dustbin,' dust bins'
784	! endif
785	! print*,nqmx-2-dustbin,' chemistry tracers'
786	! print*,' 1 water vapour tracer'
787	! print*,' 1 water ice tracer'
788	! endif
789	!
790	! if (.not.(doubleq).and.(h2o).and.
791	! $ .not.(chem)) then
792	! if (dustbin.gt.0) then
793	! print*,dustbin,' dust bins'
794	! endif
795	! print*,' 1 water vapour tracer'
796	! print*,' 1 water ice tracer'
797	! if (nqmx.gt.(dustbin+2)) then
798	! print*,'nqmx should be ',(dustbin+2),
799	! $ ' with these options...'
800	! print*,'(or check callphys.def)'
801	! endif
802	! if (nqmx.lt.(dustbin+2)) then
803	! write(,) "inifis: nqmx.lt.(dustbin+2)"
804	! stop
805	! endif
806	! endif
807	!
808	! endif ! of if (tracer)
809	!
810	! RETURN
811
812	#endif
813
814	END

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

Download in other formats:

Original Format