Context Navigation

interpolate_continuum.F90 @ 3809

Last change on this file since 3809 was 3746, checked in by emillour, 2 months ago
Generic PCM: Minor fix in interpolate_continuum: handle the extreme case when temperature is below minimum value in the table. EM
File size: 37.3 KB

Rev	Line
[3693]	1	module interpolate_continuum_mod
[3641]	2
[3693]	3	implicit none
	4
	5	contains
	6
[3641]	7	subroutine interpolate_continuum(filename,igas_X,igas_Y,c_WN,ind_WN,temp,pres_X,pres_Y,abs_coef,firstcall)
	8
	9	!==================================================================
	10	!
	11	! Purpose
	12	! -------
[3713]	13	! Generic routine to calculate continuum opacities, using lookup tables provided here: https://web.lmd.jussieu.fr/~lmdz/planets/generic/datagcm/continuum_data/
[3641]	14	! More information on the data here: https://lmdz-forge.lmd.jussieu.fr/mediawiki/Planets/index.php/Continuum_Database
	15	!
	16	! Author
	17	! -------
	18	! M. Turbet (2025)
	19	!
	20	!==================================================================
	21
	22	use datafile_mod, only: datadir
	23	use mod_phys_lmdz_para, only : is_master
	24
	25	use gases_h, only: ngasmx, gnom, &
	26	igas_H2, igas_H2O, igas_He, igas_N2, &
	27	igas_CH4, igas_CO2, igas_O2
	28
	29	use radinc_h, only: L_NSPECTI, L_NSPECTV
	30
	31	use radcommon_h, only : BWNV,BWNI,WNOI,WNOV
	32
	33
	34	implicit none
	35
	36	! input
[3693]	37	integer,intent(in) :: ind_WN ! wavenumber index
	38	integer,intent(in) :: igas_X ! index of molecule X
	39	integer,intent(in) :: igas_Y ! index of molecule Y
	40	double precision,intent(in) :: temp ! temperature (Kelvin)
	41	double precision,intent(in) :: pres_X ! partial pressure of molecule X (Pascals)
	42	double precision,intent(in) :: pres_Y ! partial pressure of molecule Y (Pascals)
	43	character(len=*),intent(in) :: filename ! name of the lookup table
	44	character(len=2),intent(in) :: c_WN ! wavelength chanel: infrared (IR) or visible (VI)
	45	logical,intent(in) :: firstcall
[3641]	46
	47	! output
[3693]	48	double precision,intent(out) :: abs_coef ! absorption coefficient (m^-1)
[3641]	49
	50	! intermediate variables
	51	double precision amagat_X ! density of molecule X (in amagat units)
	52	double precision amagat_Y ! density of molecule Y (in amagat units)
	53
	54	character(len=512) :: line
[3746]	55	character(len=21),parameter :: rname="interpolate_continuum"
[3641]	56
	57	integer i, pos, iT, iW, iB, count_norm, igas
	58
	59	double precision temp_value, temp_abs, temp_wn
	60
	61	double precision z_temp
	62
	63	integer num_wn, num_T
	64
	65	double precision, dimension(:), allocatable :: temp_arr
	66	double precision, dimension(:), allocatable :: wn_arr
	67	double precision, dimension(:,:), allocatable :: abs_arr
	68
	69	integer ios
	70
	71	! Temperature array, continuum absorption grid for the pair N2-N2
[3693]	72	integer,save :: num_T_N2N2
	73	double precision,save,dimension(:),allocatable :: temp_arr_N2N2
	74	double precision,save,dimension(:,:),allocatable :: abs_arr_N2N2_IR
	75	double precision,save,dimension(:,:),allocatable :: abs_arr_N2N2_VI
	76	! None of these saved variables are THREADPRIVATE because read by master
	77	! and then only accessed but never modified and thus can be shared
[3641]	78
	79	! Temperature array, continuum absorption grid for the pair O2-O2
[3693]	80	integer,save :: num_T_O2O2
	81	double precision,save,dimension(:),allocatable :: temp_arr_O2O2
	82	double precision,save,dimension(:,:),allocatable :: abs_arr_O2O2_IR
	83	double precision,save,dimension(:,:),allocatable :: abs_arr_O2O2_VI
	84	! None of these saved variables are THREADPRIVATE because read by master
	85	! and then only accessed but never modified and thus can be shared
[3641]	86
	87	! Temperature array, continuum absorption grid for the pair H2-H2
[3693]	88	integer,save :: num_T_H2H2
	89	double precision,save,dimension(:),allocatable :: temp_arr_H2H2
	90	double precision,save,dimension(:,:),allocatable :: abs_arr_H2H2_IR
	91	double precision,save,dimension(:,:),allocatable :: abs_arr_H2H2_VI
	92	! None of these saved variables are THREADPRIVATE because read by master
	93	! and then only accessed but never modified and thus can be shared
[3641]	94
	95	! Temperature array, continuum absorption grid for the pair CO2-CO2
[3693]	96	integer,save :: num_T_CO2CO2
	97	double precision,save,dimension(:),allocatable :: temp_arr_CO2CO2
	98	double precision,save,dimension(:,:),allocatable :: abs_arr_CO2CO2_IR
	99	double precision,save,dimension(:,:),allocatable :: abs_arr_CO2CO2_VI
	100	! None of these saved variables are THREADPRIVATE because read by master
	101	! and then only accessed but never modified and thus can be shared
[3641]	102
	103	! Temperature array, continuum absorption grid for the pair CH4-CH4
[3693]	104	integer,save :: num_T_CH4CH4
	105	double precision,save,dimension(:),allocatable :: temp_arr_CH4CH4
	106	double precision,save,dimension(:,:),allocatable :: abs_arr_CH4CH4_IR
	107	double precision,save,dimension(:,:),allocatable :: abs_arr_CH4CH4_VI
	108	! None of these saved variables are THREADPRIVATE because read by master
	109	! and then only accessed but never modified and thus can be shared
[3641]	110
	111	! Temperature array, continuum absorption grid for the pair H2O-H2O
[3693]	112	integer,save :: num_T_H2OH2O
	113	double precision,save,dimension(:),allocatable :: temp_arr_H2OH2O
	114	double precision,save,dimension(:,:),allocatable :: abs_arr_H2OH2O_IR
	115	double precision,save,dimension(:,:),allocatable :: abs_arr_H2OH2O_VI
	116	! None of these saved variables are THREADPRIVATE because read by master
	117	! and then only accessed but never modified and thus can be shared
[3641]	118
	119	! Temperature array, continuum absorption grid for the pair H2-He
