Look for profile with given configuration in array profiles
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(profile_config_t), | intent(in), | allocatable | :: | profiles(:) |
Array of profiles |
|
character(len=:), | intent(in), | allocatable | :: | profile_name |
Name of profile |
|
character(len=:), | intent(in), | allocatable | :: | compiler |
Name of compiler |
|
integer, | intent(in) | :: | os_type |
Type of operating system (enum) |
||
logical, | intent(out) | :: | found_matching |
Boolean value containing true if matching profile was found |
||
type(profile_config_t), | intent(out) | :: | chosen_profile |
Last matching profile in the profiles array |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
character(len=:), | public, | allocatable | :: | curr_compiler | |||
integer, | public | :: | curr_os | ||||
integer, | public | :: | curr_priority | ||||
character(len=:), | public, | allocatable | :: | curr_profile_name | |||
integer, | public | :: | i | ||||
integer, | public | :: | priority |
subroutine find_profile(profiles, profile_name, compiler, os_type, found_matching, chosen_profile)
!> Array of profiles
type(profile_config_t), allocatable, intent(in) :: profiles(:)
!> Name of profile
character(:), allocatable, intent(in) :: profile_name
!> Name of compiler
character(:), allocatable, intent(in) :: compiler
!> Type of operating system (enum)
integer, intent(in) :: os_type
!> Boolean value containing true if matching profile was found
logical, intent(out) :: found_matching
!> Last matching profile in the profiles array
type(profile_config_t), intent(out) :: chosen_profile
character(:), allocatable :: curr_profile_name
character(:), allocatable :: curr_compiler
integer :: curr_os
integer :: i, priority, curr_priority
found_matching = .false.
if (size(profiles) < 1) return
! Try to find profile with matching OS type
do i=1,size(profiles)
curr_profile_name = profiles(i)%profile_name
curr_compiler = profiles(i)%compiler
curr_os = profiles(i)%os_type
if (curr_profile_name.eq.profile_name) then
if (curr_compiler.eq.compiler) then
if (curr_os.eq.os_type) then
chosen_profile = profiles(i)
found_matching = .true.
end if
end if
end if
end do
! Try to find profile with OS type 'all'
if (.not. found_matching) then
do i=1,size(profiles)
curr_profile_name = profiles(i)%profile_name
curr_compiler = profiles(i)%compiler
curr_os = profiles(i)%os_type
if (curr_profile_name.eq.profile_name) then
if (curr_compiler.eq.compiler) then
if (curr_os.eq.OS_ALL) then
chosen_profile = profiles(i)
found_matching = .true.
end if
end if
end if
end do
end if
end subroutine find_profile