- validate connection parallel-proof (activated again) (#1288)

- clean up circ. dep. with VirtualSolution

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

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)

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

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

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

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, &