[3693]	120	integer,save :: num_T_H2He
	121	double precision,save,dimension(:),allocatable :: temp_arr_H2He
	122	double precision,save,dimension(:,:),allocatable :: abs_arr_H2He_IR
	123	double precision,save,dimension(:,:),allocatable :: abs_arr_H2He_VI
	124	! None of these saved variables are THREADPRIVATE because read by master
	125	! and then only accessed but never modified and thus can be shared
[3641]	126
	127	! Temperature array, continuum absorption grid for the pair H2-CH4
[3693]	128	integer,save :: num_T_H2CH4
	129	double precision,save,dimension(:),allocatable :: temp_arr_H2CH4
	130	double precision,save,dimension(:,:),allocatable :: abs_arr_H2CH4_IR
	131	double precision,save,dimension(:,:),allocatable :: abs_arr_H2CH4_VI
	132	! None of these saved variables are THREADPRIVATE because read by master
	133	! and then only accessed but never modified and thus can be shared
[3641]	134
	135	! Temperature array, continuum absorption grid for the pair CO2-H2
[3693]	136	integer,save :: num_T_CO2H2
	137	double precision,save,dimension(:),allocatable :: temp_arr_CO2H2
	138	double precision,save,dimension(:,:),allocatable :: abs_arr_CO2H2_IR
	139	double precision,save,dimension(:,:),allocatable :: abs_arr_CO2H2_VI
	140	! None of these saved variables are THREADPRIVATE because read by master
	141	! and then only accessed but never modified and thus can be shared
[3641]	142
	143	! Temperature array, continuum absorption grid for the pair CO2-CH4
[3693]	144	integer,save :: num_T_CO2CH4
	145	double precision,save,dimension(:),allocatable :: temp_arr_CO2CH4
	146	double precision,save,dimension(:,:),allocatable :: abs_arr_CO2CH4_IR
	147	double precision,save,dimension(:,:),allocatable :: abs_arr_CO2CH4_VI
	148	! None of these saved variables are THREADPRIVATE because read by master
	149	! and then only accessed but never modified and thus can be shared
[3641]	150
	151	! Temperature array, continuum absorption grid for the pair N2-H2
[3693]	152	integer,save :: num_T_N2H2
	153	double precision,save,dimension(:),allocatable :: temp_arr_N2H2
	154	double precision,save,dimension(:,:),allocatable :: abs_arr_N2H2_IR
	155	double precision,save,dimension(:,:),allocatable :: abs_arr_N2H2_VI
	156	! None of these saved variables are THREADPRIVATE because read by master
	157	! and then only accessed but never modified and thus can be shared
[3641]	158
	159	! Temperature array, continuum absorption grid for the pair N2-CH4
[3693]	160	integer,save :: num_T_N2CH4
	161	double precision,save,dimension(:),allocatable :: temp_arr_N2CH4
	162	double precision,save,dimension(:,:),allocatable :: abs_arr_N2CH4_IR
	163	double precision,save,dimension(:,:),allocatable :: abs_arr_N2CH4_VI
	164	! None of these saved variables are THREADPRIVATE because read by master
	165	! and then only accessed but never modified and thus can be shared
[3641]	166
	167	! Temperature array, continuum absorption grid for the pair CO2-O2
[3693]	168	integer,save :: num_T_CO2O2
	169	double precision,save,dimension(:),allocatable :: temp_arr_CO2O2
	170	double precision,save,dimension(:,:),allocatable :: abs_arr_CO2O2_IR
	171	double precision,save,dimension(:,:),allocatable :: abs_arr_CO2O2_VI
	172	! None of these saved variables are THREADPRIVATE because read by master
	173	! and then only accessed but never modified and thus can be shared
[3641]	174
	175	! Temperature array, continuum absorption grid for the pair N2-O2
[3693]	176	integer,save :: num_T_N2O2
	177	double precision,save,dimension(:), allocatable :: temp_arr_N2O2
	178	double precision,save,dimension(:,:), allocatable :: abs_arr_N2O2_IR
	179	double precision,save,dimension(:,:), allocatable :: abs_arr_N2O2_VI
	180	! None of these saved variables are THREADPRIVATE because read by master
	181	! and then only accessed but never modified and thus can be shared
[3641]	182
	183	! Temperature array, continuum absorption grid for the pair H2O-N2
[3693]	184	integer,save :: num_T_H2ON2
	185	double precision,save,dimension(:),allocatable :: temp_arr_H2ON2
	186	double precision,save,dimension(:,:),allocatable :: abs_arr_H2ON2_IR
	187	double precision,save,dimension(:,:),allocatable :: abs_arr_H2ON2_VI
	188	! None of these saved variables are THREADPRIVATE because read by master
	189	! and then only accessed but never modified and thus can be shared
[3641]	190
	191	! Temperature array, continuum absorption grid for the pair H2O-O2
[3693]	192	integer,save :: num_T_H2OO2
	193	double precision,save,dimension(:),allocatable :: temp_arr_H2OO2
	194	double precision,save,dimension(:,:),allocatable :: abs_arr_H2OO2_IR
	195	double precision,save,dimension(:,:),allocatable :: abs_arr_H2OO2_VI
	196	! None of these saved variables are THREADPRIVATE because read by master
	197	! and then only accessed but never modified and thus can be shared
[3641]	198
	199	! Temperature array, continuum absorption grid for the pair H2O-CO2
[3693]	200	integer,save :: num_T_H2OCO2
	201	double precision,save,dimension(:),allocatable :: temp_arr_H2OCO2
	202	double precision,save,dimension(:,:),allocatable :: abs_arr_H2OCO2_IR
	203	double precision,save,dimension(:,:),allocatable :: abs_arr_H2OCO2_VI
	204	! None of these saved variables are THREADPRIVATE because read by master
	205	! and then only accessed but never modified and thus can be shared
[3641]	206
	207
	208	if(firstcall)then ! called by sugas_corrk only
	209	if (is_master) print*,'----------------------------------------------------'
	210	if (is_master) print*,'Initialising continuum (interpolate_continuum routine) from ', trim(filename)
	211
	212	!$OMP MASTER
	213
	214	open(unit=33, file=trim(filename), status="old", action="read",iostat=ios)
	215
	216	if (ios.ne.0) then ! file not found
	217	if (is_master) then
	218	write(,) 'Error from interpolate_continuum routine'
	219	write(,) 'Data file ',trim(filename),' not found.'
	220	write(,) 'Check that your path to datagcm:',trim(datadir)
	221	write(,) 'is correct. You can change it in callphys.def with:'
	222	write(,) 'datadir = /absolute/path/to/datagcm'
	223	write(,) 'Also check that the continuum data is there.'
	224	write(,) 'Latest continuum data can be downloaded here:'
