From 6247990c429f8596946939bdc56460e7787133b9 Mon Sep 17 00:00:00 2001 From: mikew097 Date: Mon, 16 Feb 2026 14:26:12 +0100 Subject: [PATCH 1/6] Condition auxiliary halo exchange when turbulence enabled --- source/mus_auxField_module.f90 | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/source/mus_auxField_module.f90 b/source/mus_auxField_module.f90 index 49d8791..9beaf64 100644 --- a/source/mus_auxField_module.f90 +++ b/source/mus_auxField_module.f90 @@ -378,12 +378,17 @@ subroutine mus_calcAuxFieldAndExchange(auxField, calcAuxField, state, & ! communicate velocity field. Requires for tubulence to compute ShearRate ! from velocity gradient. ! exchange velocity halo on current level - call general%commpattern%exchange_real( & - & send = auxField%sendBuffer, & - & recv = auxField%recvBuffer , & - & state = auxField%val(:), & - & message_flag = iLevel+100, & - & comm = general%proc%comm ) + if (trim(schemeHeader%kind) == 'fluid' .or. & + & trim(schemeHeader%kind) == 'fluid_incompressible') then + if (field(1)%fieldProp%fluid%turbulence%active) then + call general%commpattern%exchange_real( & + & send = auxField%sendBuffer, & + & recv = auxField%recvBuffer , & + & state = auxField%val(:), & + & message_flag = iLevel+100, & + & comm = general%proc%comm ) + end if + end if ! communicate ghost halos from coarser if (iLevel > minLevel) then From 9e66e00fe37522472acee961ef7d212b6310925e Mon Sep 17 00:00:00 2001 From: mikew097 Date: Tue, 24 Feb 2026 16:27:01 +0100 Subject: [PATCH 2/6] Add scheme-level needAuxHaloComm flag for aux halo exchanges. --- source/mus_auxField_module.f90 | 70 ++++++++++++++---------- source/mus_control_module.f90 | 12 ++-- source/mus_dynLoadBal_module.f90 | 6 +- source/mus_flow_module.fpp | 9 ++- source/mus_tracking_module.f90 | 51 +++++++++++++++++ source/scheme/mus_scheme_type_module.f90 | 5 ++ 6 files changed, 116 insertions(+), 37 deletions(-) diff --git a/source/mus_auxField_module.f90 b/source/mus_auxField_module.f90 index 9beaf64..0d5d9ea 100644 --- a/source/mus_auxField_module.f90 +++ b/source/mus_auxField_module.f90 @@ -223,7 +223,8 @@ end subroutine mus_init_auxFieldArrays !! PDF initialized by IC subroutine mus_initAuxFieldFluidAndExchange(auxField, state, neigh, nElems, & & nSize, nFields, stencil, varSys, & - & derVarPos, iLevel, general, quantities) + & derVarPos, iLevel, general, & + & quantities, needAuxHaloComm) !--------------------------------------------------------------------------- !> auxilary field array type(mus_auxFieldVar_type), intent(inout) :: auxField @@ -249,6 +250,8 @@ subroutine mus_initAuxFieldFluidAndExchange(auxField, state, neigh, nElems, & type(tem_general_type), intent(in) :: general !> Class that contains pointers to the proper derived quantities functions type(mus_scheme_derived_quantities_type), intent(in) :: quantities + !> Whether auxField halo communication is required + logical, intent(in) :: needAuxHaloComm !--------------------------------------------------------------------------- integer :: iField !--------------------------------------------------------------------------- @@ -269,12 +272,14 @@ subroutine mus_initAuxFieldFluidAndExchange(auxField, state, neigh, nElems, & ! communicate velocity field. Requires for tubulence to compute ShearRate ! from velocity gradient. ! exchange velocity halo on current level - call general%commpattern%exchange_real( & - & send = auxField%sendBuffer, & - & recv = auxField%recvBuffer, & - & state = auxField%val(:), & - & message_flag = iLevel+100, & - & comm = general%proc%comm ) + if (needAuxHaloComm) then + call general%commpattern%exchange_real( & + & send = auxField%sendBuffer, & + & recv = auxField%recvBuffer, & + & state = auxField%val(:), & + & message_flag = iLevel+100, & + & comm = general%proc%comm ) + end if end subroutine mus_initAuxFieldFluidAndExchange ! ************************************************************************** ! @@ -285,7 +290,8 @@ end subroutine mus_initAuxFieldFluidAndExchange !! halos subroutine mus_calcAuxFieldAndExchange(auxField, calcAuxField, state, & & pdfData, nFields, field, globSrc, stencil, varSys, derVarPos, & - & phyConvFac, general, iLevel, minLevel, schemeHeader, quantities) + & phyConvFac, general, iLevel, minLevel, schemeHeader, quantities, & + & needAuxHaloComm) ! -------------------------------------------------------------------- ! !> auxilary field array type(mus_auxFieldVar_type), intent(inout) :: auxField @@ -319,6 +325,8 @@ subroutine mus_calcAuxFieldAndExchange(auxField, calcAuxField, state, & type(mus_scheme_header_type), intent(in) :: schemeHeader !> Class that contains pointers to the proper derived quantities functions type(mus_scheme_derived_quantities_type), intent(in) :: quantities + !> Whether auxField halo communication is required + logical, intent(in) :: needAuxHaloComm ! -------------------------------------------------------------------- ! integer :: nSolve, iField, iSrc ! -------------------------------------------------------------------- ! @@ -378,20 +386,17 @@ subroutine mus_calcAuxFieldAndExchange(auxField, calcAuxField, state, & ! communicate velocity field. Requires for tubulence to compute ShearRate ! from velocity gradient. ! exchange velocity halo on current level - if (trim(schemeHeader%kind) == 'fluid' .or. & - & trim(schemeHeader%kind) == 'fluid_incompressible') then - if (field(1)%fieldProp%fluid%turbulence%active) then + if (needAuxHaloComm) then call general%commpattern%exchange_real( & & send = auxField%sendBuffer, & & recv = auxField%recvBuffer , & & state = auxField%val(:), & & message_flag = iLevel+100, & & comm = general%proc%comm ) - end if end if ! communicate ghost halos from coarser - if (iLevel > minLevel) then + if (needAuxHaloComm .and. iLevel > minLevel) then call general%commpattern%exchange_real( & & send = auxField%sendBufferFromCoarser, & & recv = auxField%recvBufferFromCoarser , & @@ -408,7 +413,8 @@ end subroutine mus_calcAuxFieldAndExchange !! halos subroutine mus_intpAuxFieldCoarserAndExchange(intp, tAuxField, sAuxField, & & tLevelDesc, stencil, iLevel, & - & nAuxScalars, general) + & nAuxScalars, general, & + & needAuxHaloComm) ! -------------------------------------------------------------------- ! !> Interpolation type type(mus_interpolation_type), intent(inout) :: intp @@ -426,6 +432,8 @@ subroutine mus_intpAuxFieldCoarserAndExchange(intp, tAuxField, sAuxField, & integer, intent(in) :: nAuxScalars !> contains commPattern, MPI communicator and simControl type(tem_general_type), intent(in) :: general + !> Whether auxField halo communication is required + logical, intent(in) :: needAuxHaloComm ! -------------------------------------------------------------------- ! call intp%fillMineFromFiner%do_intpArbiVal( & & tLevelDesc = tLevelDesc, & @@ -439,12 +447,14 @@ subroutine mus_intpAuxFieldCoarserAndExchange(intp, tAuxField, sAuxField, & ! exchange velocity halo fromFiner, required to compute velocity ! gradient - call general%commPattern%exchange_real( & - & send = tAuxField%sendBufferFromFiner, & - & recv = tAuxField%recvBufferFromFiner, & - & state = tAuxField%val(:), & - & message_flag = iLevel+300, & - & comm = general%proc%comm ) + if (needAuxHaloComm) then + call general%commPattern%exchange_real( & + & send = tAuxField%sendBufferFromFiner, & + & recv = tAuxField%recvBufferFromFiner, & + & state = tAuxField%val(:), & + & message_flag = iLevel+300, & + & comm = general%proc%comm ) + end if end subroutine mus_intpAuxFieldCoarserAndExchange ! ************************************************************************* ! @@ -454,7 +464,8 @@ end subroutine mus_intpAuxFieldCoarserAndExchange !! halos subroutine mus_intpAuxFieldFinerAndExchange(intp, tAuxField, sAuxField, & & tLevelDesc, stencil, iLevel, & - & nAuxScalars, general) + & nAuxScalars, general, & + & needAuxHaloComm) ! -------------------------------------------------------------------- ! !> Interpolation type type(mus_interpolation_type), intent(inout) :: intp @@ -472,6 +483,8 @@ subroutine mus_intpAuxFieldFinerAndExchange(intp, tAuxField, sAuxField, & integer, intent(in) :: nAuxScalars !> contains commPattern, MPI communicator and simControl type(tem_general_type), intent(in) :: general + !> Whether auxField halo communication is required + logical, intent(in) :: needAuxHaloComm ! -------------------------------------------------------------------- ! integer :: iOrder ! -------------------------------------------------------------------- ! @@ -489,14 +502,15 @@ subroutine mus_intpAuxFieldFinerAndExchange(intp, tAuxField, sAuxField, & ! exchange velocity halo fromFiner, required to compute velocity ! gradient - call general%commPattern%exchange_real( & - & send = tAuxField%sendBufferFromCoarser, & - & recv = tAuxField%recvBufferFromCoarser, & - & state = tAuxField%val(:), & - & message_flag = iLevel+200, & - & comm = general%proc%comm ) + if (needAuxHaloComm) then + call general%commPattern%exchange_real( & + & send = tAuxField%sendBufferFromCoarser, & + & recv = tAuxField%recvBufferFromCoarser, & + & state = tAuxField%val(:), & + & message_flag = iLevel+200, & + & comm = general%proc%comm ) + end if end subroutine mus_intpAuxFieldFinerAndExchange ! ************************************************************************* ! end module mus_auxField_module - diff --git a/source/mus_control_module.f90 b/source/mus_control_module.f90 index 9698933..ad5103a 100644 --- a/source/mus_control_module.f90 +++ b/source/mus_control_module.f90 @@ -335,7 +335,8 @@ recursive subroutine do_recursive_multiLevel(me, iLevel) & iLevel = iLevel, & & minLevel = me%geometry%tree%global%minLevel, & & schemeHeader = me%scheme%header, & - & quantities = me%scheme%layout%quantities ) + & quantities = me%scheme%layout%quantities, & + & needAuxHaloComm = me%scheme%needAuxHaloComm ) if (iLevel < me%geometry%tree%global%maxLevel) then write(logUnit(10), "(A)") 'Interpolate and exchange auxField in ' & @@ -348,7 +349,8 @@ recursive subroutine do_recursive_multiLevel(me, iLevel) & stencil = me%scheme%layout%fStencil, & & iLevel = iLevel, & & nAuxScalars = me%scheme%varSys%nAuxScalars, & - & general = me%params%general ) + & general = me%params%general, & + & needAuxHaloComm = me%scheme%needAuxHaloComm ) end if call tem_stopTimer( timerHandle = mus_timerHandles%aux(iLevel) ) @@ -577,7 +579,8 @@ subroutine do_fast_singleLevel( me, iLevel ) & iLevel = iLevel, & & minLevel = me%geometry%tree%global%minLevel, & & schemeHeader = me%scheme%header, & - & quantities = me%scheme%layout%quantities ) + & quantities = me%scheme%layout%quantities, & + & needAuxHaloComm = me%scheme%needAuxHaloComm ) call tem_stopTimer( timerHandle = mus_timerHandles%aux(iLevel) ) ! -------------------------------------------------------------------------- @@ -772,7 +775,8 @@ subroutine do_benchmark(me, iLevel) & iLevel = iLevel, & & minLevel = me%geometry%tree%global%minLevel, & & schemeHeader = me%scheme%header, & - & quantities = me%scheme%layout%quantities ) + & quantities = me%scheme%layout%quantities, & + & needAuxHaloComm = me%scheme%needAuxHaloComm ) call tem_stopTimer( timerHandle = mus_timerHandles%aux(iLevel) ) ! -------------------------------------------------------------------------- diff --git a/source/mus_dynLoadBal_module.f90 b/source/mus_dynLoadBal_module.f90 index f983956..3ffae87 100644 --- a/source/mus_dynLoadBal_module.f90 +++ b/source/mus_dynLoadBal_module.f90 @@ -450,7 +450,8 @@ subroutine mus_reset_aux( scheme, params, geometry) & iLevel = iLevel, & & minLevel = geometry%tree%global%minLevel, & & schemeHeader = scheme%header, & - & quantities = scheme%layout%quantities ) + & quantities = scheme%layout%quantities, & + & needAuxHaloComm = scheme%needAuxHaloComm ) if (iLevel < maxLevel) then call mus_intpAuxFieldCoarserAndExchange( & @@ -461,7 +462,8 @@ subroutine mus_reset_aux( scheme, params, geometry) & stencil = scheme%layout%fStencil, & & iLevel = iLevel, & & nAuxScalars = scheme%varSys%nAuxScalars, & - & general = params%general ) + & general = params%general, & + & needAuxHaloComm = scheme%needAuxHaloComm ) end if end do diff --git a/source/mus_flow_module.fpp b/source/mus_flow_module.fpp index ff17e49..e75fcf2 100644 --- a/source/mus_flow_module.fpp +++ b/source/mus_flow_module.fpp @@ -1704,7 +1704,8 @@ write(dbgUnit(5), *) '' & varSys = scheme%varSys, & & derVarPos = scheme%derVarPos, & & general = general, & - & quantities = scheme%layout%quantities ) + & quantities = scheme%layout%quantities, & + & needAuxHaloComm = scheme%needAuxHaloComm ) end do ! Initilialize auxField ghostFromFiner and ghostFromCoarser with @@ -1718,7 +1719,8 @@ write(dbgUnit(5), *) '' & stencil = scheme%layout%fStencil, & & iLevel = iLevel, & & nAuxScalars = scheme%varSys%nAuxScalars, & - & general = general ) + & general = general, & + & needAuxHaloComm = scheme%needAuxHaloComm ) end do do iLevel = minLevel+1, maxLevel @@ -1730,7 +1732,8 @@ write(dbgUnit(5), *) '' & stencil = scheme%layout%fStencil, & & iLevel = iLevel, & & nAuxScalars = scheme%varSys%nAuxScalars, & - & general = general ) + & general = general, & + & needAuxHaloComm = scheme%needAuxHaloComm ) end do end subroutine mus_initAuxField diff --git a/source/mus_tracking_module.f90 b/source/mus_tracking_module.f90 index 5d86e4d..f00e0dc 100644 --- a/source/mus_tracking_module.f90 +++ b/source/mus_tracking_module.f90 @@ -72,6 +72,11 @@ subroutine mus_init_tracker( scheme, geometry, params ) integer :: iTrack, iConfig ! -------------------------------------------------------------------------- + select case (trim(scheme%header%kind)) + case ('fluid', 'fluid_incompressible') + scheme%needAuxHaloComm = scheme%field(1)%fieldProp%fluid%turbulence%active + end select + write(dbgUnit(1),*) 'Enter mus_init_tracker' write(dbgUnit(1),*) 'Tracking control active is: ', & & scheme%track%control%active @@ -113,8 +118,54 @@ subroutine mus_init_tracker( scheme, geometry, params ) & solver = params%general%solver, & & varSys = scheme%varSys ) + scheme%needAuxHaloComm = scheme%needAuxHaloComm & + & .or. mus_tracking_needs_velocity_gradient( & + & scheme = scheme ) + + if (scheme%needAuxHaloComm) then + write(logUnit(1),*) 'Auxiliary field halo communication activated.' + else + write(logUnit(1),*) 'Auxiliary field halo communication deactivated.' + end if + end subroutine mus_init_tracker ! **************************************************************************** ! + +! **************************************************************************** ! + !> Check whether any active tracking object requests velocity-gradient based + !! variables that require auxField halo values. + logical function mus_tracking_needs_velocity_gradient(scheme) + ! -------------------------------------------------------------------------- + type(mus_scheme_type), intent(in) :: scheme + ! -------------------------------------------------------------------------- + integer :: iTrack, iConfig, iVar + ! -------------------------------------------------------------------------- + + mus_tracking_needs_velocity_gradient = .false. + + if (.not. scheme%track%control%active) return + + select case (trim(scheme%header%kind)) + case ('fluid', 'fluid_incompressible') + continue + case default + return + end select + + do iTrack = 1, scheme%track%control%nActive + iConfig = scheme%track%instance(iTrack)%pntConfig + do iVar = 1, size(scheme%track%config(iConfig)%varName) + select case(trim(scheme%track%config(iConfig)%varName(iVar))) + case ('grad_velocity', 'vorticity', 'q_criterion', & + & 'grad_velocity_phy', 'vorticity_phy', 'q_criterion_phy') + mus_tracking_needs_velocity_gradient = .true. + return + end select + end do + end do + end function mus_tracking_needs_velocity_gradient +! **************************************************************************** ! + end module mus_tracking_module ! **************************************************************************** ! diff --git a/source/scheme/mus_scheme_type_module.f90 b/source/scheme/mus_scheme_type_module.f90 index ad83e2e..204fc43 100644 --- a/source/scheme/mus_scheme_type_module.f90 +++ b/source/scheme/mus_scheme_type_module.f90 @@ -138,6 +138,11 @@ module mus_scheme_type_module !> Contains trackingControl, config and instances type( tem_tracking_type ) :: track + !> Controls auxField halo communication. + !! Set during tracking initialization: + !! fluid/incompressible -> turbulence OR tracked grad-vars + !! otherwise remains false. + logical :: needAuxHaloComm = .false. !> Position of reduction transient variable in varSys type(tem_varMap_type) :: redTransVarMap From b6959053c2bc9a54a28a0a1d3bd312081741b3b5 Mon Sep 17 00:00:00 2001 From: mikew097 Date: Wed, 25 Feb 2026 15:47:06 +0100 Subject: [PATCH 3/6] flag aux to avoid interface change (corrections based on old base) --- source/mus_auxField_module.f90 | 31 +++++++++--------------- source/mus_control_module.f90 | 12 +++------ source/mus_dynLoadBal_module.f90 | 6 ++--- source/mus_flow_module.fpp | 9 +++---- source/mus_tracking_module.f90 | 18 +++++++++----- source/scheme/mus_scheme_type_module.f90 | 5 ---- 6 files changed, 32 insertions(+), 49 deletions(-) diff --git a/source/mus_auxField_module.f90 b/source/mus_auxField_module.f90 index 0d5d9ea..e7261f9 100644 --- a/source/mus_auxField_module.f90 +++ b/source/mus_auxField_module.f90 @@ -85,6 +85,8 @@ module mus_auxField_module type( tem_communication_type ) :: recvBufferFromCoarser !> My halos which are ghostFromFiner on remote processes type( tem_communication_type ) :: recvBufferFromFiner + !> Controls whether auxField halo exchange is required on this level. + logical :: needHaloComm = .false. end type mus_auxFieldVar_type abstract interface @@ -224,7 +226,7 @@ end subroutine mus_init_auxFieldArrays subroutine mus_initAuxFieldFluidAndExchange(auxField, state, neigh, nElems, & & nSize, nFields, stencil, varSys, & & derVarPos, iLevel, general, & - & quantities, needAuxHaloComm) + & quantities) !--------------------------------------------------------------------------- !> auxilary field array type(mus_auxFieldVar_type), intent(inout) :: auxField @@ -250,8 +252,6 @@ subroutine mus_initAuxFieldFluidAndExchange(auxField, state, neigh, nElems, & type(tem_general_type), intent(in) :: general !> Class that contains pointers to the proper derived quantities functions type(mus_scheme_derived_quantities_type), intent(in) :: quantities - !> Whether auxField halo communication is required - logical, intent(in) :: needAuxHaloComm !--------------------------------------------------------------------------- integer :: iField !--------------------------------------------------------------------------- @@ -272,7 +272,7 @@ subroutine mus_initAuxFieldFluidAndExchange(auxField, state, neigh, nElems, & ! communicate velocity field. Requires for tubulence to compute ShearRate ! from velocity gradient. ! exchange velocity halo on current level - if (needAuxHaloComm) then + if (auxField%needHaloComm) then call general%commpattern%exchange_real( & & send = auxField%sendBuffer, & & recv = auxField%recvBuffer, & @@ -290,8 +290,7 @@ end subroutine mus_initAuxFieldFluidAndExchange !! halos subroutine mus_calcAuxFieldAndExchange(auxField, calcAuxField, state, & & pdfData, nFields, field, globSrc, stencil, varSys, derVarPos, & - & phyConvFac, general, iLevel, minLevel, schemeHeader, quantities, & - & needAuxHaloComm) + & phyConvFac, general, iLevel, minLevel, schemeHeader, quantities) ! -------------------------------------------------------------------- ! !> auxilary field array type(mus_auxFieldVar_type), intent(inout) :: auxField @@ -325,8 +324,6 @@ subroutine mus_calcAuxFieldAndExchange(auxField, calcAuxField, state, & type(mus_scheme_header_type), intent(in) :: schemeHeader !> Class that contains pointers to the proper derived quantities functions type(mus_scheme_derived_quantities_type), intent(in) :: quantities - !> Whether auxField halo communication is required - logical, intent(in) :: needAuxHaloComm ! -------------------------------------------------------------------- ! integer :: nSolve, iField, iSrc ! -------------------------------------------------------------------- ! @@ -386,7 +383,7 @@ subroutine mus_calcAuxFieldAndExchange(auxField, calcAuxField, state, & ! communicate velocity field. Requires for tubulence to compute ShearRate ! from velocity gradient. ! exchange velocity halo on current level - if (needAuxHaloComm) then + if (auxField%needHaloComm) then call general%commpattern%exchange_real( & & send = auxField%sendBuffer, & & recv = auxField%recvBuffer , & @@ -396,7 +393,7 @@ subroutine mus_calcAuxFieldAndExchange(auxField, calcAuxField, state, & end if ! communicate ghost halos from coarser - if (needAuxHaloComm .and. iLevel > minLevel) then + if (auxField%needHaloComm .and. iLevel > minLevel) then call general%commpattern%exchange_real( & & send = auxField%sendBufferFromCoarser, & & recv = auxField%recvBufferFromCoarser , & @@ -413,8 +410,7 @@ end subroutine mus_calcAuxFieldAndExchange !! halos subroutine mus_intpAuxFieldCoarserAndExchange(intp, tAuxField, sAuxField, & & tLevelDesc, stencil, iLevel, & - & nAuxScalars, general, & - & needAuxHaloComm) + & nAuxScalars, general) ! -------------------------------------------------------------------- ! !> Interpolation type type(mus_interpolation_type), intent(inout) :: intp @@ -432,8 +428,6 @@ subroutine mus_intpAuxFieldCoarserAndExchange(intp, tAuxField, sAuxField, & integer, intent(in) :: nAuxScalars !> contains commPattern, MPI communicator and simControl type(tem_general_type), intent(in) :: general - !> Whether auxField halo communication is required - logical, intent(in) :: needAuxHaloComm ! -------------------------------------------------------------------- ! call intp%fillMineFromFiner%do_intpArbiVal( & & tLevelDesc = tLevelDesc, & @@ -447,7 +441,7 @@ subroutine mus_intpAuxFieldCoarserAndExchange(intp, tAuxField, sAuxField, & ! exchange velocity halo fromFiner, required to compute velocity ! gradient - if (needAuxHaloComm) then + if (tAuxField%needHaloComm) then call general%commPattern%exchange_real( & & send = tAuxField%sendBufferFromFiner, & & recv = tAuxField%recvBufferFromFiner, & @@ -464,8 +458,7 @@ end subroutine mus_intpAuxFieldCoarserAndExchange !! halos subroutine mus_intpAuxFieldFinerAndExchange(intp, tAuxField, sAuxField, & & tLevelDesc, stencil, iLevel, & - & nAuxScalars, general, & - & needAuxHaloComm) + & nAuxScalars, general) ! -------------------------------------------------------------------- ! !> Interpolation type type(mus_interpolation_type), intent(inout) :: intp @@ -483,8 +476,6 @@ subroutine mus_intpAuxFieldFinerAndExchange(intp, tAuxField, sAuxField, & integer, intent(in) :: nAuxScalars !> contains commPattern, MPI communicator and simControl type(tem_general_type), intent(in) :: general - !> Whether auxField halo communication is required - logical, intent(in) :: needAuxHaloComm ! -------------------------------------------------------------------- ! integer :: iOrder ! -------------------------------------------------------------------- ! @@ -502,7 +493,7 @@ subroutine mus_intpAuxFieldFinerAndExchange(intp, tAuxField, sAuxField, & ! exchange velocity halo fromFiner, required to compute velocity ! gradient - if (needAuxHaloComm) then + if (tAuxField%needHaloComm) then call general%commPattern%exchange_real( & & send = tAuxField%sendBufferFromCoarser, & & recv = tAuxField%recvBufferFromCoarser, & diff --git a/source/mus_control_module.f90 b/source/mus_control_module.f90 index ad5103a..9698933 100644 --- a/source/mus_control_module.f90 +++ b/source/mus_control_module.f90 @@ -335,8 +335,7 @@ recursive subroutine do_recursive_multiLevel(me, iLevel) & iLevel = iLevel, & & minLevel = me%geometry%tree%global%minLevel, & & schemeHeader = me%scheme%header, & - & quantities = me%scheme%layout%quantities, & - & needAuxHaloComm = me%scheme%needAuxHaloComm ) + & quantities = me%scheme%layout%quantities ) if (iLevel < me%geometry%tree%global%maxLevel) then write(logUnit(10), "(A)") 'Interpolate and exchange auxField in ' & @@ -349,8 +348,7 @@ recursive subroutine do_recursive_multiLevel(me, iLevel) & stencil = me%scheme%layout%fStencil, & & iLevel = iLevel, & & nAuxScalars = me%scheme%varSys%nAuxScalars, & - & general = me%params%general, & - & needAuxHaloComm = me%scheme%needAuxHaloComm ) + & general = me%params%general ) end if call tem_stopTimer( timerHandle = mus_timerHandles%aux(iLevel) ) @@ -579,8 +577,7 @@ subroutine do_fast_singleLevel( me, iLevel ) & iLevel = iLevel, & & minLevel = me%geometry%tree%global%minLevel, & & schemeHeader = me%scheme%header, & - & quantities = me%scheme%layout%quantities, & - & needAuxHaloComm = me%scheme%needAuxHaloComm ) + & quantities = me%scheme%layout%quantities ) call tem_stopTimer( timerHandle = mus_timerHandles%aux(iLevel) ) ! -------------------------------------------------------------------------- @@ -775,8 +772,7 @@ subroutine do_benchmark(me, iLevel) & iLevel = iLevel, & & minLevel = me%geometry%tree%global%minLevel, & & schemeHeader = me%scheme%header, & - & quantities = me%scheme%layout%quantities, & - & needAuxHaloComm = me%scheme%needAuxHaloComm ) + & quantities = me%scheme%layout%quantities ) call tem_stopTimer( timerHandle = mus_timerHandles%aux(iLevel) ) ! -------------------------------------------------------------------------- diff --git a/source/mus_dynLoadBal_module.f90 b/source/mus_dynLoadBal_module.f90 index 3ffae87..f983956 100644 --- a/source/mus_dynLoadBal_module.f90 +++ b/source/mus_dynLoadBal_module.f90 @@ -450,8 +450,7 @@ subroutine mus_reset_aux( scheme, params, geometry) & iLevel = iLevel, & & minLevel = geometry%tree%global%minLevel, & & schemeHeader = scheme%header, & - & quantities = scheme%layout%quantities, & - & needAuxHaloComm = scheme%needAuxHaloComm ) + & quantities = scheme%layout%quantities ) if (iLevel < maxLevel) then call mus_intpAuxFieldCoarserAndExchange( & @@ -462,8 +461,7 @@ subroutine mus_reset_aux( scheme, params, geometry) & stencil = scheme%layout%fStencil, & & iLevel = iLevel, & & nAuxScalars = scheme%varSys%nAuxScalars, & - & general = params%general, & - & needAuxHaloComm = scheme%needAuxHaloComm ) + & general = params%general ) end if end do diff --git a/source/mus_flow_module.fpp b/source/mus_flow_module.fpp index e75fcf2..ff17e49 100644 --- a/source/mus_flow_module.fpp +++ b/source/mus_flow_module.fpp @@ -1704,8 +1704,7 @@ write(dbgUnit(5), *) '' & varSys = scheme%varSys, & & derVarPos = scheme%derVarPos, & & general = general, & - & quantities = scheme%layout%quantities, & - & needAuxHaloComm = scheme%needAuxHaloComm ) + & quantities = scheme%layout%quantities ) end do ! Initilialize auxField ghostFromFiner and ghostFromCoarser with @@ -1719,8 +1718,7 @@ write(dbgUnit(5), *) '' & stencil = scheme%layout%fStencil, & & iLevel = iLevel, & & nAuxScalars = scheme%varSys%nAuxScalars, & - & general = general, & - & needAuxHaloComm = scheme%needAuxHaloComm ) + & general = general ) end do do iLevel = minLevel+1, maxLevel @@ -1732,8 +1730,7 @@ write(dbgUnit(5), *) '' & stencil = scheme%layout%fStencil, & & iLevel = iLevel, & & nAuxScalars = scheme%varSys%nAuxScalars, & - & general = general, & - & needAuxHaloComm = scheme%needAuxHaloComm ) + & general = general ) end do end subroutine mus_initAuxField diff --git a/source/mus_tracking_module.f90 b/source/mus_tracking_module.f90 index f00e0dc..3d44375 100644 --- a/source/mus_tracking_module.f90 +++ b/source/mus_tracking_module.f90 @@ -69,12 +69,14 @@ subroutine mus_init_tracker( scheme, geometry, params ) !> Global parameters type( mus_param_type ), intent(in) :: params ! -------------------------------------------------------------------------- - integer :: iTrack, iConfig + integer :: iTrack, iConfig, iLevel + logical :: needAuxHaloComm ! -------------------------------------------------------------------------- + needAuxHaloComm = .false. select case (trim(scheme%header%kind)) case ('fluid', 'fluid_incompressible') - scheme%needAuxHaloComm = scheme%field(1)%fieldProp%fluid%turbulence%active + needAuxHaloComm = scheme%field(1)%fieldProp%fluid%turbulence%active end select write(dbgUnit(1),*) 'Enter mus_init_tracker' @@ -118,11 +120,15 @@ subroutine mus_init_tracker( scheme, geometry, params ) & solver = params%general%solver, & & varSys = scheme%varSys ) - scheme%needAuxHaloComm = scheme%needAuxHaloComm & - & .or. mus_tracking_needs_velocity_gradient( & - & scheme = scheme ) + needAuxHaloComm = needAuxHaloComm & + & .or. mus_tracking_needs_velocity_gradient( & + & scheme = scheme ) - if (scheme%needAuxHaloComm) then + do iLevel = lbound(scheme%auxField, 1), ubound(scheme%auxField, 1) + scheme%auxField(iLevel)%needHaloComm = needAuxHaloComm + end do + + if (needAuxHaloComm) then write(logUnit(1),*) 'Auxiliary field halo communication activated.' else write(logUnit(1),*) 'Auxiliary field halo communication deactivated.' diff --git a/source/scheme/mus_scheme_type_module.f90 b/source/scheme/mus_scheme_type_module.f90 index 204fc43..ad83e2e 100644 --- a/source/scheme/mus_scheme_type_module.f90 +++ b/source/scheme/mus_scheme_type_module.f90 @@ -138,11 +138,6 @@ module mus_scheme_type_module !> Contains trackingControl, config and instances type( tem_tracking_type ) :: track - !> Controls auxField halo communication. - !! Set during tracking initialization: - !! fluid/incompressible -> turbulence OR tracked grad-vars - !! otherwise remains false. - logical :: needAuxHaloComm = .false. !> Position of reduction transient variable in varSys type(tem_varMap_type) :: redTransVarMap From 3309ee5f35b3594489ac11f72e74c448c9858b10 Mon Sep 17 00:00:00 2001 From: mikew097 Date: Fri, 27 Feb 2026 03:57:41 +0100 Subject: [PATCH 4/6] function auxfield_configure_from_tracking for needHaloComm flag setup --- source/mus_auxField_module.f90 | 86 +++++++++++++++++++- source/mus_aux_module.f90 | 6 ++ source/mus_construction_module.fpp | 10 ++- source/mus_dynLoadBal_module.f90 | 8 +- source/mus_harvesting/mus_hvs_aux_module.f90 | 6 ++ source/mus_tracking_module.f90 | 59 +------------- 6 files changed, 114 insertions(+), 61 deletions(-) diff --git a/source/mus_auxField_module.f90 b/source/mus_auxField_module.f90 index e7261f9..2824087 100644 --- a/source/mus_auxField_module.f90 +++ b/source/mus_auxField_module.f90 @@ -39,6 +39,8 @@ module mus_auxField_module & tem_comm_init use tem_construction_module, only: tem_levelDesc_type use tem_general_module, only: tem_general_type + use tem_tracking_module, only: tem_tracking_type + use tem_logging_module, only: logUnit use mus_derVarPos_module, only: mus_derVarPos_type use mus_scheme_header_module, only: mus_scheme_header_type @@ -60,6 +62,7 @@ module mus_auxField_module public :: mus_calcAuxFieldAndExchange public :: mus_intpAuxFieldCoarserAndExchange public :: mus_intpAuxFieldFinerAndExchange + public :: mus_auxField_configure_from_tracking !> Contains auxiliary field variable values per level and communication !! buffers @@ -134,7 +137,8 @@ end subroutine mus_proc_calcAuxField ! ************************************************************************* ! !> This routine initialize auxField var val array and communication buffers - subroutine mus_init_auxFieldArrays(me, levelDesc, pattern, nSize, nAuxScalars) + subroutine mus_init_auxFieldArrays(me, levelDesc, pattern, nSize, nAuxScalars, & + & needHaloComm) ! --------------------------------------------------------------------- ! !> Auxiliary field variable type(mus_auxFieldVar_type), intent(out) :: me @@ -146,8 +150,14 @@ subroutine mus_init_auxFieldArrays(me, levelDesc, pattern, nSize, nAuxScalars) integer, intent(in) :: nSize !> Number of scalars in auxiliary variables integer, intent(in) :: nAuxScalars + !> Default for halo communication flag + logical, intent(in), optional :: needHaloComm ! --------------------------------------------------------------------- ! ! --------------------------------------------------------------------- ! + if (present(needHaloComm)) then + me%needHaloComm = needHaloComm + end if + allocate(me%val(nSize * nAuxScalars)) me%val(:) = -1000000.0_rk @@ -504,4 +514,78 @@ subroutine mus_intpAuxFieldFinerAndExchange(intp, tAuxField, sAuxField, & end subroutine mus_intpAuxFieldFinerAndExchange ! ************************************************************************* ! + + + ! ************************************************************************* ! + !> Configure auxField halo communication once tracking information is known. + !! Uses the initialization default as baseline and only enables additional + !! communication when velocity-gradient tracking variables are requested. + subroutine mus_auxField_configure_from_tracking(auxField, track, schemeKind) + ! -------------------------------------------------------------------- ! + type(mus_auxFieldVar_type), intent(inout) :: auxField(:) + type(tem_tracking_type), intent(in) :: track + character(len=*), intent(in) :: schemeKind + ! -------------------------------------------------------------------- ! + integer :: iLevel + logical :: needHaloComm + ! -------------------------------------------------------------------- ! + + if (size(auxField) == 0) return + + needHaloComm = auxField(lbound(auxField, 1))%needHaloComm + needHaloComm = needHaloComm & + & .or. aux_tracking_needs_velocity_gradient( & + & track = track, & + & schemeKind = schemeKind ) + + do iLevel = lbound(auxField, 1), ubound(auxField, 1) + auxField(iLevel)%needHaloComm = needHaloComm + end do + + if (needHaloComm) then + write(logUnit(1),*) 'Auxiliary field halo communication activated.' + else + write(logUnit(1),*) 'Auxiliary field halo communication deactivated.' + end if + + end subroutine mus_auxField_configure_from_tracking + ! ************************************************************************* ! + + + ! ************************************************************************* ! + !> Check if active tracking requests velocity-gradient based quantities. + logical function aux_tracking_needs_velocity_gradient(track, schemeKind) + ! -------------------------------------------------------------------- ! + type(tem_tracking_type), intent(in) :: track + character(len=*), intent(in) :: schemeKind + ! -------------------------------------------------------------------- ! + integer :: iTrack, iConfig, iVar + ! -------------------------------------------------------------------- ! + + aux_tracking_needs_velocity_gradient = .false. + + if (.not. track%control%active) return + + select case (trim(schemeKind)) + case ('fluid', 'fluid_incompressible') + continue + case default + return + end select + + do iTrack = 1, track%control%nActive + iConfig = track%instance(iTrack)%pntConfig + do iVar = 1, size(track%config(iConfig)%varName) + select case(trim(track%config(iConfig)%varName(iVar))) + case ('grad_velocity', 'vorticity', 'q_criterion', & + & 'grad_velocity_phy', 'vorticity_phy', 'q_criterion_phy') + aux_tracking_needs_velocity_gradient = .true. + return + end select + end do + end do + + end function aux_tracking_needs_velocity_gradient + ! ************************************************************************* ! + end module mus_auxField_module diff --git a/source/mus_aux_module.f90 b/source/mus_aux_module.f90 index 95e033f..3ace0c5 100644 --- a/source/mus_aux_module.f90 +++ b/source/mus_aux_module.f90 @@ -63,6 +63,7 @@ module mus_aux_module use mus_turbulence_module, only: mus_turb_updateViscOfTurbWall use mus_field_module, only: setParameters_multispecies use mus_tracking_module, only: mus_init_tracker + use mus_auxField_module, only: mus_auxField_configure_from_tracking use mus_restart_module, only: mus_writeRestart use mus_timer_module, only: mus_timerHandles use mus_physics_module, only: mus_physics_type @@ -376,6 +377,11 @@ subroutine mus_init_aux( scheme, geometry, params) & geometry = geometry, & & params = params ) + call mus_auxField_configure_from_tracking( & + & auxField = scheme%auxField, & + & track = scheme%track, & + & schemeKind = scheme%header%kind ) + ! convergence objects if ( params%general%simControl%abortCriteria%steady_state ) then write(logUnit(1),*) 'Initializing convergence...' diff --git a/source/mus_construction_module.fpp b/source/mus_construction_module.fpp index 7a890fb..1bad72a 100644 --- a/source/mus_construction_module.fpp +++ b/source/mus_construction_module.fpp @@ -206,6 +206,7 @@ contains type( logical_array_type ), allocatable :: haloRequired(:) integer :: symmetricBCs(geometry%boundary%nBCtypes) integer :: nSymBCs + logical :: needAuxHaloCommDefault ! -------------------------------------------------------------------------- minLevel = geometry%tree%global%minLevel maxLevel = geometry%tree%global%maxLevel @@ -650,13 +651,20 @@ contains deallocate( haloRequired ) ! Initialize auxField var val array and communication buffers + needAuxHaloCommDefault = .false. + select case (trim(scheme%header%kind)) + case ('fluid', 'fluid_incompressible') + needAuxHaloCommDefault = scheme%field(1)%fieldProp%fluid%turbulence%active + end select + allocate(scheme%auxField(minLevel:maxLevel)) do iLevel = minLevel, maxLevel call mus_init_auxFieldArrays( me = scheme%auxField(iLevel), & & levelDesc = scheme%levelDesc(iLevel), & & pattern = params%general%commPattern, & & nSize = scheme%pdf(iLevel)%nSize, & - & nAuxScalars = scheme%varSys%nAuxScalars ) + & nAuxScalars = scheme%varSys%nAuxScalars, & + & needHaloComm = needAuxHaloCommDefault ) end do call tem_write_debugMesh( globtree = geometry%tree, & diff --git a/source/mus_dynLoadBal_module.f90 b/source/mus_dynLoadBal_module.f90 index f983956..0616a0b 100644 --- a/source/mus_dynLoadBal_module.f90 +++ b/source/mus_dynLoadBal_module.f90 @@ -98,7 +98,8 @@ module mus_dynLoadBal_module & mus_pdf_serialize use mus_weights_module, only: mus_getWeights, mus_dumpWeights use mus_auxField_module, only: mus_calcAuxFieldAndExchange, & - & mus_intpAuxFieldCoarserAndExchange + & mus_intpAuxFieldCoarserAndExchange, & + & mus_auxField_configure_from_tracking implicit none @@ -371,6 +372,11 @@ subroutine mus_reset_aux( scheme, params, geometry) call mus_init_tracker( scheme = scheme, & & geometry = geometry, & & params = params ) + + call mus_auxField_configure_from_tracking( & + & auxField = scheme%auxField, & + & track = scheme%track, & + & schemeKind = scheme%header%kind ) ! ------------------------------------------------------------------------ ! Reinitialize the tracking objects ! ! ------------------------------------------------------------------------ diff --git a/source/mus_harvesting/mus_hvs_aux_module.f90 b/source/mus_harvesting/mus_hvs_aux_module.f90 index 351a946..8695317 100644 --- a/source/mus_harvesting/mus_hvs_aux_module.f90 +++ b/source/mus_harvesting/mus_hvs_aux_module.f90 @@ -40,6 +40,7 @@ module mus_hvs_aux_module use mus_fluid_module, only: mus_init_fluid use mus_gradData_module, only: mus_init_gradData use mus_tracking_module, only: mus_init_tracker + use mus_auxField_module, only: mus_auxField_configure_from_tracking use mus_bndForce_module, only: mus_init_BndForce ! include treelm modules @@ -149,6 +150,11 @@ subroutine mus_hvs_init_aux( scheme, geometry, params ) & geometry = geometry, & & params = params ) + call mus_auxField_configure_from_tracking( & + & auxField = scheme%auxField, & + & track = scheme%track, & + & schemeKind = scheme%header%kind ) + if( minLevel /= maxlevel ) then write(logUnit(1),*) 'Initializing interpolation...' ! initialize the interpolation diff --git a/source/mus_tracking_module.f90 b/source/mus_tracking_module.f90 index 3d44375..5d86e4d 100644 --- a/source/mus_tracking_module.f90 +++ b/source/mus_tracking_module.f90 @@ -69,16 +69,9 @@ subroutine mus_init_tracker( scheme, geometry, params ) !> Global parameters type( mus_param_type ), intent(in) :: params ! -------------------------------------------------------------------------- - integer :: iTrack, iConfig, iLevel - logical :: needAuxHaloComm + integer :: iTrack, iConfig ! -------------------------------------------------------------------------- - needAuxHaloComm = .false. - select case (trim(scheme%header%kind)) - case ('fluid', 'fluid_incompressible') - needAuxHaloComm = scheme%field(1)%fieldProp%fluid%turbulence%active - end select - write(dbgUnit(1),*) 'Enter mus_init_tracker' write(dbgUnit(1),*) 'Tracking control active is: ', & & scheme%track%control%active @@ -120,58 +113,8 @@ subroutine mus_init_tracker( scheme, geometry, params ) & solver = params%general%solver, & & varSys = scheme%varSys ) - needAuxHaloComm = needAuxHaloComm & - & .or. mus_tracking_needs_velocity_gradient( & - & scheme = scheme ) - - do iLevel = lbound(scheme%auxField, 1), ubound(scheme%auxField, 1) - scheme%auxField(iLevel)%needHaloComm = needAuxHaloComm - end do - - if (needAuxHaloComm) then - write(logUnit(1),*) 'Auxiliary field halo communication activated.' - else - write(logUnit(1),*) 'Auxiliary field halo communication deactivated.' - end if - end subroutine mus_init_tracker ! **************************************************************************** ! - -! **************************************************************************** ! - !> Check whether any active tracking object requests velocity-gradient based - !! variables that require auxField halo values. - logical function mus_tracking_needs_velocity_gradient(scheme) - ! -------------------------------------------------------------------------- - type(mus_scheme_type), intent(in) :: scheme - ! -------------------------------------------------------------------------- - integer :: iTrack, iConfig, iVar - ! -------------------------------------------------------------------------- - - mus_tracking_needs_velocity_gradient = .false. - - if (.not. scheme%track%control%active) return - - select case (trim(scheme%header%kind)) - case ('fluid', 'fluid_incompressible') - continue - case default - return - end select - - do iTrack = 1, scheme%track%control%nActive - iConfig = scheme%track%instance(iTrack)%pntConfig - do iVar = 1, size(scheme%track%config(iConfig)%varName) - select case(trim(scheme%track%config(iConfig)%varName(iVar))) - case ('grad_velocity', 'vorticity', 'q_criterion', & - & 'grad_velocity_phy', 'vorticity_phy', 'q_criterion_phy') - mus_tracking_needs_velocity_gradient = .true. - return - end select - end do - end do - end function mus_tracking_needs_velocity_gradient -! **************************************************************************** ! - end module mus_tracking_module ! **************************************************************************** ! From 93be1708b7cd67c6c2731c1d59880b768ab61e73 Mon Sep 17 00:00:00 2001 From: Harald Klimach Date: Sat, 28 Feb 2026 07:49:10 +0100 Subject: [PATCH 5/6] Some formatting --- source/mus_auxField_module.f90 | 32 +- source/mus_aux_module.f90 | 8 +- source/mus_construction_module.fpp | 343 ++++++++++--------- source/mus_harvesting/mus_hvs_aux_module.f90 | 8 +- 4 files changed, 199 insertions(+), 192 deletions(-) diff --git a/source/mus_auxField_module.f90 b/source/mus_auxField_module.f90 index 2824087..e8c54c0 100644 --- a/source/mus_auxField_module.f90 +++ b/source/mus_auxField_module.f90 @@ -132,13 +132,13 @@ end subroutine mus_proc_calcAuxField end interface - contains + ! ************************************************************************* ! !> This routine initialize auxField var val array and communication buffers - subroutine mus_init_auxFieldArrays(me, levelDesc, pattern, nSize, nAuxScalars, & - & needHaloComm) + subroutine mus_init_auxFieldArrays(me, levelDesc, pattern, nSize, & + & nAuxScalars, needHaloComm ) ! --------------------------------------------------------------------- ! !> Auxiliary field variable type(mus_auxFieldVar_type), intent(out) :: me @@ -300,7 +300,7 @@ end subroutine mus_initAuxFieldFluidAndExchange !! halos subroutine mus_calcAuxFieldAndExchange(auxField, calcAuxField, state, & & pdfData, nFields, field, globSrc, stencil, varSys, derVarPos, & - & phyConvFac, general, iLevel, minLevel, schemeHeader, quantities) + & phyConvFac, general, iLevel, minLevel, schemeHeader, quantities ) ! -------------------------------------------------------------------- ! !> auxilary field array type(mus_auxFieldVar_type), intent(inout) :: auxField @@ -420,7 +420,7 @@ end subroutine mus_calcAuxFieldAndExchange !! halos subroutine mus_intpAuxFieldCoarserAndExchange(intp, tAuxField, sAuxField, & & tLevelDesc, stencil, iLevel, & - & nAuxScalars, general) + & nAuxScalars, general ) ! -------------------------------------------------------------------- ! !> Interpolation type type(mus_interpolation_type), intent(inout) :: intp @@ -468,7 +468,7 @@ end subroutine mus_intpAuxFieldCoarserAndExchange !! halos subroutine mus_intpAuxFieldFinerAndExchange(intp, tAuxField, sAuxField, & & tLevelDesc, stencil, iLevel, & - & nAuxScalars, general) + & nAuxScalars, general ) ! -------------------------------------------------------------------- ! !> Interpolation type type(mus_interpolation_type), intent(inout) :: intp @@ -533,10 +533,10 @@ subroutine mus_auxField_configure_from_tracking(auxField, track, schemeKind) if (size(auxField) == 0) return needHaloComm = auxField(lbound(auxField, 1))%needHaloComm - needHaloComm = needHaloComm & - & .or. aux_tracking_needs_velocity_gradient( & - & track = track, & - & schemeKind = schemeKind ) + needHaloComm = needHaloComm & + & .or. aux_tracking_needs_velocity_gradient( & + & track = track, & + & schemeKind = schemeKind ) do iLevel = lbound(auxField, 1), ubound(auxField, 1) auxField(iLevel)%needHaloComm = needHaloComm @@ -545,7 +545,7 @@ subroutine mus_auxField_configure_from_tracking(auxField, track, schemeKind) if (needHaloComm) then write(logUnit(1),*) 'Auxiliary field halo communication activated.' else - write(logUnit(1),*) 'Auxiliary field halo communication deactivated.' + write(logUnit(1),*) 'Auxiliary field halo communication DEACTIVATED.' end if end subroutine mus_auxField_configure_from_tracking @@ -554,15 +554,17 @@ end subroutine mus_auxField_configure_from_tracking ! ************************************************************************* ! !> Check if active tracking requests velocity-gradient based quantities. - logical function aux_tracking_needs_velocity_gradient(track, schemeKind) + function aux_tracking_needs_velocity_gradient(track, schemeKind) & + & result(needed) ! -------------------------------------------------------------------- ! type(tem_tracking_type), intent(in) :: track character(len=*), intent(in) :: schemeKind + logical :: needed ! -------------------------------------------------------------------- ! integer :: iTrack, iConfig, iVar ! -------------------------------------------------------------------- ! - aux_tracking_needs_velocity_gradient = .false. + needed = .false. if (.not. track%control%active) return @@ -577,9 +579,9 @@ logical function aux_tracking_needs_velocity_gradient(track, schemeKind) iConfig = track%instance(iTrack)%pntConfig do iVar = 1, size(track%config(iConfig)%varName) select case(trim(track%config(iConfig)%varName(iVar))) - case ('grad_velocity', 'vorticity', 'q_criterion', & + case ('grad_velocity', 'vorticity', 'q_criterion', & & 'grad_velocity_phy', 'vorticity_phy', 'q_criterion_phy') - aux_tracking_needs_velocity_gradient = .true. + needed = .true. return end select end do diff --git a/source/mus_aux_module.f90 b/source/mus_aux_module.f90 index 3ace0c5..b932d52 100644 --- a/source/mus_aux_module.f90 +++ b/source/mus_aux_module.f90 @@ -377,10 +377,10 @@ subroutine mus_init_aux( scheme, geometry, params) & geometry = geometry, & & params = params ) - call mus_auxField_configure_from_tracking( & - & auxField = scheme%auxField, & - & track = scheme%track, & - & schemeKind = scheme%header%kind ) + call mus_auxField_configure_from_tracking( & + & auxField = scheme%auxField, & + & track = scheme%track, & + & schemeKind = scheme%header%kind ) ! convergence objects if ( params%general%simControl%abortCriteria%steady_state ) then diff --git a/source/mus_construction_module.fpp b/source/mus_construction_module.fpp index 1bad72a..f34c963 100644 --- a/source/mus_construction_module.fpp +++ b/source/mus_construction_module.fpp @@ -226,14 +226,14 @@ contains ! boundaries ! 4. allocate the BC lists in globbc ! THIS ROUTINE DOES NOT MODIFY THE BC LISTS IN THE FIELDS!!! - call build_BClists( globBC = scheme%globBC, & - & tree = geometry%tree, & - & bc_prop = geometry%boundary, & - & minLevel = minLevel, & - & maxLevel = maxLevel, & - & layout = scheme%layout, & - & field = scheme%field(:), & - & comm = params%general%proc%comm ) + call build_BClists( globBC = scheme%globBC, & + & tree = geometry%tree, & + & bc_prop = geometry%boundary, & + & minLevel = minLevel, & + & maxLevel = maxLevel, & + & layout = scheme%layout, & + & field = scheme%field(:), & + & comm = params%general%proc%comm ) ! Treat the boundary lists: in addition to the normal stencil treatment ! one has to find all those elements along the element list in the stencil @@ -261,9 +261,9 @@ contains enddo ! iField ! Build and append IBM stencils to stencil array - call mus_build_IBMStencils( globIBM = geometry%globIBM, & - & layout = scheme%layout, & - & grwStencil = scheme%layout%grwStencil ) + call mus_build_IBMStencils( globIBM = geometry%globIBM, & + & layout = scheme%layout, & + & grwStencil = scheme%layout%grwStencil ) ! finalize scheme layout ! copy growing array of stencil to allocatable array of stencil @@ -282,7 +282,7 @@ contains ! directly ! THIS MEANS THAT FOR ALL ELEMENTS (INCL. BOUNDARY ELEMENTS) NEIGHBORS ! ARE STORED BUT THEY DO NOT NEED TO EXIST IN THE MESH AT THIS POINT!!! - call tem_init_elemLevels( me = scheme%levelDesc, & + call tem_init_elemLevels( me = scheme%levelDesc, & & boundary = geometry%boundary, & & tree = geometry%tree, & & stencils = scheme%layout%stencil(:) ) @@ -331,11 +331,11 @@ contains write(dbgUnit(6),*) 'before horizontal dep' write(logUnit(6),*) 'before tem_build_horizontalDependencies' do iStencil = 1, scheme%layout%nStencils - call tem_build_horizontalDependencies( & - & iStencil = iStencil, & - & levelDesc = scheme%levelDesc, & - & tree = geometry%tree, & - & computeStencil = scheme%layout%stencil(iStencil) ) + call tem_build_horizontalDependencies( & + & iStencil = iStencil, & + & levelDesc = scheme%levelDesc, & + & tree = geometry%tree, & + & computeStencil = scheme%layout%stencil(iStencil) ) ?? IF( .not. SOA) then if( main_debug%checkDependencies ) then call tem_debug_HorizontalDependencies( iStencil, & @@ -352,27 +352,27 @@ contains write(logUnit(6),*) 'before communicate_property' do iLevel = minLevel, maxLevel - call communicate_property( & - & send = scheme%levelDesc( iLevel )%sendbuffer,& - & recv = scheme%levelDesc( iLevel )%recvbuffer,& - & property = scheme%levelDesc( iLevel )%property, & - & flag = iLevel, & - & proc = params%general%proc, & - & pattern = params%general%commPattern ) - call communicate_property( & - & send = scheme%levelDesc( iLevel )%sendbufferFromCoarser, & - & recv = scheme%levelDesc( iLevel )%recvbufferFromCoarser, & - & property = scheme%levelDesc( iLevel )%property, & - & flag = iLevel, & - & proc = params%general%proc, & - & pattern = params%general%commPattern ) - call communicate_property( & - & send = scheme%levelDesc( iLevel )%sendbufferFromFiner, & - & recv = scheme%levelDesc( iLevel )%recvbufferFromFiner, & - & property = scheme%levelDesc( iLevel )%property, & - & flag = iLevel, & - & proc = params%general%proc, & - & pattern = params%general%commPattern ) + call communicate_property( & + & send = scheme%levelDesc( iLevel )%sendbuffer, & + & recv = scheme%levelDesc( iLevel )%recvbuffer, & + & property = scheme%levelDesc( iLevel )%property, & + & flag = iLevel, & + & proc = params%general%proc, & + & pattern = params%general%commPattern ) + call communicate_property( & + & send = scheme%levelDesc( iLevel )%sendbufferFromCoarser, & + & recv = scheme%levelDesc( iLevel )%recvbufferFromCoarser, & + & property = scheme%levelDesc( iLevel )%property, & + & flag = iLevel, & + & proc = params%general%proc, & + & pattern = params%general%commPattern ) + call communicate_property( & + & send = scheme%levelDesc( iLevel )%sendbufferFromFiner, & + & recv = scheme%levelDesc( iLevel )%recvbufferFromFiner, & + & property = scheme%levelDesc( iLevel )%property, & + & flag = iLevel, & + & proc = params%general%proc, & + & pattern = params%general%commPattern ) end do ! iLevel ! peakval = my_status_int('VmPeak:') ! write(logUnit(10),"(A,I0)") 'After comm property, VmPeak: ', peakval @@ -592,7 +592,7 @@ contains call set_halo_commLinks( scheme, minLevel, maxLevel, & & geometry%boundary%nBCtypes, & & params%comm_reduced, & - & haloRequired ) + & haloRequired ) write(dbgUnit(6),*) 'before init levelBuffers' @@ -614,7 +614,7 @@ contains & comm = params%general%proc%comm, & & scheme = scheme, & & stat = stat, & - & haloRequired = haloRequired(iLevel)%val, & + & haloRequired = haloRequired(iLevel)%val, & & offset = scheme%levelDesc( iLevel )%offset ) @@ -1032,9 +1032,9 @@ contains & %depFromCoarser( iElem )%elem%val( iSourceElem ) ! Check the type of the source element. ! If it is a halo -> mark as require all links - call set_requiredLink( & - & haloElem = sourceElem, & - & offset = haloOffset, & + call set_requiredLink( & + & haloElem = sourceElem, & + & offset = haloOffset, & & linkField = haloRequired( sourceLevel )%val ) end do ! iSourceElem end do ! iElem @@ -1050,9 +1050,9 @@ contains & nElemsProc( iProc ) elemPos = scheme%levelDesc( iLevel )%recvBufferFromCoarser% & & elemPos( iProc )%val( iElem ) - call set_requiredLink( & - & haloElem = elemPos, & - & offset = haloOffset, & + call set_requiredLink( & + & haloElem = elemPos, & + & offset = haloOffset, & & linkField = haloRequired( iLevel )%val ) end do end do @@ -1065,9 +1065,9 @@ contains & nElemsProc( iProc ) elemPos = scheme%levelDesc( iLevel )%recvBufferFromFiner% & & elemPos( iProc )%val( iElem ) - call set_requiredLink( & - & haloElem = elemPos, & - & offset = haloOffset, & + call set_requiredLink( & + & haloElem = elemPos, & + & offset = haloOffset, & & linkField = haloRequired( iLevel )%val ) end do end do @@ -1084,9 +1084,9 @@ contains ! Get the neighbor source element sourceElem = scheme%field( iField )%bc( iBnd ) & & %neigh( iLevel )%posInState( iNeigh, iElem ) - call set_requiredLink( & - & haloElem = sourceElem, & - & offset = haloOffset, & + call set_requiredLink( & + & haloElem = sourceElem, & + & offset = haloOffset, & & linkField = haloRequired( iLevel )%val ) end do ! iNeigh end do ! iField @@ -1108,9 +1108,9 @@ contains sourceElem = scheme%levelDesc(iLevel)%neigh(1)% & & nghElems(?NgDir?(iNeigh, scheme%layout%fStencil),elemPos) ! if sourceElem < 0 then this neighbor is boundary - call set_requiredLink( & - & haloElem = sourceElem, & - & offset = haloOffset, & + call set_requiredLink( & + & haloElem = sourceElem, & + & offset = haloOffset, & & linkField = haloRequired( iLevel )%val ) end do ! iNeigh end do ! iElem @@ -1399,19 +1399,19 @@ contains ! Calculate the total number of fluid elements in ALL LEVELS and processes ! count level-wise global nElems_total - ElemCount(minLevel:maxLevel) = & - & levelDesc( minLevel:maxLevel )%elem%nElems( eT_fluid ) & + ElemCount(minLevel:maxLevel) = & + & levelDesc( minLevel:maxLevel )%elem%nElems( eT_fluid ) & & + levelDesc( minLevel:maxLevel )%elem%nElems( eT_ghostFromCoarser ) & - & + levelDesc( minLevel:maxLevel )%elem%nElems( eT_ghostFromFiner ) & + & + levelDesc( minLevel:maxLevel )%elem%nElems( eT_ghostFromFiner ) & & + levelDesc( minLevel:maxLevel )%elem%nElems( eT_halo ) - call mpi_allreduce( ElemCount(minLevel:maxLevel), & + call mpi_allreduce( ElemCount(minLevel:maxLevel), & & nElems_allLevel(minLevel:maxLevel), & & nLevels, mpi_integer8, mpi_sum, proc%comm, iErr ) ! count level-wise global nElems_fluid - ElemCount(minLevel:maxLevel) = & + ElemCount(minLevel:maxLevel) = & & levelDesc( minLevel:maxLevel )%elem%nElems( eT_fluid ) - call mpi_allreduce( ElemCount(minLevel:maxLevel), & + call mpi_allreduce( ElemCount(minLevel:maxLevel), & & nElems_fluidLevel(minLevel:maxLevel), & & nLevels, mpi_integer8, mpi_sum, proc%comm, iErr ) @@ -1426,9 +1426,9 @@ contains end do ! count global ghost call mpi_allreduce( myGhostFromFiner, nElems_totalGhostFromFiner, & - & 1, mpi_integer, mpi_sum, proc%comm, iErr ) + & 1, mpi_integer, mpi_sum, proc%comm, iErr ) call mpi_allreduce( myGhostFromCoarser, nElems_totalGhostFromCoarser, & - & 1, mpi_integer, mpi_sum, proc%comm, iErr ) + & 1, mpi_integer, mpi_sum, proc%comm, iErr ) nElems_overall = sum( nElems_allLevel( minLevel:maxLevel )) do iLevel = minLevel, maxLevel @@ -1484,16 +1484,16 @@ contains ! set posInNghElems in scheme%field(iField)%bc do iField = 1, scheme%nFields do iBnd = 1, nBCs - call mus_set_posInNghElems( minLevel, maxLevel, & - & scheme%layout%nStencils, & - & scheme%globBC(iBnd), & + call mus_set_posInNghElems( minLevel, maxLevel, & + & scheme%layout%nStencils, & + & scheme%globBC(iBnd), & & scheme%field(iField)%bc(iBnd) ) end do end do if ( remove_solid .and. (nBCs > 0) ) then - call remove_solid_in_bc( minLevel, maxLevel, nBCs, & - & scheme%nFields, LP, & + call remove_solid_in_bc( minLevel, maxLevel, nBCs, & + & scheme%nFields, LP, & & scheme%levelDesc, scheme%globBC, scheme%field ) end if @@ -1507,7 +1507,7 @@ contains do iBnd = 1, nBCs bcBufferSize = bcBufferSize + scheme%globBC( iBnd )%nElems( iLevel ) end do ! iBnd - call init( me = scheme%levelDesc( iLevel )%bc_elemBuffer, & + call init( me = scheme%levelDesc( iLevel )%bc_elemBuffer, & & length = bcBufferSize ) do iBnd = 1, nBCs ! if BC kind of all fields are wall then do nothing for this boundary @@ -1523,13 +1523,13 @@ contains scheme%globBC( iBnd )%elemLvl( iLevel )%elem%val( iElem ) = elemPos ! store elemPos in bc_elemBuffer - call append( me = scheme%levelDesc( iLevel )%bc_elemBuffer, & - & val = elemPos, & + call append( me = scheme%levelDesc( iLevel )%bc_elemBuffer, & + & val = elemPos, & & pos = iPos ) ! store the position in the bc_elemBuffer in the elemBuffer - call append ( me = scheme%globBC( iBnd )%elemLvl( iLevel )% & - & posInBcElemBuf, & - & val = iPos ) + call append ( me = scheme%globBC( iBnd )%elemLvl( iLevel ) & + & %posInBcElemBuf, & + & val = iPos ) end do ! iElem in globBC%nElems on the current level ! elem and elemBuffer for corner nodes @@ -1609,11 +1609,11 @@ contains end if if (scheme%field( iField )%bc( iBnd )%requireNeighBufPost) then - allocate( scheme%field( iField )%bc( iBnd )% & - & neigh( iLevel )%neighBufferPost( & - & scheme%field( iField )%bc( iBnd )%nNeighs, & - & scheme%globBC( iBnd )%nElems( iLevel )* & - & scheme%layout%fStencil%QQ ) ) + allocate( scheme%field( iField )%bc( iBnd )% & + & neigh( iLevel )%neighBufferPost( & + & scheme%field( iField )%bc( iBnd )%nNeighs, & + & scheme%globBC( iBnd )%nElems( iLevel )* & + & scheme%layout%fStencil%QQ ) ) scheme%field(iField)%bc(iBnd)%neigh(iLevel)%neighBufferPost & & = -1._rk end if @@ -1622,7 +1622,7 @@ contains allocate( scheme%field( iField )%bc( iBnd )%neigh( iLevel ) & & %computeNeighBuf( & & scheme%globBC( iBnd )%nElems( iLevel )* & - & scheme%layout%fStencil%QQ ) ) + & scheme%layout%fStencil%QQ ) ) scheme%field( iField )%bc( iBnd )%neigh( iLevel ) & & %computeNeighBuf = -1._rk end if @@ -1640,12 +1640,12 @@ contains ! Copy the neighboring information to the bc%elem%neigh if( scheme%field( iField )%bc( iBnd )%nNeighs > 0 ) then ! get position of neighbor element in the levelwise list - call setFieldBCNeigh( & - & fieldBC = scheme%field( iField )%bc( iBnd ), & - & globBC = scheme%globBC( iBnd ), & - & levelDesc = scheme%levelDesc(minLevel:maxLevel),& - & minLevel = minLevel, & - & maxLevel = maxLevel ) + call setFieldBCNeigh( & + & fieldBC = scheme%field( iField )%bc( iBnd ), & + & globBC = scheme%globBC( iBnd ), & + & levelDesc = scheme%levelDesc(minLevel:maxLevel), & + & minLevel = minLevel, & + & maxLevel = maxLevel ) end if ! nNeigh>0 end do ! iBnd end do ! iField @@ -1795,7 +1795,7 @@ contains neighLoop: do iNeigh = 1, fieldBC%nNeighs ! neighbor position in the levelwise list - neighVal = levelDesc( iLevel )%neigh( stencilPos )% & + neighVal = levelDesc( iLevel )%neigh( stencilPos )% & & nghElems( iNeigh, posInNghElems ) ?? if( DEBUG ) then write(dbgUnit(10),*) 'iNeigh:', iNeigh, 'neighval:', neighVal @@ -1806,7 +1806,7 @@ contains if ( neighVal < 1 ) then if ( iNeigh == 1 ) then ?? if( DEBUG ) then - write(dbgUnit(6),*) 'setting current elemPos',& + write(dbgUnit(6),*) 'setting current elemPos', & globBC%elemLvl( iLevel )%elem%val( iElem ) ?? endif @@ -1825,7 +1825,7 @@ contains ! Neighbor fails, so take last neighbor which was valid fieldBC%neigh( iLevel )%posInState( iNeigh:, iElem ) = & & fieldBC%neigh( iLevel )%posInState( iNeigh-1, iElem ) - write(logUnit(1),"(A,I0,A,I5,A)") 'neighbor number ',iNeigh, & + write(logUnit(1),"(A,I0,A,I5,A)") 'neighbor number ',iNeigh, & & ' not found for elem:', iElem,'. Use last found neighbor.' end if ! iNeigh = 1 ! no need to find further neighbors @@ -1889,7 +1889,7 @@ contains ! Neighbor fails, so take last neighbor which was valid fieldBC%neigh( iLevel )%posInState( iNeigh:, iElem ) = & & fieldBC%neigh( iLevel )%posInState( iNeigh-1, iElem ) - write(logUnit(1),"(A,I0,A,I5,A)") 'neighbor number ',ineigh, & + write(logUnit(1),"(A,I0,A,I5,A)") 'neighbor number ',ineigh, & & ' not found for elem:', iElem,'. Use last found neighbor.' end if ! iNeigh = 1 ! no need to find further neighbors @@ -1924,7 +1924,7 @@ contains !! stored to the FETCH position !! subroutine build_BClists( globBC, tree, bc_prop, minLevel, maxLevel, & - & layout, field, comm ) + & layout, field, comm ) ! -------------------------------------------------------------------------- !> fluid tree from mesh type( treelmesh_type ), intent(in) :: tree @@ -2286,32 +2286,32 @@ contains ! If this boundary ID was not found for current element yet, ! assign to list - if( .not. allocated( globBC(bID)%elemLvl(level)%elem%val))then - write(dbgUnit(1),*) 'Error: bc not allctd lvl ', level, & + if( .not. allocated( globBC(bID)%elemLvl(level)%elem%val)) then + write(dbgUnit(1),*) 'Error: bc not allctd lvl ', level, & & ' bid ', bID end if ! append the position of the treeID in tree%treeID list ! to the boundary elem lists - call append( me = globBC( bID )%elemLvl( level )%elem, & - & val = posInTree, & - & pos = nBnds( bID ), & - & wasadded = wasadded ) + call append( me = globBC( bID )%elemLvl( level )%elem, & + & val = posInTree, & + & pos = nBnds( bID ), & + & wasadded = wasadded ) if ( wasadded ) then bitmask = .false. normal = 0 !append the bitmask for bID call append( me = globBC( bID )%elemLvl( level )%bitmask, & - & val = bitmask ) + & val = bitmask ) !append normal call append( me = globBC( bID )%elemLvl( level )%normal, & - & val = normal ) + & val = normal ) if ( globBC( bID )%hasQVal ) then !append qVal call append( me = globBC( bID )%elemLvl( level )%qVal, & - & val = qVal ) + & val = qVal ) end if ! haQval found( bID ) = .true. @@ -2339,8 +2339,8 @@ contains ! Add this boundary direction to the sum for the normal vector ! use the minus, as we want to go into the flow domain, and the ! stencil is pointing outside - globBC( bID )%elemLvl( level )%normal%val(:, nBnds( bID ) ) & - & = globBC( bID )%elemLvl( level )%normal%val(:, nBnds( bID ) )& + globBC( bID )%elemLvl( level )%normal%val(:, nBnds( bID ) ) & + & = globBC( bID )%elemLvl( level )%normal%val(:, nBnds( bID ) ) & & - weight(iDir) * stencil%cxDir( :, iDir ) end if ! hasQVal end if ! bID > 0 @@ -2353,8 +2353,8 @@ contains do iBnd = 1, bc_prop%nBCtypes if (found(iBnd) .and. globBC(iBnd)%treat_corner ) then ! Assign the position of the treeID to the corner elem list - call append( me = globBC( iBnd )%cornerBC%elemLvl( level )%elem, & - & val = posInTree ) + call append( me = globBC( iBnd )%cornerBC%elemLvl( level )%elem, & + & val = posInTree ) corner_bitmask = corner_bitmask .or. & & globBC( iBnd )%elemLvl(level)%bitmask%val(:, nBnds( iBnd )) @@ -2365,8 +2365,8 @@ contains do iBnd = 1, bc_prop%nBCtypes if (found(iBnd) .and. globBC(iBnd)%treat_corner ) then - call append( me = globBC(iBnd)%cornerBC%elemLvl(level)%bitmask, & - & val = corner_bitmask ) + call append( me = globBC(iBnd)%cornerBC%elemLvl(level)%bitmask, & + & val = corner_bitmask ) call append( me = globBC( iBnd )%cornerBC%elemLvl( level )%normal, & & val = normal ) @@ -2384,7 +2384,7 @@ contains !! the corner elements as well as assigns the corresponding prevailing !! direction from the stencil subroutine normalizeBC( nBCs, minLevel, maxLevel, globBC, layout, field, & - & comm ) + & comm ) ! -------------------------------------------------------------------------- !> number of boundaries integer, intent(in) :: nBCs, minLevel, maxLevel @@ -2429,9 +2429,9 @@ contains bc_normal = 0.0_rk do iLevel = minLevel, maxLevel do iElem = 1, globBC( iBnd )%nElems( iLevel ) - call tem_determine_discreteVector( & - & globBC( iBnd )%elemLvl( iLevel )%normal%val( :, iElem ), & - & layout%prevailDir, angle ) + call tem_determine_discreteVector( & + & globBC( iBnd )%elemLvl( iLevel )%normal%val( :, iElem ), & + & layout%prevailDir, angle ) ! element normal elem_normal = globBC( iBnd )%elemLvl( iLevel )%normal%val( :, iElem ) ! average boundary normal @@ -2443,12 +2443,12 @@ contains ! Find the index in the stencil corresponding to the normal ! direction do iDir = 1, layout%fStencil%QQ - if( layout%fStencil%cxDir(1, iDir ) == elem_normal(1) & - & .and. layout%fStencil%cxDir(2, iDir ) == elem_normal(2) & + if( layout%fStencil%cxDir(1, iDir ) == elem_normal(1) & + & .and. layout%fStencil%cxDir(2, iDir ) == elem_normal(2) & & .and. layout%fStencil%cxDir(3, iDir ) == elem_normal(3) ) then - call append ( & - & me = globBC(iBnd)%elemLvl(iLevel)%normalInd, & - & val = iDir ) + call append ( & + & me = globBC(iBnd)%elemLvl(iLevel)%normalInd, & + & val = iDir ) end if end do end do ! iElem @@ -2492,8 +2492,8 @@ contains globBC(iBnd)%normal = bc_globNormal do iDir = 1, layout%fStencil%QQ - if( layout%fStencil%cxDir(1, iDir ) == bc_globNormal(1) & - & .and. layout%fStencil%cxDir(2, iDir ) == bc_globNormal(2) & + if( layout%fStencil%cxDir(1, iDir ) == bc_globNormal(1) & + & .and. layout%fStencil%cxDir(2, iDir ) == bc_globNormal(2) & & .and. layout%fStencil%cxDir(3, iDir ) == bc_globNormal(3) ) then globBC(iBnd)%normalInd = iDir end if @@ -2514,7 +2514,7 @@ contains angleMax = angleMax / oneDegInRad ! if angle is > 1 deg then print warning message if (angleMax > 1.0_rk) then - write(logUnit(6),'(a,i0,a)') ' WARNING: Normal direction of ',& + write(logUnit(6),'(a,i0,a)') ' WARNING: Normal direction of ', & & counter, ' elements of "'// trim(globBC(iBnd)%label)//'" boundary' write(logUnit(6),*) 'deviates from stencil discrete vectors.' write(logUnit(6),'(a,f5.2)') ' Max. angle between bnd normal and '//& @@ -2532,10 +2532,10 @@ contains do iLevel = minLevel, maxLevel if (globBC(iBnd)%treat_corner) then do iElem = 1, globBC(iBnd)%cornerBC%nElems( iLevel ) - call tem_determine_discreteVector( & - & globBC( iBnd)%cornerBC%elemLvl( iLevel )% & - & normal%val( :, iElem ),& - & layout%prevailDir) + call tem_determine_discreteVector( & + & globBC( iBnd)%cornerBC%elemLvl( iLevel )% & + & normal%val( :, iElem ), & + & layout%prevailDir ) ! Find the index in the stencil corresponding to the normal ! direction do iDir = 1, layout%fStencil%QQ @@ -2548,9 +2548,11 @@ contains & layout%fStencil%cxDir(3, iDir) == & & globBC(iBnd)%cornerBC%elemLvl(iLevel)%normal%val(3, iElem)) & & then - call append ( & - & me = globBC(iBnd)%cornerBC%elemLvl(iLevel)%normalInd, & - & val = iDir ) + + call append ( & + & me = globBC(iBnd)%cornerBC%elemLvl(iLevel)%normalInd, & + & val = iDir ) + end if end do end do ! iElem @@ -2569,7 +2571,7 @@ contains !! Unique stencil label for boundary stencils are created with boundary label !! and stencil%cxDir therefore each stencil is limited to one boundary type subroutine mus_build_BCStencils( globBC, bc, prevailDir, prefix, minLevel, & - & maxLevel, stencil_labels, grwStencil ) + & maxLevel, stencil_labels, grwStencil ) ! -------------------------------------------------------------------------- !> boundaries for the elements with bnd property set type(glob_boundary_type), intent(in) :: globBC @@ -2686,9 +2688,9 @@ write(dbgUnit(1),*) 'wasAdded ', wasAdded, ' stencilPos ', stencilPos ! append element position in treeID list ! to level wise list and level independent list call append( me = grwStencil%val(stencilPos)%elemLvl( iLevel ), & - & val = elemPos ) + & val = elemPos ) call append( me = grwStencil%val(stencilPos)%elem, & - & val = elemPos ) + & val = elemPos ) ! store stencil position current boundary element bc%elemLvl(iLevel)%stencilPos(iElem) = stencilPos @@ -2760,7 +2762,7 @@ write(dbgUnit(1),*) 'wasAdded ', wasAdded, ' stencilPos ', stencilPos ! store position of IBM stencil in stencil array globIBM%IBM(iIBM)%stencilPos = stencilPos - write(logUnit(10),*) 'Stored stencil for IBM ', iIBM, ' at position ', & + write(logUnit(10),*) 'Stored stencil for IBM ', iIBM, ' at position ', & & globIBM%IBM(iIbm)%stencilPos end do end subroutine mus_build_IBMStencils @@ -2842,41 +2844,42 @@ write(dbgUnit(1),*) 'wasAdded ', wasAdded, ' stencilPos ', stencilPos nGhostFromCoarser = levelDesc( iLevel )%offset(2, eT_ghostFromCoarser ) & & - levelDesc( iLevel )%offset(1, eT_ghostFromCoarser ) ! add all ghost from Coarser ghostelements to bc list - call mus_add_BcghostElem( & - & levelDesc = levelDesc(iLevel), & - & stencil = layout%fstencil, & - & bc_prop = bc_prop, & - & globBC = globBc, & - & nGhosts = nGhostFromCoarser, & - & offset = offset, & - & weight = weight, & - & iLevel = iLevel ) + call mus_add_BcghostElem( & + & levelDesc = levelDesc(iLevel), & + & stencil = layout%fstencil, & + & bc_prop = bc_prop, & + & globBC = globBc, & + & nGhosts = nGhostFromCoarser, & + & offset = offset, & + & weight = weight, & + & iLevel = iLevel ) do iBnd = 1 , bc_prop%nBCtypes ! store number of Bc Elems without GhostBoundaryElems globBC( iBnd )%nElems_Fluid(iLevel) = globBC( iBnd )%nElems( ilevel ) ! replace nElems without GhostBoundaryElems ! by nElems incl. GhostFromCoarser boundary elem - globBC( iBnd )%nElems( ilevel ) = & - & globBC( iBnd )%elemLvl( ilevel )%elem%nVals - - if ( globBC( iBnd )%nElems( ilevel ) - & - & globBC( iBnd )%nElems_Fluid( ilevel ) > 0) then - write(logUnit(5),"(A,I5,A,I2,A,A)") 'Added ', & - &globBC( iBnd )%nElems( ilevel ) - & - &globBC( iBnd )%nElems_Fluid( ilevel ), ' Ghostelements on Level: ',& - &iLevel,' to Boundary: ', globBC( iBND )%label + globBC( iBnd )%nElems( ilevel ) = & + & globBC( iBnd )%elemLvl( ilevel )%elem%nVals + + if ( globBC( iBnd )%nElems( ilevel ) & + & - globBC( iBnd )%nElems_Fluid( ilevel ) > 0) then + write(logUnit(5),"(A,I5,A,I2,A,A)") 'Added ', & + & globBC( iBnd )%nElems( ilevel ) & + & - globBC( iBnd )%nElems_Fluid( ilevel ), & + & ' Ghostelements on Level: ', & + & iLevel, ' to Boundary: ', globBC( iBND )%label end if end do !iBnd end do !iLevel - call set_normalIndGhost( & - & nBCs = bc_prop%nBCtypes, & - & minLevel = minLevel, & - & maxLevel = maxLevel, & - & globBC = globBC, & - & layout = layout ) + call set_normalIndGhost( & + & nBCs = bc_prop%nBCtypes, & + & minLevel = minLevel, & + & maxLevel = maxLevel, & + & globBC = globBC, & + & layout = layout ) contains @@ -2897,24 +2900,26 @@ write(dbgUnit(1),*) 'wasAdded ', wasAdded, ' stencilPos ', stencilPos ! for all Fluid elems do iBnd = 1 , nBCs do iLevel = minLevel, maxLevel - do iElem = globBC( iBnd )%nElems_fluid( iLevel ) +1, & - & globBC( iBnd )%nElems( iLevel ) - call tem_determine_discreteVector( & - & globBC( iBnd )%elemLvl( iLevel )%normal%val( :, iElem ), & - & layout%prevailDir, angle ) + do iElem = globBC( iBnd )%nElems_fluid( iLevel ) +1, & + & globBC( iBnd )%nElems( iLevel ) + call tem_determine_discreteVector( & + & globBC( iBnd )%elemLvl( iLevel )%normal%val( :, iElem ), & + & layout%prevailDir, angle ) ! loop over all directions do iDir = 1, layout%fstencil%QQN - if( layout%fstencil%cxDir(1, iDir ) == & - & globBC( iBnd )%elemLvl( iLevel )%normal%val( 1, iElem ) & - & .and. & - & layout%fstencil%cxDir(2, iDir ) == & - & globBC( iBnd )%elemLvl( iLevel )%normal%val( 2, iElem ) & - & .and. layout%fstencil%cxDir(3, iDir ) == & - & globBC( iBnd )%elemLvl( iLevel )%normal%val( 3, iElem ) ) & + if( layout%fstencil%cxDir(1, iDir ) == & + & globBC( iBnd )%elemLvl( iLevel )%normal%val( 1, iElem ) & + & .and. & + & layout%fstencil%cxDir(2, iDir ) == & + & globBC( iBnd )%elemLvl( iLevel )%normal%val( 2, iElem ) & + & .and. layout%fstencil%cxDir(3, iDir ) == & + & globBC( iBnd )%elemLvl( iLevel )%normal%val( 3, iElem ) ) & & then - call append ( & - & me = globBC( iBnd )%elemLvl( iLevel )%normalInd, & - & val = iDir ) + + call append ( & + & me = globBC( iBnd )%elemLvl( iLevel )%normalInd, & + & val = iDir ) + end if ! iDir end do ! iDir end do !iElem @@ -2938,7 +2943,7 @@ write(dbgUnit(1),*) 'wasAdded ', wasAdded, ' stencilPos ', stencilPos ! Run over all the ghostelements with boundary property and check each ! direction. Also sets normal, bitmask and qVal for ghostelements. subroutine mus_add_BcghostElem(levelDesc, stencil, bc_prop, globBC, nGhosts, & - & offset, weight, iLevel ) + & offset, weight, iLevel ) ! -------------------------------------------------------------------------- !> Level Descriptor for iLevel type( tem_levelDesc_type ),intent(inout) :: levelDesc diff --git a/source/mus_harvesting/mus_hvs_aux_module.f90 b/source/mus_harvesting/mus_hvs_aux_module.f90 index 8695317..e422b20 100644 --- a/source/mus_harvesting/mus_hvs_aux_module.f90 +++ b/source/mus_harvesting/mus_hvs_aux_module.f90 @@ -150,10 +150,10 @@ subroutine mus_hvs_init_aux( scheme, geometry, params ) & geometry = geometry, & & params = params ) - call mus_auxField_configure_from_tracking( & - & auxField = scheme%auxField, & - & track = scheme%track, & - & schemeKind = scheme%header%kind ) + call mus_auxField_configure_from_tracking( & + & auxField = scheme%auxField, & + & track = scheme%track, & + & schemeKind = scheme%header%kind ) if( minLevel /= maxlevel ) then write(logUnit(1),*) 'Initializing interpolation...' From 6e87f5e7bf632ab24d192db4239f448133d820eb Mon Sep 17 00:00:00 2001 From: mikew097 Date: Sat, 28 Feb 2026 14:34:46 +0100 Subject: [PATCH 6/6] add copyright lines on top of files --- source/mus_auxField_module.f90 | 1 + source/mus_aux_module.f90 | 1 + source/mus_construction_module.fpp | 1 + source/mus_harvesting/mus_hvs_aux_module.f90 | 1 + 4 files changed, 4 insertions(+) diff --git a/source/mus_auxField_module.f90 b/source/mus_auxField_module.f90 index e8c54c0..057ab0b 100644 --- a/source/mus_auxField_module.f90 +++ b/source/mus_auxField_module.f90 @@ -1,4 +1,5 @@ ! Copyright (c) 2019-2020, 2022 Kannan Masilamani +! Copyright (c) 2025 Mengyu Wang ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions are met: diff --git a/source/mus_aux_module.f90 b/source/mus_aux_module.f90 index b932d52..1f56066 100644 --- a/source/mus_aux_module.f90 +++ b/source/mus_aux_module.f90 @@ -13,6 +13,7 @@ ! Copyright (c) 2016 Peter Vitt ! Copyright (c) 2016-2017 Raphael Haupt ! Copyright (c) 2022 Gregorio Gerardo Spinelli +! Copyright (c) 2025 Mengyu Wang ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions are met: diff --git a/source/mus_construction_module.fpp b/source/mus_construction_module.fpp index f34c963..74a845c 100644 --- a/source/mus_construction_module.fpp +++ b/source/mus_construction_module.fpp @@ -11,6 +11,7 @@ ! Copyright (c) 2016 Peter Vitt ! Copyright (c) 2016-2018 Raphael Haupt ! Copyright (c) 2021 Gregorio Gerardo Spinelli +! Copyright (c) 2025 Mengyu Wang ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions are met: diff --git a/source/mus_harvesting/mus_hvs_aux_module.f90 b/source/mus_harvesting/mus_hvs_aux_module.f90 index e422b20..d00243c 100644 --- a/source/mus_harvesting/mus_hvs_aux_module.f90 +++ b/source/mus_harvesting/mus_hvs_aux_module.f90 @@ -1,6 +1,7 @@ ! Copyright (c) 2015-2016, 2018-2020 Kannan Masilamani ! Copyright (c) 2016 Tobias Schneider ! Copyright (c) 2016 Jiaxing Qi +! Copyright (c) 2025 Mengyu Wang ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions are met: