disconnexchangemodule Module Reference

Data Types
type	disconnexchangetype
	Exchange based on connection between discretizations of DisBaseType. The data specifies the connections, similar to the information stored in the connections object: DisBaseTypecon. More...
type	disconnexchangefoundtype
	@ brief DisConnExchangeFoundType More...

Functions/Subroutines
subroutine	source_options (this, iout)
	Source options from input context. More...
subroutine	source_dimensions (this, iout)
	Source dimension from input context. More...
integer(i4b) function	noder (this, model, cellid, iout)
	Returns reduced node number from user. More...
character(len=20) function	cellstr (this, ndim, cellid, iout)
subroutine	source_data (this, iout)
	Source exchange data from input context. More...
subroutine	allocate_scalars (this)
	Allocate scalars and initialize to defaults. More...
subroutine	allocate_arrays (this)
	Allocate array data, using the number of connected nodes. More...
logical(lgp) function	use_interface_model (this)
	Should interface model be used to handle these exchanges, to be overridden for inheriting types. More...
subroutine	disconnex_da (this)
	Clean up all scalars and arrays. More...
class(disconnexchangetype) function, pointer, public	castasdisconnexchangeclass (obj)
subroutine, public	adddisconnexchangetolist (list, exchange)
class(disconnexchangetype) function, pointer, public	getdisconnexchangefromlist (list, idx)

Function/Subroutine Documentation

adddisconnexchangetolist()

subroutine, public disconnexchangemodule::adddisconnexchangetolist	(	type(listtype), intent(inout)	list,
		class(disconnexchangetype), intent(in), pointer	exchange
	)

Definition at line 534 of file DisConnExchange.f90.

    implicit none
    ! -- dummy
    type(ListType), intent(inout) :: list
    class(DisConnExchangeType), pointer, intent(in) :: exchange
    ! -- local
    class(*), pointer :: obj
    !
    obj => exchange
    call list%Add(obj)

allocate_arrays()

subroutine disconnexchangemodule::allocate_arrays

(

class(disconnexchangetype)

this

)

Parameters

nexg
this	instance of exchange object

Definition at line 447 of file DisConnExchange.f90.

    ! -- dummy
    class(DisConnExchangeType) :: this !< instance of exchange object
    !
    call mem_allocate(this%nodem1, this%nexg, 'NODEM1', this%memoryPath)
    call mem_allocate(this%nodem2, this%nexg, 'NODEM2', this%memoryPath)
    call mem_allocate(this%ihc, this%nexg, 'IHC', this%memoryPath)
    call mem_allocate(this%cl1, this%nexg, 'CL1', this%memoryPath)
    call mem_allocate(this%cl2, this%nexg, 'CL2', this%memoryPath)
    call mem_allocate(this%hwva, this%nexg, 'HWVA', this%memoryPath)
    ! NB: auxname array is allocated while parsing
    call mem_allocate(this%auxvar, this%naux, this%nexg, &
                      'AUXVAR', this%memoryPath)
    !
    ! allocate boundname
    if (this%inamedbound == 1) then
      allocate (this%boundname(this%nexg))
    else
      allocate (this%boundname(1))
    end if
    this%boundname(:) = ''

allocate_scalars()

subroutine disconnexchangemodule::allocate_scalars

(

class(disconnexchangetype)

this

)

Parameters

this	instance of exchange object

Definition at line 406 of file DisConnExchange.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(DisConnExchangeType) :: this !< instance of exchange object
    !
    allocate (this%filename)
    this%filename = ''
    !
    call mem_allocate(this%nexg, 'NEXG', this%memoryPath)
    call mem_allocate(this%naux, 'NAUX', this%memoryPath)
    call mem_allocate(this%ianglex, 'IANGLEX', this%memoryPath)
    call mem_allocate(this%icdist, 'ICDIST', this%memoryPath)
    call mem_allocate(this%ixt3d, 'IXT3D', this%memoryPath)
    call mem_allocate(this%iprpak, 'IPRPAK', this%memoryPath)
    call mem_allocate(this%iprflow, 'IPRFLOW', this%memoryPath)
    call mem_allocate(this%ipakcb, 'IPAKCB', this%memoryPath)
    call mem_allocate(this%inamedbound, 'INAMEDBOUND', this%memoryPath)
    call mem_allocate(this%dev_ifmod_on, 'DEV_IFMOD_ON', this%memoryPath)
 
    call mem_allocate(this%auxname, lenauxname, 0, &
                      'AUXNAME', this%memoryPath)
    call mem_allocate(this%auxname_cst, lenauxname, 0, &
                      'AUXNAME_CST', this%memoryPath)
    !
    this%nexg = 0
    this%naux = 0
    this%ianglex = 0
    this%icdist = 0
    this%ixt3d = 0
    this%iprpak = 0
    this%iprflow = 0
    this%ipakcb = 0
    this%inamedbound = 0
    !
    this%dev_ifmod_on = .false.