[3713]	225	write(,) 'https://web.lmd.jussieu.fr/~lmdz/planets/generic/datagcm/continuum_data/'
[3641]	226	endif
[3746]	227	call abort_physic(rname,"missing input file",1)
[3641]	228	endif
	229
	230	! We read the first line of the file to get the number of temperatures provided in the data file
	231	read(33, '(A)') line
	232
	233	i = 1
	234	iT = 0
	235
	236	do while (i .lt. len_trim(line))
	237	pos = index(line(i:), 'T=')
	238	if (pos == 0) exit
	239	i = i + pos
	240	iT = iT + 1
	241	read(line(i+2:i+10), '(E9.2)') temp_value
	242	end do
	243
	244	num_T=iT ! num_T is the number of temperatures provided in the data file
	245
	246	! We read all the remaining lines of the file to get the number of wavenumbers provided in the data file
	247	iW = 0
	248	do
	249	read(33,*, end=501) line
	250	iW = iW + 1
	251	end do
	252
	253	501 continue
	254
	255	num_wn=iW ! num_wn is the number of wavenumbers provided in the data file
	256
	257	close(33)
	258
[3693]	259	allocate(temp_arr(num_T))
	260	allocate(wn_arr(num_wn))
	261	allocate(abs_arr(num_wn,num_T))
[3641]	262
	263	! We now open and read the file a second time to extract the temperature array, wavenumber array and continuum absorption data
	264
	265	open(unit=33, file=trim(filename), status="old", action="read")
	266
	267	! We extract the temperature array (temp_arr)
	268
	269	read(33, '(A)') line
	270
	271	i = 1
	272	iT = 0
	273
	274	do while (i .lt. len_trim(line))
	275	pos = index(line(i:), 'T=')
	276	if (pos == 0) exit
	277	i = i + pos
	278	iT = iT + 1
	279	read(line(i+2:i+10), '(E9.2)') temp_arr(iT)
	280	end do
	281
	282	! We extract the wavenumber array (wn_arr) and continuum absorption (abs_arr)
	283
	284	do iW=1,num_wn
	285	read(33,*) wn_arr(iW), (abs_arr(iW, iT), iT=1,num_T)
	286	end do
	287
	288	close(33)
	289
	290	print*,'We read continuum absorption data for the pair ', trim(gnom(igas_X)),'-',trim(gnom(igas_Y))
	291	print*,'Temperature grid of the dataset: ', temp_arr(:)
	292
	293	! We loop on all molecular pairs with available continuum data and fill the corresponding array
	294
	295	if ((igas_X .eq. igas_CO2) .and. (igas_Y .eq. igas_CO2)) then
	296	num_T_CO2CO2=num_T
[3693]	297	allocate(temp_arr_CO2CO2(num_T_CO2CO2))
	298	allocate(abs_arr_CO2CO2_VI(L_NSPECTV,num_T_CO2CO2))
	299	allocate(abs_arr_CO2CO2_IR(L_NSPECTI,num_T_CO2CO2))
[3641]	300	temp_arr_CO2CO2(:)=temp_arr(:)
	301	abs_arr_CO2CO2_VI(:,:)=0.
	302	abs_arr_CO2CO2_IR(:,:)=0.
	303	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_CO2CO2_VI,abs_arr_CO2CO2_IR,num_T_CO2CO2)
	304	elseif ((igas_X .eq. igas_N2) .and. (igas_Y .eq. igas_N2)) then
	305	num_T_N2N2=num_T
[3693]	306	allocate(temp_arr_N2N2(num_T_N2N2))
	307	allocate(abs_arr_N2N2_VI(L_NSPECTV,num_T_N2N2))
	308	allocate(abs_arr_N2N2_IR(L_NSPECTI,num_T_N2N2))
[3641]	309	temp_arr_N2N2(:)=temp_arr(:)
	310	abs_arr_N2N2_VI(:,:)=0.
	311	abs_arr_N2N2_IR(:,:)=0.
	312	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_N2N2_VI,abs_arr_N2N2_IR,num_T_N2N2)
	313	elseif ((igas_X .eq. igas_O2) .and. (igas_Y .eq. igas_O2)) then
	314	num_T_O2O2=num_T
[3693]	315	allocate(temp_arr_O2O2(num_T_O2O2))
	316	allocate(abs_arr_O2O2_VI(L_NSPECTV,num_T_O2O2))
	317	allocate(abs_arr_O2O2_IR(L_NSPECTI,num_T_O2O2))
[3641]	318	temp_arr_O2O2(:)=temp_arr(:)
	319	abs_arr_O2O2_VI(:,:)=0.
	320	abs_arr_O2O2_IR(:,:)=0.
	321	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_O2O2_VI,abs_arr_O2O2_IR,num_T_O2O2)
	322	elseif ((igas_X .eq. igas_CH4) .and. (igas_Y .eq. igas_CH4)) then
	323	num_T_CH4CH4=num_T
[3693]	324	allocate(temp_arr_CH4CH4(num_T_CH4CH4))
	325	allocate(abs_arr_CH4CH4_VI(L_NSPECTV,num_T_CH4CH4))
	326	allocate(abs_arr_CH4CH4_IR(L_NSPECTI,num_T_CH4CH4))
[3641]	327	temp_arr_CH4CH4(:)=temp_arr(:)
	328	abs_arr_CH4CH4_VI(:,:)=0.
	329	abs_arr_CH4CH4_IR(:,:)=0.
	330	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_CH4CH4_VI,abs_arr_CH4CH4_IR,num_T_CH4CH4)
	331	elseif ((igas_X .eq. igas_H2) .and. (igas_Y .eq. igas_H2)) then
	332	num_T_H2H2=num_T
[3693]	333	allocate(temp_arr_H2H2(num_T_H2H2))
	334	allocate(abs_arr_H2H2_VI(L_NSPECTV,num_T_H2H2))
	335	allocate(abs_arr_H2H2_IR(L_NSPECTI,num_T_H2H2))
[3641]	336	temp_arr_H2H2(:)=temp_arr(:)
	337	abs_arr_H2H2_VI(:,:)=0.
	338	abs_arr_H2H2_IR(:,:)=0.
	339	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_H2H2_VI,abs_arr_H2H2_IR,num_T_H2H2)
	340	elseif ((igas_X .eq. igas_H2O) .and. (igas_Y .eq. igas_H2O)) then
	341	num_T_H2OH2O=num_T
[3693]	342	allocate(temp_arr_H2OH2O(num_T_H2OH2O))
	343	allocate(abs_arr_H2OH2O_VI(L_NSPECTV,num_T_H2OH2O))
	344	allocate(abs_arr_H2OH2O_IR(L_NSPECTI,num_T_H2OH2O))
