From 2358c0591db50330e873ab2142dea51a4dc16874 Mon Sep 17 00:00:00 2001 From: Andrew Benson Date: Wed, 13 Sep 2023 20:32:12 +0000 Subject: [PATCH] fix: Add missing modifications to the `nodePropertyExtractorList` class to support multiple lists --- ...rty_extractor.galaxy_major_merger_time.F90 | 67 ++++++++++++------- source/nodes.property_extractor.list.F90 | 52 ++++++++------ source/nodes.property_extractor.multi.F90 | 39 ++++++----- 3 files changed, 100 insertions(+), 58 deletions(-) diff --git a/source/nodes.property_extractor.galaxy_major_merger_time.F90 b/source/nodes.property_extractor.galaxy_major_merger_time.F90 index 725cacb4ef..5a6ae838af 100644 --- a/source/nodes.property_extractor.galaxy_major_merger_time.F90 +++ b/source/nodes.property_extractor.galaxy_major_merger_time.F90 @@ -31,10 +31,11 @@ private integer :: galaxyMajorMergerTimeID contains - procedure :: extract => galaxyMajorMergerTimeExtract - procedure :: name => galaxyMajorMergerTimeName - procedure :: description => galaxyMajorMergerTimeDescription - procedure :: unitsInSI => galaxyMajorMergerTimeUnitsInSI + procedure :: elementCount => galaxyMajorMergerTimeElementCount + procedure :: extract => galaxyMajorMergerTimeExtract + procedure :: names => galaxyMajorMergerTimeNames + procedure :: descriptions => galaxyMajorMergerTimeDescriptions + procedure :: unitsInSI => galaxyMajorMergerTimeUnitsInSI end type nodePropertyExtractorGalaxyMajorMergerTime interface nodePropertyExtractorGalaxyMajorMergerTime @@ -76,59 +77,77 @@ function galaxyMajorMergerTimeConstructorInternal() result(self) return end function galaxyMajorMergerTimeConstructorInternal + integer function galaxyMajorMergerTimeElementCount(self) + !!{ + Return a count of the number of properties extracted. + !!} + implicit none + class(nodePropertyExtractorGalaxyMajorMergerTime), intent(inout) :: self + + galaxyMajorMergerTimeElementCount=1 + return + end function galaxyMajorMergerTimeElementCount + function galaxyMajorMergerTimeExtract(self,node,instance) result(timeMajorMergers) !!{ Implement a galaxyMajorMergerTime output extractor. !!} use :: Galacticus_Nodes, only : nodeComponentBasic implicit none - double precision , dimension(:) , allocatable :: timeMajorMergers - class (nodePropertyExtractorGalaxyMajorMergerTime), intent(inout) :: self - type (treeNode ), intent(inout) :: node - type (multiCounter ), intent(inout), optional :: instance - class (nodeComponentBasic ) , pointer :: basic + double precision , dimension(:,:), allocatable :: timeMajorMergers + class (nodePropertyExtractorGalaxyMajorMergerTime), intent(inout) :: self + type (treeNode ), intent(inout) :: node + type (multiCounter ), intent(inout) , optional :: instance + class (nodeComponentBasic ) , pointer :: basic + double precision , dimension(: ), allocatable :: times !$GLC attributes unused :: instance - basic => node %basic ( ) - timeMajorMergers = basic%floatRank1MetaPropertyGet(self%galaxyMajorMergerTimeID) + basic => node %basic ( ) + times = basic%floatRank1MetaPropertyGet(self%galaxyMajorMergerTimeID) + allocate(timeMajorMergers(size(times),1)) + timeMajorMergers(:,1)=times return end function galaxyMajorMergerTimeExtract - function galaxyMajorMergerTimeName(self) + subroutine galaxyMajorMergerTimeNames(self,names) !!{ Return the names of the {\normalfont \ttfamily galaxyMajorMergerTime} properties. !!} implicit none - type (varying_string ) :: galaxyMajorMergerTimeName - class(nodePropertyExtractorGalaxyMajorMergerTime), intent(inout) :: self + class(nodePropertyExtractorGalaxyMajorMergerTime), intent(inout) :: self + type (varying_string ), intent(inout), dimension(:) , allocatable :: names !$GLC attributes unused :: self - galaxyMajorMergerTimeName=var_str('galaxyMajorMergerTime') + allocate(names(1)) + names(1)=var_str('galaxyMajorMergerTime') return - end function galaxyMajorMergerTimeName + end subroutine galaxyMajorMergerTimeNames - function galaxyMajorMergerTimeDescription(self) + subroutine galaxyMajorMergerTimeDescriptions(self,descriptions) !!{ Return the descriptions of the {\normalfont \ttfamily galaxyMajorMergerTime} properties. !!} implicit none - type (varying_string ) :: galaxyMajorMergerTimeDescription - class(nodePropertyExtractorGalaxyMajorMergerTime), intent(inout) :: self + class(nodePropertyExtractorGalaxyMajorMergerTime), intent(inout) :: self + type (varying_string ), intent(inout), dimension(:) , allocatable :: descriptions !$GLC attributes unused :: self - galaxyMajorMergerTimeDescription=var_str('Time of the last galaxy major merger.') + allocate(descriptions(1)) + descriptions(1)=var_str('Time of the last galaxy major merger.') return - end function galaxyMajorMergerTimeDescription + end subroutine galaxyMajorMergerTimeDescriptions - double precision function galaxyMajorMergerTimeUnitsInSI(self) + function galaxyMajorMergerTimeUnitsInSI(self) result(unitsInSI) !!{ Return the units of the {\normalfont \ttfamily galaxyMajorMergerTime} properties in the SI system. !!} use :: Numerical_Constants_Astronomical, only : gigaYear implicit none - class(nodePropertyExtractorGalaxyMajorMergerTime), intent(inout) :: self + double precision , dimension(:) , allocatable :: unitsInSI + class (nodePropertyExtractorGalaxyMajorMergerTime), intent(inout) :: self !$GLC attributes unused :: self - galaxyMajorMergerTimeUnitsInSI=gigaYear + allocate(unitsInSI(1)) + unitsInSI(1)=gigaYear return end function galaxyMajorMergerTimeUnitsInSI diff --git a/source/nodes.property_extractor.list.F90 b/source/nodes.property_extractor.list.F90 index 0edacc8ff2..37e166b9f1 100644 --- a/source/nodes.property_extractor.list.F90 +++ b/source/nodes.property_extractor.list.F90 @@ -32,6 +32,7 @@ contains !![ + @@ -39,55 +40,68 @@ !!] - procedure(listExtract ), deferred :: extract - procedure(listName ), deferred :: name - procedure(listDescription), deferred :: description - procedure(listUnitsInSI ), deferred :: unitsInSI - procedure :: metaData => listMetaData + procedure(listElementCount), deferred :: elementCount + procedure(listExtract ), deferred :: extract + procedure(listNames ), deferred :: names + procedure(listDescriptions), deferred :: descriptions + procedure(listUnitsInSI ), deferred :: unitsInSI + procedure :: metaData => listMetaData end type nodePropertyExtractorList + abstract interface + function listElementCount(self) + !!{ + Interface for list property count. + !!} + import nodePropertyExtractorList + integer :: listElementCount + class (nodePropertyExtractorList), intent(inout) :: self + end function listElementCount + end interface + abstract interface function listExtract(self,node,instance) !!{ Interface for list property extraction. !!} import nodePropertyExtractorList, treeNode, multiCounter - double precision , dimension(:) , allocatable :: listExtract - class (nodePropertyExtractorList), intent(inout) :: self - type (treeNode ), intent(inout) :: node - type (multiCounter ), intent(inout), optional :: instance + double precision , dimension(:,:), allocatable :: listExtract + class (nodePropertyExtractorList), intent(inout) :: self + type (treeNode ), intent(inout) :: node + type (multiCounter ), intent(inout) , optional :: instance end function listExtract end interface abstract interface - function listName(self) + subroutine listNames(self,names) !!{ Interface for list names. !!} import varying_string, nodePropertyExtractorList - type (varying_string ) :: listName - class(nodePropertyExtractorList), intent(inout) :: self - end function listName + class(nodePropertyExtractorList), intent(inout) :: self + type (varying_string ), intent(inout), dimension(:) , allocatable :: names + end subroutine listNames end interface abstract interface - function listDescription(self) + subroutine listDescriptions(self,descriptions) !!{ Interface for list descriptions. !!} import varying_string, nodePropertyExtractorList - type (varying_string ) :: listDescription - class(nodePropertyExtractorList), intent(inout) :: self - end function listDescription + class(nodePropertyExtractorList), intent(inout) :: self + type (varying_string ), intent(inout), dimension(:) , allocatable :: descriptions + end subroutine listDescriptions end interface abstract interface - double precision function listUnitsInSI(self) + function listUnitsInSI(self) !!{ Interface for list property units. !!} import nodePropertyExtractorList - class (nodePropertyExtractorList), intent(inout) :: self + double precision , dimension(:) , allocatable :: listUnitsInSI + class (nodePropertyExtractorList), intent(inout) :: self end function listUnitsInSI end interface diff --git a/source/nodes.property_extractor.multi.F90 b/source/nodes.property_extractor.multi.F90 index 56129e3c83..c3a3c95df9 100644 --- a/source/nodes.property_extractor.multi.F90 +++ b/source/nodes.property_extractor.multi.F90 @@ -187,7 +187,7 @@ integer function multiElementCount(self,elementType,time) class is (nodePropertyExtractorArray ) if (elementType == elementTypeDouble ) multiElementCount=multiElementCount+extractor_%elementCount(time) class is (nodePropertyExtractorList ) - if (elementType == elementTypeDouble ) multiElementCount=multiElementCount+1 + if (elementType == elementTypeDouble ) multiElementCount=multiElementCount+extractor_%elementCount( ) class default call Error_Report('unsupported property extractor type'//{introspection:location}) end select @@ -242,11 +242,13 @@ function multiExtractDouble(self,node,time,instance,ranks) end do deallocate(rank1) class is (nodePropertyExtractorList ) - elementCount=1 - rank0=extractor_%extract(node ,instance) - multiExtractDouble(offset+1)=polyRankDouble(rank0(:)) - deallocate(rank0) - if (present(ranks)) ranks(offset+1)=-1 + elementCount=extractor_%elementCount() + rank1=extractor_%extract(node ,instance) + do i=1,elementCount + multiExtractDouble(offset+i)=polyRankDouble(rank1(:,i)) + if (present(ranks)) ranks(offset+i)=-1 + end do + deallocate(rank1) class is (nodePropertyExtractorIntegerScalar) elementCount=0 class is (nodePropertyExtractorIntegerTuple ) @@ -388,8 +390,12 @@ subroutine multiNames(self,elementType,time,names) end if class is (nodePropertyExtractorList ) if (elementType == elementTypeDouble ) then - elementCount =1 - names (offset+1:offset+elementCount)=extractor_%name ( ) + elementCount=extractor_%elementCount() + if (elementCount > 0) then + call extractor_%names(namesTmp ) + names(offset+1:offset+elementCount)=namesTmp + deallocate(namesTmp) + end if end if class default call Error_Report('unsupported property extractor type'//{introspection:location}) @@ -461,7 +467,7 @@ subroutine multiColumnDescriptions(self,elementType,i,time,descriptions) end if class is (nodePropertyExtractorList ) if (elementType == elementTypeDouble ) then - elementCount=1 + elementCount=extractor_%elementCount() if (offset+elementCount >= i) then allocate(descriptions(0)) return @@ -535,8 +541,12 @@ subroutine multiDescriptions(self,elementType,time,descriptions) end if class is (nodePropertyExtractorList ) if (elementType == elementTypeDouble ) then - elementCount=1 - descriptions (offset+1:offset+elementCount)=extractor_%description ( ) + elementCount=extractor_%elementCount() + if (elementCount > 0) then + call extractor_%descriptions(descriptionsTmp) + descriptions(offset+1:offset+elementCount)=descriptionsTmp + deallocate(descriptionsTmp) + end if end if class default call Error_Report('unsupported property extractor type'//{introspection:location}) @@ -593,7 +603,7 @@ function multiUnitsInSI(self,elementType,time) end if class is (nodePropertyExtractorList ) if (elementType == elementTypeDouble ) then - elementCount=1 + elementCount=extractor_%elementCount() multiUnitsInSI(offset+1:offset+elementCount)=extractor_%unitsInSI( ) end if class default @@ -651,7 +661,7 @@ function multiRanks(self,elementType,time) end if class is (nodePropertyExtractorList ) if (elementType == elementTypeDouble ) then - elementCount=1 + elementCount=extractor_%elementCount() multiRanks(offset+1:offset+elementCount)=-1 end if class default @@ -663,7 +673,6 @@ function multiRanks(self,elementType,time) return end function multiRanks - subroutine multiMetaData(self,elementType,time,iProperty,metaData) !!{ Populate multiple property meta-data. @@ -710,7 +719,7 @@ subroutine multiMetaData(self,elementType,time,iProperty,metaData) end if class is (nodePropertyExtractorList ) if (elementType == elementTypeDouble ) then - elementCount=1 + elementCount=extractor_%elementCount() if (offset+1 <= iProperty .and. offset+elementCount >= iProperty) call extractor_%metaData( metaData) end if class default