castasdisconnexchangeclass()

class(disconnexchangetype) function, pointer, public disconnexchangemodule::castasdisconnexchangeclass

(

class(*), intent(inout), pointer

obj

)

Definition at line 518 of file DisConnExchange.f90.

    implicit none
    ! -- dummy
    class(*), pointer, intent(inout) :: obj
    ! -- return
    class(DisConnExchangeType), pointer :: res
    !
    res => null()
    if (.not. associated(obj)) return
    !
    select type (obj)
    class is (disconnexchangetype)
      res => obj
    end select

Here is the caller graph for this function:

cellstr()

character(len=20) function disconnexchangemodule::cellstr	(	class(disconnexchangetype)	this,
		integer(i4b)	ndim,
		integer(i4b), dimension(:), intent(in)	cellid,
		integer(i4b), intent(in)	iout
	)

Parameters

	this	instance of exchange object
	ndim	model DIS dimension
[in]	iout	the output file unit

Definition at line 221 of file DisConnExchange.f90.

    ! -- modules
    ! -- dummy
    class(DisConnExchangeType) :: this !< instance of exchange object
    integer(I4B) :: ndim !< model DIS dimension
    integer(I4B), dimension(:), intent(in) :: cellid
    integer(I4B), intent(in) :: iout !< the output file unit
    character(len=20) :: cellstr
    character(len=*), parameter :: fmtndim1 = &
                                   "('(',i0,')')"
    character(len=*), parameter :: fmtndim2 = &
                                   "('(',i0,',',i0,')')"
    character(len=*), parameter :: fmtndim3 = &
                                   "('(',i0,',',i0,',',i0,')')"
    !
    cellstr = ''
    !
    select case (ndim)
    case (1)
      write (cellstr, fmtndim1) cellid(1)
    case (2)
      write (cellstr, fmtndim2) cellid(1), cellid(2)
    case (3)
      write (cellstr, fmtndim3) cellid(1), cellid(2), cellid(3)
    case default
    end select

disconnex_da()

subroutine disconnexchangemodule::disconnex_da ( class(disconnexchangetype)  this )

private

Parameters

this	instance of exchange object

Definition at line 486 of file DisConnExchange.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(DisConnExchangeType) :: this !< instance of exchange object
    !
    ! arrays
    call mem_deallocate(this%nodem1)
    call mem_deallocate(this%nodem2)
    call mem_deallocate(this%ihc)
    call mem_deallocate(this%cl1)
    call mem_deallocate(this%cl2)
    call mem_deallocate(this%hwva)
    call mem_deallocate(this%auxvar)
    !
    deallocate (this%boundname)
    !
    ! scalars
    call mem_deallocate(this%nexg)
    call mem_deallocate(this%naux)
    call mem_deallocate(this%auxname, 'AUXNAME', this%memoryPath)
    call mem_deallocate(this%auxname_cst, 'AUXNAME_CST', this%memoryPath)
    call mem_deallocate(this%ianglex)
    call mem_deallocate(this%icdist)
    call mem_deallocate(this%ixt3d)
    call mem_deallocate(this%iprpak)
    call mem_deallocate(this%iprflow)
    call mem_deallocate(this%ipakcb)
    call mem_deallocate(this%inamedbound)
    call mem_deallocate(this%dev_ifmod_on)

getdisconnexchangefromlist()

class(disconnexchangetype) function, pointer, public disconnexchangemodule::getdisconnexchangefromlist	(	type(listtype), intent(inout)	list,
		integer(i4b), intent(in)	idx
	)

Definition at line 546 of file DisConnExchange.f90.

    implicit none
    ! -- dummy
    type(ListType), intent(inout) :: list
    integer(I4B), intent(in) :: idx
    ! -- return
    class(DisConnExchangeType), pointer :: res
    ! -- local
    class(*), pointer :: obj
    !
    obj => list%GetItem(idx)
    res => castasdisconnexchangeclass(obj)

