disv1dmodule Module Reference

Data Types
type	disv1dtype
type	disfoundtype
	Simplifies tracking parameters sourced from the input context. More...

Functions/Subroutines
subroutine, public	disv1d_cr (dis, name_model, input_mempath, inunit, iout)
subroutine	disv1d_df (this)
	Define the discretization. More...
subroutine	connection_normal (this, noden, nodem, ihc, xcomp, ycomp, zcomp, ipos)
	Get normal vector components between the cell and a given neighbor. More...
subroutine	connection_vector (this, noden, nodem, nozee, satn, satm, ihc, xcomp, ycomp, zcomp, conlen)
	Get unit vector components between the cell and a given neighbor. More...
subroutine	get_dis_type (this, dis_type)
	Get the discretization type (DIS, DIS2D, DISV, DISV1D, DISU) More...
integer(i4b) function	get_dis_enum (this)
	Get the discretization type enumeration. More...
subroutine	allocate_scalars (this, name_model, input_mempath)
	Allocate scalar variables. More...
subroutine	disv1d_load (this)
subroutine	source_options (this)
	Copy options from IDM into package. More...
subroutine	log_options (this, found)
	Write user options to list file. More...
subroutine	source_dimensions (this)
	Copy dimensions from IDM into package. More...
subroutine	log_dimensions (this, found)
	Write dimensions to list file. More...
subroutine	source_griddata (this)
subroutine	log_griddata (this, found)
	Write griddata found to list file. More...
subroutine	source_vertices (this)
	Copy vertex information from input data context to model context. More...
subroutine	source_cell1d (this)
	Copy cell1d information from input data context to model context. More...
subroutine	define_cellverts (this, icell1d, ncvert, icvert)
	Construct the iavert and javert integer vectors which are compressed sparse row index arrays that relate the vertices to reaches. More...
subroutine	calculate_cellxy (vertices, fdc, iavert, javert, length, cellxy)
	Calculate x, y, coordinates of reach midpoint. More...
subroutine	calculate_cell_length (vertices, iavert, javert, length)
	Calculate x, y, coordinates of reach midpoint. More...
subroutine	grid_finalize (this)
	Finalize grid construction. More...
subroutine	allocate_arrays (this)
subroutine	create_connections (this)
subroutine	write_grb (this, icelltype)
	Write binary grid file. More...
integer(i4b) function	get_nodenumber_idx1 (this, nodeu, icheck)
	Return a nodenumber from the user specified node number with an option to perform a check. This subroutine can be overridden by child classes to perform mapping to a model node number. More...
subroutine	nodeu_to_string (this, nodeu, str)
integer(i4b) function	nodeu_from_string (this, lloc, istart, istop, in, iout, line, flag_string, allow_zero)
	nodeu_from_string – Receive a string and convert the string to a user nodenumber. The model is unstructured; just read user nodenumber. If flag_string argument is present and true, the first token in string is allowed to be a string (e.g. boundary name). In this case, if a string is encountered, return value as -2. More...
subroutine	disv1d_da (this)
subroutine	record_array (this, darray, iout, iprint, idataun, aname, cdatafmp, nvaluesp, nwidthp, editdesc, dinact)
	Record a double precision array. More...
subroutine	record_srcdst_list_header (this, text, textmodel, textpackage, dstmodel, dstpackage, naux, auxtxt, ibdchn, nlist, iout)
	Record list header using ubdsv06. More...
subroutine	get_flow_width (this, n, m, idx_conn, width_n, width_m)
	@ brief Calculate the flow width between two cells More...

Function/Subroutine Documentation

allocate_arrays()

subroutine disv1dmodule::allocate_arrays

(

class(disv1dtype)

this

)

Definition at line 795 of file Disv1d.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(Disv1dType) :: this
    !
    ! -- Allocate arrays in DisBaseType (mshape, top, bot, area)
    ! todo: disbasetype will have memory allocated for unneeded arrays
    call this%DisBaseType%allocate_arrays()
    !
    ! -- Allocate arrays
    if (this%nodes < this%nodesuser) then
      call mem_allocate(this%nodeuser, this%nodes, 'NODEUSER', this%memoryPath)
      call mem_allocate(this%nodereduced, this%nodesuser, 'NODEREDUCED', &
                        this%memoryPath)
    else
      call mem_allocate(this%nodeuser, 1, 'NODEUSER', this%memoryPath)
      call mem_allocate(this%nodereduced, 1, 'NODEREDUCED', this%memoryPath)
    end if
    !
    ! -- Initialize
    this%mshape(1) = this%nodesuser

allocate_scalars()

subroutine disv1dmodule::allocate_scalars	(	class(disv1dtype)	this,
		character(len=*), intent(in)	name_model,
		character(len=*), intent(in)	input_mempath
	)

Definition at line 231 of file Disv1d.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    use constantsmodule, only: done
    ! -- dummy
    class(Disv1dType) :: this
    character(len=*), intent(in) :: name_model
    character(len=*), intent(in) :: input_mempath
    !
    ! -- Allocate parent scalars
    call this%DisBaseType%allocate_scalars(name_model, input_mempath)
    !
    ! -- Allocate
    call mem_allocate(this%nvert, 'NVERT', this%memoryPath)
    !
    ! -- Initialize
    this%nvert = 0
    this%ndim = 1

calculate_cell_length()

subroutine disv1dmodule::calculate_cell_length ( real(dp), dimension(:, :), intent(in)  vertices, integer(i4b), dimension(:), intent(in)  iavert, integer(i4b), dimension(:), intent(in)  javert, real(dp), dimension(:), intent(inout)  length  )

private

Parameters

[in]	vertices	2d array of vertices with x, y as columns
[in]	iavert	csr mapping of vertices to cell reaches
[in]	javert	csr mapping of vertices to cell reaches
[in,out]	length	2d array of reach midpoint with x, y as columns

Definition at line 688 of file Disv1d.f90.

    ! -- dummy
    real(DP), dimension(:, :), intent(in) :: vertices !< 2d array of vertices with x, y as columns
    integer(I4B), dimension(:), intent(in) :: iavert !< csr mapping of vertices to cell reaches
    integer(I4B), dimension(:), intent(in) :: javert !< csr mapping of vertices to cell reaches
    real(DP), dimension(:), intent(inout) :: length !< 2d array of reach midpoint with x, y as columns
    ! -- local
    integer(I4B) :: nodes !< number of nodes
    integer(I4B) :: n !< node index
    integer(I4B) :: j !< vertex index
    real(DP) :: dlen !< length
 
    nodes = size(iavert) - 1
    do n = 1, nodes
 
      ! calculate length of this reach
      dlen = dzero
      do j = iavert(n), iavert(n + 1) - 2
        dlen = dlen + calcdist(vertices, javert(j), javert(j + 1))
      end do
      length(n) = dlen
 
    end do

