Context Navigation

sugas_corrk.F90 @ 848

Last change on this file since 848 was 810, checked in by aslmd, 12 years ago
LMDZ.GENERIC: corrected a typo in sugas_corrk. was not SPECTV buy SPECTI.
File size: 22.4 KB

Line
1	subroutine sugas_corrk
2
3	!==================================================================
4	!
5	! Purpose
6	! -------
7	! Set up gaseous absorption parameters used by the radiation code.
8	! This subroutine is a replacement for the old 'setrad', which contained
9	! both absorption and scattering data.
10	!
11	! Authors
12	! -------
13	! Adapted and generalised from the NASA Ames code by Robin Wordsworth (2009)
14	! Added double gray case by Jeremy Leconte (2012)
15	! New HITRAN continuum data section by RW (2012)
16	!
17	! Summary
18	! -------
19	!
20	!==================================================================
21
22	use radinc_h
23	use radcommon_h, only : pgasref,pfgasref,pgasmin,pgasmax
24	use radcommon_h, only : tgasref,tgasmin,tgasmax
25	use radcommon_h, only : gasv,gasi,FZEROI,FZEROV,gweight
26	use radcommon_h, only : wrefvar,WNOI,WNOV
27	use datafile_mod, only: datadir
28
29	use gases_h
30	use ioipsl_getincom
31	implicit none
32
33	#include "callkeys.h"
34	#include "comcstfi.h"
35
36	!==================================================================
37
38	logical file_ok
39
40	integer n, nt, np, nh, ng, nw, m, i
41	integer L_NGAUSScheck
42
43	character(len=200) :: file_id
44	character(len=500) :: file_path
45
46	! ALLOCATABLE ARRAYS -- AS 12/2011
47	REAL*8, DIMENSION(:,:,:,:,:), ALLOCATABLE :: gasi8, gasv8
48	character*3,allocatable,DIMENSION(:) :: gastype ! for check with gnom
49
50	real*8 x, xi(4), yi(4), ans, p
51	! For gray case (JL12)
52	real kappa_IR, kappa_VI, IR_VI_wnlimit, nVI_limit,nIR_limit
53
54	integer ngas, igas, jgas
55
56	double precision testcont ! for continuum absorption initialisation
57
58	!=======================================================================
59	! Load variable species data, exit if we have wrong database
60	file_id='/corrk_data/' // TRIM(corrkdir) // '/Q.dat'
61	file_path=TRIM(datadir)//TRIM(file_id)
62
63	! check that the file exists
64	inquire(FILE=file_path,EXIST=file_ok)
65	if(.not.file_ok) then
66	write(,)'The file ',TRIM(file_path)
67	write(,)'was not found by sugas_corrk.F90, exiting.'
68	write(,)'Check that your path to datagcm:',trim(datadir)
69	write(,)' is correct. You can change it in callphys.def with:'
70	write(,)' datadir = /absolute/path/to/datagcm'
71	write(,)'Also check that the corrkdir you chose in callphys.def exists.'
72	call abort
73	endif
74
75	! check that database matches varactive toggle
76	open(111,file=TRIM(file_path),form='formatted')
77	read(111,*) ngas
78
79	if(ngas.ne.ngasmx)then
80	print*,'Number of gases in radiative transfer data (',ngas,') does not', &
81	'match that in gases.def (',ngasmx,'), exiting.'
82	call abort
83	endif
84
85	if(ngas.eq.1 .and. (varactive.or.varfixed))then
86	print*,'You have varactive/fixed=.true. but the database [', &
87	corrkdir(1:LEN_TRIM(corrkdir)), &
88	'] has no variable species, exiting.'
89	call abort
90	elseif(ngas.gt.5 .or. ngas.lt.1)then
91	print*,ngas,' species in database [', &
92	corrkdir(1:LEN_TRIM(corrkdir)), &
93	'], radiative code cannot handle this.'
94	call abort
95	endif
96
97	! dynamically allocate gastype and read from Q.dat
98	IF ( .NOT. ALLOCATED( gastype ) ) ALLOCATE( gastype( ngas ) )
99
100	do igas=1,ngas
101	read(111,*) gastype(igas)
102	print*,'Gas ',igas,' is ',gastype(igas)
103	enddo
104
105	! get array size, load the coefficients
106	open(111,file=TRIM(file_path),form='formatted')
107	read(111,*) L_REFVAR
108	IF( .NOT. ALLOCATED( wrefvar ) ) ALLOCATE( WREFVAR(L_REFVAR) )
109	read(111,*) wrefvar
110	close(111)
111
112	if(L_REFVAR.gt.1 .and. (.not.varactive) .and. (.not.varfixed))then
113	print*,'You have varactive and varfixed=.false. and the database [', &
114	corrkdir(1:LEN_TRIM(corrkdir)), &
115	'] has a variable species.'
116	call abort
117	endif
118
119	! Check that gastype and gnom match
120	do igas=1,ngas
121	print*,'Gas ',igas,' is ',gnom(igas)
122	if(gnom(igas).ne.gastype(igas))then
123	print*,'Name of a gas in radiative transfer data (',gastype(igas),') does not ', &
124	'match that in gases.def (',gnom(igas),'), exiting. You should compare ', &
125	'gases.def with Q.dat in your radiative transfer directory.'
126	call abort
127	endif
128	enddo
129	print*,'Confirmed gas match in radiative transfer and gases.def!'
130
131	! display the values
132	print*,'Variable gas volume mixing ratios:'
133	do n=1,L_REFVAR
134	!print*,n,'.',wrefvar(n),' kg/kg' ! pay attention!
135	print*,n,'.',wrefvar(n),' mol/mol'
136	end do
137	print*,''
138
139	!=======================================================================
140	! Set the weighting in g-space
141
142	file_id='/corrk_data/' // TRIM(corrkdir) // '/g.dat'
143	file_path=TRIM(datadir)//TRIM(file_id)
144
145	! check that the file exists
146	inquire(FILE=file_path,EXIST=file_ok)
147	if(.not.file_ok) then
148	write(,)'The file ',TRIM(file_path)
149	write(,)'was not found by sugas_corrk.F90, exiting.'
150	write(,)'Check that your path to datagcm:',trim(datadir)
151	write(,)' is correct. You can change it in callphys.def with:'
152	write(,)' datadir = /absolute/path/to/datagcm'
153	write(,)'Also check that the corrkdir you chose in callphys.def exists.'
154	call abort
155	endif
156
157	! check the array size is correct, load the coefficients
158	open(111,file=TRIM(file_path),form='formatted')
159	read(111,*) L_NGAUSScheck
160	if(.not.(L_NGAUSScheck.eq.L_NGAUSS)) then
161	print*,'The size of your radiative transfer g-space array does '
162	print*,'not match the value given in g.dat, exiting.'
163	call abort
164	endif
165	read(111,*) gweight
166	close(111)
167
168	! display the values
169	print*,'Correlated-k g-space grid:'
170	do n=1,L_NGAUSS
171	print*,n,'.',gweight(n)
172	end do
173	print*,''
174
175	!=======================================================================
176	! Set the reference pressure and temperature arrays. These are
177	! the pressures and temperatures at which we have k-coefficients.
178
179	!-----------------------------------------------------------------------
180	! pressure
181
182	file_id='/corrk_data/' // TRIM(corrkdir) // '/p.dat'
183	file_path=TRIM(datadir)//TRIM(file_id)
184
185	! check that the file exists
186	inquire(FILE=file_path,EXIST=file_ok)
187	if(.not.file_ok) then
188	write(,)'The file ',TRIM(file_path)
189	write(,)'was not found by sugas_corrk.F90, exiting.'
190	write(,)'Check that your path to datagcm:',trim(datadir)
191	write(,)' is correct. You can change it in callphys.def with:'
192	write(,)' datadir = /absolute/path/to/datagcm'
193	write(,)'Also check that the corrkdir you chose in callphys.def exists.'
194	call abort
195	endif
196
197	! get array size, load the coefficients
198	open(111,file=TRIM(file_path),form='formatted')
199	read(111,*) L_NPREF
200	IF( .NOT. ALLOCATED( pgasref ) ) ALLOCATE( PGASREF(L_NPREF) )
201	read(111,*) pgasref
202	close(111)
203	L_PINT = (L_NPREF-1)*5+1
204	IF( .NOT. ALLOCATED( pfgasref ) ) ALLOCATE( PFGASREF(L_PINT) )
205
206	! display the values
207	print*,'Correlated-k pressure grid (mBar):'
208	do n=1,L_NPREF
209	print*,n,'. 1 x 10^',pgasref(n),' mBar'
210	end do
211	print*,''
212
213	! save the min / max matrix values
214	pgasmin = 10.0**pgasref(1)
215	pgasmax = 10.0**pgasref(L_NPREF)
216
217	! interpolate to finer grid
218	do n=1,L_NPREF-1
219	do m=1,5
220	pfgasref((n-1)5+m) = pgasref(n)+(m-1)0.2
221	end do
222	end do
223	pfgasref(L_PINT) = pgasref(L_NPREF)
224	! Warning, pfgasref needs generalisation to uneven grids!
225
226	!-----------------------------------------------------------------------
227	! temperature
228
229	file_id='/corrk_data/' // TRIM(corrkdir) // '/T.dat'
230	file_path=TRIM(datadir)//TRIM(file_id)
231
232	! check that the file exists
233	inquire(FILE=file_path,EXIST=file_ok)
234	if(.not.file_ok) then
235	write(,)'The file ',TRIM(file_path)
236	write(,)'was not found by sugas_corrk.F90, exiting.'
237	write(,)'Check that your path to datagcm:',trim(datadir)
238	write(,)' is correct. You can change it in callphys.def with:'
239	write(,)' datadir = /absolute/path/to/datagcm'
240	write(,)'Also check that the corrkdir you chose in callphys.def exists.'
241	call abort
242	endif
243
244	! get array size, load the coefficients
245	open(111,file=TRIM(file_path),form='formatted')
246	read(111,*) L_NTREF
247	IF( .NOT. ALLOCATED( tgasref ) ) ALLOCATE( TGASREF(L_NTREF) )
248	read(111,*) tgasref
249	close(111)
250
251	! display the values
252	print*,'Correlated-k temperature grid:'
253	do n=1,L_NTREF
254	print*,n,'.',tgasref(n),' K'
255	end do
256
257	! save the min / max matrix values
258	tgasmin = tgasref(1)
259	tgasmax = tgasref(L_NTREF)
260
261	!-----------------------------------------------------------------------
262	! allocate the multidimensional arrays in radcommon_h
263
264	IF( .NOT. ALLOCATED( gasi8 ) ) ALLOCATE( gasi8(L_NTREF,L_NPREF,L_REFVAR,L_NSPECTI,L_NGAUSS) )
265	IF( .NOT. ALLOCATED( gasv8 ) ) ALLOCATE( gasv8(L_NTREF,L_NPREF,L_REFVAR,L_NSPECTV,L_NGAUSS) )
266	IF( .NOT. ALLOCATED( gasi ) ) ALLOCATE( gasi(L_NTREF,L_PINT,L_REFVAR,L_NSPECTI,L_NGAUSS) )
267	IF( .NOT. ALLOCATED( gasv ) ) ALLOCATE( gasv(L_NTREF,L_PINT,L_REFVAR,L_NSPECTV,L_NGAUSS) )
268
269	! display the values
270	print*,''
271	print*,'Correlated-k matrix size:'
272	print*,'[',L_NTREF,',',L_NPREF,',',L_REFVAR,',',L_NGAUSS,']'
273
274	!=======================================================================
275	! Get gaseous k-coefficients and interpolate onto finer pressure grid
276
277	if (graybody) then
278	! constant absorption coefficient in visible
279	write(,)"graybody: constant absorption coefficient in visible:"
280	kappa_VI=-100000.
281	call getin("kappa_VI",kappa_VI)
282	write(,)" kappa_VI = ",kappa_VI
283	kappa_VI=kappa_VI1.e4 mugaz * 1.672621e-27 ! conversion from m^2/kg to cm^2/molecule
284
285	! constant absorption coefficient in IR
286	write(,)"graybody: constant absorption coefficient in InfraRed:"
287	kappa_IR=-100000.
288	call getin("kappa_IR",kappa_IR)
289	write(,)" kappa_IR = ",kappa_IR
290	kappa_IR=kappa_IR1.e4 mugaz * 1.672621e-27 ! conversion from m^2/kg to cm^2/molecule
291
292	! wavelength used to separate IR from VI
293	IR_VI_wnlimit=3000.
294	write(,)"graybody: Visible / Infrared separation set at",10000./IR_VI_wnlimit,"um"
295
296	nVI_limit=L_NSPECTV
297	Do nw=1,L_NSPECTV
298	if (WNOV(nw).gt.IR_VI_wnlimit) then
299	nVI_limit=nw-1
300	exit
301	endif
302	End do
303	nIR_limit=L_NSPECTI
304	Do nw=1,L_NSPECTI
305	if (WNOI(nw).gt.IR_VI_wnlimit) then
306	nIR_limit=nw-1
307	exit
308	endif
309	End do
310	write(,)"graybody: Visible / Infrared separation set at band ",nIR_limit,nVI_limit
311
312	End if
313
314
315	! VISIBLE
316	if (callgasvis.and.(.not.TRIM(corrkdir).eq.'null').and.(.not.TRIM(corrkdir).eq.'null_LowTeffStar').and.(.not.graybody)) then
317	file_id='/corrk_data/'//trim(adjustl(banddir))//'/corrk_gcm_VI.dat'
318	file_path=TRIM(datadir)//TRIM(file_id)
319
320	! check that the file exists
321	inquire(FILE=file_path,EXIST=file_ok)
322	if(.not.file_ok) then
323	write(,)'The file ',TRIM(file_path)
324	write(,)'was not found by sugas_corrk.F90.'
325	write(,)'Are you sure you have absorption data for these bands?'
326	call abort
327	endif
328
329	open(111,file=TRIM(file_path),form='formatted')
330	read(111,*) gasv8
331	close(111)
332
333	else if (callgasvis.and.graybody) then
334	if(nVI_limit.eq.0) then
335	gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTV,1:L_NGAUSS)=kappa_VI
336	else if (nVI_limit.eq.L_NSPECTV) then
337	gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTV,1:L_NGAUSS)=kappa_IR
338	else
339	gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:nVI_limit,1:L_NGAUSS)=kappa_IR
340	gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,nVI_limit+1:L_NSPECTV,1:L_NGAUSS)=kappa_VI
341	end if
342	else
343	print*,'Visible corrk gaseous absorption is set to zero.'
344	gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTV,1:L_NGAUSS)=0.0
345	endif
346
347	! INFRA-RED
348	if ((.not.TRIM(corrkdir).eq.'null').and.(.not.TRIM(corrkdir).eq.'null_LowTeffStar').and.(.not.graybody)) then
349	file_id='/corrk_data/'//trim(adjustl(banddir))//'/corrk_gcm_IR.dat'
350	file_path=TRIM(datadir)//TRIM(file_id)
351
352	! check that the file exists
353	inquire(FILE=file_path,EXIST=file_ok)
354	if(.not.file_ok) then
355	write(,)'The file ',TRIM(file_path)
356	write(,)'was not found by sugas_corrk.F90.'
357	write(,)'Are you sure you have absorption data for these bands?'
358	call abort
359	endif
360
361	open(111,file=TRIM(file_path),form='formatted')
362	read(111,*) gasi8
363	close(111)
364
365	! 'fzero' is a currently unused feature that allows optimisation
366	! of the radiative transfer by neglecting bands where absorption
367	! is close to zero. As it could be useful in the future, this
368	! section of the code has been kept commented and not erased.
369	! RW 7/3/12.
370
371	do nw=1,L_NSPECTI
372	fzeroi(nw) = 0.
373	! do nt=1,L_NTREF
374	! do np=1,L_NPREF
375	! do nh=1,L_REFVAR
376	! do ng = 1,L_NGAUSS
377	! if(gasi8(nt,np,nh,nw,ng).lt.1.0e-25)then
378	! fzeroi(nw)=fzeroi(nw)+1.
379	! endif
380	! end do
381	! end do
382	! end do
383	! end do
384	! fzeroi(nw)=fzeroi(nw)/dble(L_NTREFL_NPREFL_REFVAR*L_NGAUSS)
385	end do
386
387	do nw=1,L_NSPECTV
388	fzerov(nw) = 0.
389	! do nt=1,L_NTREF
390	! do np=1,L_NPREF
391	! do nh=1,L_REFVAR
392	! do ng = 1,L_NGAUSS
393	! if(gasv8(nt,np,nh,nw,ng).lt.1.0e-25)then
394	! fzerov(nw)=fzerov(nw)+1.
395	! endif
396	! end do
397	! end do
398	! end do
399	! end do
400	! fzerov(nw)=fzerov(nw)/dble(L_NTREFL_NPREFL_REFVAR*L_NGAUSS)
401	end do
402
403	else if (graybody) then
404	if(nIR_limit.eq.0) then
405	gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTI,1:L_NGAUSS)=kappa_VI
406	else if (nIR_limit.eq.L_NSPECTI) then
407	gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTI,1:L_NGAUSS)=kappa_IR
408	else
409	gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:nIR_limit,1:L_NGAUSS)=kappa_IR
410	gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,nIR_limit+1:L_NSPECTI,1:L_NGAUSS)=kappa_VI
411	end if
412	else
413	print*,'Infrared corrk gaseous absorption is set to zero.'
414	gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTI,1:L_NGAUSS)=0.0
415	endif
416
417
418	! Take log10 of the values - this is what we will interpolate.
419	! Smallest value is 1.0E-200.
420
421	do nt=1,L_NTREF
422	do np=1,L_NPREF
423	do nh=1,L_REFVAR
424	do ng = 1,L_NGAUSS
425
426	do nw=1,L_NSPECTV
427	if(gasv8(nt,np,nh,nw,ng).gt.1.0d-200) then
428	gasv8(nt,np,nh,nw,ng) = log10(gasv8(nt,np,nh,nw,ng))
429	else
430	gasv8(nt,np,nh,nw,ng) = -200.0
431	end if
432	end do
433
434	do nw=1,L_NSPECTI
435	if(gasi8(nt,np,nh,nw,ng).gt.1.0d-200) then
436	gasi8(nt,np,nh,nw,ng) = log10(gasi8(nt,np,nh,nw,ng))
437	else
438	gasi8(nt,np,nh,nw,ng) = -200.0
439	end if
440	end do
441
442	end do
443	end do
444	end do
445	end do
446
447	! Interpolate the values: first the longwave
448
449	do nt=1,L_NTREF
450	do nh=1,L_REFVAR
451	do nw=1,L_NSPECTI
452	do ng=1,L_NGAUSS
453
454	! First, the initial interval
455
456	n = 1
457	do m=1,5
458	x = pfgasref(m)
459	xi(1) = pgasref(n)
460	xi(2) = pgasref(n+1)
461	xi(3) = pgasref(n+2)
462	xi(4) = pgasref(n+3)
463	yi(1) = gasi8(nt,n,nh,nw,ng)
464	yi(2) = gasi8(nt,n+1,nh,nw,ng)
465	yi(3) = gasi8(nt,n+2,nh,nw,ng)
466	yi(4) = gasi8(nt,n+3,nh,nw,ng)
467	call lagrange(x,xi,yi,ans)
468	gasi(nt,m,nh,nw,ng) = 10.0**ans
469	end do
470
471	do n=2,L_NPREF-2
472	do m=1,5
473	i = (n-1)*5+m
474	x = pfgasref(i)
475	xi(1) = pgasref(n-1)
476	xi(2) = pgasref(n)
477	xi(3) = pgasref(n+1)
478	xi(4) = pgasref(n+2)
479	yi(1) = gasi8(nt,n-1,nh,nw,ng)
480	yi(2) = gasi8(nt,n,nh,nw,ng)
481	yi(3) = gasi8(nt,n+1,nh,nw,ng)
482	yi(4) = gasi8(nt,n+2,nh,nw,ng)
483	call lagrange(x,xi,yi,ans)
484	gasi(nt,i,nh,nw,ng) = 10.0**ans
485	end do
486	end do
487
488	! Now, get the last interval
489
490	n = L_NPREF-1
491	do m=1,5
492	i = (n-1)*5+m
493	x = pfgasref(i)
494	xi(1) = pgasref(n-2)
495	xi(2) = pgasref(n-1)
496	xi(3) = pgasref(n)
497	xi(4) = pgasref(n+1)
498	yi(1) = gasi8(nt,n-2,nh,nw,ng)
499	yi(2) = gasi8(nt,n-1,nh,nw,ng)
500	yi(3) = gasi8(nt,n,nh,nw,ng)
501	yi(4) = gasi8(nt,n+1,nh,nw,ng)
502	call lagrange(x,xi,yi,ans)
503	gasi(nt,i,nh,nw,ng) = 10.0**ans
504	end do
505
506	! Fill the last pressure point
507
508	gasi(nt,L_PINT,nh,nw,ng) = &
509	10.0**gasi8(nt,L_NPREF,nh,nw,ng)
510
511	end do
512	end do
513	end do
514	end do
515
516	! Interpolate the values: now the shortwave
517
518	do nt=1,L_NTREF
519	do nh=1,L_REFVAR
520	do nw=1,L_NSPECTV
521	do ng=1,L_NGAUSS
522
523	! First, the initial interval
524
525	n = 1
526	do m=1,5
527	x = pfgasref(m)
528	xi(1) = pgasref(n)
529	xi(2) = pgasref(n+1)
530	xi(3) = pgasref(n+2)
531	xi(4) = pgasref(n+3)
532	yi(1) = gasv8(nt,n,nh,nw,ng)
533	yi(2) = gasv8(nt,n+1,nh,nw,ng)
534	yi(3) = gasv8(nt,n+2,nh,nw,ng)
535	yi(4) = gasv8(nt,n+3,nh,nw,ng)
536	call lagrange(x,xi,yi,ans)
537	gasv(nt,m,nh,nw,ng) = 10.0**ans
538	end do
539
540	do n=2,L_NPREF-2
541	do m=1,5
542	i = (n-1)*5+m
543	x = pfgasref(i)
544	xi(1) = pgasref(n-1)
545	xi(2) = pgasref(n)
546	xi(3) = pgasref(n+1)
547	xi(4) = pgasref(n+2)
548	yi(1) = gasv8(nt,n-1,nh,nw,ng)
549	yi(2) = gasv8(nt,n,nh,nw,ng)
550	yi(3) = gasv8(nt,n+1,nh,nw,ng)
551	yi(4) = gasv8(nt,n+2,nh,nw,ng)
552	call lagrange(x,xi,yi,ans)
553	gasv(nt,i,nh,nw,ng) = 10.0**ans
554	end do
555	end do
556
557	! Now, get the last interval
558
559	n = L_NPREF-1
560	do m=1,5
561	i = (n-1)*5+m
562	x = pfgasref(i)
563	xi(1) = pgasref(n-2)
564	xi(2) = pgasref(n-1)
565	xi(3) = pgasref(n)
566	xi(4) = pgasref(n+1)
567	yi(1) = gasv8(nt,n-2,nh,nw,ng)
568	yi(2) = gasv8(nt,n-1,nh,nw,ng)
569	yi(3) = gasv8(nt,n,nh,nw,ng)
570	yi(4) = gasv8(nt,n+1,nh,nw,ng)
571	call lagrange(x,xi,yi,ans)
572	gasv(nt,i,nh,nw,ng) = 10.0**ans
573	end do
574
575	! Fill the last pressure point
576
577	gasv(nt,L_PINT,nh,nw,ng) = &
578	10.0**gasv8(nt,L_NPREF,nh,nw,ng)
579
580	end do
581	end do
582	end do
583	end do
584
585
586	!=======================================================================
587	! Initialise the continuum absorption data
588
589	do igas=1,ngasmx
590
591	if(gnom(igas).eq.'N2_')then
592
593	call interpolateN2N2(100.D+0,250.D+0,17500.D+0,testcont,.true.)
594
595	elseif(gnom(igas).eq.'H2_')then
596
597	! first do self-induced absorption
598	call interpolateH2H2(500.D+0,250.D+0,17500.D+0,testcont,.true.)
599	! then cross-interactions with other gases
600	do jgas=1,ngasmx
601	if(gnom(jgas).eq.'N2_')then
602	call interpolateN2H2(592.D+0,278.15D+0,200000.D+0,10000.D+0,testcont,.true.)
603	elseif(gnom(jgas).eq.'He_')then
604	call interpolateH2He(500.D+0,250.D+0,200000.D+0,10000.D+0,testcont,.true.)
605	endif
606	enddo
607
608	elseif(gnom(igas).eq.'H2O')then
609
610	! H2O is special
611	if(H2Ocont_simple)then
612	call interpolateH2Ocont_PPC(990.D+0,296.D+0,683.2D+0*2,0.D+0,testcont,.true.)
613	else
614	call interpolateH2Ocont_CKD(990.D+0,296.D+0,683.2D+0*2,0.D+0,testcont,.true.)
615	endif
616
617	endif
618
619	enddo
620
621	print*,'----------------------------------------------------'
622	print*,'And that`s all we have. It`s possible that other'
623	print*,'continuum absorption may be present, but if it is we'
624	print*,'don`t yet have data for it...'
625	print*,''
626
627	! Deallocate local arrays
628	IF( ALLOCATED( gasi8 ) ) DEALLOCATE( gasi8 )
629	IF( ALLOCATED( gasv8 ) ) DEALLOCATE( gasv8 )
630	IF( ALLOCATED( pgasref ) ) DEALLOCATE( pgasref )
631	IF( ALLOCATED( gastype ) ) DEALLOCATE( gastype )
632
633	return
634	end subroutine sugas_corrk

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

Download in other formats:

Original Format