Here is the call graph for this function:

Here is the caller graph for this function:

noder()

integer(i4b) function disconnexchangemodule::noder	(	class(disconnexchangetype)	this,
		class(numericalmodeltype), intent(in), pointer	model,
		integer(i4b), dimension(:), intent(in)	cellid,
		integer(i4b), intent(in)	iout
	)

Parameters

	this	instance of exchange object
[in]	iout	the output file unit

Definition at line 194 of file DisConnExchange.f90.

    ! -- modules
    use geomutilmodule, only: get_node
    ! -- dummy
    class(DisConnExchangeType) :: this !< instance of exchange object
    class(NumericalModelType), pointer, intent(in) :: model
    integer(I4B), dimension(:), intent(in) :: cellid
    integer(I4B), intent(in) :: iout !< the output file unit
    integer(I4B) :: noder, node
    !
    if (model%dis%ndim == 1) then
      node = cellid(1)
    elseif (model%dis%ndim == 2) then
      node = get_node(cellid(1), 1, cellid(2), &
                      model%dis%mshape(1), 1, &
                      model%dis%mshape(2))
    else
      node = get_node(cellid(1), cellid(2), cellid(3), &
                      model%dis%mshape(1), &
                      model%dis%mshape(2), &
                      model%dis%mshape(3))
    end if
    noder = model%dis%get_nodenumber(node, 0)

Here is the call graph for this function:

source_data()

subroutine disconnexchangemodule::source_data ( class(disconnexchangetype)  this, integer(i4b), intent(in)  iout  )

private

Parameters

	this	instance of exchange object
[in]	iout	the output file unit