Here is the call graph for this function:

Here is the caller graph for this function:

calculate_cellxy()

subroutine disv1dmodule::calculate_cellxy	(	real(dp), dimension(:, :), intent(in)	vertices,
		real(dp), dimension(:), intent(in)	fdc,
		integer(i4b), dimension(:), intent(in)	iavert,
		integer(i4b), dimension(:), intent(in)	javert,
		real(dp), dimension(:), intent(in)	length,
		real(dp), dimension(:, :), intent(inout)	cellxy
	)

Parameters

[in]	vertices	2d array of vertices with x, y as columns
[in]	fdc	fractional distance to reach midpoint (normally 0.5)
[in]	iavert	csr mapping of vertices to cell reaches
[in]	javert	csr mapping of vertices to cell reaches
[in]	length	vector of cell lengths
[in,out]	cellxy	2d array of reach midpoint with x, y as columns

Definition at line 635 of file Disv1d.f90.

    ! -- dummy
    real(DP), dimension(:, :), intent(in) :: vertices !< 2d array of vertices with x, y as columns
    real(DP), dimension(:), intent(in) :: fdc !< fractional distance to reach midpoint (normally 0.5)
    integer(I4B), dimension(:), intent(in) :: iavert !< csr mapping of vertices to cell reaches
    integer(I4B), dimension(:), intent(in) :: javert !< csr mapping of vertices to cell reaches
    real(DP), dimension(:), intent(in) :: length !< vector of cell lengths
    real(DP), dimension(:, :), intent(inout) :: cellxy !< 2d array of reach midpoint with x, y as columns
    ! -- local
    integer(I4B) :: nodes !< number of nodes
    integer(I4B) :: n !< node index
    integer(I4B) :: j !< vertex index
    integer(I4B) :: iv0 !< index for line reach start
    integer(I4B) :: iv1 !< index for linen reach end
    integer(I4B) :: ixy !< x, y column index
    real(DP) :: fd0 !< fractional distance to start of this line reach
    real(DP) :: fd1 !< fractional distance to end of this line reach
    real(DP) :: fd !< fractional distance where midpoint (defined by fdc) is located
    real(DP) :: d !< distance
 
    nodes = size(iavert) - 1
    do n = 1, nodes
 
      ! find vertices that span midpoint
      iv0 = 0
      iv1 = 0
      fd0 = dzero
      do j = iavert(n), iavert(n + 1) - 2
        d = calcdist(vertices, javert(j), javert(j + 1))
        fd1 = fd0 + d / length(n)
 
        ! if true, then we know the midpoint is some fractional distance (fd)
        ! from vertex j to vertex j + 1
        if (fd1 >= fdc(n)) then
          iv0 = javert(j)
          iv1 = javert(j + 1)
          fd = (fdc(n) - fd0) / (fd1 - fd0)
          exit
        end if
        fd0 = fd1
      end do
 
      ! find x, y position of point on line
      do ixy = 1, 2
        cellxy(ixy, n) = (done - fd) * vertices(ixy, iv0) + &
                         fd * vertices(ixy, iv1)
      end do
 
    end do

Here is the call graph for this function:

Here is the caller graph for this function:

connection_normal()

subroutine disv1dmodule::connection_normal ( class(disv1dtype)  this, integer(i4b), intent(in)  noden, integer(i4b), intent(in)  nodem, integer(i4b), intent(in)  ihc, real(dp), intent(inout)  xcomp, real(dp), intent(inout)  ycomp, real(dp), intent(inout)  zcomp, integer(i4b), intent(in)  ipos  )

private

The normal points outward from the shared face between noden and nodem.

Parameters

[in]	noden	cell (reduced nn)
[in]	nodem	neighbor (reduced nn)
[in]	ihc	horizontal connection flag (not used)
[in,out]	xcomp	x component of outward normal vector
[in,out]	ycomp	y component of outward normal vector
[in,out]	zcomp	z component of outward normal vector
[in]	ipos	connection position

Definition at line 146 of file Disv1d.f90.

    ! -- dummy
    class(Disv1dType) :: this
    integer(I4B), intent(in) :: noden !< cell (reduced nn)
    integer(I4B), intent(in) :: nodem !< neighbor (reduced nn)
    integer(I4B), intent(in) :: ihc !< horizontal connection flag (not used)
    real(DP), intent(inout) :: xcomp !< x component of outward normal vector
    real(DP), intent(inout) :: ycomp !< y component of outward normal vector
    real(DP), intent(inout) :: zcomp !< z component of outward normal vector
    integer(I4B), intent(in) :: ipos !< connection position
    ! -- local
    real(DP) :: angle, dmult
 
    ! find from anglex, since anglex is symmetric, need to flip vector
    ! for lower triangle (nodem < noden)
    angle = this%con%anglex(this%con%jas(ipos))
    dmult = done
    if (nodem < noden) dmult = -done
    xcomp = cos(angle) * dmult
    ycomp = sin(angle) * dmult
    zcomp = dzero
    !

connection_vector()

subroutine disv1dmodule::connection_vector ( class(disv1dtype)  this, integer(i4b), intent(in)  noden, integer(i4b), intent(in)  nodem, logical, intent(in)  nozee, real(dp), intent(in)  satn, real(dp), intent(in)  satm, integer(i4b), intent(in)  ihc, real(dp), intent(inout)  xcomp, real(dp), intent(inout)  ycomp, real(dp), intent(inout)  zcomp, real(dp), intent(inout)  conlen  )

private

Saturation must be provided to compute cell center vertical coordinates. Also return the straight-line connection length.

Parameters

[in]	noden	cell (reduced nn)
[in]	nodem	neighbor (reduced nn)
[in]	nozee	do not use z in calculations
[in]	satn	not used for disv1d
[in]	satm	not used for disv1d
[in]	ihc	horizontal connection flag
[in,out]	xcomp	x component of connection vector
[in,out]	ycomp	y component of connection vector
[in,out]	zcomp	z component of connection vector
[in,out]	conlen	calculated straight-line distance between cell centers

