Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
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
53 changes: 36 additions & 17 deletions src/core.F90
Original file line number Diff line number Diff line change
Expand Up @@ -86,23 +86,45 @@ module tuvx_core
end type core_t

interface core_t
module procedure constructor
module procedure constructor_file_path, constructor_config
end interface core_t

contains

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

function constructor( config, grids, profiles, radiators ) result( new_core )
! Constructor of TUV-x core objects
function constructor_file_path( config_file_path, grids, profiles, &
radiators ) result( new_core )
! Constructor of TUV-x core objects from a configuration file

use musica_string, only : string_t

type(string_t), intent(in) :: config_file_path ! Path to TUV-x configuration file
class(grid_warehouse_t), optional, intent(in) :: grids ! Set of grids to include in the configuration
class(profile_warehouse_t), optional, intent(in) :: profiles ! Set of profiles to include in the configuration
class(radiator_warehouse_t), optional, intent(in) :: radiators ! Set of radiators to include in the configuration
class(core_t), pointer :: new_core

type(config_t) :: config

call config%from_file( config_file_path%to_char() )
new_core => constructor_config( config, grids, profiles, radiators )

end function constructor_file_path

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

function constructor_config( config, grids, profiles, radiators ) &
result( new_core )
! Constructor of TUV-x core objects from a configuration object

use musica_assert, only : assert_msg
use musica_string, only : string_t
use tuvx_diagnostic_util, only : diagout
use tuvx_profile, only : profile_t
use tuvx_radiator_warehouse, only : radiator_warehouse_t

type(string_t), intent(in) :: config ! Full TUV-x configuration data
type(config_t), intent(in) :: config ! Full TUV-x configuration data
class(grid_warehouse_t), optional, intent(in) :: grids ! Set of grids to include in the configuration
class(profile_warehouse_t), optional, intent(in) :: profiles ! Set of profiles to include in the configuration
class(radiator_warehouse_t), optional, intent(in) :: radiators ! Set of radiators to include in the configuration
Expand All @@ -111,12 +133,10 @@ function constructor( config, grids, profiles, radiators ) result( new_core )
! Local variables
character(len=*), parameter :: Iam = 'Photolysis core constructor: '
logical :: found
type(config_t) :: core_config, child_config
type(config_t) :: child_config
class(profile_t), pointer :: aprofile
type(string_t) :: required_keys(4), optional_keys(3)

call core_config%from_file( config%to_char() )

! Check json configuration file for basic structure, integrity
required_keys(1) = "radiative transfer"
required_keys(2) = "grids"
Expand All @@ -126,22 +146,22 @@ function constructor( config, grids, profiles, radiators ) result( new_core )
optional_keys(2) = "dose rates"
optional_keys(3) = "enable diagnostics"
call assert_msg( 255400232, &
core_config%validate( required_keys, optional_keys ), &
config%validate( required_keys, optional_keys ), &
"Bad configuration data format for tuv-x core." )

! Instantiate photolysis core
allocate( new_core )