[3641]	345	temp_arr_H2OH2O(:)=temp_arr(:)
	346	abs_arr_H2OH2O_VI(:,:)=0.
	347	abs_arr_H2OH2O_IR(:,:)=0.
	348	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_H2OH2O_VI,abs_arr_H2OH2O_IR,num_T_H2OH2O)
	349	elseif ((igas_X .eq. igas_N2) .and. (igas_Y .eq. igas_H2)) then
	350	num_T_N2H2=num_T
[3693]	351	allocate(temp_arr_N2H2(num_T_N2H2))
	352	allocate(abs_arr_N2H2_VI(L_NSPECTV,num_T_N2H2))
	353	allocate(abs_arr_N2H2_IR(L_NSPECTI,num_T_N2H2))
[3641]	354	temp_arr_N2H2(:)=temp_arr(:)
	355	abs_arr_N2H2_VI(:,:)=0.
	356	abs_arr_N2H2_IR(:,:)=0.
	357	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_N2H2_VI,abs_arr_N2H2_IR,num_T_N2H2)
	358	elseif ((igas_X .eq. igas_N2) .and. (igas_Y .eq. igas_O2)) then
	359	num_T_N2O2=num_T
[3693]	360	allocate(temp_arr_N2O2(num_T_N2O2))
	361	allocate(abs_arr_N2O2_VI(L_NSPECTV,num_T_N2O2))
	362	allocate(abs_arr_N2O2_IR(L_NSPECTI,num_T_N2O2))
[3641]	363	temp_arr_N2O2(:)=temp_arr(:)
	364	abs_arr_N2O2_VI(:,:)=0.
	365	abs_arr_N2O2_IR(:,:)=0.
	366	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_N2O2_VI,abs_arr_N2O2_IR,num_T_N2O2)
	367	elseif ((igas_X .eq. igas_N2) .and. (igas_Y .eq. igas_CH4)) then
	368	num_T_N2CH4=num_T
[3693]	369	allocate(temp_arr_N2CH4(num_T_N2CH4))
	370	allocate(abs_arr_N2CH4_VI(L_NSPECTV,num_T_N2CH4))
	371	allocate(abs_arr_N2CH4_IR(L_NSPECTI,num_T_N2CH4))
[3641]	372	temp_arr_N2CH4(:)=temp_arr(:)
	373	abs_arr_N2CH4_VI(:,:)=0.
	374	abs_arr_N2CH4_IR(:,:)=0.
	375	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_N2CH4_VI,abs_arr_N2CH4_IR,num_T_N2CH4)
	376	elseif ((igas_X .eq. igas_CO2) .and. (igas_Y .eq. igas_O2)) then
	377	num_T_CO2O2=num_T
[3693]	378	allocate(temp_arr_CO2O2(num_T_CO2O2))
	379	allocate(abs_arr_CO2O2_VI(L_NSPECTV,num_T_CO2O2))
	380	allocate(abs_arr_CO2O2_IR(L_NSPECTI,num_T_CO2O2))
[3641]	381	temp_arr_CO2O2(:)=temp_arr(:)
	382	abs_arr_CO2O2_VI(:,:)=0.
	383	abs_arr_CO2O2_IR(:,:)=0.
	384	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_CO2O2_VI,abs_arr_CO2O2_IR,num_T_CO2O2)
	385	elseif ((igas_X .eq. igas_H2) .and. (igas_Y .eq. igas_CH4)) then
	386	num_T_H2CH4=num_T
[3693]	387	allocate(temp_arr_H2CH4(num_T_H2CH4))
	388	allocate(abs_arr_H2CH4_VI(L_NSPECTV,num_T_H2CH4))
	389	allocate(abs_arr_H2CH4_IR(L_NSPECTI,num_T_H2CH4))
[3641]	390	temp_arr_H2CH4(:)=temp_arr(:)
	391	abs_arr_H2CH4_VI(:,:)=0.
	392	abs_arr_H2CH4_IR(:,:)=0.
	393	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_H2CH4_VI,abs_arr_H2CH4_IR,num_T_H2CH4)
	394	elseif ((igas_X .eq. igas_H2) .and. (igas_Y .eq. igas_He)) then
	395	num_T_H2He=num_T
[3693]	396	allocate(temp_arr_H2He(num_T_H2He))
	397	allocate(abs_arr_H2He_VI(L_NSPECTV,num_T_H2He))
	398	allocate(abs_arr_H2He_IR(L_NSPECTI,num_T_H2He))
[3641]	399	temp_arr_H2He(:)=temp_arr(:)
	400	abs_arr_H2He_VI(:,:)=0.
	401	abs_arr_H2He_IR(:,:)=0.
	402	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_H2He_VI,abs_arr_H2He_IR,num_T_H2He)
	403	elseif ((igas_X .eq. igas_H2O) .and. (igas_Y .eq. igas_N2)) then
	404	num_T_H2ON2=num_T
[3693]	405	allocate(temp_arr_H2ON2(num_T_H2ON2))
	406	allocate(abs_arr_H2ON2_VI(L_NSPECTV,num_T_H2ON2))
	407	allocate(abs_arr_H2ON2_IR(L_NSPECTI,num_T_H2ON2))
[3641]	408	temp_arr_H2ON2(:)=temp_arr(:)
	409	abs_arr_H2ON2_VI(:,:)=0.
	410	abs_arr_H2ON2_IR(:,:)=0.
	411	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_H2ON2_VI,abs_arr_H2ON2_IR,num_T_H2ON2)
	412	elseif ((igas_X .eq. igas_H2O) .and. (igas_Y .eq. igas_O2)) then
	413	num_T_H2OO2=num_T
[3693]	414	allocate(temp_arr_H2OO2(num_T_H2OO2))
	415	allocate(abs_arr_H2OO2_VI(L_NSPECTV,num_T_H2OO2))
	416	allocate(abs_arr_H2OO2_IR(L_NSPECTI,num_T_H2OO2))
[3641]	417	temp_arr_H2OO2(:)=temp_arr(:)
	418	abs_arr_H2OO2_VI(:,:)=0.
	419	abs_arr_H2OO2_IR(:,:)=0.
	420	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_H2OO2_VI,abs_arr_H2OO2_IR,num_T_H2OO2)
	421	elseif ((igas_X .eq. igas_H2O) .and. (igas_Y .eq. igas_CO2)) then
	422	num_T_H2OCO2=num_T
[3693]	423	allocate(temp_arr_H2OCO2(num_T_H2OCO2))
	424	allocate(abs_arr_H2OCO2_VI(L_NSPECTV,num_T_H2OCO2))
	425	allocate(abs_arr_H2OCO2_IR(L_NSPECTI,num_T_H2OCO2))