Definition at line 176 of file Disv1d.f90.

    ! -- dummy
    class(Disv1dType) :: this
    integer(I4B), intent(in) :: noden !< cell (reduced nn)
    integer(I4B), intent(in) :: nodem !< neighbor (reduced nn)
    logical, intent(in) :: nozee !< do not use z in calculations
    real(DP), intent(in) :: satn !< not used for disv1d
    real(DP), intent(in) :: satm !< not used for disv1d
    integer(I4B), intent(in) :: ihc !< horizontal connection flag
    real(DP), intent(inout) :: xcomp !< x component of connection vector
    real(DP), intent(inout) :: ycomp !< y component of connection vector
    real(DP), intent(inout) :: zcomp !< z component of connection vector
    real(DP), intent(inout) :: conlen !< calculated straight-line distance between cell centers
    ! -- local
    integer(I4B) :: nodeun, nodeum
    real(DP) :: xn, xm, yn, ym, zn, zm
 
    ! horizontal connection, with possible z component due to cell offsets
    ! and/or water table conditions
    if (nozee) then
      zn = dzero
      zm = dzero
    else
      zn = this%bot(noden)
      zm = this%bot(nodem)
    end if
    nodeun = this%get_nodeuser(noden)
    nodeum = this%get_nodeuser(nodem)
    xn = this%cellxy(1, nodeun)
    yn = this%cellxy(2, nodeun)
    xm = this%cellxy(1, nodeum)
    ym = this%cellxy(2, nodeum)
    call line_unit_vector(xn, yn, zn, xm, ym, zm, xcomp, ycomp, zcomp, &
                          conlen)
 

Here is the call graph for this function:

create_connections()

subroutine disv1dmodule::create_connections

(

class(disv1dtype)

this

)

Definition at line 819 of file Disv1d.f90.

    ! modules
    ! dummy
    class(Disv1dType) :: this
    ! local
    integer(I4B) :: nrsize
 
    ! create and fill the connections object
    nrsize = 0
    if (this%nodes < this%nodesuser) nrsize = this%nodes
 
    ! Allocate connections object
    allocate (this%con)
 
    ! Build connectivity based on vertices
    call this%con%disv1dconnections_verts(this%name_model, this%nodes, &
                                          this%nodesuser, nrsize, this%nvert, &
                                          this%vertices, this%iavert, &
                                          this%javert, this%cellxy, this%fdc, &
                                          this%nodereduced, this%nodeuser, &
                                          this%length)
 
    this%nja = this%con%nja
    this%njas = this%con%njas
 

define_cellverts()

subroutine disv1dmodule::define_cellverts	(	class(disv1dtype)	this,
		integer(i4b), dimension(:), intent(in), pointer, contiguous	icell1d,
		integer(i4b), dimension(:), intent(in), pointer, contiguous	ncvert,
		integer(i4b), dimension(:), intent(in), pointer, contiguous	icvert
	)

Definition at line 597 of file Disv1d.f90.

    ! -- modules
    use sparsemodule, only: sparsematrix
    ! -- dummy
    class(Disv1dType) :: this
    integer(I4B), dimension(:), contiguous, pointer, intent(in) :: icell1d
    integer(I4B), dimension(:), contiguous, pointer, intent(in) :: ncvert
    integer(I4B), dimension(:), contiguous, pointer, intent(in) :: icvert
    ! -- locals
    type(sparsematrix) :: vert_spm
    integer(I4B) :: i, j, ierr
    integer(I4B) :: icv_idx, startvert, maxnnz = 2
    !
    ! -- initialize sparse matrix
    call vert_spm%init(this%nodesuser, this%nvert, maxnnz)
    !
    ! -- add sparse matrix connections from input memory paths
    icv_idx = 1
    do i = 1, this%nodesuser
      if (icell1d(i) /= i) call store_error('ICELL1D input sequence violation.')
      do j = 1, ncvert(i)
        call vert_spm%addconnection(i, icvert(icv_idx), 0)
        if (j == 1) then
          startvert = icvert(icv_idx)
        end if
        icv_idx = icv_idx + 1
      end do
    end do
    !
    ! -- allocate and fill iavert and javert
    call mem_allocate(this%iavert, this%nodesuser + 1, 'IAVERT', this%memoryPath)
    call mem_allocate(this%javert, vert_spm%nnz, 'JAVERT', this%memoryPath)
    call vert_spm%filliaja(this%iavert, this%javert, ierr)
    call vert_spm%destroy()

Here is the call graph for this function:

disv1d_cr()

subroutine, public disv1dmodule::disv1d_cr	(	class(disbasetype), pointer	dis,
		character(len=*), intent(in)	name_model,
		character(len=*), intent(in)	input_mempath,
		integer(i4b), intent(in)	inunit,
		integer(i4b), intent(in)	iout
	)

Definition at line 89 of file Disv1d.f90.

    ! -- modules
    use kindmodule, only: lgp
    ! -- dummy
    class(DisBaseType), pointer :: dis
    character(len=*), intent(in) :: name_model
    character(len=*), intent(in) :: input_mempath
    integer(I4B), intent(in) :: inunit
    integer(I4B), intent(in) :: iout
    ! -- locals
    type(Disv1dType), pointer :: disnew
    logical(LGP) :: found_fname
    character(len=*), parameter :: fmtheader = &
      "(1X, /1X, 'DISV1D -- DISCRETIZATION BY VERTICES IN 1D PACKAGE,', &
      &' VERSION 1 : 4/2/2024 - INPUT READ FROM MEMPATH: ', A, /)"
    allocate (disnew)
    dis => disnew
    call disnew%allocate_scalars(name_model, input_mempath)
    dis%input_mempath = input_mempath
    dis%inunit = inunit
    dis%iout = iout
    !
    ! -- set name of input file
    call mem_set_value(dis%input_fname, 'INPUT_FNAME', dis%input_mempath, &
                       found_fname)
    !
    ! -- If dis enabled
    if (inunit > 0) then
 
      ! -- Identify package
      if (iout > 0) then
        write (iout, fmtheader) dis%input_mempath
      end if
 
    end if

Here is the caller graph for this function:

disv1d_da()

subroutine disv1dmodule::disv1d_da ( class(disv1dtype)  this )

private

Definition at line 1090 of file Disv1d.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    use memorymanagerextmodule, only: memorystore_remove
    use simvariablesmodule, only: idm_context
    ! -- dummy
    class(Disv1dType) :: this
    ! -- local
    logical(LGP) :: deallocate_vertices
    !
    ! -- Deallocate idm memory
    call memorystore_remove(this%name_model, 'DISV1D', idm_context)
    !
    ! -- scalars
    deallocate_vertices = (this%nvert > 0)
    call mem_deallocate(this%nvert)
    !
    ! -- arrays
    call mem_deallocate(this%nodeuser)
    call mem_deallocate(this%nodereduced)
    call mem_deallocate(this%length)
    call mem_deallocate(this%width)
    call mem_deallocate(this%bottom)
    call mem_deallocate(this%idomain)
    !
    ! -- cdl hack for arrays for vertices and cell1d blocks
    if (deallocate_vertices) then
      call mem_deallocate(this%vertices)
      call mem_deallocate(this%fdc)
      call mem_deallocate(this%cellxy)
      call mem_deallocate(this%iavert)
      call mem_deallocate(this%javert)
    end if
    !
    ! -- DisBaseType deallocate
    call this%DisBaseType%dis_da()

Here is the call graph for this function:

disv1d_df()

subroutine disv1dmodule::disv1d_df

