Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2011 Bill Paxton & The MESA Team
4 : !
5 : ! This program is free software: you can redistribute it and/or modify
6 : ! it under the terms of the GNU Lesser General Public License
7 : ! as published by the Free Software Foundation,
8 : ! either version 3 of the License, or (at your option) any later version.
9 : !
10 : ! This program is distributed in the hope that it will be useful,
11 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
12 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 : ! See the GNU Lesser General Public License for more details.
14 : !
15 : ! You should have received a copy of the GNU Lesser General Public License
16 : ! along with this program. If not, see <https://www.gnu.org/licenses/>.
17 : !
18 : ! ***********************************************************************
19 :
20 : module ion_tables_load
21 : use ionization_def
22 : use const_def, only: dp, use_mesa_temp_cache
23 : use utils_lib, only: mesa_error, mv, switch_str
24 :
25 : implicit none
26 :
27 : contains
28 :
29 6 : subroutine Init_ion_tables(file_prefix, Z1_suffix, use_cache, ierr)
30 : character(*), intent(in) :: file_prefix, Z1_suffix
31 : logical, intent(in) :: use_cache
32 : integer, intent(out) :: ierr ! 0 means AOK.
33 3 : ierr = 0
34 3 : if (ion_root_is_initialized) return
35 3 : ion_file_prefix = file_prefix
36 3 : ion_Z1_suffix = Z1_suffix
37 3 : use_cache_for_ion = use_cache
38 3 : call ion_read_sizes(ierr)
39 3 : if (ierr /= 0) return
40 3 : ion_root_is_initialized = .true.
41 3 : end subroutine Init_ion_tables
42 :
43 :
44 3 : subroutine ion_read_sizes(ierr)
45 : use utils_lib
46 : integer, intent(out) :: ierr
47 :
48 : character (len=256) :: message, fname, cache_filename, temp_cache_filename
49 : integer :: iounit
50 3 : real(dp) :: xin, zz
51 :
52 3 : ierr = 0
53 :
54 3 : call Get_ion_Table_Filenames(ion_Zs(1), ion_Xs(1), fname, cache_filename, temp_cache_filename)
55 3 : open(newunit=iounit, file=trim(fname), action='read', status='old', iostat=ierr)
56 3 : call check_for_error_in_ion_data(ierr, fname)
57 :
58 3 : read(iounit,*, iostat=ierr)
59 3 : call check_for_error_in_ion_data(ierr, fname)
60 :
61 : read(iounit,*, iostat=ierr) &
62 3 : ion_version, xin, zz, ion_num_logTs, ion_logT_min, ion_logT_max, ion_del_logT, &
63 6 : ion_num_logQs, ion_logQ_min, ion_logQ_max, ion_del_logQ
64 3 : call check_for_error_in_ion_data(ierr, fname)
65 :
66 3 : close(iounit)
67 :
68 3 : if (ion_version < min_version) call request_user_to_reinstall
69 :
70 3 : end subroutine ion_read_sizes
71 :
72 :
73 0 : subroutine request_user_to_reinstall
74 0 : write(*,*)
75 0 : write(*,*)
76 0 : write(*,*)
77 0 : write(*,*)
78 0 : write(*,*)
79 0 : write(*,*)
80 0 : write(*,*) 'NOTICE: you need to install a new version of the ion data.'
81 0 : write(*,*) 'Please update by removing the directory mesa/data/ionization_data,'
82 0 : write(*,*) 'and rerunning the mesa ./install script.'
83 0 : write(*,*)
84 0 : write(*,*)
85 0 : call mesa_error(__FILE__,__LINE__)
86 0 : end subroutine request_user_to_reinstall
87 :
88 :
89 53 : subroutine check_for_error_in_ion_data(ierr, fname)
90 : integer, intent(in) :: ierr
91 : character (len=*) :: fname
92 53 : if (ierr == 0) return
93 0 : write(*,*) 'load ion tables ' // trim(fname)
94 0 : write(*,*)
95 0 : write(*,*)
96 0 : write(*,*)
97 0 : write(*,*)
98 0 : write(*,*)
99 0 : write(*,'(a)') 'FATAL ERROR: missing or bad ion data.'
100 0 : write(*,'(a)') 'Please update by removing the directories mesa/data/ionization_data,'
101 0 : write(*,'(a)') 'and rerunning the mesa ./install script.'
102 0 : write(*,*)
103 0 : call mesa_error(__FILE__,__LINE__)
104 : end subroutine check_for_error_in_ion_data
105 :
106 :
107 2 : subroutine Load_ion_Table(ierr)
108 : use utils_lib
109 : integer, intent(out) :: ierr
110 :
111 : integer :: iz, ix, i
112 :
113 2 : ierr = 0
114 4 : !$OMP CRITICAL (load_ionization_table)
115 2 : call do_read
116 : !$OMP END CRITICAL (load_ionization_table)
117 :
118 : contains
119 :
120 2 : subroutine do_read
121 : integer :: sz_ion_tbl
122 :
123 2 : if (ion_is_initialized) return
124 : sz_ion_tbl = sz_per_ion_point*num_ion_vals* &
125 2 : ion_num_logQs*ion_num_logTs*num_ion_Xs*num_ion_Zs
126 : allocate(ion_tbl1(sz_ion_tbl),&
127 : ion_logQs(ion_num_logQs), ion_logTs(ion_num_logTs), &
128 2 : STAT=ierr)
129 2 : if (ierr /= 0) return
130 : ion_tbl(1:sz_per_ion_point, 1:num_ion_vals,&
131 : 1:ion_num_logQs, 1:ion_num_logTs, 1:num_ion_Xs, 1:num_ion_Zs) => &
132 2 : ion_tbl1(1:sz_ion_tbl)
133 :
134 2 : ion_logQs(1) = ion_logQ_min
135 348 : do i = 2, ion_num_logQs-1
136 348 : ion_logQs(i) = ion_logQs(i-1) + ion_del_logQ
137 : end do
138 2 : ion_logQs(ion_num_logQs) = ion_logQ_max
139 :
140 2 : ion_logTs(1) = ion_logT_min
141 202 : do i = 2, ion_num_logTs-1
142 202 : ion_logTs(i) = ion_logTs(i-1) + ion_del_logT
143 : end do
144 2 : ion_logTs(ion_num_logTs) = ion_logT_max
145 :
146 12 : do iz = 1, num_ion_Zs
147 72 : do ix = 1, num_ion_Xs
148 60 : if (ion_Zs(iz) + ion_Xs(ix) > 1.0000001d0) cycle
149 44 : call read_one(ix,iz,ierr)
150 54 : if (ierr /= 0) return
151 : end do
152 : end do
153 :
154 2 : ion_is_initialized = .true.
155 : end subroutine do_read
156 :
157 44 : subroutine read_one(ix,iz,ierr)
158 : integer, intent(in) :: ix, iz
159 : integer, intent(out) :: ierr
160 :
161 : character (len=256) :: fname, cache_filename, temp_cache_filename
162 :
163 : include 'formats'
164 :
165 : call Get_ion_Table_Filenames(&
166 44 : ion_Zs(iz), ion_Xs(ix), fname, cache_filename, temp_cache_filename)
167 : call Load1_ion_Table(&
168 : ion_Xs(ix), ion_Zs(iz), ion_tbl(:,:,:,:,ix,iz),&
169 44 : fname, cache_filename, temp_cache_filename, use_cache_for_ion, ierr)
170 44 : if (ierr /= 0) then
171 0 : write(*,*) 'Load1_ion_Table ierr', ierr, ix, iz, ion_Xs(ix), ion_Zs(iz)
172 : end if
173 :
174 44 : end subroutine read_one
175 :
176 : end subroutine Load_ion_Table
177 :
178 :
179 47 : subroutine Get_ion_Table_Filenames(Z, X, fname, cache_filename, temp_cache_filename)
180 : use const_def, only: mesa_data_dir
181 : real(dp), intent(in) :: Z, X
182 : character (len=*), intent(out) :: fname, cache_filename, temp_cache_filename
183 : character (len=256) :: Zstr, Xstr, suffix
184 :
185 47 : call setstr(Z,Zstr)
186 47 : call setstr(X,Xstr)
187 47 : if (Zstr == '100') then
188 2 : suffix = ion_Z1_suffix
189 : else
190 45 : suffix = ''
191 : end if
192 :
193 : fname = trim(mesa_data_dir) // &
194 : '/ionization_data/' // trim(ion_file_prefix) // '_' //&
195 47 : trim(Zstr) // 'z' // trim(Xstr) // 'x' // trim(suffix) // '.data'
196 : cache_filename = trim(ionization_cache_dir) // &
197 : '/' // trim(ion_file_prefix) // '_' //&
198 47 : trim(Zstr) // 'z' // trim(Xstr) // 'x' // trim(suffix) // '.bin'
199 :
200 : temp_cache_filename = trim(ionization_temp_cache_dir) // &
201 : '/' // trim(ion_file_prefix) // '_' //&
202 94 : trim(Zstr) // 'z' // trim(Xstr) // 'x' // trim(suffix) // '.bin'
203 :
204 : contains
205 :
206 94 : subroutine setstr(v,str)
207 : real(dp), intent(in) :: v
208 : character (len=*) :: str
209 94 : if (v > 0.99999d0) then
210 4 : str = '100'
211 90 : else if (v > 0.09999d0) then
212 42 : write(str, '(i2)') floor(100d0 * v + 0.5d0)
213 : else
214 48 : write(str, '(a,i1)') '0', floor(100d0 * v + 0.5d0)
215 : end if
216 94 : end subroutine setstr
217 :
218 : end subroutine Get_ion_Table_Filenames
219 :
220 :
221 66 : subroutine Load1_ion_Table(&
222 44 : X, Z, tbl, filename, cache_filename, temp_cache_filename, use_cache, info)
223 : real(dp), intent(in) :: X, Z
224 : real(dp) :: tbl(sz_per_ion_point, num_ion_vals, ion_num_logQs, ion_num_logTs)
225 : character (*), intent(in) :: filename, cache_filename, temp_cache_filename
226 : logical, intent(in) :: use_cache
227 : integer, intent(out) :: info
228 :
229 : integer :: io_unit, cache_io_unit
230 :
231 : integer :: num_logQs_in, num_logTs_in, version_in
232 1276 : real(dp) :: logT_min_in, logT_max_in, del_logT_in, vals(num_ion_vals),&
233 44 : logQ_min_in, logQ_max_in, del_logQ_in, X_in, Z_in, logQ, logT
234 : integer :: j,i,k,iQ,ios,status,line_number
235 : character (len=500) :: message, input_line
236 : real(dp), parameter :: tiny = 1e-6
237 :
238 : include 'formats'
239 :
240 44 : info = 0
241 :
242 44 : write(message,*) 'open ', trim(filename)
243 44 : open(NEWUNIT=io_unit, FILE=trim(filename), ACTION='READ', STATUS='OLD', IOSTAT=ios)
244 44 : call check_for_error_in_ion_data(ios, filename)
245 :
246 : line_number = 0
247 44 : read(io_unit,*,iostat=info)
248 66 : if (info /= 0) return
249 44 : line_number = line_number + 1
250 : read(io_unit,*,iostat=info) &
251 44 : version_in, X_in, Z_in, num_logTs_in, logT_min_in, logT_max_in, del_logT_in, &
252 88 : num_logQs_in, logQ_min_in, logQ_max_in, del_logQ_in
253 44 : if (info /= 0) return
254 : line_number = line_number + 1
255 44 : read(io_unit,*,iostat=info)
256 44 : if (info /= 0) return
257 44 : line_number = line_number + 1
258 :
259 : if (ion_version > version_in &
260 : .or. ion_num_logQs /= num_logQs_in &
261 : .or. ion_num_logTs /= num_logTs_in&
262 : .or. abs(X-X_in) > tiny&
263 : .or. abs(Z-Z_in) > tiny&
264 : .or. abs(ion_logT_min-logT_min_in) > tiny &
265 : .or. abs(ion_logT_max-logT_max_in) > tiny &
266 : .or. abs(ion_del_logT-del_logT_in) > tiny &
267 : .or. abs(ion_logQ_min-logQ_min_in) > tiny &
268 : .or. abs(ion_logQ_max-logQ_max_in) > tiny &
269 44 : .or. abs(ion_del_logQ-del_logQ_in) > tiny &
270 : ) then
271 0 : write(*,*) 'bad header info in ' // trim(filename)
272 0 : info = -1
273 0 : close(io_unit)
274 0 : write(*,'(a50,l1,2i10)') 'ion_version > version_in', ion_version > version_in, ion_version, version_in
275 0 : write(*,'(a50,l1)') 'ion_num_logQs /= num_logQs_in', ion_num_logQs /= num_logQs_in
276 0 : write(*,'(a50,l1)') 'ion_num_logTs /= num_logTs_in', ion_num_logTs /= num_logTs_in
277 0 : write(*,'(a50,l1)') 'abs(X-X_in) > tiny', abs(X-X_in) > tiny
278 0 : write(*,'(a50,l1)') 'abs(Z-Z_in) > tiny', abs(Z-Z_in) > tiny
279 0 : write(*,'(a50,l1)') 'abs(ion_logT_min-logT_min_in) > tiny', abs(ion_logT_min-logT_min_in) > tiny
280 0 : write(*,'(a50,l1)') 'abs(ion_logT_max-logT_max_in) > tiny', abs(ion_logT_max-logT_max_in) > tiny
281 0 : write(*,'(a50,l1)') 'abs(ion_del_logT-del_logT_in) > tiny', abs(ion_del_logT-del_logT_in) > tiny
282 0 : write(*,'(a50,l1)') 'abs(ion_logQ_min-logQ_min_in) > tiny', abs(ion_logQ_min-logQ_min_in) > tiny
283 0 : write(*,'(a50,l1)') 'abs(ion_logQ_max-logQ_max_in) > tiny', abs(ion_logQ_max-logQ_max_in) > tiny
284 0 : write(*,'(a50,l1)') 'abs(ion_del_logQ-del_logQ_in) > tiny', abs(ion_del_logQ-del_logQ_in) > tiny
285 0 : write(*,*)
286 0 : write(*,1) 'ion_logT_max', ion_logT_max
287 0 : write(*,1) 'logT_max_in', logT_max_in
288 0 : stop
289 : return
290 : end if
291 :
292 44 : if (use_cache) then
293 44 : call Read_ion_Cache(X, Z, tbl, cache_filename, ios)
294 44 : if (ios == 0) then
295 22 : close(io_unit)
296 22 : return
297 : end if
298 : end if
299 :
300 3872 : do iQ=1,ion_num_logQs
301 3850 : read(io_unit,*,iostat=info)
302 3850 : if (failed('skip line')) return
303 3850 : line_number = line_number + 1
304 3850 : read (io_unit,*,iostat=info) logQ
305 3850 : if (failed('skip line')) return
306 3850 : line_number = line_number + 1
307 3850 : read(io_unit,*,iostat=info)
308 3850 : if (failed('skip line')) return
309 3850 : line_number = line_number + 1
310 3850 : read(io_unit,*,iostat=info)
311 3850 : if (failed('skip line')) return
312 3850 : line_number = line_number + 1
313 396550 : do i=1,ion_num_logTs
314 392700 : read(io_unit,'(a)',iostat=info) input_line
315 392700 : if (failed('read line')) return
316 392700 : line_number = line_number + 1
317 392700 : read (input_line,*,iostat=info) logT, vals(1:num_ion_vals)
318 392700 : if (failed('read tbl')) then
319 0 : write(*,'(a)') trim(input_line)
320 0 : write(*,*) trim(filename)
321 0 : write(*,*) 'iQ, i', iQ, i
322 0 : write(*,*) 'num_ion_vals', num_ion_vals
323 0 : write(*,*) 'logQ', logQ
324 0 : write(*,*) 'bad input line?'
325 0 : call mesa_error(__FILE__,__LINE__)
326 : end if
327 11392150 : tbl(1,1:num_ion_vals,iQ,i) = vals(1:num_ion_vals)
328 : end do
329 3850 : if(iQ < ion_num_logQs) read(io_unit,*,iostat=info)
330 3850 : if (failed('skip line')) return
331 3850 : line_number = line_number + 1
332 3850 : if(iQ < ion_num_logQs) read(io_unit,*,iostat=info)
333 3850 : if (failed('skip line')) return
334 3872 : line_number = line_number + 1
335 : end do
336 :
337 22 : close(io_unit)
338 :
339 22 : call Make_ion_Interpolation_Data(tbl, info)
340 22 : if (failed('Make_ion_Interpolation_Data')) return
341 :
342 22 : call Check_ion_Interpolation_Data(tbl)
343 :
344 22 : if (.not. use_cache) return
345 :
346 : open(NEWUNIT=cache_io_unit, file=trim(switch_str(temp_cache_filename, cache_filename, use_mesa_temp_cache)),&
347 22 : iostat=ios, action='write', form='unformatted')
348 :
349 22 : if (ios == 0) then
350 22 : write(*,'(a)') 'write ' // trim(cache_filename)
351 : write(cache_io_unit) &
352 22 : X_in, Z_in, ion_num_logTs, ion_logT_min, ion_logT_max, ion_del_logT, &
353 44 : ion_num_logQs, ion_logQ_min, ion_logQ_max, ion_del_logQ, ion_version
354 : write(cache_io_unit) &
355 22 : tbl(1:sz_per_ion_point, 1:num_ion_vals, 1:ion_num_logQs, 1:ion_num_logTs)
356 22 : close(cache_io_unit)
357 22 : if(use_mesa_temp_cache) call mv(temp_cache_filename, cache_filename,.true.)
358 : end if
359 :
360 : contains
361 :
362 22 : subroutine Check_ion_Interpolation_Data(tbl)
363 : use utils_lib,only:is_bad
364 : real(dp) :: tbl(sz_per_ion_point, num_ion_vals, ion_num_logQs, ion_num_logTs)
365 :
366 : ! for logT > 6.8 and logRho < -10, splines can get bogus higher order terms
367 : ! replace NaN's and Infinities with 0
368 :
369 : integer :: i, j, iQ, jtemp
370 :
371 110 : do i = 1, sz_per_ion_point
372 2574 : do j = 1, num_ion_vals
373 433752 : do iQ = 1, ion_num_logQs
374 44416064 : do jtemp = 1, ion_num_logTs
375 44413600 : if (is_bad(tbl(i,j,iQ,jtemp))) then
376 0 : tbl(i,j,iQ,jtemp) = 0
377 : end if
378 : end do
379 : end do
380 : end do
381 : end do
382 :
383 22 : end subroutine Check_ion_Interpolation_Data
384 :
385 808522 : logical function failed(str)
386 : character (len=*), intent(in) :: str
387 808522 : failed = (info /= 0)
388 808522 : if (failed) then
389 0 : write(*,*)
390 0 : write(*,'(a)') trim(filename)
391 : write(*,'(a,i9)') &
392 0 : ' Load1_ion_Table failed: ' // trim(str) // ' line', line_number
393 : end if
394 808522 : end function failed
395 :
396 :
397 : end subroutine Load1_ion_Table
398 :
399 :
400 22 : subroutine Make_ion_Interpolation_Data(tbl, info)
401 : use interp_2d_lib_db
402 : use const_def, only: crad, ln10
403 :
404 : real(dp) :: tbl(sz_per_ion_point, num_ion_vals, ion_num_logQs, ion_num_logTs)
405 : integer, intent(out) :: info
406 :
407 3872 : real(dp) :: logQs(ion_num_logQs) ! x vector, strict ascending
408 2266 : real(dp) :: logTs(ion_num_logTs) ! y vector, strict ascending
409 : real(dp) :: Ts(ion_num_logTs)
410 22 : real(dp), allocatable, target :: f1_ary(:) ! data & spline coefficients
411 22 : real(dp), pointer :: f1(:), f(:,:,:)
412 : integer :: ibcxmin ! bc flag for x=xmin
413 2266 : real(dp) :: bcxmin(ion_num_logTs) ! bc data vs. y at x=xmin
414 : integer :: ibcxmax ! bc flag for x=xmax
415 2266 : real(dp) :: bcxmax(ion_num_logTs) ! bc data vs. y at x=xmax
416 : integer :: ibcymin ! bc flag for y=ymin
417 3872 : real(dp) :: bcymin(ion_num_logQs) ! bc data vs. x at y=ymin
418 : integer :: ibcymax ! bc flag for y=ymax
419 3894 : real(dp) :: bcymax(ion_num_logQs) ! bc data vs. x at y=ymax
420 : integer :: ili_logQs ! =1: logRho grid is "nearly" equally spaced
421 : integer :: ili_logTs ! =1: logT grid is "nearly" equally spaced
422 : integer :: ier ! =0 on exit if there is no error.
423 : real(dp) :: logQ, Rho, logRho, T, P, Cv, chiRho, chiT, logT, logT0, logT1, logQ0, logQ1
424 : real(dp) :: gamma3, gamma1, grad_ad, Prad, E, S
425 : integer :: iQ, jtemp, ilogT, ilogQ
426 : real(dp) :: fval(num_ion_vals), df_dx(num_ion_vals), df_dy(num_ion_vals)
427 :
428 : integer :: v, vlist(3), var, i, j
429 : character (len=256) :: message
430 :
431 22 : allocate(f1_ary(sz_per_ion_point*ion_num_logQs*ion_num_logTs))
432 :
433 22 : f1 => f1_ary
434 : f(1:sz_per_ion_point,1:ion_num_logQs,1:ion_num_logTs) => &
435 22 : f1_ary(1:sz_per_ion_point*ion_num_logQs*ion_num_logTs)
436 :
437 22 : info = 0
438 :
439 3872 : do iQ = 1, ion_num_logQs
440 3872 : logQs(iQ) = ion_logQ_min + (iQ-1) * ion_del_logQ
441 : end do
442 :
443 2266 : do jtemp = 1, ion_num_logTs
444 2266 : logTs(jtemp) = ion_logT_min + (jtemp-1) * ion_del_logT
445 : end do
446 :
447 : ! just use "not a knot" bc's at edges of tables
448 2266 : ibcxmin = 0; bcxmin(:) = 0
449 2266 : ibcxmax = 0; bcxmax(:) = 0
450 3872 : ibcymin = 0; bcymin(:) = 0
451 3872 : ibcymax = 0; bcymax(:) = 0
452 :
453 : ! create tables for bicubic spline interpolation
454 638 : do v = 1, num_ion_vals
455 :
456 11059048 : f(1,:,:) = tbl(1,v,:,:)
457 : call interp_mkbicub_db(&
458 : logQs,ion_num_logQs,logTs,ion_num_logTs,f1,ion_num_logQs,&
459 : ibcxmin,bcxmin,ibcxmax,bcxmax,&
460 : ibcymin,bcymin,ibcymax,bcymax,&
461 616 : ili_logQs,ili_logTs,ier)
462 616 : if (ier /= 0) then
463 0 : write(*,*) 'Make_ion_Interpolation_Data error happened for ion_value', v
464 0 : info = 3
465 0 : return
466 : end if
467 44045870 : tbl(2:4,v,:,:) = f(2:4,:,:)
468 :
469 : end do
470 :
471 44 : end subroutine Make_ion_Interpolation_Data
472 :
473 :
474 44 : subroutine Read_ion_Cache(X, Z, tbl, cache_filename, ios)
475 : real(dp), intent(in) :: X, Z
476 : real(dp) :: tbl(sz_per_ion_point, num_ion_vals, ion_num_logQs, ion_num_logTs)
477 : character (*), intent(in) :: cache_filename
478 : integer, intent(out) :: ios
479 :
480 : integer :: io_unit ! use this for file access
481 :
482 44 : real(dp) :: X_in, Z_in, logT_min_in, logT_max_in, del_logT_in, &
483 44 : logQ_min_in, logQ_max_in, del_logQ_in
484 : integer :: num_logQs_in, num_logTs_in, version_in
485 : real(dp), parameter :: tiny = 1d-6
486 :
487 44 : ios = 0
488 : open(newunit=io_unit,file=trim(cache_filename),action='read',&
489 44 : status='old',iostat=ios,form='unformatted')
490 44 : if (ios /= 0) return
491 :
492 : read(io_unit, iostat=ios) &
493 22 : X_in, Z_in, num_logTs_in, logT_min_in, logT_max_in, del_logT_in, &
494 44 : num_logQs_in, logQ_min_in, logQ_max_in, del_logQ_in, version_in
495 22 : if (ios /= 0) return
496 :
497 22 : if (ion_version /= version_in) then
498 0 : ios = 1
499 0 : write(*,*) 'read cache failed for version_in'
500 : end if
501 22 : if (ion_num_logQs /= num_logQs_in) then
502 0 : ios = 1
503 0 : write(*,*) 'read cache failed for ion_num_logQs'
504 : end if
505 22 : if (ion_num_logTs /= num_logTs_in) then
506 0 : ios = 1
507 0 : write(*,*) 'read cache failed for ion_num_logTs'
508 : end if
509 22 : if (abs(X-X_in) > tiny) then
510 0 : ios = 1
511 0 : write(*,*) 'read cache failed for X_in'
512 : end if
513 22 : if (abs(Z-Z_in) > tiny) then
514 0 : ios = 1
515 0 : write(*,*) 'read cache failed for Z_in'
516 : end if
517 22 : if (abs(ion_logT_min-logT_min_in) > tiny) then
518 0 : ios = 1
519 0 : write(*,*) 'read cache failed for ion_logT_min'
520 : end if
521 22 : if (abs(ion_logT_max-logT_max_in) > tiny) then
522 0 : ios = 1
523 0 : write(*,*) 'read cache failed for ion_logT_max'
524 : end if
525 22 : if (abs(ion_del_logT-del_logT_in) > tiny) then
526 0 : ios = 1
527 0 : write(*,*) 'read cache failed for ion_del_logT'
528 : end if
529 22 : if (abs(ion_logQ_min-logQ_min_in) > tiny) then
530 0 : ios = 1
531 0 : write(*,*) 'read cache failed for ion_logQ_min'
532 : end if
533 22 : if (abs(ion_logQ_max-logQ_max_in) > tiny) then
534 0 : ios = 1
535 0 : write(*,*) 'read cache failed for ion_logQ_max'
536 : end if
537 22 : if (abs(ion_del_logQ-del_logQ_in) > tiny) then
538 0 : ios = 1
539 0 : write(*,*) 'read cache failed for ion_del_logQ'
540 : end if
541 :
542 22 : if (ios /= 0) then
543 0 : close(io_unit); return
544 : end if
545 :
546 : read(io_unit, iostat=ios) tbl(1:sz_per_ion_point, &
547 22 : 1:num_ion_vals, 1:ion_num_logQs, 1:ion_num_logTs)
548 22 : if (ios /= 0) then
549 0 : close(io_unit); return
550 : end if
551 :
552 22 : close(io_unit)
553 :
554 : end subroutine Read_ion_Cache
555 :
556 : end module ion_tables_load
|
