Skip to content

refactor inlist reading #970

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
VincentVanlaer wants to merge 1 commit into
base: main
Choose a base branch
from
Open

refactor inlist reading #970

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
137 changes: 34 additions & 103 deletions astero/public/astero_def.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -839,73 +839,39 @@ end subroutine realloc_integer2_modes


subroutine read_astero_search_controls(filename, ierr)
use utils_namelist, only: read_namelist, missing_namelist_error
character (len=*), intent(in) :: filename
integer, intent(out) :: ierr

! initialize controls to default values
include 'astero_search.defaults'
ierr = 0
call read1_astero_search_inlist(filename, 1, ierr)
end subroutine read_astero_search_controls

call read_namelist(filename, read_astero_search_file, "astero_search_controls", ierr, missing_namelist_error)
end subroutine read_astero_search_controls

recursive subroutine read1_astero_search_inlist(filename, level, ierr)
character (len=*), intent(in) :: filename
integer, intent(in) :: level
integer, intent(out) :: ierr
subroutine read_astero_search_file(unit, iostat, iomsg, extra_inlists, extra_inlists_mask)
use const_def, only: strlen, max_extra_inlists

logical, dimension(max_extra_inlists) :: read_extra
character (len=strlen) :: message
character (len=strlen), dimension(max_extra_inlists) :: extra
integer :: unit, i
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(len=strlen), intent(out) :: iomsg
character(len=strlen), dimension(max_extra_inlists), intent(out) :: extra_inlists
logical, dimension(max_extra_inlists), intent(out) :: extra_inlists_mask

if (level >= 10) then
write(*,*) 'ERROR: too many levels of nested extra star_job inlist files'
ierr = -1
return
end if
integer :: i

ierr = 0
unit=alloc_iounit(ierr)
if (ierr /= 0) return
read(unit, nml=astero_search_controls, iostat=iostat, iomsg=iomsg)

open(unit=unit, file=trim(filename), action='read', delim='quote', iostat=ierr)
if (ierr /= 0) then
write(*, *) 'Failed to open astero search inlist file ', trim(filename)
else
read(unit, nml=astero_search_controls, iostat=ierr)
close(unit)
if (ierr /= 0) then
write(*, *) &
'Failed while trying to read astero search inlist file ', trim(filename)
write(*, '(a)') trim(message)
write(*, '(a)') &
'The following runtime error message might help you find the problem'
write(*, *)
open(unit=unit, file=trim(filename), &
action='read', delim='quote', status='old', iostat=ierr)
read(unit, nml=astero_search_controls)
close(unit)
end if
if (iostat /= 0) then
return
end if
call free_iounit(unit)
if (ierr /= 0) return

! recursive calls to read other inlists
do i=1, max_extra_inlists
read_extra(i) = read_extra_astero_search_inlist(i)
read_extra_astero_search_inlist(i) = .false.
extra(i) = extra_astero_search_inlist_name(i)
extra_astero_search_inlist_name(i) = 'undefined'

if (read_extra(i)) then
call read1_astero_search_inlist(extra(i), level+1, ierr)
if (ierr /= 0) return
end if
extra_inlists(i) = extra_astero_search_inlist_name(i)
extra_inlists_mask(i) = read_extra_astero_search_inlist(i)
end do


end subroutine read1_astero_search_inlist

end subroutine read_astero_search_file

subroutine write_astero_search_controls(filename_in, ierr)
use utils_lib
Expand Down Expand Up @@ -938,75 +904,40 @@ subroutine write_astero_search_controls(filename_in, ierr)

end subroutine write_astero_search_controls


subroutine read_astero_pgstar_controls(filename, ierr)
use utils_namelist, only: read_namelist, missing_namelist_error
character (len=*), intent(in) :: filename
integer, intent(out) :: ierr

! initialize controls to default values
include 'astero_pgstar.defaults'

ierr = 0
call read1_astero_pgstar_inlist(filename, 1, ierr)

call read_namelist(filename, read_astero_pgstar_file, "astero_pgstar_controls", ierr, missing_namelist_error)
end subroutine read_astero_pgstar_controls

subroutine read_astero_pgstar_file(unit, iostat, iomsg, extra_inlists, extra_inlists_mask)
use const_def, only: strlen, max_extra_inlists

recursive subroutine read1_astero_pgstar_inlist(filename, level, ierr)
character (len=*), intent(in) :: filename
integer, intent(in) :: level
integer, intent(out) :: ierr
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(len=strlen), intent(out) :: iomsg
character(len=strlen), dimension(max_extra_inlists), intent(out) :: extra_inlists
logical, dimension(max_extra_inlists), intent(out) :: extra_inlists_mask

logical, dimension(max_extra_inlists) :: read_extra
character (len=strlen), dimension(max_extra_inlists) :: extra
integer :: unit, i
integer :: i

if (level >= 10) then
write(*,*) 'ERROR: too many levels of nested extra star_job inlist files'
ierr = -1
return
end if
read(unit, nml=astero_pgstar_controls, iostat=iostat, iomsg=iomsg)

ierr = 0
unit=alloc_iounit(ierr)
if (ierr /= 0) return