(

class(disv1dtype)

this

)

Definition at line 128 of file Disv1d.f90.

    ! -- dummy
    class(Disv1dType) :: this
    !
    ! -- Transfer the data from the memory manager into this package object
    if (this%inunit /= 0) then
      call this%disv1d_load()
    end if
 
    ! finalize the grid
    call this%grid_finalize()
 

disv1d_load()

subroutine disv1dmodule::disv1d_load

(

class(disv1dtype)

this

)

Definition at line 251 of file Disv1d.f90.

    ! -- dummy
    class(Disv1dType) :: this
    ! -- locals
    !
    ! -- source input data
    call this%source_options()
    call this%source_dimensions()
    call this%source_griddata()
 
    ! If vertices provided by user, read and store vertices
    if (this%nvert > 0) then
      call this%source_vertices()
      call this%source_cell1d()
    end if
 

get_dis_enum()

integer(i4b) function disv1dmodule::get_dis_enum ( class(disv1dtype), intent(in)  this )

private

Definition at line 222 of file Disv1d.f90.

    use constantsmodule, only: disv1d
    class(Disv1dType), intent(in) :: this
    integer(I4B) :: dis_enum
    dis_enum = disv1d

get_dis_type()

subroutine disv1dmodule::get_dis_type ( class(disv1dtype), intent(in)  this, character(len=*), intent(out)  dis_type  )

private

Definition at line 215 of file Disv1d.f90.

    class(Disv1dType), intent(in) :: this
    character(len=*), intent(out) :: dis_type
    dis_type = "DISV1D"

get_flow_width()

subroutine disv1dmodule::get_flow_width	(	class(disv1dtype)	this,
		integer(i4b), intent(in)	n,
		integer(i4b), intent(in)	m,
		integer(i4b), intent(in)	idx_conn,
		real(dp), intent(out)	width_n,
		real(dp), intent(out)	width_m
	)

This should only be called for connections with IHC > 0. Routine is needed, so it can be overridden by the linear network discretization, which allows for a separate flow

Parameters

[in]	n	cell node number
[in]	m	cell node number
[in]	idx_conn	connection index
[out]	width_n	flow width for cell n
[out]	width_m	flow width for cell m

Definition at line 1261 of file Disv1d.f90.

    ! dummy
    class(Disv1dType) :: this
    integer(I4B), intent(in) :: n !< cell node number
    integer(I4B), intent(in) :: m !< cell node number
    integer(I4B), intent(in) :: idx_conn !< connection index
    real(DP), intent(out) :: width_n !< flow width for cell n
    real(DP), intent(out) :: width_m !< flow width for cell m
 
    ! For disv1d case, width_n and width_m can be different
    width_n = this%width(n)
    width_m = this%width(m)
 

get_nodenumber_idx1()

integer(i4b) function disv1dmodule::get_nodenumber_idx1	(	class(disv1dtype), intent(in)	this,
		integer(i4b), intent(in)	nodeu,
		integer(i4b), intent(in)	icheck
	)

Definition at line 998 of file Disv1d.f90.

    class(Disv1dType), intent(in) :: this
    integer(I4B), intent(in) :: nodeu
    integer(I4B), intent(in) :: icheck
    integer(I4B) :: nodenumber
    !
    if (icheck /= 0) then
      if (nodeu < 1 .or. nodeu > this%nodes) then
        write (errmsg, '(a,i10)') &
          'Nodenumber less than 1 or greater than nodes:', nodeu
        call store_error(errmsg)
      end if
    end if
    !
    ! -- set node number based on whether it is reduced or not
    if (this%nodes == this%nodesuser) then
      nodenumber = nodeu
    else
      nodenumber = this%nodereduced(nodeu)
    end if

Here is the call graph for this function:

grid_finalize()

subroutine disv1dmodule::grid_finalize ( class(disv1dtype)  this )

private

Definition at line 715 of file Disv1d.f90.

    ! modules
    use simmodule, only: ustop, count_errors, store_error
    use constantsmodule, only: linelength, dzero, done
    ! dummy
    class(Disv1dType) :: this
    ! local
    integer(I4B) :: node, noder, k
    ! format
    character(len=*), parameter :: fmtnr = &
      "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',&
      &/1x, 'Number of user nodes: ',I0,&
      &/1X, 'Number of nodes in solution: ', I0, //)"
 
    ! count active cells
    this%nodes = 0
    do k = 1, this%nodesuser
      if (this%idomain(k) > 0) this%nodes = this%nodes + 1
    end do
    !
    ! Check to make sure nodes is a valid number
    if (this%nodes == 0) then
      call store_error('Model does not have any active nodes.  Make sure &
                       &IDOMAIN has some values greater than zero.')
      call store_error_filename(this%input_fname)
    end if
 
    ! Write message if reduced grid
    if (this%nodes < this%nodesuser) then
      write (this%iout, fmtnr) this%nodesuser, this%nodes
    end if
 
    ! Array size is now known, so allocate
    call this%allocate_arrays()
 
    ! Fill the nodereduced array with the reduced nodenumber, or
    ! a negative number to indicate it is a pass-through cell, or
    ! a zero to indicate that the cell is excluded from the
    ! solution.
    if (this%nodes < this%nodesuser) then
      node = 1
      noder = 1
      do k = 1, this%nodesuser
        if (this%idomain(k) > 0) then
          this%nodereduced(node) = noder
          noder = noder + 1
        else
          this%nodereduced(node) = 0
        end if
        node = node + 1
      end do
    end if
 
    ! allocate and fill nodeuser if a reduced grid
    if (this%nodes < this%nodesuser) then
      node = 1
      noder = 1
      do k = 1, this%nodesuser
        if (this%idomain(k) > 0) then
          this%nodeuser(noder) = node
          noder = noder + 1
        end if
        node = node + 1
      end do
    end if
 
    ! Move bottom into bot and put length into disbase%area
    ! and set x and y center coordinates
    do node = 1, this%nodesuser
      noder = node
      if (this%nodes < this%nodesuser) noder = this%nodereduced(node)
      if (noder <= 0) cycle
      this%bot(noder) = this%bottom(node)
      this%area(noder) = this%length(node)
    end do
 
    ! create connectivity using vertices and cell1d
    call this%create_connections()

Here is the call graph for this function:

log_dimensions()

subroutine disv1dmodule::log_dimensions	(	class(disv1dtype)	this,
		type(disfoundtype), intent(in)	found
	)

Definition at line 409 of file Disv1d.f90.

    class(Disv1dType) :: this
    type(DisFoundType), intent(in) :: found
 
    write (this%iout, '(1x,a)') 'Setting Discretization Dimensions'
 
    if (found%nodes) then
      write (this%iout, '(4x,a,i0)') 'NODES = ', this%nodesuser
    end if
 
    if (found%nvert) then
      write (this%iout, '(4x,a,i0)') 'NVERT = ', this%nvert
    end if
 
    write (this%iout, '(1x,a,/)') 'End Setting Discretization Dimensions'
 

log_griddata()

subroutine disv1dmodule::log_griddata	(	class(disv1dtype)	this,
		type(disfoundtype), intent(in)	found
	)

Definition at line 469 of file Disv1d.f90.

    class(Disv1dType) :: this
    type(DisFoundType), intent(in) :: found
 
    write (this%iout, '(1x,a)') 'Setting Discretization Griddata'
 
    if (found%width) then
      write (this%iout, '(4x,a)') 'WIDTH set from input file'
    end if
 
    if (found%bottom) then
      write (this%iout, '(4x,a)') 'BOTTOM set from input file'
    end if
 
    if (found%idomain) then
      write (this%iout, '(4x,a)') 'IDOMAIN set from input file'
    end if
 
    write (this%iout, '(1x,a,/)') 'End Setting Discretization Griddata'
 

log_options()

subroutine disv1dmodule::log_options	(	class(disv1dtype)	this,
		type(disfoundtype), intent(in)	found
	)

Definition at line 306 of file Disv1d.f90.

    class(Disv1dType) :: this
    type(DisFoundType), intent(in) :: found
 
    write (this%iout, '(1x,a)') 'Setting Discretization Options'
 
    if (found%length_units) then
      write (this%iout, '(4x,a,i0)') 'Model length unit [0=UND, 1=FEET, &
      &2=METERS, 3=CENTIMETERS] set as ', this%lenuni
    end if
 
    if (found%nogrb) then
      write (this%iout, '(4x,a,i0)') 'Binary grid file [0=GRB, 1=NOGRB] &
        &set as ', this%nogrb
    end if
 
    if (found%xorigin) then
      write (this%iout, '(4x,a,G0)') 'XORIGIN = ', this%xorigin
    end if
 
    if (found%yorigin) then
      write (this%iout, '(4x,a,G0)') 'YORIGIN = ', this%yorigin
    end if
 
    if (found%angrot) then
      write (this%iout, '(4x,a,G0)') 'ANGROT = ', this%angrot
    end if
 
    write (this%iout, '(1x,a,/)') 'End Setting Discretization Options'
 