Definition at line 251 of file DisConnExchange.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    use memorymanagerextmodule, only: memorystore_release
    ! -- dummy
    class(DisConnExchangeType) :: this !< instance of exchange object
    integer(I4B), intent(in) :: iout !< the output file unit
    ! -- local
    integer(I4B), dimension(:, :), contiguous, pointer :: cellidm1
    integer(I4B), dimension(:, :), contiguous, pointer :: cellidm2
    integer(I4B), dimension(:), contiguous, pointer :: ihc
    real(DP), dimension(:), contiguous, pointer :: cl1
    real(DP), dimension(:), contiguous, pointer :: cl2
    real(DP), dimension(:), contiguous, pointer :: hwva
    real(DP), dimension(:, :), contiguous, pointer :: auxvar
    type(CharacterStringType), dimension(:), contiguous, pointer :: boundname
    integer(I4B) :: ndim1, ndim2
    character(len=20) :: cellstr1, cellstr2
    character(len=2) :: cnfloat
    integer(I4B) :: nerr, iaux
    integer(I4B) :: iexg, nodem1, nodem2
    ! -- format
    character(len=*), parameter :: fmtexglabel = "(1x, 3a10, 50(a16))"
    character(len=*), parameter :: fmtexgdata = &
                                   "(5x, a, 1x, a ,I10, 50(1pg16.6))"
    character(len=40) :: fmtexgdata2
    !
    call mem_setptr(cellidm1, 'CELLIDM1', this%input_mempath)
    call mem_setptr(cellidm2, 'CELLIDM2', this%input_mempath)
    call mem_setptr(ihc, 'IHC', this%input_mempath)
    call mem_setptr(cl1, 'CL1', this%input_mempath)
    call mem_setptr(cl2, 'CL2', this%input_mempath)
    call mem_setptr(hwva, 'HWVA', this%input_mempath)
    call mem_setptr(auxvar, 'AUXVAR', this%input_mempath)
    call mem_setptr(boundname, 'BOUNDNAME', this%input_mempath)
    ndim1 = size(cellidm1, dim=1)
    ndim2 = size(cellidm2, dim=1)
    !
    write (iout, '(1x,a)') 'PROCESSING EXCHANGEDATA'
    !
    if (this%iprpak /= 0) then
      if (this%inamedbound == 0) then
        write (iout, fmtexglabel) 'NODEM1', 'NODEM2', 'IHC', &
          'CL1', 'CL2', 'HWVA', (adjustr(this%auxname(iaux)), &
                                 iaux=1, this%naux)
      else
        write (iout, fmtexglabel) 'NODEM1', 'NODEM2', 'IHC', 'CL1', 'CL2', &
          'HWVA', (adjustr(this%auxname(iaux)), iaux=1, this%naux), &
          ' BOUNDNAME      '
        ! Define format suitable for writing input data,
        ! any auxiliary variables, and boundname.
        write (cnfloat, '(i0)') 3 + this%naux
        fmtexgdata2 = '(5x, a, 1x, a, i10, '//trim(cnfloat)// &
                      '(1pg16.6), 1x, a)'
      end if
    end if
    !
    do iexg = 1, this%nexg
      !
      if (associated(this%model1)) then
        !
        ! -- Determine reduced node number
        nodem1 = this%noder(this%model1, cellidm1(:, iexg), iout)
        this%nodem1(iexg) = nodem1
        !
      else
        this%nodem1(iexg) = -1
      end if
      !
      if (associated(this%model2)) then
        !
        ! -- Determine reduced node number
        nodem2 = this%noder(this%model2, cellidm2(:, iexg), iout)
        this%nodem2(iexg) = nodem2
        !
      else
        this%nodem2(iexg) = -1
      end if
      !
      ! -- Read rest of input line
      this%ihc(iexg) = ihc(iexg)
      this%cl1(iexg) = cl1(iexg)
      this%cl2(iexg) = cl2(iexg)
      this%hwva(iexg) = hwva(iexg)
      do iaux = 1, this%naux
        this%auxvar(iaux, iexg) = auxvar(iaux, iexg)
      end do
      if (this%inamedbound == 1) then
        this%boundname(iexg) = boundname(iexg)
      end if
      !
      ! -- Write the data to listing file if requested
      if (this%iprpak /= 0) then
        cellstr1 = this%cellstr(ndim1, cellidm1(:, iexg), iout)
        cellstr2 = this%cellstr(ndim2, cellidm2(:, iexg), iout)
        if (this%inamedbound == 0) then
          write (iout, fmtexgdata) trim(cellstr1), trim(cellstr2), &
            this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), &
            this%hwva(iexg), &
            (this%auxvar(iaux, iexg), iaux=1, this%naux)
        else
          write (iout, fmtexgdata2) trim(cellstr1), trim(cellstr2), &
            this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), &
            this%hwva(iexg), &
            (this%auxvar(iaux, iexg), iaux=1, this%naux), &
            trim(this%boundname(iexg))
        end if
      end if
      !
      ! -- Check to see if nodem1 is outside of active domain
      if (associated(this%model1)) then
        if (nodem1 <= 0) then
          cellstr1 = this%cellstr(ndim1, cellidm1(:, iexg), iout)
          write (errmsg, *) &
            trim(adjustl(this%model1%name))// &
            ' Cell is outside active grid domain ('// &
            trim(adjustl(cellstr1))//').'
          call store_error(errmsg)
        end if
      end if
      !
      ! -- Check to see if nodem2 is outside of active domain
      if (associated(this%model2)) then
        if (nodem2 <= 0) then
          cellstr2 = this%cellstr(ndim2, cellidm2(:, iexg), iout)
          write (errmsg, *) &
            trim(adjustl(this%model2%name))// &
            ' Cell is outside active grid domain ('// &
            trim(adjustl(cellstr2))//').'
          call store_error(errmsg)
        end if
      end if
    end do
    !
    write (iout, '(1x,a)') 'END OF EXCHANGEDATA'
    !
    ! -- Stop if errors
    nerr = count_errors()
    if (nerr > 0) then
      call store_error('Errors encountered in exchange input file.')
      call store_error_filename(this%filename)
    end if
    !
    call memorystore_release('CELLIDM1', this%input_mempath)
    call memorystore_release('CELLIDM2', this%input_mempath)
    call memorystore_release('IHC', this%input_mempath)
    call memorystore_release('CL1', this%input_mempath)
    call memorystore_release('CL2', this%input_mempath)
    Call memorystore_release('HWVA', this%input_mempath)
    call memorystore_release('AUXVAR', this%input_mempath)
    call memorystore_release('BOUNDNAME', this%input_mempath)

Here is the call graph for this function:

source_dimensions()

subroutine disconnexchangemodule::source_dimensions	(	class(disconnexchangetype)	this,
		integer(i4b), intent(in)	iout
	)

Parameters

	this	instance of exchange object
[in]	iout	for logging