open(unit=unit, file=trim(filename), action='read', delim='quote', iostat=ierr)
if (ierr /= 0) then
write(*, *) 'Failed to open astero pgstar inlist file ', trim(filename)
else
read(unit, nml=astero_pgstar_controls, iostat=ierr)
close(unit)
if (ierr /= 0) then
write(*, *) &
'Failed while trying to read astero pgstar inlist file ', trim(filename)
write(*, '(a)') &
'The following runtime error message might help you find the problem'
write(*, *)
open(unit=unit, file=trim(filename), &
action='read', delim='quote', status='old', iostat=ierr)
read(unit, nml=astero_pgstar_controls)
close(unit)
end if
if (iostat /= 0) then
return
end if
call free_iounit(unit)
if (ierr /= 0) return

! recursive calls to read other inlists
do i=1, max_extra_inlists
read_extra(i) = read_extra_astero_pgstar_inlist(i)
read_extra_astero_pgstar_inlist(i) = .false.
extra(i) = extra_astero_pgstar_inlist_name(i)
extra_astero_pgstar_inlist_name(i) = 'undefined'

if (read_extra(i)) then
call read1_astero_pgstar_inlist(extra(i), level+1, ierr)
if (ierr /= 0) return
end if
extra_inlists(i) = extra_astero_pgstar_inlist_name(i)
extra_inlists_mask(i) = read_extra_astero_pgstar_inlist(i)
end do

end subroutine read1_astero_pgstar_inlist

end subroutine read_astero_pgstar_file

subroutine save_sample_results_to_file(i_total, results_fname, ierr)
use utils_lib
Expand Down
79 changes: 21 additions & 58 deletions binary/private/binary_ctrls_io.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -259,88 +259,51 @@ end subroutine do_one_binary_setup


subroutine read_binary_controls(b, filename, ierr)
use utils_lib
use utils_namelist, only: read_namelist, missing_namelist_error
type (binary_info), pointer :: b
character(*), intent(in) :: filename
integer, intent(out) :: ierr

call read_binary_controls_file(b, filename, 1, ierr)
call read_namelist(filename, read_binary_controls_file, "binary_controls", ierr, missing_namelist_error)

if (ierr /= 0) return

call store_binary_controls(b)

end subroutine read_binary_controls

subroutine read_binary_controls_file(unit, iostat, iomsg, extra_inlists, extra_inlists_mask)
use const_def, only: strlen, max_extra_inlists

recursive subroutine read_binary_controls_file(b, filename, level, ierr)
use utils_lib
character(*), intent(in) :: filename
type (binary_info), pointer :: b
integer, intent(in) :: level
integer, intent(out) :: ierr
logical, dimension(max_extra_inlists) :: read_extra
character (len=strlen), dimension(max_extra_inlists) :: extra
integer :: unit, i
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(len=strlen), intent(out) :: iomsg
character(len=strlen), dimension(max_extra_inlists), intent(out) :: extra_inlists
logical, dimension(max_extra_inlists), intent(out) :: extra_inlists_mask

ierr = 0
integer :: i

if (level >= 10) then
write(*,*) 'ERROR: too many levels of nested extra binary controls inlist files'
ierr = -1
return
end if
read(unit, nml=binary_controls, iostat=iostat, iomsg=iomsg)

if (len_trim(filename) > 0) then
open(newunit=unit, file=trim(filename), action='read', delim='quote', status='old', iostat=ierr)
if (ierr /= 0) then
write(*, *) 'Failed to open binary control namelist file ', trim(filename)
return
end if
read(unit, nml=binary_controls, iostat=ierr)
close(unit)
if (ierr /= 0) then
write(*, *)
write(*, *)
write(*, *)
write(*, *)
write(*, '(a)') &
'Failed while trying to read binary control namelist file: ' // trim(filename)
write(*, '(a)') &
'Perhaps the following runtime error message will help you find the problem.'
write(*, *)
open(newunit=unit, file=trim(filename), action='read', delim='quote', status='old', iostat=ierr)
read(unit, nml=binary_controls)
close(unit)
return
end if
if (iostat /= 0) then
return
end if

call store_binary_controls(b, ierr)

! recursive calls to read other inlists
do i=1, max_extra_inlists
read_extra(i) = read_extra_binary_controls_inlist(i)
read_extra_binary_controls_inlist(i) = .false.
extra(i) = extra_binary_controls_inlist_name(i)
extra_binary_controls_inlist_name(i) = 'undefined'

if (read_extra(i)) then
call read_binary_controls_file(b, extra(i), level+1, ierr)
if (ierr /= 0) return
end if
extra_inlists(i) = extra_binary_controls_inlist_name(i)
extra_inlists_mask(i) = read_extra_binary_controls_inlist(i)
end do

end subroutine read_binary_controls_file


subroutine set_default_binary_controls
include 'binary_controls.defaults'
end subroutine set_default_binary_controls


subroutine store_binary_controls(b, ierr)
subroutine store_binary_controls(b)
use utils_lib, only: mkdir
type (binary_info), pointer :: b
integer, intent(out) :: ierr

ierr = 0

! specifications for starting model
b% m1 = m1
Expand Down Expand Up @@ -812,7 +775,7 @@ subroutine set_binary_control(b, name, val, ierr)
read(tmp, nml=binary_controls)

! Add to star
call store_binary_controls(b, ierr)
call store_binary_controls(b)
if(ierr/=0) return

end subroutine set_binary_control
Expand Down
Loading
Loading