diff --git a/CHANGELOG.md b/CHANGELOG.md index c1641916f7ee..5eb701d91678 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 13d32d223d0b..fe074f32874b 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -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__) @@ -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 @@ -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__) @@ -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') @@ -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 @@ -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 @@ -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__) @@ -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) @@ -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 diff --git a/shared/DSO_Utilities.F90 b/shared/DSO_Utilities.F90 index 1cd331d2a83c..7f720edaf7cf 100644 --- a/shared/DSO_Utilities.F90 +++ b/shared/DSO_Utilities.F90 @@ -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