nodeu_from_string()

integer(i4b) function disv1dmodule::nodeu_from_string ( class(disv1dtype)  this, integer(i4b), intent(inout)  lloc, integer(i4b), intent(inout)  istart, integer(i4b), intent(inout)  istop, integer(i4b), intent(in)  in, integer(i4b), intent(in)  iout, character(len=*), intent(inout)  line, logical, intent(in), optional  flag_string, logical, intent(in), optional  allow_zero  )

private

Definition at line 1039 of file Disv1d.f90.

    ! -- dummy
    class(Disv1dType) :: this
    integer(I4B), intent(inout) :: lloc
    integer(I4B), intent(inout) :: istart
    integer(I4B), intent(inout) :: istop
    integer(I4B), intent(in) :: in
    integer(I4B), intent(in) :: iout
    character(len=*), intent(inout) :: line
    logical, optional, intent(in) :: flag_string
    logical, optional, intent(in) :: allow_zero
    integer(I4B) :: nodeu
    ! -- local
    integer(I4B) :: lloclocal, ndum, istat, n
    real(DP) :: r
    !
    if (present(flag_string)) then
      if (flag_string) then
        ! Check to see if first token in line can be read as an integer.
        lloclocal = lloc
        call urword(line, lloclocal, istart, istop, 1, ndum, r, iout, in)
        read (line(istart:istop), *, iostat=istat) n
        if (istat /= 0) then
          ! First token in line is not an integer; return flag to this effect.
          nodeu = -2
          return
        end if
      end if
    end if
    !
    call urword(line, lloc, istart, istop, 2, nodeu, r, iout, in)
    !
    if (nodeu == 0) then
      if (present(allow_zero)) then
        if (allow_zero) then
          return
        end if
      end if
    end if
    !
    if (nodeu < 1 .or. nodeu > this%nodesuser) then
      write (errmsg, '(a,i0,a)') &
        "Node number in list (", nodeu, ") is outside of the grid. "// &
        "Cell number cannot be determined in line '"// &
        trim(adjustl(line))//"'."
      call store_error(errmsg)
      call store_error_filename(this%input_fname)
    end if

Here is the call graph for this function:

nodeu_to_string()

subroutine disv1dmodule::nodeu_to_string ( class(disv1dtype)  this, integer(i4b), intent(in)  nodeu, character(len=*), intent(inout)  str  )

private

Definition at line 1020 of file Disv1d.f90.

    ! -- dummy
    class(Disv1dType) :: this
    integer(I4B), intent(in) :: nodeu
    character(len=*), intent(inout) :: str
    ! -- local
    character(len=10) :: nstr
    !
    write (nstr, '(i0)') nodeu
    str = '('//trim(adjustl(nstr))//')'

record_array()

subroutine disv1dmodule::record_array	(	class(disv1dtype), intent(inout)	this,
		real(dp), dimension(:), intent(inout), pointer, contiguous	darray,
		integer(i4b), intent(in)	iout,
		integer(i4b), intent(in)	iprint,
		integer(i4b), intent(in)	idataun,
		character(len=*), intent(in)	aname,
		character(len=*), intent(in)	cdatafmp,
		integer(i4b), intent(in)	nvaluesp,
		integer(i4b), intent(in)	nwidthp,
		character(len=*), intent(in)	editdesc,
		real(dp), intent(in)	dinact
	)

Record a double precision array. The array will be printed to an external file and/or written to an unformatted external file depending on the argument specifications.

Parameters

[in,out]	darray	double precision array to record
[in]	iout	unit number for ascii output
[in]	iprint	flag indicating whether or not to print the array
[in]	idataun	unit number to which the array will be written in binary
[in]	aname	text descriptor of the array
[in]	nvaluesp	number of values per line for printing
[in]	nwidthp	width of the number for printing
[in]	editdesc	format type (I, G, F, S, E)
[in]	dinact	double precision value to use for cells that are excluded from model domain

