From 4260c63e9a78c251427943683fd5233e95959e31 Mon Sep 17 00:00:00 2001 From: Andrew Benson Date: Mon, 18 Sep 2023 19:08:41 +0000 Subject: [PATCH 1/3] fix: Remove doubled parentheses --- .../Build/Components/Implementations/Serialization.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/perl/Galacticus/Build/Components/Implementations/Serialization.pm b/perl/Galacticus/Build/Components/Implementations/Serialization.pm index ba2de376ba..0966bc2438 100644 --- a/perl/Galacticus/Build/Components/Implementations/Serialization.pm +++ b/perl/Galacticus/Build/Components/Implementations/Serialization.pm @@ -160,7 +160,7 @@ CODE if ( $metaPropertyType->{'rank'} == 0 ) { $function->{'content'} .= fill_in_string(<<'CODE', PACKAGE => 'code'); if (allocated({$class->{'name'}.$prefix}MetaPropertyNames)) then - do i=1,size(({$class->{'name'}.$prefix}MetaPropertyNames)) + do i=1,size({$class->{'name'}.$prefix}MetaPropertyNames) write (label,{$format}) self%{$prefix}MetaProperties(i) message=trim({$class->{'name'}.$prefix}MetaPropertyNames(i))//': '//repeat(' ',propertyNameLengthMax-len_trim({$class->{'name'}.$prefix}MetaPropertyNames(i)))//label call displayMessage(message) @@ -170,7 +170,7 @@ CODE } elsif ( $metaPropertyType->{'rank'} == 1 ) { $function->{'content'} .= fill_in_string(<<'CODE', PACKAGE => 'code'); if (allocated({$class->{'name'}.$prefix}MetaPropertyNames)) then - do i=1,size(({$class->{'name'}.$prefix}MetaPropertyNames)) + do i=1,size({$class->{'name'}.$prefix}MetaPropertyNames) do j=1,size( self%{$prefix}MetaProperties(i)%values) write (label,'(i3)') j message=trim({$class->{'name'}.$prefix}MetaPropertyNames(i))//': '//repeat(' ',propertyNameLengthMax-len_trim({$class->{'name'}.$prefix}MetaPropertyNames(i)))//trim(label) From 6f74f915893ee0e925167e26aa080f0dedee3d84 Mon Sep 17 00:00:00 2001 From: Andrew Benson Date: Mon, 18 Sep 2023 19:13:26 +0000 Subject: [PATCH 2/3] fix: Trap floating point overflows --- source/nodes.operators.physics.CGM.chemistry.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/source/nodes.operators.physics.CGM.chemistry.F90 b/source/nodes.operators.physics.CGM.chemistry.F90 index 7edfd09393..414a59dca0 100644 --- a/source/nodes.operators.physics.CGM.chemistry.F90 +++ b/source/nodes.operators.physics.CGM.chemistry.F90 @@ -461,13 +461,15 @@ subroutine cgmChemistryComputeState(self,node,temperature,chemicalDensities,mass ! Truncate masses to zero to avoid unphysical behavior. call chemicalMasses%enforcePositive() massChemicals=chemicalMasses%sumOver() - if ( & - & massChemicals > 0.0d0 & - & .and. & - & massChemicals > hotHalo%mass() & - & ) call chemicalMasses%scale( & - & +hotHalo%mass () & - & / massChemicals & + if ( & + & massChemicals > 0.0d0 & + & .and. & + & massChemicals > hotHalo%mass() & + & .and. & + & -exponent(massChemicals)+exponent(hotHalo%mass()) < maxExponent(0.0d0) & + & ) call chemicalMasses%scale( & + & +hotHalo%mass () & + & / massChemicals & & ) ! Scale all chemical masses by their mass in atomic mass units to get a number density. call chemicalMasses%massToNumber(chemicalDensities) From 5d027ca6308fa5ec8e8d827d4f4bcdd74d1b62c9 Mon Sep 17 00:00:00 2001 From: Andrew Benson Date: Mon, 18 Sep 2023 19:14:33 +0000 Subject: [PATCH 3/3] feat(perf): Provide the `uniqueID` for `calculationReset` events This avoids each function called having to re-obtain the `uniqueID`. --- source/accretion.halo.Naoz_Barkana_2007.F90 | 17 +++++---- source/accretion.halo.cold_mode.F90 | 13 ++++--- .../cooling.cooling_radius.beta_profile.F90 | 15 +++++--- ...ling.cooling_radius.isothermal_profile.F90 | 15 +++++--- source/cooling.cooling_radius.simple.F90 | 15 +++++--- ...fic_angular_momentum.constant_rotation.F90 | 13 ++++--- ...os.mass_accretion_history.Wechsler2002.F90 | 12 +++--- ...r_halos.scales.virial_density_contrast.F90 | 19 ++++++---- .../dark_matter_profiles.SIDM.isothermal.F90 | 37 ++++++++++--------- source/dark_matter_profiles.accelerator.F90 | 13 ++++--- ...k_matter_profiles.adiabatic_Gnedin2004.F90 | 17 +++++---- source/dark_matter_profiles.generic.F90 | 15 +++++--- source/dark_matter_profiles.heating.tidal.F90 | 12 +++--- source/dark_matter_profiles_DMO.Burkert.F90 | 15 +++++--- source/dark_matter_profiles_DMO.NFW.F90 | 23 +++++++----- ...ark_matter_profiles_DMO.Penarrubia2010.F90 | 15 +++++--- .../dark_matter_profiles_DMO.SIDM.coreNFW.F90 | 13 ++++--- ...rk_matter_profiles_DMO.SIDM.isothermal.F90 | 37 ++++++++++--------- source/dark_matter_profiles_DMO.Zhao1996.F90 | 11 ++++-- .../dark_matter_profiles_DMO.accelerator.F90 | 12 +++--- ...ark_matter_profiles_DMO.accretion_flow.F90 | 11 ++++-- ..._matter_profiles_DMO.finite_resolution.F90 | 17 +++++---- ...ter_profiles_DMO.finite_resolution.NFW.F90 | 25 +++++++------ source/dark_matter_profiles_DMO.heated.F90 | 15 +++++--- ...k_matter_profiles_DMO.heated.monotonic.F90 | 15 +++++--- source/dark_matter_profiles_DMO.truncated.F90 | 21 ++++++----- ...ter_profiles_DMO.truncated.exponential.F90 | 21 ++++++----- source/galactic.structure.standard.F90 | 13 ++++--- ...incorporation.velocity_maximum_scaling.F90 | 13 ++++--- ..._trees.node_evolver.calculations_reset.F90 | 4 +- ...objects.nodes.components.disk.standard.F90 | 21 ++++++----- ...nodes.components.disk.very_simple.size.F90 | 9 +++-- ...cts.nodes.components.hot_halo.standard.F90 | 11 ++++-- ....nodes.components.hot_halo.very_simple.F90 | 8 ++-- ...lites.merging.mass_movements.Baugh2005.F90 | 15 +++++--- ...tellites.merging.mass_movements.simple.F90 | 15 +++++--- ...tes.merging.mass_movements.very_simple.F90 | 15 +++++--- ...ellites.merging.remnant_sizes.Cole2000.F90 | 15 +++++--- ...es.merging.remnant_sizes.Covington2008.F90 | 15 +++++--- ...llites.tidal_stripping.radius.King1962.F90 | 13 ++++--- ...n.rate_surface_density.disks.Blitz2006.F90 | 15 +++++--- ...urface_density.disks.Kennicutt-Schmidt.F90 | 13 ++++--- ...ate_surface_density.disks.Krumholz2009.F90 | 13 ++++--- ...surface_density.disks.extended_Schmidt.F90 | 15 +++++--- ...star_formation.timescales.halo_scaling.F90 | 13 ++++--- ...on.timescales.velocity_maximum_scaling.F90 | 13 ++++--- ...e_formation.cosmological_density_field.F90 | 10 +++-- ...ture_formation.halo_environment.normal.F90 | 9 +++-- ...sts.work_share.first_come_first_served.F90 | 12 +++--- 49 files changed, 441 insertions(+), 303 deletions(-) diff --git a/source/accretion.halo.Naoz_Barkana_2007.F90 b/source/accretion.halo.Naoz_Barkana_2007.F90 index 8b896b3216..236dd83a08 100644 --- a/source/accretion.halo.Naoz_Barkana_2007.F90 +++ b/source/accretion.halo.Naoz_Barkana_2007.F90 @@ -224,18 +224,21 @@ subroutine naozBarkana2007Destructor(self) return end subroutine naozBarkana2007Destructor - subroutine naozBarkana2007CalculationReset(self,node) + subroutine naozBarkana2007CalculationReset(self,node,uniqueID) !!{ Reset the accretion rate calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(accretionHaloNaozBarkana2007), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (accretionHaloNaozBarkana2007), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%filteredFractionComputed =.false. self%filteredFractionRateComputed=.false. self%rateCorrectionComputed =.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine naozBarkana2007CalculationReset @@ -282,7 +285,7 @@ double precision function naozBarkana2007FilteredFraction(self,node) double precision :: massFiltering, massHalo ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Evaluate the filtering mass suppression fitting formula as defined by Naoz & Barkana (2007; ! http://adsabs.harvard.edu/abs/2007MNRAS.377..667N). We use a halo mass in this formula defined in the same way (∆=200) as in ! the original work by Gnedin (2000; http://adsabs.harvard.edu/abs/2000ApJ...542..535G) based on the discussion of halo @@ -319,7 +322,7 @@ double precision function naozBarkana2007FilteredFractionRate(self,node) double precision :: massFiltering, massHalo ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Evaluate the rate of change of the filtering mass suppression fitting formula as defined by Naoz & Barkana (2007; ! http://adsabs.harvard.edu/abs/2007MNRAS.377..667N). We use a halo mass in this formula defined in the same way (∆=200) as in ! the original work by Gnedin (2000; http://adsabs.harvard.edu/abs/2000ApJ...542..535G) based on the discussion of halo @@ -393,7 +396,7 @@ double precision function naozBarkana2007RateCorrection(self,node) result(rateCo & growthRate ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) if (.not.self%rateCorrectionComputed) then hotHalo => node %hotHalo ( ) growthRate = +self %rateAdjust & diff --git a/source/accretion.halo.cold_mode.F90 b/source/accretion.halo.cold_mode.F90 index b04d08f770..30bdd77a2a 100644 --- a/source/accretion.halo.cold_mode.F90 +++ b/source/accretion.halo.cold_mode.F90 @@ -198,16 +198,19 @@ subroutine coldModeDestructor(self) return end subroutine coldModeDestructor - subroutine coldModeCalculationReset(self,node) + subroutine coldModeCalculationReset(self,node,uniqueID) !!{ Reset the accretion rate calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(accretionHaloColdMode), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (accretionHaloColdMode), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%coldFractionComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine coldModeCalculationReset @@ -472,7 +475,7 @@ double precision function coldModeColdModeFraction(self,node,accretionMode) coldModeColdModeFraction=1.0d0 case (accretionModeHot%ID,accretionModeCold%ID) ! Reset calculations if necessary. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Compute cold fraction if not already computed. if (.not.self%coldFractionComputed) then ! Get the basic component. diff --git a/source/cooling.cooling_radius.beta_profile.F90 b/source/cooling.cooling_radius.beta_profile.F90 index 980bdf85d3..18b69a190c 100644 --- a/source/cooling.cooling_radius.beta_profile.F90 +++ b/source/cooling.cooling_radius.beta_profile.F90 @@ -239,17 +239,20 @@ subroutine betaProfileDestructor(self) return end subroutine betaProfileDestructor - subroutine betaProfileCalculationReset(self,node) + subroutine betaProfileCalculationReset(self,node,uniqueID) !!{ Reset the cooling radius calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(coolingRadiusBetaProfile), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (coolingRadiusBetaProfile), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%radiusComputed =.false. self%radiusGrowthRateComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine betaProfileCalculationReset @@ -274,7 +277,7 @@ double precision function betaProfileRadiusGrowthRate(self,node) type (chemicalAbundances ) :: chemicalFractions, chemicalMasses ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if cooling radius growth rate is already computed. if (.not.self%radiusGrowthRateComputed) then @@ -352,7 +355,7 @@ double precision function betaProfileRadius(self,node) type (chemicalAbundances ) :: chemicalFractions, chemicalMasses ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if cooling radius is already computed. if (.not.self%radiusComputed) then ! Get the time available for cooling in node. diff --git a/source/cooling.cooling_radius.isothermal_profile.F90 b/source/cooling.cooling_radius.isothermal_profile.F90 index 77a5f6d97d..07632942a0 100644 --- a/source/cooling.cooling_radius.isothermal_profile.F90 +++ b/source/cooling.cooling_radius.isothermal_profile.F90 @@ -228,17 +228,20 @@ subroutine isothermalDestructor(self) return end subroutine isothermalDestructor - subroutine isothermalCalculationReset(self,node) + subroutine isothermalCalculationReset(self,node,uniqueID) !!{ Reset the cooling radius calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(coolingRadiusIsothermal), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (coolingRadiusIsothermal), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%radiusComputed =.false. self%radiusGrowthRateComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine isothermalCalculationReset @@ -252,7 +255,7 @@ double precision function isothermalRadiusGrowthRate(self,node) double precision :: radiusCooling, radiusVirial ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if cooling radius growth rate is already computed. if (.not.self%radiusGrowthRateComputed) then @@ -298,7 +301,7 @@ double precision function isothermalRadius(self,node) type (chemicalAbundances ) :: chemicalFractions, chemicalMasses ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if cooling radius is already computed. if (.not.self%radiusComputed) then ! Get the time available for cooling in node. diff --git a/source/cooling.cooling_radius.simple.F90 b/source/cooling.cooling_radius.simple.F90 index 46643d50db..8e977e8982 100644 --- a/source/cooling.cooling_radius.simple.F90 +++ b/source/cooling.cooling_radius.simple.F90 @@ -228,17 +228,20 @@ subroutine simpleDestructor(self) return end subroutine simpleDestructor - subroutine simpleCalculationReset(self,node) + subroutine simpleCalculationReset(self,node,uniqueID) !!{ Reset the cooling radius calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(coolingRadiusSimple), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (coolingRadiusSimple), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%radiusComputed =.false. self%radiusGrowthRateComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine simpleCalculationReset @@ -259,7 +262,7 @@ double precision function simpleRadiusGrowthRate(self,node) & temperature , temperatureLogSlope ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if cooling radius growth rate is already computed. if (.not.self%radiusGrowthRateComputed) then ! Flag that cooling radius is now computed. @@ -324,7 +327,7 @@ double precision function simpleRadius(self,node) & rootZero , rootOuter ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if cooling radius is already computed. if (.not.self%radiusComputed) then ! Flag that cooling radius is now computed. diff --git a/source/cooling.specific_angular_momentum.constant_rotation.F90 b/source/cooling.specific_angular_momentum.constant_rotation.F90 index 028e73c1f7..df751302af 100644 --- a/source/cooling.specific_angular_momentum.constant_rotation.F90 +++ b/source/cooling.specific_angular_momentum.constant_rotation.F90 @@ -218,7 +218,7 @@ double precision function constantRotationAngularMomentumSpecific(self,node,radi double precision :: angularMomentumSpecificMean, normalizationRotation ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if specific angular momentum of cooling gas is already computed. if (.not.self%angularMomentumSpecificComputed) then ! Flag that cooling radius is now computed. @@ -274,15 +274,18 @@ double precision function constantRotationAngularMomentumSpecific(self,node,radi return end function constantRotationAngularMomentumSpecific - subroutine constantRotationCalculationReset(self,node) + subroutine constantRotationCalculationReset(self,node,uniqueID) !!{ Reset the specific angular momentum of cooling gas calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(coolingSpecificAngularMomentumConstantRotation), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (coolingSpecificAngularMomentumConstantRotation), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%angularMomentumSpecificComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine constantRotationCalculationReset diff --git a/source/dark_matter_halos.mass_accretion_history.Wechsler2002.F90 b/source/dark_matter_halos.mass_accretion_history.Wechsler2002.F90 index 1030074a65..ca346a08ff 100644 --- a/source/dark_matter_halos.mass_accretion_history.Wechsler2002.F90 +++ b/source/dark_matter_halos.mass_accretion_history.Wechsler2002.F90 @@ -173,17 +173,19 @@ subroutine wechsler2002Destructor(self) return end subroutine wechsler2002Destructor - subroutine wechsler2002CalculationReset(self,node) + subroutine wechsler2002CalculationReset(self,node,uniqueID) !!{ Reset the cooling radius calculation. !!} implicit none - class(darkMatterHaloMassAccretionHistoryWechsler2002), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterHaloMassAccretionHistoryWechsler2002), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%timeFormationPrevious=-huge(0.0d0) self%massPrevious =-huge(0.0d0) - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine wechsler2002CalculationReset @@ -202,7 +204,7 @@ double precision function wechsler2002Time(self,node,mass) & mergerTreeFormationExpansionFactor ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Compute formation time if necessary. if (self%massPrevious /= mass) then basicBase => node%basic() diff --git a/source/dark_matter_halos.scales.virial_density_contrast.F90 b/source/dark_matter_halos.scales.virial_density_contrast.F90 index 1109fb28e9..8b83ae8004 100644 --- a/source/dark_matter_halos.scales.virial_density_contrast.F90 +++ b/source/dark_matter_halos.scales.virial_density_contrast.F90 @@ -192,19 +192,22 @@ subroutine virialDensityContrastDefinitionDestructor(self) return end subroutine virialDensityContrastDefinitionDestructor - subroutine virialDensityContrastDefinitionCalculationReset(self,node) + subroutine virialDensityContrastDefinitionCalculationReset(self,node,uniqueID) !!{ Reset the halo scales calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterHaloScaleVirialDensityContrastDefinition), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterHaloScaleVirialDensityContrastDefinition), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%radiusVirialComputed =.false. self%temperatureVirialComputed =.false. self%velocityVirialComputed =.false. self%timescaleDynamicalComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine virialDensityContrastDefinitionCalculationReset @@ -224,7 +227,7 @@ double precision function virialDensityContrastDefinitionDynamicalTimescale(self return end if ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if halo dynamical timescale is already computed. Compute and store if not. if (.not.self%timescaleDynamicalComputed) then self%timescaleDynamicalComputed= .true. @@ -254,7 +257,7 @@ double precision function virialDensityContrastDefinitionVirialVelocity(self,nod return end if ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if virial velocity is already computed. Compute and store if not. if (.not.self%velocityVirialComputed) then ! Get the basic component. @@ -317,7 +320,7 @@ double precision function virialDensityContrastDefinitionVirialTemperature(self, return end if ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if virial temperature is already computed. Compute and store if not. if (.not.self%temperatureVirialComputed) then self%temperatureVirialComputed=.true. @@ -347,7 +350,7 @@ double precision function virialDensityContrastDefinitionVirialRadius(self,node) return end if ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if virial radius is already computed. Compute and store if not. if (.not.self%radiusVirialComputed) then ! Get the basic component. diff --git a/source/dark_matter_profiles.SIDM.isothermal.F90 b/source/dark_matter_profiles.SIDM.isothermal.F90 index df18242514..0806fc89db 100644 --- a/source/dark_matter_profiles.SIDM.isothermal.F90 +++ b/source/dark_matter_profiles.SIDM.isothermal.F90 @@ -187,17 +187,20 @@ subroutine sidmIsothermalDestructor(self) return end subroutine sidmIsothermalDestructor - subroutine sidmIsothermalCalculationReset(self,node) + subroutine sidmIsothermalCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileSIDMIsothermal), intent(inout) :: self - type (treeNode ), intent(inout) :: node - - self%uniqueIDPrevious =node%uniqueID() - self%genericLastUniqueID =node%uniqueID() - self%uniqueIDPreviousSIDM =node%uniqueID() + class (darkMatterProfileSIDMIsothermal), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node + + self%uniqueIDPrevious =uniqueID + self%genericLastUniqueID =uniqueID + self%uniqueIDPreviousSIDM =uniqueID self%radiusInteractivePrevious =-1.0d0 self%velocityDispersionCentral =-1.0d0 self%genericEnclosedMassRadiusMinimum =+huge(0.0d0) @@ -378,8 +381,8 @@ double precision function sidmIsothermalDensity(self,node,radius) if (radius > self%radiusInteraction(node)) then sidmIsothermalDensity=self%darkMatterProfile_%density(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution(node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) sidmIsothermalDensity=self%densityProfile%interpolate(radius) end if return @@ -398,8 +401,8 @@ double precision function sidmIsothermalDensityLogSlope(self,node,radius) if (radius > self%radiusInteraction(node)) then sidmIsothermalDensityLogSlope=self%darkMatterProfile_%densityLogSlope(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution(node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) sidmIsothermalDensityLogSlope=self%densityProfile%derivative(radius)*radius/self%densityProfile%interpolate(radius) end if return @@ -418,8 +421,8 @@ double precision function sidmIsothermalEnclosedMass(self,node,radius) if (radius > self%radiusInteraction(node)) then sidmIsothermalEnclosedMass=self%darkMatterProfile_%enclosedMass(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution(node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) sidmIsothermalEnclosedMass=self%massProfile%interpolate(radius) end if return @@ -482,8 +485,8 @@ double precision function sidmIsothermalPotential(self,node,radius,status) if (radius > self%radiusInteraction(node)) then sidmIsothermalPotential=self%darkMatterProfile_%potential(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution(node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) sidmIsothermalPotential=self%darkMatterProfile_%potential(node,self%radiusInteraction(node))-self%velocityDispersionCentral**2*log(self%densityProfile%interpolate(radius)/self%densityProfile%interpolate(self%radiusInteraction(node))) end if return @@ -528,8 +531,8 @@ double precision function sidmIsothermalRadialVelocityDispersion(self,node,radiu if (radius > self%radiusInteraction(node)) then sidmIsothermalRadialVelocityDispersion=self%darkMatterProfile_%radialVelocityDispersion(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution(node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) sidmIsothermalRadialVelocityDispersion=self%velocityDispersionCentral end if return diff --git a/source/dark_matter_profiles.accelerator.F90 b/source/dark_matter_profiles.accelerator.F90 index 440ad2e179..b7bf5ddda0 100644 --- a/source/dark_matter_profiles.accelerator.F90 +++ b/source/dark_matter_profiles.accelerator.F90 @@ -162,21 +162,24 @@ subroutine acceleratorDestructor(self) return end subroutine acceleratorDestructor - subroutine acceleratorCalculationReset(self,node) + subroutine acceleratorCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none class (darkMatterProfileAccelerator), intent(inout) :: self type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID integer :: i + !$GLC attributes unused :: node ! Trees are maintained for two nodes - this is often advantageous as queries are often made for satellite and host nodes ! together. If the current node is one for which we currently have a tree, invalidate that tree. Otherwise, if the current ! node is a satellite in the current host node, place it into the second tree, otherwise, into the first. - if (node%uniqueID() == self%uniqueIDPrevious(1)) then + if (uniqueID == self%uniqueIDPrevious(1)) then i =+1 - else if (node%uniqueID() == self%uniqueIDPrevious(2)) then + else if (uniqueID == self%uniqueIDPrevious(2)) then i =+2 else if (node%isSatellite() .and. node%parent%uniqueID() == self%uniqueIDPrevious(1)) then @@ -185,7 +188,7 @@ subroutine acceleratorCalculationReset(self,node) i=1 end if end if - self%uniqueIDPrevious(i)=node%uniqueID() + self%uniqueIDPrevious(i)=uniqueID self%treePrevious =i if (associated(self%treeMassEnclosed(i)%root)) deallocate(self%treeMassEnclosed(i)%root) return @@ -285,7 +288,7 @@ double precision function acceleratorEnclosedMass(self,node,radius) else if (node%uniqueID() == self%uniqueIDPrevious(2)) then i=2 else - call self%calculationReset(node) + call self%calculationReset(node,node%uniqueID()) i=self%treePrevious end if found=.false. diff --git a/source/dark_matter_profiles.adiabatic_Gnedin2004.F90 b/source/dark_matter_profiles.adiabatic_Gnedin2004.F90 index 6e47d70e24..7677d7d05c 100644 --- a/source/dark_matter_profiles.adiabatic_Gnedin2004.F90 +++ b/source/dark_matter_profiles.adiabatic_Gnedin2004.F90 @@ -343,17 +343,20 @@ subroutine adiabaticGnedin2004Destructor(self) return end subroutine adiabaticGnedin2004Destructor - subroutine adiabaticGnedin2004CalculationReset(self,node) + subroutine adiabaticGnedin2004CalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileAdiabaticGnedin2004), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileAdiabaticGnedin2004), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node ! Reset calculations for this profile. - self%lastUniqueID =node%uniqueID() - self%genericLastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID + self%genericLastUniqueID =uniqueID self%radiusPreviousIndex = 0 self%radiusPreviousIndexMaximum = 0 self%radiusPrevious =-1.0d0 @@ -761,7 +764,7 @@ double precision function adiabaticGnedin2004RadiusInitial(self,node,radius) double precision :: radiusUpperBound, massEnclosed ! Reset stored solutions if the node has changed. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check for a previously computed solution. if (self%radiusPreviousIndexMaximum > 0 .and. any(self%radiusPrevious(1:self%radiusPreviousIndexMaximum) == radius)) then adiabaticGnedin2004RadiusInitial=0.0d0 @@ -876,7 +879,7 @@ double precision function adiabaticGnedin2004RadiusInitialDerivative(self,node,r & numerator , denominator ! Reset stored solutions if the node has changed. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Compute the various factors needed by this calculation. call self%computeFactors(node,radius,computeGradientFactors=.true.) ! Return unit derivative if radius is larger than the virial radius. diff --git a/source/dark_matter_profiles.generic.F90 b/source/dark_matter_profiles.generic.F90 index b0b29aa730..24519abea1 100644 --- a/source/dark_matter_profiles.generic.F90 +++ b/source/dark_matter_profiles.generic.F90 @@ -211,7 +211,7 @@ double precision function genericEnclosedMassDifferenceNumerical(self,node,radiu return end if ! Reset calculations if necessary. - if (node%uniqueID() /= self%genericLastUniqueID) call self%calculationResetGeneric(node) + if (node%uniqueID() /= self%genericLastUniqueID) call self%calculationResetGeneric(node,node%uniqueID()) ! Determine if the table must be rebuilt. remakeTable=.false. if (.not.allocated(self%genericEnclosedMassMass)) then @@ -465,7 +465,7 @@ double precision function genericRadialVelocityDispersionNumerical(self,node,rad !$omp threadprivate(integrator_,initialized) ! Reset calculations if necessary. - if (node%uniqueID() /= self%genericLastUniqueID) call self%calculationResetGeneric(node) + if (node%uniqueID() /= self%genericLastUniqueID) call self%calculationResetGeneric(node,node%uniqueID()) ! Determine if the table must be rebuilt. remakeTable=.false. if (.not.allocated(self%genericVelocityDispersionRadialVelocity)) then @@ -1287,15 +1287,18 @@ subroutine genericSolverUnset() return end subroutine genericSolverUnset - subroutine genericCalculationResetGeneric(self,node) + subroutine genericCalculationResetGeneric(self,node,uniqueID) !!{ Reset generic profile memoized data. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileGeneric), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileGeneric), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node - self%genericLastUniqueID=node%uniqueID() + self%genericLastUniqueID=uniqueID if (allocated(self%genericVelocityDispersionRadialVelocity)) deallocate(self%genericVelocityDispersionRadialVelocity) if (allocated(self%genericVelocityDispersionRadialRadius )) deallocate(self%genericVelocityDispersionRadialRadius ) if (allocated(self%genericEnclosedMassMass )) deallocate(self%genericEnclosedMassMass ) diff --git a/source/dark_matter_profiles.heating.tidal.F90 b/source/dark_matter_profiles.heating.tidal.F90 index e75de2d6ed..3c3bbdf4fe 100644 --- a/source/dark_matter_profiles.heating.tidal.F90 +++ b/source/dark_matter_profiles.heating.tidal.F90 @@ -155,17 +155,19 @@ subroutine tidalAutoHook(self) return end subroutine tidalAutoHook - subroutine tidalCalculationReset(self,node) + subroutine tidalCalculationReset(self,node,uniqueID) !!{ Reset the stored tidal radii. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileHeatingTidal), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileHeatingTidal), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID self %specificEnergyOverRadiusSquared_ =-1.0d0 self %specificEnergyOverRadiusSquaredParent_=-1.0d0 - self %lastUniqueID =node %uniqueID() + self %lastUniqueID = uniqueID if (associated(node%parent)) then self%parentUniqueID =node%parent%uniqueID() else @@ -314,7 +316,7 @@ double precision function tidalSpecificEnergyOverRadiusSquared(self,node) & uniqueID /= self%parentUniqueID & & .and. & & uniqueID /= self%lastUniqueID & - & ) call self%calculationReset(node) + & ) call self%calculationReset(node,uniqueID) if (uniqueID == self%parentUniqueID) then if (self%specificEnergyOverRadiusSquaredParent_ < 0.0d0) then satellite => node %satellite () diff --git a/source/dark_matter_profiles_DMO.Burkert.F90 b/source/dark_matter_profiles_DMO.Burkert.F90 index 758bd5517d..2820a03b26 100644 --- a/source/dark_matter_profiles_DMO.Burkert.F90 +++ b/source/dark_matter_profiles_DMO.Burkert.F90 @@ -288,17 +288,20 @@ subroutine burkertDestructor(self) return end subroutine burkertDestructor - subroutine burkertCalculationReset(self,node) + subroutine burkertCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOBurkert), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOBurkert), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%specificAngularMomentumScalingsComputed=.false. self%maximumVelocityComputed =.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine burkertCalculationReset @@ -553,7 +556,7 @@ double precision function burkertCircularVelocityMaximum(self,node) double precision :: scaleRadius ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if maximum velocity is already computed. Compute and store if not. if (.not.self%maximumVelocityComputed) then darkMatterProfile => node %darkMatterProfile(autoCreate=.true. ) @@ -638,7 +641,7 @@ double precision function burkertRadiusFromSpecificAngularMomentum(self,node,spe return end if ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if scalings are already computed. Compute and store if not. if (.not.self%specificAngularMomentumScalingsComputed) then ! Flag that scale quantities are now computed. diff --git a/source/dark_matter_profiles_DMO.NFW.F90 b/source/dark_matter_profiles_DMO.NFW.F90 index 245bc1f3c1..76cfe26820 100644 --- a/source/dark_matter_profiles_DMO.NFW.F90 +++ b/source/dark_matter_profiles_DMO.NFW.F90 @@ -271,13 +271,16 @@ subroutine nfwDestructor(self) return end subroutine nfwDestructor - subroutine nfwCalculationReset(self,node) + subroutine nfwCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMONFW), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMONFW), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%specificAngularMomentumScalingsComputed=.false. self%maximumVelocityComputed =.false. @@ -287,7 +290,7 @@ subroutine nfwCalculationReset(self,node) self%massScalePrevious =-1.0d0 self%circularVelocityRadiusPrevious =-1.0d0 self%radialVelocityDispersionRadiusPrevious =-1.0d0 - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine nfwCalculationReset @@ -589,7 +592,7 @@ double precision function nfwCircularVelocity(self,node,radius) if (radius > 0.0d0) then ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Compute the circular velocity if the radius has changed. if (radius /= self%circularVelocityRadiusPrevious) then self%circularVelocityPrevious =sqrt(gravitationalConstantGalacticus*self%enclosedMass(node,radius)/radius) @@ -639,7 +642,7 @@ double precision function nfwCircularVelocityMaximum(self,node) double precision :: scaleRadius ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if maximum velocity is already computed. Compute and store if not. if (.not.self%maximumVelocityComputed) then basic => node %basic ( ) @@ -677,7 +680,7 @@ double precision function nfwRadialVelocityDispersion(self,node,radius) if (radius > 0.0d0) then ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Compute the radial velocity dispersion if the radius has changed. if (radius /= self%radialVelocityDispersionRadiusPrevious) then darkMatterProfile => node%darkMatterProfile(autoCreate=.true.) @@ -718,7 +721,7 @@ double precision function nfwRadiusFromSpecificAngularMomentum(self,node,specifi return end if ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if scalings are already computed. Compute and store if not. if (.not.self%specificAngularMomentumScalingsComputed) then ! Flag that scale quantities are now computed. @@ -940,7 +943,7 @@ double precision function nfwRadiusEnclosingDensity(self,node,density) & virialRadiusOverScaleRadius ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Get scale radius if required. if (self%densityScalePrevious < 0.0d0 .or. density /= self%enclosedDensityPrevious) then darkMatterProfile => node %darkMatterProfile(autoCreate=.true.) @@ -988,7 +991,7 @@ double precision function nfwRadiusEnclosingMass(self,node,mass) & virialRadiusOverScaleRadius ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Get scale radius if required. if (self%massScalePrevious < 0.0d0 .or. mass /= self%enclosedMassPrevious) then darkMatterProfile => node %darkMatterProfile(autoCreate=.true.) diff --git a/source/dark_matter_profiles_DMO.Penarrubia2010.F90 b/source/dark_matter_profiles_DMO.Penarrubia2010.F90 index 05475bccfd..8a8ce475cc 100644 --- a/source/dark_matter_profiles_DMO.Penarrubia2010.F90 +++ b/source/dark_matter_profiles_DMO.Penarrubia2010.F90 @@ -216,17 +216,20 @@ subroutine penarrubia2010Destructor(self) return end subroutine penarrubia2010Destructor - subroutine penarrubia2010CalculationReset(self,node) + subroutine penarrubia2010CalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOPenarrubia2010), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOPenarrubia2010), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%scaleRadiusPrevious =-1.0d0 self%normalizationPrevious=-1.0d0 - self%uniqueIDPrevious =node%uniqueID() + self%uniqueIDPrevious =uniqueID return end subroutine penarrubia2010CalculationReset @@ -271,7 +274,7 @@ double precision function penarrubia2010ScaleRadius(self,node) double precision :: fractionMassBound , fractionRadiusMaximum, & & ratioRadiusMaximumRadiusScale - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) if (self%scaleRadiusPrevious < 0.0d0) then basic => node %basic () satellite => node %satellite () @@ -313,7 +316,7 @@ double precision function penarrubia2010Normalization(self,node) & ratioVelocityMaximumVelocityScale, massScale , & & massScaleOriginal - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) if (self%normalizationPrevious < 0.0d0) then basic => node %basic () satellite => node %satellite () diff --git a/source/dark_matter_profiles_DMO.SIDM.coreNFW.F90 b/source/dark_matter_profiles_DMO.SIDM.coreNFW.F90 index c15be4fefd..20ab6b126f 100644 --- a/source/dark_matter_profiles_DMO.SIDM.coreNFW.F90 +++ b/source/dark_matter_profiles_DMO.SIDM.coreNFW.F90 @@ -182,16 +182,19 @@ subroutine sidmCoreNFWDestructor(self) return end subroutine sidmCoreNFWDestructor - subroutine sidmCoreNFWCalculationReset(self,node) + subroutine sidmCoreNFWCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOSIDMCoreNFW), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOSIDMCoreNFW), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node - self%genericLastUniqueID =node%uniqueID() - self%uniqueIDPreviousSIDM =node%uniqueID() + self%genericLastUniqueID =uniqueID + self%uniqueIDPreviousSIDM =uniqueID self%radiusInteractivePrevious =-1.0d0 self%genericEnclosedMassRadiusMinimum =+huge(0.0d0) self%genericEnclosedMassRadiusMaximum =-huge(0.0d0) diff --git a/source/dark_matter_profiles_DMO.SIDM.isothermal.F90 b/source/dark_matter_profiles_DMO.SIDM.isothermal.F90 index 3d73e18b25..fbafbd8ceb 100644 --- a/source/dark_matter_profiles_DMO.SIDM.isothermal.F90 +++ b/source/dark_matter_profiles_DMO.SIDM.isothermal.F90 @@ -220,17 +220,20 @@ subroutine sidmIsothermalDestructor(self) return end subroutine sidmIsothermalDestructor - subroutine sidmIsothermalCalculationReset(self,node) + subroutine sidmIsothermalCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOSIDMIsothermal), intent(inout) :: self - type (treeNode ), intent(inout) :: node - - self%uniqueIDPrevious =node%uniqueID() - self%genericLastUniqueID =node%uniqueID() - self%uniqueIDPreviousSIDM =node%uniqueID() + class (darkMatterProfileDMOSIDMIsothermal), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node + + self%uniqueIDPrevious =uniqueID + self%genericLastUniqueID =uniqueID + self%uniqueIDPreviousSIDM =uniqueID self%velocityDispersionCentral =-1.0d0 self%radiusInteractivePrevious =-1.0d0 self%radiusInteraction_ =-1.0d0 @@ -557,8 +560,8 @@ double precision function sidmIsothermalDensity(self,node,radius) if (radius > self%radiusInteraction(node)) then sidmIsothermalDensity=self%darkMatterProfileDMO_%density(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) call self%interpolatorRadiiDimensionless%linearFactors(radius/self%radiusInteraction_,indexRadius,factorsRadius) sidmIsothermalDensity=0.0d0 do i=0,1 @@ -590,8 +593,8 @@ double precision function sidmIsothermalDensityLogSlope(self,node,radius) if (radius > self%radiusInteraction(node)) then sidmIsothermalDensityLogSlope=self%darkMatterProfileDMO_%densityLogSlope(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) call self%interpolatorRadiiDimensionless%linearFactors(radius/self%radiusInteraction_,indexRadius,factorsRadius) if (indexRadius > 1) then sidmIsothermalDensityLogSlope=+log(self%densityProfileDimensionless(indexRadius+1,self%indexXi+0)/self%densityProfileDimensionless(indexRadius+0,self%indexXi+0)) & @@ -619,8 +622,8 @@ double precision function sidmIsothermalEnclosedMass(self,node,radius) if (radius > self%radiusInteraction(node)) then sidmIsothermalEnclosedMass=self%darkMatterProfileDMO_%enclosedMass(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) call self%interpolatorRadiiDimensionless%linearFactors(radius/self%radiusInteraction_,indexRadius,factorsRadius) sidmIsothermalEnclosedMass=0.0d0 do i=0,1 @@ -694,8 +697,8 @@ double precision function sidmIsothermalPotential(self,node,radius,status) if (radius > self%radiusInteraction(node)) then sidmIsothermalPotential=self%darkMatterProfileDMO_%potential(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) sidmIsothermalPotential=+ self%darkMatterProfileDMO_%potential (node,self%radiusInteraction_) & & - self %velocityDispersionCentral **2 & & *log( & @@ -757,8 +760,8 @@ double precision function sidmIsothermalRadialVelocityDispersion(self,node,radiu if (radius > self%radiusInteraction(node)) then sidmIsothermalRadialVelocityDispersion=self%darkMatterProfileDMO_%radialVelocityDispersion(node,radius) else - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) - if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) + if (self%velocityDispersionCentral <= 0.0d0 ) call self%computeSolution (node ) sidmIsothermalRadialVelocityDispersion=self%velocityDispersionCentral end if return diff --git a/source/dark_matter_profiles_DMO.Zhao1996.F90 b/source/dark_matter_profiles_DMO.Zhao1996.F90 index 0ad9f5ceff..d5fbc82da0 100644 --- a/source/dark_matter_profiles_DMO.Zhao1996.F90 +++ b/source/dark_matter_profiles_DMO.Zhao1996.F90 @@ -229,15 +229,18 @@ subroutine zhao1996Destructor(self) return end subroutine zhao1996Destructor - subroutine zhao1996CalculationReset(self,node) + subroutine zhao1996CalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOZhao1996), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOZhao1996), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node - self%genericLastUniqueID =node%uniqueID() + self%genericLastUniqueID =uniqueID self%genericEnclosedMassRadiusMinimum =+huge(0.0d0) self%genericEnclosedMassRadiusMaximum =-huge(0.0d0) self%genericVelocityDispersionRadialRadiusMinimum=+huge(0.0d0) diff --git a/source/dark_matter_profiles_DMO.accelerator.F90 b/source/dark_matter_profiles_DMO.accelerator.F90 index 5df05f7b88..0001639f11 100644 --- a/source/dark_matter_profiles_DMO.accelerator.F90 +++ b/source/dark_matter_profiles_DMO.accelerator.F90 @@ -158,21 +158,23 @@ subroutine acceleratorDestructor(self) return end subroutine acceleratorDestructor - subroutine acceleratorCalculationReset(self,node) + subroutine acceleratorCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none class (darkMatterProfileDMOAccelerator), intent(inout) :: self type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID integer :: i ! Trees are maintained for two nodes - this is often advantageous as queries are often made for satellite and host nodes ! together. If the current node is one for which we currently have a tree, invalidate that tree. Otherwise, if the current ! node is a satellite in the current host node, place it into the second tree, otherwise, into the first. - if (node%uniqueID() == self%uniqueIDPrevious(1)) then + if (uniqueID == self%uniqueIDPrevious(1)) then i =+1 - else if (node%uniqueID() == self%uniqueIDPrevious(2)) then + else if (uniqueID == self%uniqueIDPrevious(2)) then i =+2 else if (node%isSatellite() .and. node%parent%uniqueID() == self%uniqueIDPrevious(1)) then @@ -181,7 +183,7 @@ subroutine acceleratorCalculationReset(self,node) i=1 end if end if - self%uniqueIDPrevious(i)=node%uniqueID() + self%uniqueIDPrevious(i)=uniqueID self%treePrevious =i if (associated(self%treeMassEnclosed(i)%root)) deallocate(self%treeMassEnclosed(i)%root) return @@ -281,7 +283,7 @@ double precision function acceleratorEnclosedMass(self,node,radius) else if (node%uniqueID() == self%uniqueIDPrevious(2)) then i=2 else - call self%calculationReset(node) + call self%calculationReset(node,node%uniqueID()) i=self%treePrevious end if found=.false. diff --git a/source/dark_matter_profiles_DMO.accretion_flow.F90 b/source/dark_matter_profiles_DMO.accretion_flow.F90 index f7cfdd17da..295eb69a67 100644 --- a/source/dark_matter_profiles_DMO.accretion_flow.F90 +++ b/source/dark_matter_profiles_DMO.accretion_flow.F90 @@ -196,15 +196,18 @@ subroutine accretionFlowDestructor(self) return end subroutine accretionFlowDestructor - subroutine accretionFlowCalculationReset(self,node) + subroutine accretionFlowCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOAccretionFlow), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOAccretionFlow), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node - self%genericLastUniqueID =node%uniqueID() + self%genericLastUniqueID =uniqueID self%genericEnclosedMassRadiusMinimum =+huge(0.0d0) self%genericEnclosedMassRadiusMaximum =-huge(0.0d0) self%genericVelocityDispersionRadialRadiusMinimum=+huge(0.0d0) diff --git a/source/dark_matter_profiles_DMO.finite_resolution.F90 b/source/dark_matter_profiles_DMO.finite_resolution.F90 index d98fa5b6de..6c711a6841 100644 --- a/source/dark_matter_profiles_DMO.finite_resolution.F90 +++ b/source/dark_matter_profiles_DMO.finite_resolution.F90 @@ -200,16 +200,19 @@ subroutine finiteResolutionDestructor(self) return end subroutine finiteResolutionDestructor - subroutine finiteResolutionCalculationReset(self,node) + subroutine finiteResolutionCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOFiniteResolution), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOFiniteResolution), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node - self%lastUniqueID =node%uniqueID() - self%genericLastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID + self%genericLastUniqueID =uniqueID self%lengthResolutionPrevious =-huge(0.0d0) self%enclosedMassPrevious =-huge(0.0d0) self%enclosedMassRadiusPrevious =-huge(0.0d0) @@ -339,7 +342,7 @@ double precision function finiteResolutionEnclosedMass(self,node,radius) type (treeNode ), intent(inout) :: node double precision , intent(in ) :: radius - if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node,node%uniqueID()) if ( radius /= self%enclosedMassRadiusPrevious) then self%enclosedMassRadiusPrevious=radius if (self%nonAnalyticSolver == nonAnalyticSolversFallThrough .or. radius > radiusLengthResolutionRatioMaximum*self%lengthResolutionPhysical(node)) then @@ -557,7 +560,7 @@ double precision function finiteResolutionLengthResolutionPhysical(self,node) type (treeNode ), intent(inout) :: node class(nodeComponentBasic ), pointer :: basic - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) if (self%lengthResolutionPrevious < 0.0d0) then self%lengthResolutionPrevious=self%lengthResolution if (self%resolutionIsComoving) then diff --git a/source/dark_matter_profiles_DMO.finite_resolution.NFW.F90 b/source/dark_matter_profiles_DMO.finite_resolution.NFW.F90 index 0498bc11e2..e6035cb240 100644 --- a/source/dark_matter_profiles_DMO.finite_resolution.NFW.F90 +++ b/source/dark_matter_profiles_DMO.finite_resolution.NFW.F90 @@ -302,15 +302,18 @@ subroutine finiteResolutionNFWAutoHook(self) return end subroutine finiteResolutionNFWAutoHook - subroutine finiteResolutionNFWCalculationReset(self,node) + subroutine finiteResolutionNFWCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOFiniteResolutionNFW), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOFiniteResolutionNFW), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node - call self%darkMatterProfileDMOFiniteResolution%calculationReset(node) + call self%darkMatterProfileDMOFiniteResolution%calculationReset(node,uniqueID) self%potentialPrevious =-huge(0.0d0) self%potentialRadiusPrevious =-huge(0.0d0) self%velocityDispersionRadialPrevious =-huge(0.0d0) @@ -343,7 +346,7 @@ double precision function finiteResolutionNFWDensity(self,node,radius) double precision :: concentration , radiusScaleFree, & & lengthResolutionScaleFree - if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node,node%uniqueID()) if ( radius /= self%densityRadiusPrevious) then darkMatterProfile => node%darkMatterProfile ( ) radiusScaleFree = radius /darkMatterProfile%scale() @@ -400,7 +403,7 @@ double precision function finiteResolutionNFWEnclosedMass(self,node,radius) double precision :: concentration , radiusScaleFree, & & lengthResolutionScaleFree - if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node,node%uniqueID()) if ( radius /= self%enclosedMassRadiusPrevious) then darkMatterProfile => node%darkMatterProfile ( ) radiusScaleFree = radius /darkMatterProfile%scale() @@ -443,7 +446,7 @@ double precision function finiteResolutionNFWRadiusEnclosingDensity(self,node,de double precision , dimension(0:1) :: hRadiusCore integer :: iRadiusCore - if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node,node%uniqueID()) if ( density /= self%radiusEnclosingDensityDensityPrevious) then basic => node%basic ( ) darkMatterProfile => node%darkMatterProfile ( ) @@ -629,7 +632,7 @@ double precision function finiteResolutionNFWRadiusEnclosingMass(self,node,mass) double precision , dimension(0:1) :: hRadiusCore integer :: iRadiusCore - if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node,node%uniqueID()) if ( mass /= self%radiusEnclosingMassMassPrevious) then basic => node%basic ( ) darkMatterProfile => node%darkMatterProfile ( ) @@ -788,7 +791,7 @@ double precision function finiteResolutionNFWEnergy(self,node) double precision , dimension(0:1) :: hRadiusCore integer :: iRadiusCore - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) if (self%energyPrevious > 0.0d0) then basic => node%basic ( ) darkMatterProfile => node%darkMatterProfile ( ) @@ -1112,7 +1115,7 @@ double precision function finiteResolutionNFWPotential(self,node,radius,status) double precision , parameter :: radiusScaleFreeSmall =1.0d-3 if (present(status)) status=structureErrorCodeSuccess - if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node,node%uniqueID()) if ( radius /= self%potentialRadiusPrevious) then basic => node%basic ( ) darkMatterProfile => node%darkMatterProfile ( ) @@ -1225,7 +1228,7 @@ double precision function finiteResolutionNFWRadialVelocityDispersion(self,node, double precision , dimension(0:1) :: hRadiusCore integer :: iRadiusCore - if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID ) call self%calculationReset(node,node%uniqueID()) if ( radius /= self%velocityDispersionRadialRadiusPrevious) then basic => node%basic ( ) darkMatterProfile => node%darkMatterProfile ( ) diff --git a/source/dark_matter_profiles_DMO.heated.F90 b/source/dark_matter_profiles_DMO.heated.F90 index 77d1567fe8..093056056f 100644 --- a/source/dark_matter_profiles_DMO.heated.F90 +++ b/source/dark_matter_profiles_DMO.heated.F90 @@ -224,17 +224,20 @@ subroutine heatedDestructor(self) return end subroutine heatedDestructor - subroutine heatedCalculationReset(self,node) + subroutine heatedCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOHeated), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOHeated), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node ! Reset calculations for this profile. - self%lastUniqueID =node%uniqueID() - self%genericLastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID + self%genericLastUniqueID =uniqueID self%radiusFinalPrevious =-huge(0.0d0) self%genericEnclosedMassRadiusMinimum =+huge(0.0d0) self%genericEnclosedMassRadiusMaximum =-huge(0.0d0) @@ -427,7 +430,7 @@ double precision function heatedRadiusInitial(self,node,radiusFinal) return end if ! Reset calculations if necessary. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Find the initial radius in the unheated profile. if (radiusFinal /= self%radiusFinalPrevious) then self_ => self diff --git a/source/dark_matter_profiles_DMO.heated.monotonic.F90 b/source/dark_matter_profiles_DMO.heated.monotonic.F90 index cf19e89372..135b21d9ac 100644 --- a/source/dark_matter_profiles_DMO.heated.monotonic.F90 +++ b/source/dark_matter_profiles_DMO.heated.monotonic.F90 @@ -219,17 +219,20 @@ subroutine heatedMonotonicDestructor(self) return end subroutine heatedMonotonicDestructor - subroutine heatedMonotonicCalculationReset(self,node) + subroutine heatedMonotonicCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers , only : kind_int8 implicit none - class(darkMatterProfileDMOHeatedMonotonic), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOHeatedMonotonic), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node ! Reset calculations for this profile. - self%lastUniqueID =node%uniqueID() - self%genericLastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID + self%genericLastUniqueID =uniqueID self%isBound =.true. self%radiusInitialMinimum =+huge(0.0d0) self%radiusInitialMaximum =-huge(0.0d0) @@ -269,7 +272,7 @@ subroutine heatedMonotonicComputeSolution(self,node,radius) integer :: i , countRadii ! Determine if we need to retabulate. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Nothing to do if profile is already tabulated. if (allocated(self%massProfile)) return ! Choose extent of radii at which to tabulate the initial profile. diff --git a/source/dark_matter_profiles_DMO.truncated.F90 b/source/dark_matter_profiles_DMO.truncated.F90 index edad509db7..12f6d3e3d6 100644 --- a/source/dark_matter_profiles_DMO.truncated.F90 +++ b/source/dark_matter_profiles_DMO.truncated.F90 @@ -176,16 +176,19 @@ subroutine truncatedDestructor(self) return end subroutine truncatedDestructor - subroutine truncatedCalculationReset(self,node) + subroutine truncatedCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOTruncated), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOTruncated), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node - self%lastUniqueID =node%uniqueID() - self%genericLastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID + self%genericLastUniqueID =uniqueID self%enclosingMassRadiusPrevious =-1.0d0 self%enclosedMassTruncateMinimumPrevious =-1.0d0 self%enclosedMassTruncateMaximumPrevious =-1.0d0 @@ -214,7 +217,7 @@ subroutine truncatedTruncationFunction(self,node,radius,x,multiplier,multiplierG & multiplierGradient double precision :: radiusVirial , x_ - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) radiusVirial=self%darkMatterHaloScale_%radiusVirial(node) if (radius <= radiusVirial*self%radiusFractionalTruncateMinimum) then if (present(x )) x =+0.0d0 @@ -310,7 +313,7 @@ double precision function truncatedRadiusEnclosingMass(self,node,mass) double precision , intent(in ) :: mass double precision :: radiusVirial, radiusTruncateMinimum - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) radiusVirial =self%darkMatterHaloScale_%radiusVirial(node) radiusTruncateMinimum=radiusVirial*self%radiusFractionalTruncateMinimum if (self%enclosedMassTruncateMinimumPrevious < 0.0d0) then @@ -354,7 +357,7 @@ double precision function truncatedEnclosedMass(self,node,radius) double precision , intent(in ) :: radius double precision :: radiusVirial, radiusTruncateMinimum - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) radiusVirial =self%darkMatterHaloScale_%radiusVirial(node) radiusTruncateMinimum=radiusVirial*self%radiusFractionalTruncateMinimum if (self%nonAnalyticSolver == nonAnalyticSolversFallThrough .or. radius <= radiusTruncateMinimum) then @@ -449,7 +452,7 @@ double precision function truncatedRadialVelocityDispersion(self,node,radius) if (self%nonAnalyticSolver == nonAnalyticSolversFallThrough) then truncatedRadialVelocityDispersion=self%darkMatterProfileDMO_%radialVelocityDispersion(node,radius) else - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) radiusVirial =self%darkMatterHaloScale_%radiusVirial(node) radiusTruncateMinimum=radiusVirial*self%radiusFractionalTruncateMinimum if (radius >= radiusTruncateMinimum) then diff --git a/source/dark_matter_profiles_DMO.truncated.exponential.F90 b/source/dark_matter_profiles_DMO.truncated.exponential.F90 index 294c69615c..e8d76814c2 100644 --- a/source/dark_matter_profiles_DMO.truncated.exponential.F90 +++ b/source/dark_matter_profiles_DMO.truncated.exponential.F90 @@ -198,16 +198,19 @@ subroutine truncatedExponentialDestructor(self) return end subroutine truncatedExponentialDestructor - subroutine truncatedExponentialCalculationReset(self,node) + subroutine truncatedExponentialCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(darkMatterProfileDMOTruncatedExponential), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (darkMatterProfileDMOTruncatedExponential), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node - self%lastUniqueID =node%uniqueID() - self%genericLastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID + self%genericLastUniqueID =uniqueID self%kappaPrevious =-huge(0.0d0) self%enclosingMassRadiusPrevious =-1.0d0 self%radialVelocityDispersionVirialRadiusPrevious =-1.0d0 @@ -235,7 +238,7 @@ subroutine truncatedExponentialTruncationFunction(self,node,radius,multiplier,mu double precision :: radiusVirial, radiusDecay , & & multiplier_ - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) radiusVirial=self%darkMatterHaloScale_%radiusVirial(node) if (radius <= radiusVirial) then if (present(multiplier )) multiplier =+1.0d0 @@ -280,7 +283,7 @@ subroutine recomputeKappa (self,node) double precision :: radiusVirial , scaleRadius, & & concentration - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) radiusVirial = self %darkMatterHaloScale_%radiusVirial(node ) darkMatterProfile => node %darkMatterProfile (autoCreate=.true.) scaleRadius = darkMatterProfile%scale ( ) @@ -421,7 +424,7 @@ double precision function truncatedExponentialEnclosedMass(self,node,radius) double precision , intent(in ) :: radius double precision :: radiusVirial, radiusDecay - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) radiusVirial=self%darkMatterHaloScale_%radiusVirial(node) if (radius <= radiusVirial) then truncatedExponentialEnclosedMass=+self%darkMatterProfileDMO_%enclosedMass(node,radius ) @@ -521,7 +524,7 @@ double precision function truncatedExponentialRadialVelocityDispersion(self,node if (self%nonAnalyticSolver == nonAnalyticSolversFallThrough) then truncatedExponentialRadialVelocityDispersion=self%darkMatterProfileDMO_%radialVelocityDispersion(node,radius) else - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) radiusVirial=self%darkMatterHaloScale_%radiusVirial(node) if (radius >= radiusVirial) then truncatedExponentialRadialVelocityDispersion=self%radialVelocityDispersionNumerical(node,radius) diff --git a/source/galactic.structure.standard.F90 b/source/galactic.structure.standard.F90 index 4e988ed1a9..acbc5ac6bf 100644 --- a/source/galactic.structure.standard.F90 +++ b/source/galactic.structure.standard.F90 @@ -212,19 +212,22 @@ subroutine standardDestructor(self) return end subroutine standardDestructor - subroutine standardCalculationReset(self,node) + subroutine standardCalculationReset(self,node,uniqueID) !!{ Reset calculations for galactic structure potentials. !!} use :: Galacticus_Nodes, only : treeNode + use :: Kind_Numbers , only : kind_int8 implicit none - class(galacticStructureStandard), intent(inout) :: self - type (treeNode ), intent(in ) :: node + class (galacticStructureStandard), intent(inout) :: self + type (treeNode ), intent(in ) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%potentialOffsetComputed =.false. self%radiusEnclosingMassPrevious =-huge(0.0d0) self%radiusEnclosingSurfaceDensityPrevious=-huge(0.0d0) - self%uniqueIDPrevious =node%uniqueID() + self%uniqueIDPrevious =uniqueID return end subroutine standardCalculationReset @@ -641,7 +644,7 @@ double precision function standardPotential(self,node,radius,componentType,massT ! Initialize pointer to function that supplies the potential for all components. potentialComponent_ => potentialComponent ! Reset calculations if this is a new node. - if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node) + if (node%uniqueID() /= self%uniqueIDPrevious) call self%calculationReset(node,node%uniqueID()) ! Evaluate the potential at the halo virial radius. if (.not.self%potentialOffsetComputed) then call self%defaults(componentType=componentTypeAll,massType=massTypeAll,radius=self%darkMatterHaloScale_%radiusVirial(node)) diff --git a/source/hot_halo.outflow_reincorporation.velocity_maximum_scaling.F90 b/source/hot_halo.outflow_reincorporation.velocity_maximum_scaling.F90 index 7002a8df37..83358e0b39 100644 --- a/source/hot_halo.outflow_reincorporation.velocity_maximum_scaling.F90 +++ b/source/hot_halo.outflow_reincorporation.velocity_maximum_scaling.F90 @@ -207,18 +207,21 @@ subroutine velocityMaximumScalingDestructor(self) return end subroutine velocityMaximumScalingDestructor - subroutine velocityMaximumScalingCalculationReset(self,node) + subroutine velocityMaximumScalingCalculationReset(self,node,uniqueID) !!{ Reset the halo scales calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(hotHaloOutflowReincorporationVelocityMaximumScaling), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (hotHaloOutflowReincorporationVelocityMaximumScaling), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%velocityMaximumComputed=.false. self%expansionFactorComputed=.false. self%rateComputed =.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine velocityMaximumScalingCalculationReset @@ -235,7 +238,7 @@ double precision function velocityMaximumScalingRate(self,node) double precision :: timeScale ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Get required components. ! Compute velocity maximum factor. if (.not.self%velocityMaximumComputed) then diff --git a/source/merger_trees.node_evolver.calculations_reset.F90 b/source/merger_trees.node_evolver.calculations_reset.F90 index 915fe475b3..e90656085a 100644 --- a/source/merger_trees.node_evolver.calculations_reset.F90 +++ b/source/merger_trees.node_evolver.calculations_reset.F90 @@ -56,7 +56,7 @@ subroutine Calculations_Reset(node) !![ - node + node,node%uniqueID() !!] include 'calculation_reset.tasks.inc' !![ @@ -65,7 +65,7 @@ subroutine Calculations_Reset(node) !![ - node + node,node%uniqueID() !!] return diff --git a/source/objects.nodes.components.disk.standard.F90 b/source/objects.nodes.components.disk.standard.F90 index 66a1008327..fd0edc74d9 100644 --- a/source/objects.nodes.components.disk.standard.F90 +++ b/source/objects.nodes.components.disk.standard.F90 @@ -404,16 +404,19 @@ end subroutine Node_Component_Disk_Standard_Thread_Uninitialize Node_Component_Disk_Standard_Calculation_Reset !!] - subroutine Node_Component_Disk_Standard_Calculation_Reset(node) + subroutine Node_Component_Disk_Standard_Calculation_Reset(node,uniqueID) !!{ Reset standard disk structure calculations. !!} use :: Galacticus_Nodes , only : treeNode + use :: Kind_Numbers , only : kind_int8 use :: Node_Component_Disk_Standard_Data, only : Node_Component_Disk_Standard_Reset implicit none - type(treeNode), intent(inout) :: node - - call Node_Component_Disk_Standard_Reset(node%uniqueID()) + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID + !$GLC attributes unused :: node + + call Node_Component_Disk_Standard_Reset(uniqueID) return end subroutine Node_Component_Disk_Standard_Calculation_Reset @@ -765,11 +768,11 @@ subroutine Node_Component_Disk_Standard_Scale_Set(node) ! Set scale for masses. !! The scale here (and for other quantities below) combines the mass of disk and spheroid. This avoids attempts to solve !! tiny disks to high precision in massive spheroidal galaxies. - mass =max( & - & +abs(disk%massGas ())+abs(spheroid%massGas ()) & - & +abs(disk%massStellar())+abs(spheroid%massStellar()), & - & +massMinimum & - & ) + mass =max( & + & +abs(disk%massGas ())+abs(spheroid%massGas ()) & + & +abs(disk%massStellar())+abs(spheroid%massStellar()), & + & +massMinimum & + & ) call disk%massGasScale (mass) call disk%massStellarScale (mass) call disk%massStellarFormedScale(mass) diff --git a/source/objects.nodes.components.disk.very_simple.size.F90 b/source/objects.nodes.components.disk.very_simple.size.F90 index 89d59bb599..1ac012c59a 100644 --- a/source/objects.nodes.components.disk.very_simple.size.F90 +++ b/source/objects.nodes.components.disk.very_simple.size.F90 @@ -169,16 +169,19 @@ end subroutine Node_Component_Disk_Very_Simple_Size_Thread_Uninitialize Node_Component_Disk_Very_Simple_Size_Calculation_Reset !!] - subroutine Node_Component_Disk_Very_Simple_Size_Calculation_Reset(node) + subroutine Node_Component_Disk_Very_Simple_Size_Calculation_Reset(node,uniqueID) !!{ Reset very simple size disk structure calculations. !!} use :: Galacticus_Nodes , only : treeNode + use :: Kind_Numbers , only : kind_int8 use :: Node_Component_Disk_Very_Simple_Size_Data, only : Node_Component_Disk_Very_Simple_Size_Reset implicit none - type(treeNode), intent(inout) :: node + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID + !$GLC attributes unused :: node - call Node_Component_Disk_Very_Simple_Size_Reset(node%uniqueID()) + call Node_Component_Disk_Very_Simple_Size_Reset(uniqueID) return end subroutine Node_Component_Disk_Very_Simple_Size_Calculation_Reset diff --git a/source/objects.nodes.components.hot_halo.standard.F90 b/source/objects.nodes.components.hot_halo.standard.F90 index b458e11c9e..fa35343868 100644 --- a/source/objects.nodes.components.hot_halo.standard.F90 +++ b/source/objects.nodes.components.hot_halo.standard.F90 @@ -582,15 +582,18 @@ end subroutine Node_Component_Hot_Halo_Standard_Thread_Uninitialize Node_Component_Hot_Halo_Standard_Reset !!] - subroutine Node_Component_Hot_Halo_Standard_Reset(node) + subroutine Node_Component_Hot_Halo_Standard_Reset(node,uniqueID) !!{ Remove memory of stored computed values as we're about to begin computing derivatives anew. !!} use :: Galacticus_Nodes, only : treeNode + use :: Kind_Numbers , only : kind_int8 implicit none - type(treeNode), intent(inout) :: node + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID + !$GLC attributes unused :: node - uniqueIDPrevious =node%uniqueID() + uniqueIDPrevious =uniqueID gotCoolingRate =.false. gotAngularMomentumCoolingRate=.false. gotOuterRadiusGrowthRate =.false. @@ -1252,7 +1255,7 @@ subroutine Node_Component_Hot_Halo_Standard_Rate_Compute(node,interrupt,interrup ! Return immediately if this class is not in use. if (.not.defaultHotHaloComponent%standardIsActive()) return ! Reset calculations if necessary. - if (node%uniqueID() /= uniqueIDPrevious) call Node_Component_Hot_Halo_Standard_Reset(node) + if (node%uniqueID() /= uniqueIDPrevious) call Node_Component_Hot_Halo_Standard_Reset(node,node%uniqueID()) ! Get the hot halo component. hotHalo => node%hotHalo() ! Ensure that the standard hot halo implementation is active. diff --git a/source/objects.nodes.components.hot_halo.very_simple.F90 b/source/objects.nodes.components.hot_halo.very_simple.F90 index b585c70107..289634d6a6 100644 --- a/source/objects.nodes.components.hot_halo.very_simple.F90 +++ b/source/objects.nodes.components.hot_halo.very_simple.F90 @@ -195,14 +195,16 @@ end subroutine Node_Component_Hot_Halo_Very_Simple_Thread_Uninitialize Node_Component_Hot_Halo_Very_Simple_Reset !!] - subroutine Node_Component_Hot_Halo_Very_Simple_Reset(node) + subroutine Node_Component_Hot_Halo_Very_Simple_Reset(node,uniqueID) !!{ Remove memory of stored computed values as we're about to begin computing derivatives anew. !!} use :: Galacticus_Nodes, only : treeNode + use :: Kind_Numbers , only : kind_int8 implicit none - type(treeNode), intent(inout) :: node - !$GLC attributes unused :: node + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID + !$GLC attributes unused :: node, uniqueID gotCoolingRate=.false. return diff --git a/source/satellites.merging.mass_movements.Baugh2005.F90 b/source/satellites.merging.mass_movements.Baugh2005.F90 index 53b3cb0b74..f9e5f9b482 100644 --- a/source/satellites.merging.mass_movements.Baugh2005.F90 +++ b/source/satellites.merging.mass_movements.Baugh2005.F90 @@ -176,19 +176,22 @@ subroutine baugh2005Destructor(self) return end subroutine baugh2005Destructor - subroutine baugh2005CalculationReset(self,node) + subroutine baugh2005CalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} - use :: Error, only : Error_Report + use :: Error , only : Error_Report + use :: Kind_Numbers, only : kind_int8 implicit none - class(* ), intent(inout) :: self - type (treeNode), intent(inout) :: node + class (* ), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID + !$GLC attributes unused :: node select type (self) class is (mergerMassMovementsBaugh2005) self%movementsCalculated=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID class default call Error_Report('incorrect class'//{introspection:location}) end select @@ -236,7 +239,7 @@ subroutine baugh2005Get(self,node,destinationGasSatellite,destinationStarsSatell ! The calculation of how mass moves as a result of the merger is computed when first needed and then stored. This ensures that ! the results are determined by the properties of the merge target prior to any modification that will occur as node ! components are modified in response to the merger. - if (node%uniqueID() /= self%lastUniqueID) call baugh2005CalculationReset(self,node) + if (node%uniqueID() /= self%lastUniqueID) call baugh2005CalculationReset(self,node,node%uniqueID()) if (.not.self%movementsCalculated) then self%movementsCalculated = .true. nodeHost => node%mergesWith() diff --git a/source/satellites.merging.mass_movements.simple.F90 b/source/satellites.merging.mass_movements.simple.F90 index 947bf68e73..ee9bab34a8 100644 --- a/source/satellites.merging.mass_movements.simple.F90 +++ b/source/satellites.merging.mass_movements.simple.F90 @@ -161,19 +161,22 @@ subroutine simpleDestructor(self) return end subroutine simpleDestructor - subroutine simpleCalculationReset(self,node) + subroutine simpleCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} - use :: Error, only : Error_Report + use :: Error , only : Error_Report + use :: Kind_Numbers, only : kind_int8 implicit none - class(* ), intent(inout) :: self - type (treeNode), intent(inout) :: node + class (* ), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID + !$GLC attributes unused :: node select type (self) class is (mergerMassMovementsSimple) self%movementsCalculated=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID class default call Error_Report('incorrect class'//{introspection:location}) end select @@ -220,7 +223,7 @@ subroutine simpleGet(self,node,destinationGasSatellite,destinationStarsSatellite ! The calculation of how mass moves as a result of the merger is computed when first needed and then stored. This ensures that ! the results are determined by the properties of the merge target prior to any modification that will occur as node ! components are modified in response to the merger. - if (node%uniqueID() /= self%lastUniqueID) call simpleCalculationReset(self,node) + if (node%uniqueID() /= self%lastUniqueID) call simpleCalculationReset(self,node,node%uniqueID()) if (.not.self%movementsCalculated) then self%movementsCalculated = .true. nodeHost => node%mergesWith() diff --git a/source/satellites.merging.mass_movements.very_simple.F90 b/source/satellites.merging.mass_movements.very_simple.F90 index 8398b6aa31..1f43de05e0 100644 --- a/source/satellites.merging.mass_movements.very_simple.F90 +++ b/source/satellites.merging.mass_movements.very_simple.F90 @@ -132,19 +132,22 @@ subroutine verySimpleDestructor(self) return end subroutine verySimpleDestructor - subroutine verySimpleCalculationReset(self,node) + subroutine verySimpleCalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} - use :: Error, only : Error_Report + use :: Error , only : Error_Report + use :: Kind_Numbers, only : kind_int8 implicit none - class(* ), intent(inout) :: self - type (treeNode), intent(inout) :: node + class (* ), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID + !$GLC attributes unused :: node select type (self) class is (mergerMassMovementsVerySimple) self%movementsCalculated=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID class default call Error_Report('incorrect class'//{introspection:location}) end select @@ -189,7 +192,7 @@ subroutine verySimpleGet(self,node,destinationGasSatellite,destinationStarsSatel ! The calculation of how mass moves as a result of the merger is computed when first needed and then stored. This ensures that ! the results are determined by the properties of the merge target prior to any modification that will occur as node ! components are modified in response to the merger. - if (node%uniqueID() /= self%lastUniqueID) call verySimpleCalculationReset(self,node) + if (node%uniqueID() /= self%lastUniqueID) call verySimpleCalculationReset(self,node,node%uniqueID()) if (.not.self%movementsCalculated) then self%movementsCalculated=.true. if (self%massRatioMajorMerger <= 0.0d0) then diff --git a/source/satellites.merging.remnant_sizes.Cole2000.F90 b/source/satellites.merging.remnant_sizes.Cole2000.F90 index e7dfeca618..ec54a7f031 100644 --- a/source/satellites.merging.remnant_sizes.Cole2000.F90 +++ b/source/satellites.merging.remnant_sizes.Cole2000.F90 @@ -177,19 +177,22 @@ subroutine cole2000Destructor(self) return end subroutine cole2000Destructor - subroutine cole2000CalculationReset(self,node) + subroutine cole2000CalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} - use :: Error, only : Error_Report + use :: Error , only : Error_Report + use :: Kind_Numbers, only : kind_int8 implicit none - class(* ), intent(inout) :: self - type (treeNode), intent(inout) :: node + class (* ), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID + !$GLC attributes unused :: node select type (self) class is (mergerRemnantSizeCole2000) self%propertiesCalculated=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID class default call Error_Report('incorrect class'//{introspection:location}) end select @@ -251,7 +254,7 @@ subroutine cole2000Get(self,node,radius,velocityCircular,angularMomentumSpecific ! The calculation of remnant size is computed when first needed and then stored. This ensures that the results are determined ! by the properties of the merge target prior to any modification that will occur as node components are modified in response ! to the merger. - if (node%uniqueID() /= self%lastUniqueID) call cole2000CalculationReset(self,node) + if (node%uniqueID() /= self%lastUniqueID) call cole2000CalculationReset(self,node,node%uniqueID()) if (.not.self%propertiesCalculated) then self%propertiesCalculated=.true. nodeHost => node%mergesWith() diff --git a/source/satellites.merging.remnant_sizes.Covington2008.F90 b/source/satellites.merging.remnant_sizes.Covington2008.F90 index 76500537a0..3ea2e51a92 100644 --- a/source/satellites.merging.remnant_sizes.Covington2008.F90 +++ b/source/satellites.merging.remnant_sizes.Covington2008.F90 @@ -167,19 +167,22 @@ subroutine covington2008Destructor(self) return end subroutine covington2008Destructor - subroutine covington2008CalculationReset(self,node) + subroutine covington2008CalculationReset(self,node,uniqueID) !!{ Reset the dark matter profile calculation. !!} - use :: Error, only : Error_Report + use :: Error , only : Error_Report + use :: Kind_Numbers, only : kind_int8 implicit none - class(* ), intent(inout) :: self - type (treeNode), intent(inout) :: node + class (* ), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID + !$GLC attributes unused :: node select type (self) class is (mergerRemnantSizeCovington2008) self%propertiesCalculated=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID class default call Error_Report('incorrect class'//{introspection:location}) end select @@ -242,7 +245,7 @@ subroutine covington2008Get(self,node,radius,velocityCircular,angularMomentumSpe ! The calculation of remnant size is computed when first needed and then stored. This ensures that the results are determined ! by the properties of the merge target prior to any modification that will occur as node components are modified in response ! to the merger. - if (node%uniqueID() /= self%lastUniqueID) call covington2008CalculationReset(self,node) + if (node%uniqueID() /= self%lastUniqueID) call covington2008CalculationReset(self,node,node%uniqueID()) if (.not.self%propertiesCalculated) then self%propertiesCalculated=.true. nodeHost => node%mergesWith() diff --git a/source/satellites.tidal_stripping.radius.King1962.F90 b/source/satellites.tidal_stripping.radius.King1962.F90 index 1422dad729..4679522fbe 100644 --- a/source/satellites.tidal_stripping.radius.King1962.F90 +++ b/source/satellites.tidal_stripping.radius.King1962.F90 @@ -300,7 +300,7 @@ double precision function king1962Radius(self,node) & self%galacticStructure_%massEnclosed(node,radiusZero) >= 0.0d0 & & ) then ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Initial estimate of the tidal radius. if (self%radiusTidalPrevious <= 0.0d0) then self%radiusTidalPrevious=+sqrt( & @@ -373,15 +373,18 @@ Root function used to find the tidal radius within a subhalo. return end function king1962TidalRadiusSolver - subroutine king1962CalculationReset(self,node) + subroutine king1962CalculationReset(self,node,uniqueID) !!{ Reset the stored tidal radii. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(satelliteTidalStrippingRadiusKing1962), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (satelliteTidalStrippingRadiusKing1962), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%radiusTidalPrevious=-1.0d0 - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine king1962CalculationReset diff --git a/source/star_formation.rate_surface_density.disks.Blitz2006.F90 b/source/star_formation.rate_surface_density.disks.Blitz2006.F90 index 1083f2d0bd..e56dca29b8 100644 --- a/source/star_formation.rate_surface_density.disks.Blitz2006.F90 +++ b/source/star_formation.rate_surface_density.disks.Blitz2006.F90 @@ -334,16 +334,19 @@ subroutine blitz2006Destructor(self) return end subroutine blitz2006Destructor - subroutine blitz2006CalculationReset(self,node) + subroutine blitz2006CalculationReset(self,node,uniqueID) !!{ Reset the Kennicutt-Schmidt relation calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(starFormationRateSurfaceDensityDisksBlitz2006), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (starFormationRateSurfaceDensityDisksBlitz2006), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%factorsComputed =.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID self%radiusCriticalPrevious=-huge(0.0d0) return end subroutine blitz2006CalculationReset @@ -362,7 +365,7 @@ double precision function blitz2006Rate(self,node,radius) & surfaceDensityGas, factorBoost ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Compute factors. call self%computeFactors(node) ! Return zero rate for non-positive radius or mass. @@ -518,7 +521,7 @@ function blitz2006Intervals(self,node,radiusInner,radiusOuter,intervalIsAnalytic rootValueInner =-huge(0.0d0) thresholdCondition=1.0d0/self%pressureRatioCoefficient-self%factorBoostStellarCoefficient >= 1.0d0 else - ! For generic disks test this numeriaclly. + ! For generic disks test this numerically. rootValueInner =blitz2006CriticalDensityRoot(radiusInner) thresholdCondition=rootValueInner <= 0.0d0 end if diff --git a/source/star_formation.rate_surface_density.disks.Kennicutt-Schmidt.F90 b/source/star_formation.rate_surface_density.disks.Kennicutt-Schmidt.F90 index 49297f0946..0310422973 100644 --- a/source/star_formation.rate_surface_density.disks.Kennicutt-Schmidt.F90 +++ b/source/star_formation.rate_surface_density.disks.Kennicutt-Schmidt.F90 @@ -203,16 +203,19 @@ subroutine kennicuttSchmidtDestructor(self) return end subroutine kennicuttSchmidtDestructor - subroutine kennicuttSchmidtCalculationReset(self,node) + subroutine kennicuttSchmidtCalculationReset(self,node,uniqueID) !!{ Reset the Kennicutt-Schmidt relation calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(starFormationRateSurfaceDensityDisksKennicuttSchmidt), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (starFormationRateSurfaceDensityDisksKennicuttSchmidt), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%factorsComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine kennicuttSchmidtCalculationReset @@ -248,7 +251,7 @@ double precision function kennicuttSchmidtRate(self,node,radius) & surfaceDensityGas ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if factors have been precomputed. if (.not.self%factorsComputed) then ! Get the disk properties. diff --git a/source/star_formation.rate_surface_density.disks.Krumholz2009.F90 b/source/star_formation.rate_surface_density.disks.Krumholz2009.F90 index d6efcb7f39..53b4a4f6e9 100644 --- a/source/star_formation.rate_surface_density.disks.Krumholz2009.F90 +++ b/source/star_formation.rate_surface_density.disks.Krumholz2009.F90 @@ -263,18 +263,21 @@ subroutine krumholz2009Destructor(self) return end subroutine krumholz2009Destructor - subroutine krumholz2009CalculationReset(self,node) + subroutine krumholz2009CalculationReset(self,node,uniqueID) !!{ Reset the Kennicutt-Schmidt relation calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(starFormationRateSurfaceDensityDisksKrumholz2009), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (starFormationRateSurfaceDensityDisksKrumholz2009), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%factorsComputed =.false. self%radiusCriticalPrevious=-1.0d0 self%radiusMaximumPrevious =-1.0d0 - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine krumholz2009CalculationReset @@ -293,7 +296,7 @@ subroutine krumholz2009ComputeFactors(self,node) !$omp threadprivate(abundancesFuel) ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if factors have been precomputed. if (.not.self%factorsComputed) then ! Get the disk properties. diff --git a/source/star_formation.rate_surface_density.disks.extended_Schmidt.F90 b/source/star_formation.rate_surface_density.disks.extended_Schmidt.F90 index 486b898bf6..c1fb41e474 100644 --- a/source/star_formation.rate_surface_density.disks.extended_Schmidt.F90 +++ b/source/star_formation.rate_surface_density.disks.extended_Schmidt.F90 @@ -165,16 +165,19 @@ subroutine extendedSchmidtDestructor(self) return end subroutine extendedSchmidtDestructor - subroutine extendedSchmidtCalculationReset(self,node) + subroutine extendedSchmidtCalculationReset(self,node,uniqueID) !!{ Reset the Kennicutt-Schmidt relation calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(starFormationRateSurfaceDensityDisksExtendedSchmidt), intent(inout) :: self - type (treeNode ), intent(inout) :: node - + class (starFormationRateSurfaceDensityDisksExtendedSchmidt), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node + self%factorsComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine extendedSchmidtCalculationReset @@ -203,7 +206,7 @@ double precision function extendedSchmidtRate(self,node,radius) & surfaceDensityStellar ! Check if node differs from previous one for which we performed calculations. - if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node) + if (node%uniqueID() /= self%lastUniqueID) call self%calculationReset(node,node%uniqueID()) ! Check if factors have been precomputed. if (.not.self%factorsComputed) then ! Get the disk properties. diff --git a/source/star_formation.timescales.halo_scaling.F90 b/source/star_formation.timescales.halo_scaling.F90 index 93632b8074..f028b20748 100644 --- a/source/star_formation.timescales.halo_scaling.F90 +++ b/source/star_formation.timescales.halo_scaling.F90 @@ -174,17 +174,20 @@ subroutine haloScalingDestructor(self) return end subroutine haloScalingDestructor - subroutine haloScalingCalculationReset(self,node) + subroutine haloScalingCalculationReset(self,node,uniqueID) !!{ Reset the halo scaling star formation timescale calculation. !!} use :: Galacticus_Nodes, only : treeNode + use :: Kind_Numbers , only : kind_int8 implicit none - class(starFormationTimescaleHaloScaling), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (starFormationTimescaleHaloScaling), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%timescaleComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine haloScalingCalculationReset @@ -201,7 +204,7 @@ double precision function haloScalingTimescale(self,component) double precision :: expansionFactor, velocityVirial ! Check if node differs from previous one for which we performed calculations. - if (component%hostNode%uniqueID() /= self%lastUniqueID) call self%calculationReset(component%hostNode) + if (component%hostNode%uniqueID() /= self%lastUniqueID) call self%calculationReset(component%hostNode,component%hostNode%uniqueID()) ! Compute the timescale if necessary. if (.not.self%timescaleComputed) then ! Get virial velocity and expansion factor. diff --git a/source/star_formation.timescales.velocity_maximum_scaling.F90 b/source/star_formation.timescales.velocity_maximum_scaling.F90 index 79c5ac6c0d..18226c0a80 100644 --- a/source/star_formation.timescales.velocity_maximum_scaling.F90 +++ b/source/star_formation.timescales.velocity_maximum_scaling.F90 @@ -174,17 +174,20 @@ subroutine velocityMaxScalingDestructor(self) return end subroutine velocityMaxScalingDestructor - subroutine velocityMaxScalingCalculationReset(self,node) + subroutine velocityMaxScalingCalculationReset(self,node,uniqueID) !!{ Reset the velocity maximum scaling star formation timescale calculation. !!} use :: Galacticus_Nodes, only : treeNode + use :: Kind_Numbers , only : kind_int8 implicit none - class(starFormationTimescaleVelocityMaxScaling), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (starFormationTimescaleVelocityMaxScaling), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node self%timescaleComputed=.false. - self%lastUniqueID =node%uniqueID() + self%lastUniqueID =uniqueID return end subroutine velocityMaxScalingCalculationReset @@ -200,7 +203,7 @@ double precision function velocityMaxScalingTimescale(self,component) double precision :: expansionFactor, velocityMaximum ! Check if node differs from previous one for which we performed calculations. - if (component%hostNode%uniqueID() /= self%lastUniqueID) call self%calculationReset(component%hostNode) + if (component%hostNode%uniqueID() /= self%lastUniqueID) call self%calculationReset(component%hostNode,component%hostNode%uniqueID()) ! Compute the timescale if necessary. if (.not.self%timescaleComputed) then ! Get virial velocity and expansion factor. diff --git a/source/structure_formation.cosmological_density_field.F90 b/source/structure_formation.cosmological_density_field.F90 index 19c0237f2e..48346c68d1 100644 --- a/source/structure_formation.cosmological_density_field.F90 +++ b/source/structure_formation.cosmological_density_field.F90 @@ -530,15 +530,17 @@ Function used in root finding for the collapsing mass at a given time. return end function collapsingMassRoot - subroutine criticalOverdensityCalculationReset(self,node) + subroutine criticalOverdensityCalculationReset(self,node,uniqueID) !!{ Reset the critical overdensity calculation. !!} + use :: Kind_Numbers, only : kind_int8 implicit none - class(criticalOverdensityClass), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class( criticalOverdensityClass), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID - self%lastUniqueID=node%uniqueID() + self%lastUniqueID=uniqueID return end subroutine criticalOverdensityCalculationReset diff --git a/source/structure_formation.halo_environment.normal.F90 b/source/structure_formation.halo_environment.normal.F90 index e99acf8989..490cd1b38f 100644 --- a/source/structure_formation.halo_environment.normal.F90 +++ b/source/structure_formation.halo_environment.normal.F90 @@ -269,14 +269,17 @@ Destructor for the {\normalfont \ttfamily normal} halo mass function class. return end subroutine normalDestructor - subroutine normalCalculationReset(self,node) + subroutine normalCalculationReset(self,node,uniqueID) !!{ Reset the normal halo environment calculation. !!} use :: Galacticus_Nodes, only : treeNode + use :: Kind_Numbers , only : kind_int8 implicit none - class(haloEnvironmentNormal), intent(inout) :: self - type (treeNode ), intent(inout) :: node + class (haloEnvironmentNormal), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8 ), intent(in ) :: uniqueID + !$GLC attributes unused :: node, uniqueID self%overdensityPrevious=-huge(0.0d0) self%uniqueIDPrevious =-1_kind_int8 diff --git a/source/tasks.evolve_forests.work_share.first_come_first_served.F90 b/source/tasks.evolve_forests.work_share.first_come_first_served.F90 index cb3669715f..2b4336c3d0 100644 --- a/source/tasks.evolve_forests.work_share.first_come_first_served.F90 +++ b/source/tasks.evolve_forests.work_share.first_come_first_served.F90 @@ -193,7 +193,7 @@ function fcfsForestNumber(self,utilizeOpenMPThreads) return end function fcfsForestNumber - subroutine fcfsPing(self,node) + subroutine fcfsPing(self,node,uniqueID) !!{ Return the number of the next forest to process. !!} @@ -201,13 +201,15 @@ subroutine fcfsPing(self,node) use :: MPI_Utilities , only : mpiSelf #endif use :: Galacticus_Nodes, only : treeNode + use :: Kind_Numbers , only : kind_int8 implicit none - class (* ), intent(inout) :: self - type (treeNode), intent(inout) :: node + class (* ), intent(inout) :: self + type (treeNode ), intent(inout) :: node + integer(kind_int8), intent(in ) :: uniqueID #ifdef USEMPI - integer(c_size_t) :: forestNumber + integer(c_size_t ) :: forestNumber #endif - !$GLC attributes unused :: self, node + !$GLC attributes unused :: self, node, uniqueID #ifdef USEMPI !$omp master