[3641]	426	temp_arr_H2OCO2(:)=temp_arr(:)
	427	abs_arr_H2OCO2_VI(:,:)=0.
	428	abs_arr_H2OCO2_IR(:,:)=0.
	429	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_H2OCO2_VI,abs_arr_H2OCO2_IR,num_T_H2OCO2)
	430	elseif ((igas_X .eq. igas_CO2) .and. (igas_Y .eq. igas_CO2)) then
	431	num_T_CO2CO2=num_T
[3693]	432	allocate(temp_arr_CO2CO2(num_T_CO2CO2))
	433	allocate(abs_arr_CO2CO2_VI(L_NSPECTV,num_T_CO2CO2))
	434	allocate(abs_arr_CO2CO2_IR(L_NSPECTI,num_T_CO2CO2))
[3641]	435	temp_arr_CO2CO2(:)=temp_arr(:)
	436	abs_arr_CO2CO2_VI(:,:)=0.
	437	abs_arr_CO2CO2_IR(:,:)=0.
	438	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_CO2CO2_VI,abs_arr_CO2CO2_IR,num_T_CO2CO2)
	439	elseif ((igas_X .eq. igas_CO2) .and. (igas_Y .eq. igas_H2)) then
	440	num_T_CO2H2=num_T
[3693]	441	allocate(temp_arr_CO2H2(num_T_CO2H2))
	442	allocate(abs_arr_CO2H2_VI(L_NSPECTV,num_T_CO2H2))
	443	allocate(abs_arr_CO2H2_IR(L_NSPECTI,num_T_CO2H2))
[3641]	444	temp_arr_CO2H2(:)=temp_arr(:)
	445	abs_arr_CO2H2_VI(:,:)=0.
	446	abs_arr_CO2H2_IR(:,:)=0.
	447	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_CO2H2_VI,abs_arr_CO2H2_IR,num_T_CO2H2)
	448	elseif ((igas_X .eq. igas_CO2) .and. (igas_Y .eq. igas_CH4)) then
	449	num_T_CO2CH4=num_T
[3693]	450	allocate(temp_arr_CO2CH4(num_T_CO2CH4))
	451	allocate(abs_arr_CO2CH4_VI(L_NSPECTV,num_T_CO2CH4))
	452	allocate(abs_arr_CO2CH4_IR(L_NSPECTI,num_T_CO2CH4))
[3641]	453	temp_arr_CO2CH4(:)=temp_arr(:)
	454	abs_arr_CO2CH4_VI(:,:)=0.
	455	abs_arr_CO2CH4_IR(:,:)=0.
	456	call interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr,abs_arr_CO2CH4_VI,abs_arr_CO2CH4_IR,num_T_CO2CH4)
	457	endif ! igas_X / igas_Y condition
	458
	459
	460	!$OMP END MASTER
	461	!$OMP BARRIER
	462
	463
	464	endif ! firstcall
	465
	466	! We loop on all molecular pairs with available continuum data and interpolate in the temperature field
	467	! Two options: we call visible (VI) or infrared (IR) tables, depending on the value of c_WN
	468
	469	if ((igas_X .eq. igas_CO2) .and. (igas_Y .eq. igas_CO2)) then
	470	call T_boundaries_continuum(z_temp,temp,temp_arr_CO2CO2,num_T_CO2CO2)
	471	if(c_WN .eq. 'IR') then
	472	call interpolate_T_abs_coeff(z_temp,temp_arr_CO2CO2,num_T_CO2CO2,abs_coef,abs_arr_CO2CO2_IR(ind_WN,:))
	473	elseif(c_WN .eq. 'VI') then
	474	call interpolate_T_abs_coeff(z_temp,temp_arr_CO2CO2,num_T_CO2CO2,abs_coef,abs_arr_CO2CO2_VI(ind_WN,:))
	475	else
[3746]	476	print*,'You must select visible (VI) or infrared (IR) channel.'
	477	call abort_physic(rname,"CO2CO2 bad channel",1)
[3641]	478	endif
	479	elseif ((igas_X .eq. igas_N2) .and. (igas_Y .eq. igas_N2)) then
	480	call T_boundaries_continuum(z_temp,temp,temp_arr_N2N2,num_T_N2N2)
	481	if(c_WN .eq. 'IR') then
	482	call interpolate_T_abs_coeff(z_temp,temp_arr_N2N2,num_T_N2N2,abs_coef,abs_arr_N2N2_IR(ind_WN,:))
	483	elseif(c_WN .eq. 'VI') then
	484	call interpolate_T_abs_coeff(z_temp,temp_arr_N2N2,num_T_N2N2,abs_coef,abs_arr_N2N2_VI(ind_WN,:))
	485	else
[3746]	486	print*,'You must select visible (VI) or infrared (IR) channel.'
	487	call abort_physic(rname,"N2N2 bad channel",1)
[3641]	488	endif
	489	elseif ((igas_X .eq. igas_O2) .and. (igas_Y .eq. igas_O2)) then
	490	call T_boundaries_continuum(z_temp,temp,temp_arr_O2O2,num_T_O2O2)
	491	if(c_WN .eq. 'IR') then
	492	call interpolate_T_abs_coeff(z_temp,temp_arr_O2O2,num_T_O2O2,abs_coef,abs_arr_O2O2_IR(ind_WN,:))
	493	elseif(c_WN .eq. 'VI') then
	494	call interpolate_T_abs_coeff(z_temp,temp_arr_O2O2,num_T_O2O2,abs_coef,abs_arr_O2O2_VI(ind_WN,:))
	495	else
[3746]	496	print*,'You must select visible (VI) or infrared (IR) channel.'
	497	call abort_physic(rname,"O2O2 bad channel",1)
[3641]	498	endif
	499	elseif ((igas_X .eq. igas_CH4) .and. (igas_Y .eq. igas_CH4)) then
	500	call T_boundaries_continuum(z_temp,temp,temp_arr_CH4CH4,num_T_CH4CH4)
	501	if(c_WN .eq. 'IR') then
	502	call interpolate_T_abs_coeff(z_temp,temp_arr_CH4CH4,num_T_CH4CH4,abs_coef,abs_arr_CH4CH4_IR(ind_WN,:))
	503	elseif(c_WN .eq. 'VI') then
	504	call interpolate_T_abs_coeff(z_temp,temp_arr_CH4CH4,num_T_CH4CH4,abs_coef,abs_arr_CH4CH4_VI(ind_WN,:))
	505	else
[3746]	506	print*,'You must select visible (VI) or infrared (IR) channel.'
	507	call abort_physic(rname,"CH4CH4 bad channel",1)