Definition at line 1134 of file Disv1d.f90.

    ! -- modules
    use tdismodule, only: kstp, kper, pertim, totim, delt
    use inputoutputmodule, only: ulasav, ulaprufw, ubdsv1
    ! -- dummy
    class(Disv1dType), intent(inout) :: this
    real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray !< double precision array to record
    integer(I4B), intent(in) :: iout !< unit number for ascii output
    integer(I4B), intent(in) :: iprint !< flag indicating whether or not to print the array
    integer(I4B), intent(in) :: idataun !< unit number to which the array will be written in binary
    character(len=*), intent(in) :: aname !< text descriptor of the array
    character(len=*), intent(in) :: cdatafmp ! fortran format for writing the array
    integer(I4B), intent(in) :: nvaluesp !< number of values per line for printing
    integer(I4B), intent(in) :: nwidthp !< width of the number for printing
    character(len=*), intent(in) :: editdesc !< format type (I, G, F, S, E)
    real(DP), intent(in) :: dinact !< double precision value to use for cells that are excluded from model domain
    ! -- local
    integer(I4B) :: k, ifirst
    integer(I4B) :: nlay
    integer(I4B) :: nrow
    integer(I4B) :: ncol
    integer(I4B) :: nval
    integer(I4B) :: nodeu, noder
    integer(I4B) :: istart, istop
    real(DP), dimension(:), pointer, contiguous :: dtemp
    ! -- formats
    character(len=*), parameter :: fmthsv = &
      "(1X,/1X,a,' WILL BE SAVED ON UNIT ',I4, &
       &' AT END OF TIME STEP',I5,', STRESS PERIOD ',I4)"
    !
    ! -- set variables
    nlay = 1
    nrow = 1
    ncol = this%mshape(1)
    !
    ! -- If this is a reduced model, then copy the values from darray into
    !    dtemp.
    if (this%nodes < this%nodesuser) then
      nval = this%nodes
      dtemp => this%dbuff
      do nodeu = 1, this%nodesuser
        noder = this%get_nodenumber(nodeu, 0)
        if (noder <= 0) then
          dtemp(nodeu) = dinact
          cycle
        end if
        dtemp(nodeu) = darray(noder)
      end do
    else
      nval = this%nodes
      dtemp => darray
    end if
    !
    ! -- Print to iout if iprint /= 0
    if (iprint /= 0) then
      istart = 1
      do k = 1, nlay
        istop = istart + nrow * ncol - 1
        call ulaprufw(ncol, nrow, kstp, kper, k, iout, dtemp(istart:istop), &
                      aname, cdatafmp, nvaluesp, nwidthp, editdesc)
        istart = istop + 1
      end do
    end if
    !
    ! -- Save array to an external file.
    if (idataun > 0) then
      ! -- write to binary file by layer
      ifirst = 1
      istart = 1
      do k = 1, nlay
        istop = istart + nrow * ncol - 1
        if (ifirst == 1) write (iout, fmthsv) &
          trim(adjustl(aname)), idataun, &
          kstp, kper
        ifirst = 0
        call ulasav(dtemp(istart:istop), aname, kstp, kper, &
                    pertim, totim, ncol, nrow, k, idataun)
        istart = istop + 1
      end do
    elseif (idataun < 0) then
      !
      ! -- write entire array as one record
      call ubdsv1(kstp, kper, aname, -idataun, dtemp, ncol, nrow, nlay, &
                  iout, delt, pertim, totim)
    end if

Here is the call graph for this function:

record_srcdst_list_header()

subroutine disv1dmodule::record_srcdst_list_header	(	class(disv1dtype)	this,
		character(len=16), intent(in)	text,
		character(len=16), intent(in)	textmodel,
		character(len=16), intent(in)	textpackage,
		character(len=16), intent(in)	dstmodel,
		character(len=16), intent(in)	dstpackage,
		integer(i4b), intent(in)	naux,
		character(len=16), dimension(:), intent(in)	auxtxt,
		integer(i4b), intent(in)	ibdchn,
		integer(i4b), intent(in)	nlist,
		integer(i4b), intent(in)	iout
	)

Definition at line 1224 of file Disv1d.f90.

    ! -- module
    use tdismodule, only: kstp, kper, pertim, totim, delt
    use inputoutputmodule, only: ubdsv06
    ! -- dummy
    class(Disv1dType) :: this
    character(len=16), intent(in) :: text
    character(len=16), intent(in) :: textmodel
    character(len=16), intent(in) :: textpackage
    character(len=16), intent(in) :: dstmodel
    character(len=16), intent(in) :: dstpackage
    integer(I4B), intent(in) :: naux
    character(len=16), dimension(:), intent(in) :: auxtxt
    integer(I4B), intent(in) :: ibdchn
    integer(I4B), intent(in) :: nlist
    integer(I4B), intent(in) :: iout
    ! -- local
    integer(I4B) :: nlay, nrow, ncol
    !
    nlay = 1
    nrow = 1
    ncol = this%mshape(1)
    !
    ! -- Use ubdsv06 to write list header
    call ubdsv06(kstp, kper, text, textmodel, textpackage, dstmodel, dstpackage, &
                 ibdchn, naux, auxtxt, ncol, nrow, nlay, &
                 nlist, iout, delt, pertim, totim)

Here is the call graph for this function:

source_cell1d()

subroutine disv1dmodule::source_cell1d

(

class(disv1dtype)

this

)

Definition at line 535 of file Disv1d.f90.

    ! -- modules
    use memoryhelpermodule, only: create_mem_path
    use simvariablesmodule, only: idm_context
    ! -- dummy
    class(Disv1dType) :: this
    ! -- locals
    character(len=LENMEMPATH) :: idmMemoryPath
    integer(I4B), dimension(:), contiguous, pointer :: icell1d => null()
    integer(I4B), dimension(:), contiguous, pointer :: ncvert => null()
    integer(I4B), dimension(:), contiguous, pointer :: icvert => null()
    real(DP), dimension(:), contiguous, pointer :: fdc => null()
    integer(I4B) :: i
    ! -- formats
    !
    ! -- set memory path
    idmmemorypath = create_mem_path(this%name_model, 'DISV1D', idm_context)
    !
    ! -- set pointers to input path ncvert and icvert
    call mem_setptr(icell1d, 'ICELL1D', idmmemorypath)
    call mem_setptr(ncvert, 'NCVERT', idmmemorypath)
    call mem_setptr(icvert, 'ICVERT', idmmemorypath)
    !
    ! --
    if (associated(icell1d) .and. associated(ncvert) &
        .and. associated(icvert)) then
      call this%define_cellverts(icell1d, ncvert, icvert)
    else
      call store_error('Required cell vertex arrays not found.')
    end if
    !
    ! -- set pointers to cell center arrays
    call mem_setptr(fdc, 'FDC', idmmemorypath)
    !
    ! -- set fractional distance to cell center
    if (associated(fdc)) then
      do i = 1, this%nodesuser
        this%fdc(i) = fdc(i)
      end do
    else
      call store_error('Required fdc array not found.')
    end if
 
    ! calculate length from vertices
    call calculate_cell_length(this%vertices, this%iavert, this%javert, &
                               this%length)
 
    ! calculate cellxy from vertices and fdc
    call calculate_cellxy(this%vertices, this%fdc, this%iavert, &
                          this%javert, this%length, this%cellxy)
 
    ! log
    if (this%iout > 0) then
      write (this%iout, '(1x,a)') 'Setting Discretization CELL1D'
      write (this%iout, '(1x,a,/)') 'End Setting Discretization CELL1D'
    end if

