diff --git a/src/Distributed/VirtualDataManager.f90 b/src/Distributed/VirtualDataManager.f90 index 86680835cdf..1505298932e 100644 --- a/src/Distributed/VirtualDataManager.f90 +++ b/src/Distributed/VirtualDataManager.f90 @@ -10,7 +10,8 @@ module VirtualDataManagerModule use RouterBaseModule use RouterFactoryModule, only: create_router use ListsModule, only: basesolutionlist - use NumericalSolutionModule, only: NumericalSolutionType + use NumericalSolutionModule, only: NumericalSolutionType, & + CastAsNumericalSolutionClass use NumericalModelModule, only: NumericalModelType, GetNumericalModelFromList use NumericalExchangeModule, only: NumericalExchangeType, & GetNumericalExchangeFromList @@ -237,7 +238,7 @@ subroutine vds_reduce_halo(this) ! merge the interface maps over this process do isol = 1, this%nr_solutions virt_sol => this%virtual_solutions(isol) - num_sol => virt_sol%numerical_solution + num_sol => CastAsNumericalSolutionClass(virt_sol%numerical_solution) do iexg = 1, num_sol%exchangelist%Count() conn => get_smc_from_list(num_sol%exchangelist, iexg) if (.not. associated(conn)) cycle diff --git a/src/Distributed/VirtualModel.f90 b/src/Distributed/VirtualModel.f90 index 4a5f761e865..be66b02b794 100644 --- a/src/Distributed/VirtualModel.f90 +++ b/src/Distributed/VirtualModel.f90 @@ -16,6 +16,7 @@ module VirtualModelModule type, public, extends(VirtualDataContainerType) :: VirtualModelType class(NumericalModelType), pointer :: local_model ! CON + type(VirtualIntType), pointer :: con_ianglex => null() type(VirtualInt1dType), pointer :: con_ia => null() type(VirtualInt1dType), pointer :: con_ja => null() type(VirtualInt1dType), pointer :: con_jas => null() @@ -86,6 +87,7 @@ subroutine init_virtual_data(this) class(VirtualModelType) :: this ! CON + call this%set(this%con_ianglex%base(), 'IANGLEX', 'CON', MAP_ALL_TYPE) call this%set(this%con_ia%base(), 'IA', 'CON', MAP_ALL_TYPE) call this%set(this%con_ja%base(), 'JA', 'CON', MAP_ALL_TYPE) call this%set(this%con_jas%base(), 'JAS', 'CON', MAP_ALL_TYPE) @@ -126,6 +128,7 @@ subroutine vm_prepare_stage(this, stage) if (stage == STG_AFT_MDL_DF) then + call this%map(this%con_ianglex%base(), (/STG_AFT_MDL_DF/)) call this%map(this%dis_ndim%base(), (/STG_AFT_MDL_DF/)) call this%map(this%dis_nodes%base(), (/STG_AFT_MDL_DF/)) call this%map(this%dis_nodesuser%base(), (/STG_AFT_MDL_DF/)) @@ -167,7 +170,11 @@ subroutine vm_prepare_stage(this, stage) call this%map(this%con_hwva%base(), njas, (/STG_BFR_CON_DF/)) call this%map(this%con_cl1%base(), njas, (/STG_BFR_CON_DF/)) call this%map(this%con_cl2%base(), njas, (/STG_BFR_CON_DF/)) - call this%map(this%con_anglex%base(), njas, (/STG_BFR_CON_DF/)) + if (this%con_ianglex%get() > 0) then + call this%map(this%con_anglex%base(), njas, (/STG_BFR_CON_DF/)) + else + call this%map(this%con_anglex%base(), 0, (/STG_NEVER/)) + end if end if @@ -216,6 +223,7 @@ end subroutine vm_destroy subroutine allocate_data(this) class(VirtualModelType) :: this + allocate (this%con_ianglex) allocate (this%con_ia) allocate (this%con_ja) allocate (this%con_jas) @@ -249,6 +257,7 @@ subroutine deallocate_data(this) class(VirtualModelType) :: this ! CON + deallocate (this%con_ianglex) deallocate (this%con_ia) deallocate (this%con_ja) deallocate (this%con_jas) diff --git a/src/Distributed/VirtualSolution.f90 b/src/Distributed/VirtualSolution.f90 index 94a7c94ca5b..0433ba6a8b2 100644 --- a/src/Distributed/VirtualSolution.f90 +++ b/src/Distributed/VirtualSolution.f90 @@ -2,7 +2,6 @@ module VirtualSolutionModule use KindModule, only: I4B use ListModule use VirtualDataContainerModule, only: VdcPtrType - use NumericalSolutionModule ! TODO_MJR: this should not be here!! use InterfaceMapModule implicit none private @@ -13,7 +12,7 @@ module VirtualSolutionModule integer(I4B) :: solution_id = -1 type(VdcPtrType), dimension(:), pointer :: models => null() !< the models as virtual data containers (wrapped) type(VdcPtrType), dimension(:), pointer :: exchanges => null() !< the exchanges as virtual data containers (wrapped) - class(NumericalSolutionType), pointer :: numerical_solution => null() !< points back to the actual numerical solution + class(*), pointer :: numerical_solution => null() !< points back to the actual numerical solution type(InterfaceMapType), pointer :: interface_map => null() !< contains the aggregate interface map for the solution !! NB: the aggregation is over multiple interface models !! and there is no unique numbering there. The target diff --git a/src/Model/Connection/GwfGwfConnection.f90 b/src/Model/Connection/GwfGwfConnection.f90 index 52e089e6aee..df6d0f15780 100644 --- a/src/Model/Connection/GwfGwfConnection.f90 +++ b/src/Model/Connection/GwfGwfConnection.f90 @@ -394,9 +394,8 @@ subroutine validateConnection(this) ! local ! base validation (geometry/spatial) - ! TODO_MJR: uncomment this... - !call this%SpatialModelConnectionType%validateConnection() - !call this%validateGwfExchange() + call this%SpatialModelConnectionType%validateConnection() + call this%validateGwfExchange() ! abort on errors if (count_errors() > 0) then @@ -426,6 +425,11 @@ subroutine validateGwfExchange(this) logical(LGP) :: compatible gwfEx => this%gwfExchange + + ! we cannot validate this (yet) in parallel mode + if (.not. gwfEx%v_model1%is_local) return + if (.not. gwfEx%v_model2%is_local) return + modelPtr => this%gwfExchange%model1 gwfModel1 => CastAsGwfModel(modelPtr) modelPtr => this%gwfExchange%model2 diff --git a/src/Model/Connection/SpatialModelConnection.f90 b/src/Model/Connection/SpatialModelConnection.f90 index a383d608414..a195d6822ba 100644 --- a/src/Model/Connection/SpatialModelConnection.f90 +++ b/src/Model/Connection/SpatialModelConnection.f90 @@ -549,16 +549,16 @@ subroutine validateConnection(this) conEx => this%prim_exchange if (conEx%ixt3d > 0) then ! if XT3D, we need these angles: - if (conEx%model1%dis%con%ianglex == 0) then + if (conEx%v_model1%con_ianglex%get() == 0) then write (errmsg, '(a,a,a,a,a)') 'XT3D configured on the exchange ', & trim(conEx%name), ' but the discretization in model ', & - trim(conEx%model1%name), ' has no ANGLDEGX specified' + trim(conEx%v_model1%name), ' has no ANGLDEGX specified' call store_error(errmsg) end if - if (conEx%model2%dis%con%ianglex == 0) then + if (conEx%v_model2%con_ianglex%get() == 0) then write (errmsg, '(a,a,a,a,a)') 'XT3D configured on the exchange ', & trim(conEx%name), ' but the discretization in model ', & - trim(conEx%model2%name), ' has no ANGLDEGX specified' + trim(conEx%v_model2%name), ' has no ANGLDEGX specified' call store_error(errmsg) end if end if diff --git a/src/Solution/NumericalSolution.f90 b/src/Solution/NumericalSolution.f90 index 1641c57b48e..0fd10397ca8 100644 --- a/src/Solution/NumericalSolution.f90 +++ b/src/Solution/NumericalSolution.f90 @@ -43,6 +43,7 @@ module NumericalSolutionModule public :: NumericalSolutionType public :: GetNumericalSolutionFromList + public :: CastAsNumericalSolutionClass public :: create_numerical_solution type, extends(BaseSolutionType) :: NumericalSolutionType @@ -1729,7 +1730,7 @@ subroutine solve(this, kiter) ! -- under-relaxation - only done if convergence not achieved if (this%icnvg /= 1) then if (this%nonmeth > 0) then - call this%sln_underrelax(kiter, this%hncg(kiter), this%neq, & ! TODO_MJR: this is not equiv. serial/parallel + call this%sln_underrelax(kiter, this%hncg(kiter), this%neq, & this%active, this%x, this%xtemp) else call this%sln_calcdx(this%neq, this%active, &