[3641]	508	endif
	509	elseif ((igas_X .eq. igas_H2) .and. (igas_Y .eq. igas_H2)) then
	510	call T_boundaries_continuum(z_temp,temp,temp_arr_H2H2,num_T_H2H2)
	511	if(c_WN .eq. 'IR') then
	512	call interpolate_T_abs_coeff(z_temp,temp_arr_H2H2,num_T_H2H2,abs_coef,abs_arr_H2H2_IR(ind_WN,:))
	513	elseif(c_WN .eq. 'VI') then
	514	call interpolate_T_abs_coeff(z_temp,temp_arr_H2H2,num_T_H2H2,abs_coef,abs_arr_H2H2_VI(ind_WN,:))
	515	else
[3746]	516	print*,'You must select visible (VI) or infrared (IR) channel.'
	517	call abort_physic(rname,"H2H2 bad channel",1)
[3641]	518	endif
	519	elseif ((igas_X .eq. igas_H2O) .and. (igas_Y .eq. igas_H2O)) then
	520	call T_boundaries_continuum(z_temp,temp,temp_arr_H2OH2O,num_T_H2OH2O)
	521	if(c_WN .eq. 'IR') then
	522	call interpolate_T_abs_coeff(z_temp,temp_arr_H2OH2O,num_T_H2OH2O,abs_coef,abs_arr_H2OH2O_IR(ind_WN,:))
	523	elseif(c_WN .eq. 'VI') then
	524	call interpolate_T_abs_coeff(z_temp,temp_arr_H2OH2O,num_T_H2OH2O,abs_coef,abs_arr_H2OH2O_VI(ind_WN,:))
	525	else
[3746]	526	print*,'You must select visible (VI) or infrared (IR) channel.'
	527	call abort_physic(rname,"H2OH2O bad channel",1)
[3641]	528	endif
	529	elseif ((igas_X .eq. igas_N2) .and. (igas_Y .eq. igas_H2)) then
	530	call T_boundaries_continuum(z_temp,temp,temp_arr_N2H2,num_T_N2H2)
	531	if(c_WN .eq. 'IR') then
	532	call interpolate_T_abs_coeff(z_temp,temp_arr_N2H2,num_T_N2H2,abs_coef,abs_arr_N2H2_IR(ind_WN,:))
	533	elseif(c_WN .eq. 'VI') then
	534	call interpolate_T_abs_coeff(z_temp,temp_arr_N2H2,num_T_N2H2,abs_coef,abs_arr_N2H2_VI(ind_WN,:))
	535	else
[3746]	536	print*,'You must select visible (VI) or infrared (IR) channel.'
	537	call abort_physic(rname,"N2H2 bad channel",1)
[3641]	538	endif
	539	elseif ((igas_X .eq. igas_N2) .and. (igas_Y .eq. igas_O2)) then
	540	call T_boundaries_continuum(z_temp,temp,temp_arr_N2O2,num_T_N2O2)
	541	if(c_WN .eq. 'IR') then
	542	call interpolate_T_abs_coeff(z_temp,temp_arr_N2O2,num_T_N2O2,abs_coef,abs_arr_N2O2_IR(ind_WN,:))
	543	elseif(c_WN .eq. 'VI') then
	544	call interpolate_T_abs_coeff(z_temp,temp_arr_N2O2,num_T_N2O2,abs_coef,abs_arr_N2O2_VI(ind_WN,:))
	545	else
[3746]	546	print*,'You must select visible (VI) or infrared (IR) channel.'
	547	call abort_physic(rname,"N2O2 bad channel",1)
[3641]	548	endif
	549	elseif ((igas_X .eq. igas_N2) .and. (igas_Y .eq. igas_CH4)) then
	550	call T_boundaries_continuum(z_temp,temp,temp_arr_N2CH4,num_T_N2CH4)
	551	if(c_WN .eq. 'IR') then
	552	call interpolate_T_abs_coeff(z_temp,temp_arr_N2CH4,num_T_N2CH4,abs_coef,abs_arr_N2CH4_IR(ind_WN,:))
	553	elseif(c_WN .eq. 'VI') then
	554	call interpolate_T_abs_coeff(z_temp,temp_arr_N2CH4,num_T_N2CH4,abs_coef,abs_arr_N2CH4_VI(ind_WN,:))
	555	else
[3746]	556	print*,'You must select visible (VI) or infrared (IR) channel.'
	557	call abort_physic(rname,"N2CH4 bad channel",1)
[3641]	558	endif
	559	elseif ((igas_X .eq. igas_CO2) .and. (igas_Y .eq. igas_O2)) then
	560	call T_boundaries_continuum(z_temp,temp,temp_arr_CO2O2,num_T_CO2O2)
	561	if(c_WN .eq. 'IR') then
	562	call interpolate_T_abs_coeff(z_temp,temp_arr_CO2O2,num_T_CO2O2,abs_coef,abs_arr_CO2O2_IR(ind_WN,:))
	563	elseif(c_WN .eq. 'VI') then
	564	call interpolate_T_abs_coeff(z_temp,temp_arr_CO2O2,num_T_CO2O2,abs_coef,abs_arr_CO2O2_VI(ind_WN,:))
	565	else
[3746]	566	print*,'You must select visible (VI) or infrared (IR) channel.'
	567	call abort_physic(rname,"CO2O2 bad channel",1)
[3641]	568	endif
	569	elseif ((igas_X .eq. igas_H2) .and. (igas_Y .eq. igas_CH4)) then
	570	call T_boundaries_continuum(z_temp,temp,temp_arr_H2CH4,num_T_H2CH4)
	571	if(c_WN .eq. 'IR') then
	572	call interpolate_T_abs_coeff(z_temp,temp_arr_H2CH4,num_T_H2CH4,abs_coef,abs_arr_H2CH4_IR(ind_WN,:))
	573	elseif(c_WN .eq. 'VI') then
	574	call interpolate_T_abs_coeff(z_temp,temp_arr_H2CH4,num_T_H2CH4,abs_coef,abs_arr_H2CH4_VI(ind_WN,:))
	575	else
[3746]	576	print*,'You must select visible (VI) or infrared (IR) channel.'
	577	call abort_physic(rname,"H2CH4 bad channel",1)
[3641]	578	endif
	579	elseif ((igas_X .eq. igas_H2) .and. (igas_Y .eq. igas_He)) then
	580	call T_boundaries_continuum(z_temp,temp,temp_arr_H2He,num_T_H2He)
	581	if(c_WN .eq. 'IR') then
	582	call interpolate_T_abs_coeff(z_temp,temp_arr_H2He,num_T_H2He,abs_coef,abs_arr_H2He_IR(ind_WN,:))
	583	elseif(c_WN .eq. 'VI') then
	584	call interpolate_T_abs_coeff(z_temp,temp_arr_H2He,num_T_H2He,abs_coef,abs_arr_H2He_VI(ind_WN,:))
	585	else
[3746]	586	print*,'You must select visible (VI) or infrared (IR) channel.'
	587	call abort_physic(rname,"H2He bad channel",1)
[3641]	588	endif
	589	elseif ((igas_X .eq. igas_H2O) .and. (igas_Y .eq. igas_N2)) then
	590	call T_boundaries_continuum(z_temp,temp,temp_arr_H2ON2,num_T_H2ON2)
	591	if(c_WN .eq. 'IR') then
	592	call interpolate_T_abs_coeff(z_temp,temp_arr_H2ON2,num_T_H2ON2,abs_coef,abs_arr_H2ON2_IR(ind_WN,:))
	593	elseif(c_WN .eq. 'VI') then
	594	call interpolate_T_abs_coeff(z_temp,temp_arr_H2ON2,num_T_H2ON2,abs_coef,abs_arr_H2ON2_VI(ind_WN,:))
	595	else
[3746]	596	print*,'You must select visible (VI) or infrared (IR) channel.'
	597	call abort_physic(rname,"H2ON2 bad channel",1)
[3641]	598	endif
	599	elseif ((igas_X .eq. igas_H2O) .and. (igas_Y .eq. igas_O2)) then
	600	call T_boundaries_continuum(z_temp,temp,temp_arr_H2OO2,num_T_H2OO2)
	601	if(c_WN .eq. 'IR') then
	602	call interpolate_T_abs_coeff(z_temp,temp_arr_H2OO2,num_T_H2OO2,abs_coef,abs_arr_H2OO2_IR(ind_WN,:))
	603	elseif(c_WN .eq. 'VI') then
	604	call interpolate_T_abs_coeff(z_temp,temp_arr_H2OO2,num_T_H2OO2,abs_coef,abs_arr_H2OO2_VI(ind_WN,:))
	605	else
[3746]	606	print*,'You must select visible (VI) or infrared (IR) channel.'
	607	call abort_physic(rname,"H2OO2 bad channel",1)
[3641]	608	endif
	609	elseif ((igas_X .eq. igas_H2O) .and. (igas_Y .eq. igas_CO2)) then
	610	call T_boundaries_continuum(z_temp,temp,temp_arr_H2OCO2,num_T_H2OCO2)
	611	if(c_WN .eq. 'IR') then
	612	call interpolate_T_abs_coeff(z_temp,temp_arr_H2OCO2,num_T_H2OCO2,abs_coef,abs_arr_H2OCO2_IR(ind_WN,:))
	613	elseif(c_WN .eq. 'VI') then
	614	call interpolate_T_abs_coeff(z_temp,temp_arr_H2OCO2,num_T_H2OCO2,abs_coef,abs_arr_H2OCO2_VI(ind_WN,:))
	615	else
[3746]	616	print*,'You must select visible (VI) or infrared (IR) channel.'
	617	call abort_physic(rname,"H2OCO2 bad channel",1)
[3641]	618	endif
	619	elseif ((igas_X .eq. igas_CO2) .and. (igas_Y .eq. igas_H2)) then
	620	call T_boundaries_continuum(z_temp,temp,temp_arr_CO2H2,num_T_CO2H2)
	621	if(c_WN .eq. 'IR') then
	622	call interpolate_T_abs_coeff(z_temp,temp_arr_CO2H2,num_T_CO2H2,abs_coef,abs_arr_CO2H2_IR(ind_WN,:))
	623	elseif(c_WN .eq. 'VI') then
	624	call interpolate_T_abs_coeff(z_temp,temp_arr_CO2H2,num_T_CO2H2,abs_coef,abs_arr_CO2H2_VI(ind_WN,:))
	625	else
[3746]	626	print*,'You must select visible (VI) or infrared (IR) channel.'
	627	call abort_physic(rname,"CO2H2 bad channel",1)
[3641]	628	endif
	629	elseif ((igas_X .eq. igas_CO2) .and. (igas_Y .eq. igas_CH4)) then
	630	call T_boundaries_continuum(z_temp,temp,temp_arr_CO2CH4,num_T_CO2CH4)
	631	if(c_WN .eq. 'IR') then
	632	call interpolate_T_abs_coeff(z_temp,temp_arr_CO2CH4,num_T_CO2CH4,abs_coef,abs_arr_CO2CH4_IR(ind_WN,:))
	633	elseif(c_WN .eq. 'VI') then
	634	call interpolate_T_abs_coeff(z_temp,temp_arr_CO2CH4,num_T_CO2CH4,abs_coef,abs_arr_CO2CH4_VI(ind_WN,:))
	635	else
[3746]	636	print*,'You must select visible (VI) or infrared (IR) channel.'
	637	call abort_physic(rname,"CO2CH4 bad channel",1)
[3641]	638	endif
	639	endif ! igas_X / igas_Y condition
	640
	641	! We compute the values of amagat for molecules X and Y
	642	amagat_X = (273.15/temp)*(pres_X/101325.0)
	643	amagat_Y = (273.15/temp)*(pres_Y/101325.0)
	644
	645	! We convert the absorption coefficient from cm^-1 amagat^-2 into m^-1
	646	abs_coef=abs_coef100.0amagat_X*amagat_Y
	647
	648	!print*,'We have ',amagat_X,' amagats of molecule ', trim(gnom(igas_X))
	649	!print*,'We have ',amagat_X,' amagats of molecule ', trim(gnom(igas_Y))
	650	!print*,'So the absorption is ',abs_coef,' m^-1'
	651
	652	end subroutine interpolate_continuum
	653
	654
	655	subroutine interpolate_wn_abs_coeff(wn_arr,num_wn,abs_arr_in,abs_arr_out_VI,abs_arr_out_IR,num_T)
	656
	657	!==================================================================
	658	!
	659	! Purpose
	660	! -------
	661	! Interpolate the continuum data into the visible (VI) and infrared (IR) spectral chanels.
	662	!
	663	! Author
	664	! -------
	665	! M. Turbet (2025)
	666	!
	667	!==================================================================
	668
	669	use radcommon_h, only : BWNV,BWNI,WNOI,WNOV
	670	use radinc_h, only: L_NSPECTI, L_NSPECTV
	671	use mod_phys_lmdz_para, only : is_master
	672
	673	implicit none
	674
	675	integer iW, iB, count_norm