Definition at line 171 of file DisConnExchange.f90.

    ! -- modules
    use memorymanagerextmodule, only: mem_set_value
    ! -- dummy
    class(DisConnExchangeType) :: this !< instance of exchange object
    integer(I4B), intent(in) :: iout !< for logging
    ! -- local
    type(DisConnExchangeFoundType) :: found
    !
    ! -- update defaults with idm sourced values
    call mem_set_value(this%nexg, 'NEXG', this%input_mempath, found%nexg)
    !
    write (iout, '(1x,a)') 'PROCESSING EXCHANGE DIMENSIONS'
    !
    if (found%nexg) then
      write (iout, '(4x,a,i0)') 'NEXG = ', this%nexg
    end if
    !
    write (iout, '(1x,a)') 'END OF EXCHANGE DIMENSIONS'

source_options()

subroutine disconnexchangemodule::source_options ( class(disconnexchangetype)  this, integer(i4b), intent(in)  iout  )

private

Parameters

	this	instance of exchange object
[in]	iout	for logging

Definition at line 95 of file DisConnExchange.f90.

    ! -- modules
    use memorymanagerextmodule, only: mem_set_value
    use arrayhandlersmodule, only: ifind
    ! -- dummy
    class(DisConnExchangeType) :: this !< instance of exchange object
    integer(I4B), intent(in) :: iout !< for logging
    ! -- local
    type(DisConnExchangeFoundType) :: found
    integer(I4B) :: ival, n
    !
    ! -- update defaults with idm sourced values
    call mem_set_value(this%naux, 'NAUX', this%input_mempath, found%naux, &
                       release=.false.)
    call mem_set_value(this%ipakcb, 'IPAKCB', this%input_mempath, found%ipakcb)
    call mem_set_value(this%iprpak, 'IPRPAK', this%input_mempath, found%iprpak)
    call mem_set_value(this%iprflow, 'IPRFLOW', this%input_mempath, found%iprflow)
    call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%input_mempath, &
                       found%boundnames, release=.false.)
    call mem_set_value(this%dev_ifmod_on, 'DEV_IFMOD_ON', this%input_mempath, &
                       found%dev_ifmod_on)
    !
    ! -- reallocate aux arrays if aux variables provided
    if (found%naux .and. this%naux > 0) then
      call mem_reallocate(this%auxname, lenauxname, this%naux, &
                          'AUXNAME', this%memoryPath)
      call mem_reallocate(this%auxname_cst, lenauxname, this%naux, &
                          'AUXNAME_CST', this%memoryPath)
      call mem_set_value(this%auxname_cst, 'AUXILIARY', this%input_mempath, &
                         found%auxiliary, release=.false.)
      !
      do n = 1, this%naux
        this%auxname(n) = this%auxname_cst(n)
      end do
      !
      ! -- If ANGLDEGX is an auxiliary variable, then anisotropy can be
      !    used in either model.  Store ANGLDEGX position in this%ianglex
      ival = ifind(this%auxname, 'ANGLDEGX')
      if (ival > 0) then
        this%ianglex = ival
      end if
      !
      ival = ifind(this%auxname, 'CDIST')
      if (ival > 0) then
        this%icdist = ival
      end if
    end if
    !
    if (found%ipakcb) then
      this%ipakcb = -1
      write (iout, '(4x,a)') &
        'EXCHANGE FLOWS WILL BE SAVED TO BINARY BUDGET FILES.'
    end if
    !
    if (found%iprpak) then
      write (iout, '(4x,a)') &
        'THE LIST OF EXCHANGES WILL BE PRINTED.'
    end if
    !
    if (found%iprflow) then
      write (iout, '(4x,a)') &
        'EXCHANGE FLOWS WILL BE PRINTED TO LIST FILES.'
    end if
    !
    if (found%boundnames) then
      write (iout, '(4x,a)') 'EXCHANGE BOUNDARIES HAVE NAMES IN LAST COLUMN'
    end if
    !
    if (found%dev_ifmod_on) then
      write (iout, '(4x,2a)') 'Interface model coupling approach manually &
        &activated for ', trim(this%name)
    end if

use_interface_model()

logical(lgp) function disconnexchangemodule::use_interface_model ( class(disconnexchangetype)  this )

private

Parameters

this	instance of exchange object

Returns

flag whether interface model should be used for this exchange instead

Definition at line 473 of file DisConnExchange.f90.

    ! -- dummy
    class(DisConnExchangeType) :: this !< instance of exchange object
    ! -- return
    logical(LGP) :: use_im !< flag whether interface model should be used
                          !! for this exchange instead
    !
    ! use im when one of the models is not local
    use_im = .not. (this%v_model1%is_local .and. this%v_model2%is_local)