Skip to content
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

change some associate block to fix GNU crash #1245

Merged
merged 2 commits into from
Dec 18, 2021
Merged

change some associate block to fix GNU crash #1245

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
ed5e31a
change some associate block to fix GNU crash
weiyuan-jiang Dec 18, 2021
01e5765
Update MAPL_Generic.F90
weiyuan-jiang Dec 18, 2021
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
2 changes: 2 additions & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0

### Fixed

- gfortran can not assoicate an allocated string. Such blocks are changed

### Added

### Changed
Expand Down
42 changes: 21 additions & 21 deletions generic/MAPL_Generic.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4600,7 +4600,7 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, &
I = META%get_num_children() + 1
AddChildFromMeta = I

call AddChild_preamble(meta, I, name, grid, configfile, parentgc, petlist, child_meta, __RC__)
call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=parentgc, petList=petlist, child_meta=child_meta, __RC__)
t_p => get_global_time_profiler()
call t_p%start(trim(NAME),__RC__)
call child_meta%t_profiler%start(__RC__)
Expand All @@ -4623,13 +4623,13 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, &

end function AddChildFromMeta

recursive subroutine AddChild_preamble(meta, I, name, grid, configfile, parent_gc, petlist, child_meta, unusable, rc)
recursive subroutine AddChild_preamble(meta, I, name, grid, configfile, parentGC, petlist, child_meta, unusable, rc)
type(MAPL_MetaComp), target, intent(INOUT) :: meta
integer, intent(in) :: I
character(*), intent(in) :: name
type(ESMF_Grid), optional, intent(INout) :: grid
character(len=*), optional, intent(IN ) :: configfile
type(ESMF_GridComp), optional, intent(IN ) :: parent_gc
type(ESMF_GridComp), optional, intent(IN ) :: parentGC
integer, optional , intent(IN ) :: petList(:)
type(MAPL_MetaComp), pointer :: child_meta
class(KeywordEnforcer), optional, intent(in) :: unusable
Expand All @@ -4649,7 +4649,7 @@ recursive subroutine AddChild_preamble(meta, I, name, grid, configfile, parent_g
type(ESMF_VM) :: vm
integer :: comm

call make_full_name(name, child_name, parent_gc, __RC__)
call make_full_name(name, child_name, parentGC, __RC__)
call grow_children_names(meta%GCNamelist, child_name, __RC__)

allocate(tmp_meta, __STAT__)
Expand Down Expand Up @@ -4706,9 +4706,9 @@ recursive subroutine AddChild_preamble(meta, I, name, grid, configfile, parent_g
end select

! put parentGC there
if (present(parent_gc)) then
if (present(parentGC)) then
allocate(child_meta%parentGC, __STAT__)
child_meta%parentGC = parent_gc
child_meta%parentGC = parentGC
end if

lgr => logging%get_logger('MAPL.GENERIC')
Expand All @@ -4725,10 +4725,10 @@ recursive subroutine AddChild_preamble(meta, I, name, grid, configfile, parent_g
_UNUSED_DUMMY(unusable)
contains

subroutine make_full_name(name, child_name, parent_gc, unusable, rc)
subroutine make_full_name(name, child_name, parentGC, unusable, rc)
character(*), intent(in) :: name
character(*), intent(out) :: child_name
type(ESMF_GridComp), optional, intent(in) :: parent_gc
type(ESMF_GridComp), optional, intent(in) :: parentGC
class(KeywordEnforcer), optional, intent(in) :: unusable
integer, optional, intent(out) :: rc

Expand All @@ -4739,8 +4739,8 @@ subroutine make_full_name(name, child_name, parent_gc, unusable, rc)
child_name = trim(name)
! Adjust with parent name if provided
if (index(name,":") == 0) then
if (present(parent_gc)) then
tmp_gc = parent_gc
if (present(parentGC)) then
tmp_gc = parentGC
call ESMF_GridCompGet(tmp_gc, name=pname, __RC__)
child_name = pname(1:index(pname,":"))//trim(name)
end if
Expand Down Expand Up @@ -4830,6 +4830,7 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb

class(Logger), pointer :: lgr
character(len=:), allocatable :: shared_object_library_to_load
character(len=6) :: extension

call MAPL_InternalStateRetrieve(gc, meta, __RC__)

Expand All @@ -4841,24 +4842,23 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb
I = meta%get_num_children() + 1
AddChildFromDSO = I

call AddChild_preamble(meta, I, name, grid, configfile, gc, petlist, child_meta, __RC__)
call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=gc, petList=petlist, child_meta=child_meta, __RC__)

t_p => get_global_time_profiler()
call t_p%start(trim(name),__RC__)
call child_meta%t_profiler%start(__RC__)
call child_meta%t_profiler%start('SetService',__RC__)

extension = get_file_extension(SharedObj)
_ASSERT(is_supported_dso_name(SharedObj), "AddChildFromDSO: Unsupported shared library extension '"//extension//",.")

associate (extension => get_file_extension(SharedObj))
_ASSERT(is_supported_dso_name(SharedObj), "AddChildFromDSO: Unsupported shared library extension '"//extension//",.")
if (.not. is_valid_dso_name(SharedObj)) then
lgr => logging%get_logger('MAPL.GENERIC')
call lgr%warning("AddChildFromDSO: changing shared library extension '%a~' to system specific extension '%a~'.", &
extension, SYSTEM_DSO_EXTENSION)
end if
end associate
if (.not. is_valid_dso_name(SharedObj)) then
lgr => logging%get_logger('MAPL.GENERIC')
call lgr%warning("AddChildFromDSO: changing shared library extension '%a~' to system specific extension '%a~'.", &
extension, SYSTEM_DSO_EXTENSION)
end if

shared_object_library_to_load = adjust_dso_name(sharedObj)

call ESMF_GridCompSetServices ( child_meta%gridcomp, userRoutine, &
sharedObj=shared_object_library_to_load,userRC=userRC,__RC__)
_VERIFY(userRC)
Expand Down Expand Up @@ -4889,7 +4889,7 @@ recursive integer function AddChildFromDSO_old(name, userRoutine, grid, ParentGC
integer :: status

_ASSERT(present(ParentGC),'must have a parent to use this interface')
addchildfromdso_old = addChildFromDSO(parentGC, name, userRoutine, grid, sharedObj, petList, configFile, __RC__)
addchildfromdso_old = addChildFromDSO(parentGC, name, userRoutine, grid=grid, sharedObj=sharedObj, petList=petList, configFile=configFile, __RC__)

_RETURN(ESMF_SUCCESS)
end function AddChildFromDSO_Old
Expand Down
4 changes: 1 addition & 3 deletions shared/DSO_Utilities.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,9 +50,7 @@ pure function adjust_dso_name(guess)
character(:), allocatable :: adjust_dso_name
character(*), intent(in) :: guess

associate (basename => get_file_basename(guess), extension => get_file_extension(guess))
adjust_dso_name = basename // SYSTEM_DSO_EXTENSION
end associate
adjust_dso_name = get_file_basename(guess) // SYSTEM_DSO_EXTENSION

end function adjust_dso_name

Expand Down