[3693]	676	integer,intent(in) :: num_T
	677	integer,intent(in) :: num_wn
	678	double precision,intent(in) :: wn_arr(num_wn)
	679	double precision,intent(in) :: abs_arr_in(num_wn,num_T)
	680	double precision,intent(out) :: abs_arr_out_IR(L_NSPECTI,num_T)
	681	double precision,intent(out) :: abs_arr_out_VI(L_NSPECTV,num_T)
[3641]	682
	683	! First visible (VI) chanel
	684
	685	! We get read of all the wavenumbers lower than the minimum wavenumber in the visible wavenumber grid
	686	iW=1
	687	do while((wn_arr(iW) .lt. BWNV(1)) .and. (iW .lt. num_wn))
	688	iW=iW+1
	689	enddo
	690
	691	! We compute the mean of the continuum absorption inside each wavenumber visible (VI) chanel
	692	do iB = 1, L_NSPECTV
	693	count_norm=0
	694	do while((wn_arr(iW) .lt. BWNV(iB+1)) .and. (iW .lt. num_wn))
	695	abs_arr_out_VI(iB,:)=abs_arr_out_VI(iB,:)+abs_arr_in(iW,:)
	696	count_norm=count_norm+1
	697	iW=iW+1
	698	enddo
	699	if(count_norm .ge. 1) abs_arr_out_VI(iB,:)=abs_arr_out_VI(iB,:)/count_norm
	700	end do
	701
	702	! Then infrared (IR) chanel
	703
	704	! We get read of all the wavenumbers lower than the minimum wavenumber in the infrared wavenumber grid
	705	iW=1
	706	do while((wn_arr(iW) .lt. BWNI(1)) .and. (iW .lt. num_wn))
	707	iW=iW+1
	708	enddo
	709
	710	! We compute the mean of the continuum absorption inside each wavenumber visible (VI) chanel
	711	do iB = 1, L_NSPECTI
	712	count_norm=0
	713	do while((wn_arr(iW) .lt. BWNI(iB+1)) .and. (iW .lt. num_wn))
	714	abs_arr_out_IR(iB,:)=abs_arr_out_IR(iB,:)+abs_arr_in(iW,:)
	715	count_norm=count_norm+1
	716	iW=iW+1
	717	enddo
	718	if(count_norm .ge. 1) abs_arr_out_IR(iB,:)=abs_arr_out_IR(iB,:)/count_norm
	719	end do
	720
	721	if (is_master) then
	722	print*, 'Continuum absorption, first temperature, visible (VI):'
	723	do iB = 1, L_NSPECTV
	724	print*,WNOV(iB),' cm-1',abs_arr_out_VI(iB,1), ' cm-1 amagat-2'
	725	end do
	726
	727	print*, 'Continuum absorption, first temperature, infrared (IR):'
	728	do iB = 1, L_NSPECTI
	729	print*,WNOI(iB),' cm-1',abs_arr_out_IR(iB,1), ' cm-1 amagat-2'
	730	end do
	731	endif
	732
	733	end subroutine interpolate_wn_abs_coeff
	734
	735
	736	subroutine T_boundaries_continuum(z_temp,temp,temp_arr,num_T)
	737
	738	!==================================================================
	739	!
	740	! Purpose
	741	! -------
	742	! Check if the temperature is outside the boundaries of the continuum data temperatures.
	743	!
	744	! Author
	745	! -------
	746	! M. Turbet (2025)
	747	!
	748	!==================================================================
	749
	750	use callkeys_mod, only: strictboundcia
	751	use mod_phys_lmdz_para, only : is_master
	752
	753	implicit none
	754
[3693]	755	double precision,intent(out) :: z_temp
	756	double precision,intent(in) :: temp
	757	integer,intent(in) :: num_T
	758	double precision,intent(in) :: temp_arr(num_T)
[3641]	759
[3693]	760	character(len=22) :: rname = "T_boundaries_continuum"
	761
[3641]	762	z_temp=temp
	763
	764	if(z_temp .lt. minval(temp_arr)) then
	765	if (strictboundcia) then
	766	if (is_master) then
	767	print*,'Your temperatures are too low for this continuum dataset'
	768	print*, 'Minimum temperature is ', minval(temp_arr), ' K'
	769	endif
[3693]	770	call abort_physic(rname,"temperature too low",1)
[3641]	771	else
	772	z_temp=minval(temp_arr)
	773	endif
	774	elseif(z_temp .gt. maxval(temp_arr)) then
	775	if (strictboundcia) then
	776	if (is_master) then
	777	print*,'Your temperatures are too high for this continuum dataset'
	778	print*, 'Maximum temperature is ', maxval(temp_arr), ' K'
	779	endif
[3746]	780	call abort_physic(rname,"temperature too high",1)
[3641]	781	else
	782	z_temp=maxval(temp_arr)
	783	endif
	784	endif
	785
	786	end subroutine T_boundaries_continuum
	787
	788
	789	subroutine interpolate_T_abs_coeff(z_temp,temp_arr,num_T,abs_coef,abs_arr)
	790
	791	!==================================================================
	792	!
	793	! Purpose
	794	! -------
	795	! Interpolate in the continuum data using the temperature field
	796	!
	797	! Author
	798	! -------
	799	! M. Turbet (2025)
	800	!
	801	!==================================================================
	802
	803	implicit none
	804
	805	integer iT
[3746]	806	double precision,intent(in) :: z_temp
	807	integer,intent(in) :: num_T
	808	double precision,intent(in) :: temp_arr(num_T)
[3641]	809
[3746]	810	double precision,intent(out) :: abs_coef
	811	double precision,intent(in) :: abs_arr(num_T)
[3641]	812
	813	! Check where to interpolate
	814	iT=1
	815	do while ( z_temp .gt. temp_arr(iT) )
	816	iT=iT+1
	817	end do
	818
[3746]	819	! If below lowest temperature in temp_arr()
	820	if (iT==1) then
	821	abs_coef=abs_arr(1)
	822	return
	823	endif
	824
[3641]	825	! We proceed to a simple linear interpolation using the two most nearby temperatures
	826	if(iT .lt. num_T) then
	827	abs_coef=abs_arr(iT-1)+(abs_arr(iT)-abs_arr(iT-1))*(z_temp-temp_arr(iT-1))/(temp_arr(iT)-temp_arr(iT-1))
	828	else
[3746]	829	! If above highest temperature
[3641]	830	abs_coef=abs_arr(iT)
	831	endif
	832
	833	!print*,'the absorption is ',abs_coef,' cm^-1 amagat^-2'
	834
	835
	836	end subroutine interpolate_T_abs_coeff
[3693]	837
	838	end module interpolate_continuum_mod

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

Download in other formats:

Original Format