Here is the call graph for this function:

source_dimensions()

subroutine disv1dmodule::source_dimensions ( class(disv1dtype)  this )

private

Definition at line 340 of file Disv1d.f90.

    use kindmodule, only: lgp
    use simvariablesmodule, only: idm_context
    ! -- dummy
    class(Disv1dType) :: this
    ! -- locals
    character(len=LENMEMPATH) :: idmMemoryPath
    integer(I4B) :: n
    type(DisFoundType) :: found
    !
    ! -- set memory path
    idmmemorypath = create_mem_path(this%name_model, 'DISV1D', idm_context)
    !
    ! -- update defaults with idm sourced values
    call mem_set_value(this%nodes, 'NODES', idmmemorypath, found%nodes)
    call mem_set_value(this%nvert, 'NVERT', idmmemorypath, found%nvert)
    !
    ! -- for now assume nodes = nodesuser
    this%nodesuser = this%nodes
    !
    ! -- log simulation values
    if (this%iout > 0) then
      call this%log_dimensions(found)
    end if
    !
    ! -- verify dimensions were set
    if (this%nodesuser < 1) then
      call store_error( &
        'NODES was not specified or was specified incorrectly.')
      call store_error_filename(this%input_fname)
    end if
    if (this%nvert < 1) then
      call store_warning( &
        'NVERT was not specified or was specified as zero.  The &
        &VERTICES and CELL1D blocks will not be read for the DISV1D6 &
        &Package in model '//trim(this%memoryPath)//'.')
    end if
    !
    ! -- Allocate non-reduced vectors for disv1d
    call mem_allocate(this%length, this%nodesuser, &
                      'LENGTH', this%memoryPath)
    call mem_allocate(this%width, this%nodesuser, &
                      'WIDTH', this%memoryPath)
    call mem_allocate(this%bottom, this%nodesuser, &
                      'BOTTOM', this%memoryPath)
    call mem_allocate(this%idomain, this%nodesuser, &
                      'IDOMAIN', this%memoryPath)
    !
    ! -- Allocate vertices array
    if (this%nvert > 0) then
      call mem_allocate(this%vertices, 2, this%nvert, &
                        'VERTICES', this%memoryPath)
      call mem_allocate(this%fdc, this%nodesuser, &
                        'FDC', this%memoryPath)
      call mem_allocate(this%cellxy, 2, this%nodesuser, &
                        'CELLXY', this%memoryPath)
    end if
    !
    ! -- initialize all cells to be active (idomain = 1)
    do n = 1, this%nodesuser
      this%length(n) = dzero
      this%width(n) = dzero
      this%bottom(n) = dzero
      this%idomain(n) = 1
    end do

Here is the call graph for this function:

source_griddata()

subroutine disv1dmodule::source_griddata ( class(disv1dtype)  this )

private

Definition at line 427 of file Disv1d.f90.

    ! modules
    use simvariablesmodule, only: idm_context
    ! dummy
    class(Disv1dType) :: this
    ! locals
    character(len=LENMEMPATH) :: idmMemoryPath
    type(DisFoundType) :: found
    ! formats
 
    ! set memory path
    idmmemorypath = create_mem_path(this%name_model, 'DISV1D', idm_context)
 
    call mem_set_value(this%width, 'WIDTH', idmmemorypath, &
                       found%width)
    call mem_set_value(this%bottom, 'BOTTOM', idmmemorypath, &
                       found%bottom)
    call mem_set_value(this%idomain, 'IDOMAIN', idmmemorypath, found%idomain)
 
    if (.not. found%width) then
      write (errmsg, '(a)') 'Error in GRIDDATA block: WIDTH not found.'
      call store_error(errmsg)
    end if
 
    if (.not. found%bottom) then
      write (errmsg, '(a)') 'Error in GRIDDATA block: BOTTOM not found.'
      call store_error(errmsg)
    end if
 
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if
 
    ! log simulation values
    if (this%iout > 0) then
      call this%log_griddata(found)
    end if
 

Here is the call graph for this function:

source_options()

subroutine disv1dmodule::source_options ( class(disv1dtype)  this )

private

Definition at line 271 of file Disv1d.f90.

    ! -- modules
    use kindmodule, only: lgp
    use simvariablesmodule, only: idm_context
    ! -- dummy
    class(Disv1dType) :: this
    ! -- locals
    character(len=LENVARNAME), dimension(3) :: lenunits = &
      &[character(len=LENVARNAME) :: 'FEET', 'METERS', 'CENTIMETERS']
    character(len=lenmempath) :: idmmemorypath
    type(DisFoundType) :: found
    !
    ! -- set memory path
    idmmemorypath = create_mem_path(this%name_model, 'DISV1D', idm_context)
    !
    ! -- update defaults with idm sourced values
    call mem_set_value(this%lenuni, 'LENGTH_UNITS', &
                       idmmemorypath, lenunits, found%length_units)
    call mem_set_value(this%nogrb, 'NOGRB', &
                       idmmemorypath, found%nogrb)
    call mem_set_value(this%xorigin, 'XORIGIN', &
                       idmmemorypath, found%xorigin)
    call mem_set_value(this%yorigin, 'YORIGIN', &
                       idmmemorypath, found%yorigin)
    call mem_set_value(this%angrot, 'ANGROT', &
                       idmmemorypath, found%angrot)
    !
    ! -- log values to list file
    if (this%iout > 0) then
      call this%log_options(found)
    end if

Here is the call graph for this function:

source_vertices()

subroutine disv1dmodule::source_vertices ( class(disv1dtype)  this )

private

Definition at line 494 of file Disv1d.f90.

    ! -- modules
    use simvariablesmodule, only: idm_context
    ! -- dummy
    class(Disv1dType) :: this
    ! -- local
    integer(I4B) :: i
    character(len=LENMEMPATH) :: idmMemoryPath
    real(DP), dimension(:), contiguous, pointer :: vert_x => null()
    real(DP), dimension(:), contiguous, pointer :: vert_y => null()
    ! -- formats
    !
    ! -- set memory path
    idmmemorypath = create_mem_path(this%name_model, 'DISV1D', idm_context)
    !
    ! -- set pointers to memory manager input arrays
    call mem_setptr(vert_x, 'XV', idmmemorypath)
    call mem_setptr(vert_y, 'YV', idmmemorypath)
    !
    ! -- set vertices 3d array
    if (associated(vert_x) .and. associated(vert_y)) then
      do i = 1, this%nvert
        this%vertices(1, i) = vert_x(i)
        this%vertices(2, i) = vert_y(i)
      end do
    else
      call store_error('Required Vertex arrays not found.')
    end if
    !
    ! -- log
    if (this%iout > 0) then
      write (this%iout, '(1x,a)') 'Setting Discretization Vertices'
      write (this%iout, '(1x,a,/)') 'End setting discretization vertices'
    end if
    call memorystore_release('XV', idmmemorypath)
    call memorystore_release('YV', idmmemorypath)

Here is the call graph for this function:

write_grb()

subroutine disv1dmodule::write_grb ( class(disv1dtype)  this, integer(i4b), dimension(:), intent(in)  icelltype  )

private

Definition at line 848 of file Disv1d.f90.

    ! -- modules
    use inputoutputmodule, only: getunit, openfile
    use openspecmodule, only: access, form
    use constantsmodule, only: lenbigline
    ! -- dummy
    class(Disv1dType) :: this
    integer(I4B), dimension(:), intent(in) :: icelltype
    ! -- local
    integer(I4B) :: i, iunit, ntxt, version
    integer(I4B), parameter :: lentxt = 100
    character(len=50) :: txthdr
    character(len=lentxt) :: txt
    character(len=LINELENGTH) :: fname
    character(len=LENBIGLINE) :: crs
    logical(LGP) :: found_crs
    character(len=*), parameter :: fmtgrdsave = &
      "(4X,'BINARY GRID INFORMATION WILL BE WRITTEN TO:', &
       &/,6X,'UNIT NUMBER: ', I0,/,6X, 'FILE NAME: ', A)"
    !
    ! -- Initialize
    version = 1
    ntxt = 10
    if (this%nvert > 0) ntxt = ntxt + 5
    !
    call mem_set_value(crs, 'CRS', this%input_mempath, found_crs)
    !
    ! -- set version
    if (found_crs) then
      ntxt = ntxt + 1
      version = 2
    end if
    !
    ! -- Open the file
    fname = trim(this%output_fname)
    iunit = getunit()
    write (this%iout, fmtgrdsave) iunit, trim(adjustl(fname))
    call openfile(iunit, this%iout, trim(adjustl(fname)), 'DATA(BINARY)', &
                  form, access, 'REPLACE')
    !
    ! -- write header information
    write (txthdr, '(a)') 'GRID DISV1D'
    txthdr(50:50) = new_line('a')
    write (iunit) txthdr
    write (txthdr, '(a)') 'VERSION 1'
    txthdr(50:50) = new_line('a')
    write (iunit) txthdr
    write (txthdr, '(a, i0)') 'NTXT ', ntxt
    txthdr(50:50) = new_line('a')
    write (iunit) txthdr
    write (txthdr, '(a, i0)') 'LENTXT ', lentxt
    txthdr(50:50) = new_line('a')
    write (iunit) txthdr
    !
    ! -- write variable definitions
    write (txt, '(3a, i0)') 'NCELLS ', 'INTEGER ', 'NDIM 0 # ', this%nodesuser
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    write (txt, '(3a, i0)') 'NJA ', 'INTEGER ', 'NDIM 0 # ', this%con%nja
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    write (txt, '(3a, 1pg24.15)') 'XORIGIN ', 'DOUBLE ', 'NDIM 0 # ', this%xorigin
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    write (txt, '(3a, 1pg24.15)') 'YORIGIN ', 'DOUBLE ', 'NDIM 0 # ', this%yorigin
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    write (txt, '(3a, 1pg24.15)') 'ANGROT ', 'DOUBLE ', 'NDIM 0 # ', this%angrot
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    write (txt, '(3a, i0)') 'BOTM ', 'DOUBLE ', 'NDIM 1 ', this%nodesuser
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    write (txt, '(3a, i0)') 'IA ', 'INTEGER ', 'NDIM 1 ', this%nodesuser + 1
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    write (txt, '(3a, i0)') 'JA ', 'INTEGER ', 'NDIM 1 ', this%con%nja
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    write (txt, '(3a, i0)') 'ICELLTYPE ', 'INTEGER ', 'NDIM 1 ', this%nodesuser
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    write (txt, '(3a, i0)') 'IDOMAIN   ', 'INTEGER ', 'NDIM 1 ', this%nodesuser
    txt(lentxt:lentxt) = new_line('a')
    write (iunit) txt
    !
    ! -- if vertices have been read then write additional header information
    if (this%nvert > 0) then
      write (txt, '(3a, i0)') 'VERTICES ', 'DOUBLE ', 'NDIM 2 2 ', this%nvert
      txt(lentxt:lentxt) = new_line('a')
      write (iunit) txt
      write (txt, '(3a, i0)') 'CELLX ', 'DOUBLE ', 'NDIM 1 ', this%nodesuser
      txt(lentxt:lentxt) = new_line('a')
      write (iunit) txt
      write (txt, '(3a, i0)') 'CELLY ', 'DOUBLE ', 'NDIM 1 ', this%nodesuser
      txt(lentxt:lentxt) = new_line('a')
      write (iunit) txt
      write (txt, '(3a, i0)') 'IAVERT ', 'INTEGER ', 'NDIM 1 ', this%nodesuser + 1
      txt(lentxt:lentxt) = new_line('a')
      write (iunit) txt
      write (txt, '(3a, i0)') 'JAVERT ', 'INTEGER ', 'NDIM 1 ', size(this%javert)
      txt(lentxt:lentxt) = new_line('a')
      write (iunit) txt
    end if
    !
    ! -- if version 2 write character array headers
    if (version == 2) then
      if (found_crs) then
        write (txt, '(3a, i0)') 'CRS ', 'CHARACTER ', 'NDIM 1 ', &
          len_trim(crs)
        txt(lentxt:lentxt) = new_line('a')
        write (iunit) txt
      end if
    end if
    !
    ! -- write data
    write (iunit) this%nodesuser ! nodes
    write (iunit) this%nja ! nja
    write (iunit) this%xorigin ! xorigin
    write (iunit) this%yorigin ! yorigin
    write (iunit) this%angrot ! angrot
    write (iunit) this%bottom ! botm
    write (iunit) this%con%iausr ! ia
    write (iunit) this%con%jausr ! ja
    write (iunit) icelltype ! icelltype
    write (iunit) this%idomain ! idomain
    !
    ! -- if vertices have been read then write additional data
    if (this%nvert > 0) then
      write (iunit) this%vertices ! vertices
      write (iunit) (this%cellxy(1, i), i=1, this%nodesuser) ! cellx
      write (iunit) (this%cellxy(2, i), i=1, this%nodesuser) ! celly
      write (iunit) this%iavert ! iavert
      write (iunit) this%javert ! javert
    end if
    !
    ! -- if version 2 write character array data
    if (version == 2) then
      if (found_crs) write (iunit) trim(crs) ! crs user input
    end if
    !
    ! -- Close the file
    close (iunit)

Here is the call graph for this function: