ConnectionBuilder.f90

Go to the documentation of this file.

module connectionbuildermodule
  use kindmodule, only: i4b, lgp
  use simmodule, only: ustop
  use simvariablesmodule, only: iout
  use listmodule, only: listtype, isequaliface
  use listnodemodule, only: listnodetype
  use basesolutionmodule, only: basesolutiontype
  use numericalsolutionmodule, only: numericalsolutiontype
  use baseexchangemodule, only: baseexchangetype, getbaseexchangefromlist
  use disconnexchangemodule, only: disconnexchangetype, &
                                   getdisconnexchangefromlist
  use numericalmodelmodule, only: numericalmodeltype
  use spatialmodelconnectionmodule, only: spatialmodelconnectiontype, &
                                          cast_as_smc, &
                                          get_smc_from_list, &
                                          add_smc_to_list
 
  implicit none
  private
 
  type, public :: connectionbuildertype
    logical(LGP) :: dev_always_ifmod = .false. !< development option: force interface model on all exchanges
  contains
    procedure, pass(this) :: processsolution
    procedure, private, pass(this) :: processexchanges
    procedure, private, pass(this) :: setconnectionstosolution
    procedure, private, pass(this) :: createmodelconnectivity
  end type connectionbuildertype
 
contains
 
  !> @brief Process the exchanges in the solution into model connections
  !!
  !! This routine processes all exchanges in a solution and,
  !! when required, creates model connections of the proper
  !! type (GWF-GWF, GWT-GWT, ...) for a subset. It removes this
  !! subset of exchanges from the solution and replaces them with the
  !! created connections.
  !<
  subroutine processsolution(this, solution)
    class(connectionbuildertype) :: this !< the connection builder object
    class(basesolutiontype), pointer :: solution !< the solution for which the exchanges are processed
    ! local
    class(numericalsolutiontype), pointer :: numSol
    type(listtype) :: newConnections
 
    ! we only deal with Num. Sol. here
    select type (solution)
    class is (numericalsolutiontype)
      numsol => solution
    class default
      return
    end select
 
    ! create the connections and add local exchanges
    call this%processExchanges(numsol%exchangelist, newconnections)
    if (newconnections%Count() == 0) then
      return
    end if
 
    write (iout, '(1x,a,i0,a,a)') 'Created ', newconnections%Count(), &
      ' model connections for solution ', trim(solution%name)
 
    ! create the topology of models participating in the interfaces
    call this%createModelConnectivity(newconnections)
 
    ! replace numerical exchanges in solution with connections
    call this%setConnectionsToSolution(newconnections, numsol)
 
    ! clean up local resources
    call newconnections%Clear(destroy=.false.)
 
  end subroutine processsolution
 
  !> @brief Create connections from exchanges
  !!
  !! If the configuration demands it, this will create connections,
  !! for the exchanges (one connection per exchange) add them to
  !! the global list, and return them as @param newConnections
  !<
  subroutine processexchanges(this, exchanges, newConnections)
    use listsmodule, only: baseconnectionlist, baseexchangelist
    class(connectionbuildertype) :: this !< the connection builder object
    type(listtype), pointer, intent(in) :: exchanges !< the list of exchanges to process
    type(listtype), intent(inout) :: newConnections !< the newly created connections
    ! local
    class(disconnexchangetype), pointer :: conEx
    class(baseexchangetype), pointer :: baseEx
    integer(I4B) :: iex, ibasex
    class(spatialmodelconnectiontype), pointer :: modelConnection
    logical(LGP) :: isPeriodic
 
    do iex = 1, exchanges%Count()
      conex => getdisconnexchangefromlist(exchanges, iex)
      if (.not. associated(conex)) then
        ! if it is not DisConnExchangeType, we can skip it
        cycle
      end if
 
      ! for now, if we have XT3D on the interface, we use a connection,
      ! (this will be more generic in the future)
      if (conex%use_interface_model() .or. conex%dev_ifmod_on &
          .or. this%dev_always_ifmod) then
 
        ! we should not get period connections here
        isperiodic = (conex%v_model1 == conex%v_model2)
        if (isperiodic) then
          write (*, *) 'Error (which should never happen): interface model '// &
            'does not support periodic boundary condition'
          call ustop()
        end if
 
        if (conex%v_model1%is_local) then
          ! create model connection for model 1
          modelconnection => createmodelconnection(conex%model1, conex)
          call add_smc_to_list(baseconnectionlist, modelconnection)
          call add_smc_to_list(newconnections, modelconnection)
        end if
 
        ! and for model 2
        if (conex%v_model2%is_local) then
          modelconnection => createmodelconnection(conex%model2, conex)
          call add_smc_to_list(baseconnectionlist, modelconnection)
          call add_smc_to_list(newconnections, modelconnection)
        end if
 
        ! remove this exchange from the base list, ownership
        ! now lies with the connection
        do ibasex = 1, baseexchangelist%Count()
          baseex => getbaseexchangefromlist(baseexchangelist, ibasex)
          if (conex%id == baseex%id) then
            call baseexchangelist%RemoveNode(ibasex, .false.)
            exit
          end if
        end do
 
      end if
    end do
 
  end subroutine processexchanges
 
  !> @brief Create a model connection of a given type
  !!
  !! This is a factory method to create the various types
  !! of model connections
  !<
  function createmodelconnection(model, exchange) result(connection)
    use gwfgwfconnectionmodule, only: gwfgwfconnectiontype
    use gwtgwtconnectionmodule, only: gwtgwtconnectiontype
    use gwegweconnectionmodule, only: gwegweconnectiontype
    use gwfmodule, only: gwfmodeltype
 
    class(numericalmodeltype), pointer, intent(in) :: model !< the model for which the connection will be created
    class(disconnexchangetype), pointer, intent(in) :: exchange !< the type of connection
    class(spatialmodelconnectiontype), pointer :: connection !< the created connection
 
    ! different concrete connection types:
    class(gwfgwfconnectiontype), pointer :: flowconnection => null()
    class(gwtgwtconnectiontype), pointer :: transportconnection => null()
    class(gwegweconnectiontype), pointer :: energytransportconnection => null()
 
    connection => null()
 
    ! select on type of connection to create
    select case (exchange%typename)
    case ('GWF-GWF')
      allocate (gwfgwfconnectiontype :: flowconnection)
      call flowconnection%construct(model, exchange)
      connection => flowconnection
      flowconnection => null()
    case ('GWT-GWT')
      allocate (gwtgwtconnectiontype :: transportconnection)
      call transportconnection%construct(model, exchange)
      connection => transportconnection
      transportconnection => null()
    case ('GWE-GWE')
      allocate (gwegweconnectiontype :: energytransportconnection)
      call energytransportconnection%construct(model, exchange)
      connection => energytransportconnection
      energytransportconnection => null()
    case default
      write (*, *) 'Error (which should never happen): '// &
        'undefined exchangetype found'
      call ustop()
    end select
 
  end function createmodelconnection
 
  !> @brief Set connections to the solution
  !!
  !! This adds the connections to the solution and removes
  !! those exchanges which are replaced by a connection
  !<
  subroutine setconnectionstosolution(this, connections, solution)
    class(connectionbuildertype) :: this !< the connection builder object
    type(listtype), intent(inout) :: connections !< the connections created for the solution
    class(numericalsolutiontype), pointer, intent(in) :: solution !< the solution to which the connections are set
    ! local
    type(listtype) :: keepList
    class(*), pointer :: exPtr, exPtr2, connPtr
    class(spatialmodelconnectiontype), pointer :: conn
    integer(I4B) :: iex, iconn
    logical(LGP) :: keepExchange
 
    ! first add all exchanges not replaced by the connections to a list
    do iex = 1, solution%exchangelist%Count()
      exptr => solution%exchangelist%GetItem(iex)
      ! will this exchange be replaced by a connection?
      keepexchange = .true.
      do iconn = 1, connections%Count()
        conn => get_smc_from_list(connections, iconn)
        exptr2 => conn%prim_exchange
        if (associated(exptr2, exptr)) then
          ! if so, don't add it to the list
          keepexchange = .false.
          exit
        end if
      end do
 
      if (keepexchange) then
        call keeplist%Add(exptr)
      end if
    end do
 
    ! first add persisting exchanges
    call solution%exchangelist%Clear(destroy=.false.)
    do iex = 1, keeplist%Count()
      exptr => keeplist%GetItem(iex)
      call solution%exchangelist%Add(exptr)
    end do
 
    ! now add connections
    do iconn = 1, connections%Count()
      connptr => connections%GetItem(iconn)
      call solution%exchangelist%Add(connptr)
    end do
 
    ! clean up
    call keeplist%Clear(destroy=.false.)
 
  end subroutine setconnectionstosolution
 
  !> @brief Create connectivity of models which contribute to the interface
  !!
  !! This loops over all connections and creates a halo with all
  !! models from the numerical solution. The model halo will be used to
  !! extend the interface grid to include cells from models which are
  !< indirectly connected, through yet another exchange object.
  subroutine createmodelconnectivity(this, connections)
    class(connectionbuildertype) :: this !< the connection builder object
    type(listtype), intent(inout) :: connections !< all connections that are created for this solution
    ! local
    integer(I4B) :: iconn
    class(spatialmodelconnectiontype), pointer :: modelConn
 
    ! create halo for the model connections
    do iconn = 1, connections%Count()
      modelconn => get_smc_from_list(connections, iconn)
      call modelconn%createModelHalo()
    end do
 
  end subroutine createmodelconnectivity
 
end module connectionbuildermodule