call core_config%get( 'enable diagnostics', new_core%enable_diagnostics_, &
call config%get( 'enable diagnostics', new_core%enable_diagnostics_, &
Iam, default=.false. )

! Instantiate and initialize grid warehouse
call core_config%get( "grids", child_config, Iam )
call config%get( "grids", child_config, Iam )
new_core%grid_warehouse_ => grid_warehouse_t( child_config )
if( present( grids ) ) call new_core%grid_warehouse_%add( grids )

! Instantiate and initialize profile warehouse
call core_config%get( "profiles", child_config, Iam )
call config%get( "profiles", child_config, Iam )
new_core%profile_warehouse_ => &
profile_warehouse_t( child_config, new_core%grid_warehouse_ )
if( present( profiles ) ) call new_core%profile_warehouse_%add( profiles )
Expand All @@ -166,16 +186,15 @@ function constructor( config, grids, profiles, radiators ) result( new_core )
end if

! Set up radiative transfer calculator
call core_config%get( "radiative transfer", child_config, Iam )
call config%get( "radiative transfer", child_config, Iam )
new_core%radiative_transfer_ => &
radiative_transfer_t( child_config, &
new_core%grid_warehouse_, &
new_core%profile_warehouse_, &
radiators )

! photolysis rate constants
call core_config%get( "photolysis", child_config, Iam, &
found = found )
call config%get( "photolysis", child_config, Iam, found = found )
if( found ) then
new_core%photolysis_rates_ => &
photolysis_rates_t( child_config, &
Expand All @@ -187,7 +206,7 @@ function constructor( config, grids, profiles, radiators ) result( new_core )
end if

! dose rates
call core_config%get( "dose rates", child_config, Iam, found = found )
call config%get( "dose rates", child_config, Iam, found = found )
if( found ) then
new_core%dose_rates_ => &
dose_rates_t( child_config, new_core%grid_warehouse_, &
Expand All @@ -199,13 +218,13 @@ function constructor( config, grids, profiles, radiators ) result( new_core )
spherical_geometry_t( new_core%grid_warehouse_ )

! instantiate and initialize lyman alpha, srb type
call core_config%get( "O2 absorption", child_config, Iam )
call config%get( "O2 absorption", child_config, Iam )
new_core%la_sr_bands_ => la_sr_bands_t( child_config, &
new_core%grid_warehouse_, &
new_core%profile_warehouse_ )


end function constructor
end function constructor_config

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Expand Down
32 changes: 16 additions & 16 deletions src/util/config.F90
Original file line number Diff line number Diff line change
Expand Up @@ -295,7 +295,7 @@ end subroutine construct_from_file
subroutine to_file( this, file_name )

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> File name to save configuration with
character(len=*), intent(in) :: file_name

Expand All @@ -316,7 +316,7 @@ function number_of_children( this )
!> Number of child objects
integer(kind=musica_ik) :: number_of_children
!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this

number_of_children = yaml_size_c( this%node_ )

Expand Down Expand Up @@ -356,7 +356,7 @@ function key( this, iterator )
!> Key name
type(string_t) :: key
!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Configuration iterator
class(iterator_t), intent(in) :: iterator

Expand All @@ -382,7 +382,7 @@ subroutine get_config( this, key, value, caller, default, found )
use musica_string, only : string_t

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand Down Expand Up @@ -418,7 +418,7 @@ subroutine get_string_string_default( this, key, value, caller, default, &
use musica_string, only : string_t

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand All @@ -444,7 +444,7 @@ subroutine get_string( this, key, value, caller, default, found )
use musica_string, only : string_t

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand Down Expand Up @@ -484,7 +484,7 @@ subroutine get_int( this, key, value, caller, default, found )
use musica_assert, only : die_msg

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand Down Expand Up @@ -519,7 +519,7 @@ subroutine get_float( this, key, value, caller, default, found )
use musica_assert, only : die_msg

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand Down Expand Up @@ -554,7 +554,7 @@ subroutine get_double( this, key, value, caller, default, found )
use musica_assert, only : die_msg

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand Down Expand Up @@ -589,7 +589,7 @@ subroutine get_logical( this, key, value, caller, default, found )
use musica_assert, only : die_msg

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand Down Expand Up @@ -625,7 +625,7 @@ subroutine get_string_array( this, key, value, caller, default, found )
use musica_string, only : string_t

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand Down Expand Up @@ -672,7 +672,7 @@ subroutine get_double_array( this, key, value, caller, default, found )
use musica_assert, only : assert, assert_msg

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand Down Expand Up @@ -717,7 +717,7 @@ subroutine get_config_array( this, key, value, caller, default, found )
use musica_assert, only : assert, assert_msg

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Key used to find value
character(len=*), intent(in) :: key
!> Returned value
Expand Down Expand Up @@ -762,7 +762,7 @@ subroutine get_from_iterator( this, iterator, value, caller )
use musica_string, only : string_t

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Iterator to use to find value
class(iterator_t), intent(in) :: iterator
!> Returned value
Expand Down Expand Up @@ -808,7 +808,7 @@ subroutine get_array_from_iterator( this, iterator, value, caller )
use musica_string, only : string_t

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Iterator to use to find value
class(iterator_t), intent(in) :: iterator
!> Returned value
Expand Down Expand Up @@ -1295,7 +1295,7 @@ logical function validate( this, required_keys, optional_keys )
use musica_string, only : string_t

!> Configuration
class(config_t), intent(inout) :: this
class(config_t), intent(in) :: this
!> Required keys
type(string_t), intent(in) :: required_keys(:)
!> Optional keys
Expand Down
Loading