Module gdxf90

module gdxf90

        ! Uses
    use gdxdll

        ! Types
    public type gdxfile
    public type elemtext
    public type set
    public type parameter
    public type variable

        ! Variables
    type (gdxfile), public, pointer :: filelist
    type (gdxfile), private, pointer :: f
    type (set), private, pointer :: s
    type (set), private, pointer :: usersets
    type (parameter), private, pointer :: p
    type (variable), private, pointer :: v
    character (len=32), private, dimension (10) :: args
    integer, private :: nargs
    integer, private :: nsing
    character (len=10), private :: suffix

        ! Interfaces
    public interface gdxdata

        ! Subroutines and functions
    public logical function gdxread (gdxfname)
    public logical function gdxwrite (fwrite, producer)
    private logical function readscalar (d, ident)
    private logical function readvector (d, ident)
    private logical function readmatrix (d, ident)
    private logical function readsparse (d, e, ident)
    private logical function readset (uel, ident)
    private logical function readstext (sarray, tarray, ident)
    private logical function readslabels (sarray, ident)
    private logical function readdomain (uel, item, i)
    private logical function readtuple (e, ident)
    private logical function readttext (e, tarray, ident)
    public logical function defineset (sarray, ident)
    private logical function findset (ident)
    private subroutine findargs (ident)
    public logical function eqv (t1, t2)
    private logical function quoted (arg)
    private logical function findp (ident)
    private logical function finds (ident)
    private logical function findv (ident)

end module gdxf90
An F90 interface to GAMS GDX files

Author: Thomas Rutherford

Version: 1.0


Description of Types

gdxfile

public type gdxfile
    character (len=256) :: gdxfname
Name of file from which this data is extracted
    type (set), pointer :: sets
Sets defined in the file. Use the following construct to loop through all the sets in the GDX file, noting that the f%SETS record is empty and the first parameter in the file is f%sets%next:
 	s => f%sets
	do while (associated(s%next))
	  s => s%next
	  ... (code operating on set s)
 	end do
    type (parameter), pointer :: parameters
Parameters in the file. Use the following construct to loop through all the parameters in the file, noting that the f%parameters record is empty and the first parameter in the file is f%parameters%next:
 	p => f%parameters
	do while (associated(p%next))
	  p => p%next
	  ... (code operating on parameter p)
 	end do
    type (variable), pointer :: variables
Variables in the file. Use the following construct to loop through all the variables in the file, noting that the f%variables record is empty and the first parameter in the file is f%parameters%next:
 	v => f%variables
	do while (associated(v%next))
	  v => v%next
	  ... (code operating on variable v)
	  ...
 	end do
    integer :: handle
Handle used to read the file
    integer :: nruel
Number of UELs in the file.
    integer :: nrsy
Number of registered symbols
    integer :: nset
Set count
    integer :: nparameter
Parameter count
    integer :: nvariable
Variable count
    character (len=32), allocatable, dimension (:) :: uel
Text strings in the UEL list
    type (gdxfile), pointer :: next
Pointer to next file.
end type gdxfile
Describes all the data in a GDX file, except equations.

elemtext

public type elemtext
    character (len=80), pointer :: text
The character string is defined as a pointer so we avoid allocating 80 bytes of memory for non-existent element text.
end type elemtext
Descriptive text associated with an individual set element

set

public type set
    character (len=31) :: ident
Set identifier
    character (len=256) :: expltxt
Explanatory text for the set
    integer :: ndim
Number of dimensions (>1 implies a tuple)
    integer :: nele
Number of set elements
    integer, allocatable, dimension (:,:) :: e
Integer indices of UELs included in the set.
    type (elemtext), allocatable, dimension (:) :: t
An array of pointers with descriptive text for individual elements. This array is only allocated if one or more set elements have associated text.
Here is how to print off only the elements of set s which have associated text:
 	if (allocated(s%t)) then
	  do i=1,s%nele
	    if (allocated(s%t(i)%text))  write(*,*) trim(s%ident)//' : '//trim(s%t(i)%text)
	  end do
 	end if
    type (set), pointer :: next
Pointer to next set in the file
end type set
Describes a set from a GDX file

parameter

public type parameter
    character (len=31) :: ident
Parameter identifier
    character (len=256) :: expltxt
Explanatory text for this parameter
    integer :: ndim
Dimension of the parameter (scalar has dimension 0)
    integer :: nele
Number of nonzeros in the parameter
    integer, allocatable, dimension (:,:) :: e
UEL indices for each dimension of the parameter domain. The following code lists the values of all nonzeros for parameter p residing in GDX file f:
 	do i=1,p%nele
	  write(*,'(12a)') trim(p%ident)//'(',(trim(f%uel(p%e(i,j))),:,'.',j=1,p%ndim),') ='
	  write(*,*) p%v(i)
 	end do
    real (kind=8), allocatable, dimension (:) :: v
Numeric values of nonzeros
    type (parameter), pointer :: next
Pointer to next parameter in this file.
end type parameter
Describes a parameter from a GDX file

variable

public type variable
    character (len=31) :: ident
Variable identifier
    character (len=256) :: expltxt
Variable explanatory text
    integer :: ndim
Number of dimensions
    integer :: nele
Number of elements
    integer, allocatable, dimension (:,:) :: e
UEL indices for parameter elements
    real (kind=8), allocatable, dimension (:) :: l
Level value of the variable
    real (kind=8), allocatable, dimension (:) :: m
Marginal of the variable
    real (kind=8), allocatable, dimension (:) :: lo
Lower bound of the variable
    real (kind=8), allocatable, dimension (:) :: up
Upper bound of the variable
    real (kind=8), allocatable, dimension (:) :: scale
Scale / SOS value for the variable
    type (variable), pointer :: next
Pointer to next variable in this file.
end type variable
Describes a variable from a GDX file

Description of Variables

filelist

type (gdxfile), public, pointer :: filelist
Pointer to the list of GDX files which have already been read. Use the following construct to loop through the files which have already been read, noting that the filelist record itself is empty and the first file actually used is filelist%next

 	f => filelist
	do while (associated(f%next))
	  f => f%next
	  ... (code operating on file f)
	  ...
 	end do

f

type (gdxfile), private, pointer :: f
Pointer to the file which is currently in focus

s

type (set), private, pointer :: s
Pointer to the set which is currently in focus

usersets

type (set), private, pointer :: usersets
Pointer to the list of sets which have been defined by the user:

p

type (parameter), private, pointer :: p
Pointer to the parameter which is currently in focus

v

type (variable), private, pointer :: v
Pointer to the variable which is currently in focus

args

character (len=32), private, dimension (10) :: args
List of arguments in the user-supplied identifier string:

nargs

integer, private :: nargs
Count of arguments in the user-supplied identifier string:

nsing

integer, private :: nsing
Number of quoted singletons in the argument list:

suffix

character (len=10), private :: suffix
Suffix in the user-supplied identifier string:

Description of Interfaces

gdxdata

public interface gdxdata
    module procedure readscalar
    module procedure readvector
    module procedure readmatrix
    module procedure readsparse
    module procedure readset
    module procedure readdomain
    module procedure readslabels
    module procedure readstext
    module procedure readtuple
    module procedure readttext
end interface gdxdata
gdxdata is a generic interface to data from a GDX file. Data are extracted from the file which is currently in focus, i.e. the file which was most recently read. A request to reread a file simply brings that file into focus.

Description of Subroutines and Functions

gdxread

public logical function gdxread (gdxfname)
    character (len=*) :: gdxfname
end function gdxread
A public function indicating which GDX file to bring into focus. If the file has not already been read, it is read into a gdxfile structure (NB The current version of this program does not read equations.)

gdxwrite

public logical function gdxwrite (fwrite, producer)
    type (gdxfile), pointer :: fwrite
    character (len=*) :: producer
end function gdxwrite
Write a user-defined GDXfile to disk. The gdxf90 interface currently does not provide any simplified interface for moving data from conventional Fortran arrays into a gdxfile structure. Writing a GDX file therefore involves creation through allocate() statements a gdxfile structure including an included sets, parameters and variables. Here is a code fragment for creating a GDX structure containing a single dimensional parameter:
 	use gdxf90	! Need this statement to have acess to the definitions of 
			! gdxfile and parameter.

	type (gdxfile), pointer :: f	! Pointers used to construct the GDX file structure
	type (parameter), pointer :: p

	character (len=32) :: label(10)    ! The parameter to be written to the GDX file
	read(kind=8) :: value(10)

	... code which assigns label() and value()

	allocate(f)
	nullify(f%next)
	f%nset = 0
	f%nvariable = 0
	f%nparametmer = 1
	allocate(f%sets);	nullify(f%sets%next)
	allocate(f%parameters); nullify(f%parameters%next)
	allocate(f%variables);	nullify(f%variables%next)

	f%handle = 0		! The value of the handle is not used but should be defined.

	f%gdxfname = 'sample.gdx'	! Define the file name here

	f%nruel = 10		! Because there is only a single parameter in the 
	allocate(f%uel(10))	! file, the labels on the parameter are the UELs.
				! If there were multiple parameters, we would take a union
	p => f%parameters
	allocate(p%next)	
	p => p%next
	nullify(p%next)

	p%ndim = 1		! Single dimensional
	p%nele = 10		! 10 nonzeros
	p%ident = 'p'		! Name the parameter here.
	pp%expltxt = 'Single dimensional parameter with 10 elements'	! Describe it here.

	allocate(p%e(10,1))	! Allocate workspace for indices
	allocate(p%v(10))	! Allocate workspace for values

	do i=1,10
	  f%uel(i) = label(i)
	  p%e(i,1) = i
	  p%v(i) = value(i)
	end do

 	if (.not.gdxwrite(f,'TFR')) stop 'Error occured in writing the file.'

readscalar

private logical function readscalar (d, ident)
    real (kind=8), intent (out) :: d
    character (len=*) :: ident
end function readscalar
Read a scalar value from the GDX file. This routine is invoked by calling gdxdata with a scalar argument. The identier may refer to a scalar parameter or a singleton value of a parameter array or variable value. Some examples of usage:

- Read a simple scalar

 		real(kind=8) :: s
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(s,'s'))	stop 'Could not extract scalar s from the GDX file.'
 		write(*,*) 'Value of scalar s is:',s
- Read a single element of a vector parameter
 		real(kind=8) :: v0
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(v0,'v("0")'))	stop 'Could not read v("0") from the GDX file.'
 		write(*,*) 'Value of v("0") is:',v0
- Read a single element of a matrix parameter
 		real(kind=8) :: m12
		if (.not.gdxread('data.gdx'))		stop 'Could not read data.gdx'
		if (.not.gdxdata(m12,'m("1","2")'))	stop 'Could not read m("1","2") from the GDX file.'
 		write(*,*) 'Value of m("1","2") is:',m12
- Read a single element of a level value for a vector variable
 		real(kind=8) :: x1
		if (.not.gdxread('data.gdx'))		stop 'Could not read data.gdx'
		if (.not.gdxdata(x1,'x.l("1")'))	stop 'Could not read x.l("1") from the GDX file.'
 		write(*,*) 'Value of x.l("1") is:',x1

readvector

private logical function readvector (d, ident)
    real (kind=8), intent (out), allocatable, dimension (:) :: d
    character (len=*) :: ident
    ! Calls: findargs
end function readvector
Read a dense one dimensional array from the GDX file. This routine is invoked by calling gdxdata with a allocatable single dimensional array. The identier may refer to a one dimensional parameter or a value associated with a one dimensional variable (level value, lower bound, upper bound, scale factor or marginal).

The identifier may reference a particular set in order to establish the element order in the returned array.

The identifier may also refer to a single dimensional "slice" through a multidimensional parameter or variable. Some examples of usage:

- Read only nonzeros for a vector parameter. Note that the vector of values to be returned must be declared as an allocatable array. Also note how the F90 intrinsic function size() is used to infer the number of nonzeros returned.

 		real(kind=8), allocatable :: v(:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(v,'v'))	stop 'Could not extract parameter v from the GDX file.'
		write(*,*) 'Number of nonzeros in v is:',size(v)
 		write(*,*) 'Nonzeros in v are:',v
- Read a specific set of elements for a vector parameter.
 		real(kind=8), allocatable :: v(:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(v,'v(i)'))	stop 'Could not extract parameter v(i) from the GDX file.'
		write(*,*) 'Number of elements in set i is:',size(v)
 		write(*,*) 'All elements in v(i) are:',v
- Read marginal values for a variable:
 		real(kind=8), allocatable :: xm(:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(xm,'x.m'))	stop 'Could not extract marginals for x from the GDX file.'
		write(*,*) 'Number of elements in x:',size(xm)
 		write(*,*) 'Marginals for variable x:',xm
- Read a slice through a multidimensional parameter.
 		real(kind=8), allocatable :: r1(:)
		if (.not.gdxread('data.gdx'))		stop 'Could not read data.gdx'
		if (.not.gdxdata(r1,'m("1",j)'))	stop 'Could not read m("1",j) from the GDX file.'
 		write(*,*) 'Value of m("1",j) is:',r1

readmatrix

private logical function readmatrix (d, ident)
    real (kind=8), intent (out), allocatable, dimension (:,:) :: d
    character (len=*) :: ident
    ! Calls: findargs
end function readmatrix
Read a dense two dimensional array from the GDX file. This routine is invoked by calling gdxdata with a allocatable two dimensional array. The identier may refer to a two dimensional parameter or a value associated with a two dimensional variable (level value, lower bound, upper bound, scale factor or marginal).

The identifier may reference specific sets in order to establish the element order in the returned array.

The identifier may also refer to a two dimensional "slice" through a multidimensional parameter or variable. Some examples of usage:

- Read only all the nonzeros for a parameter array. The variable to be returned must be declared as an allocatable array. The F90 intrinsic function size() can be used to infer the number of rows and columns in the allocated matrix:

 		real(kind=8), allocatable :: m(:,:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(m,'m'))	stop 'Could not extract parameter m from the GDX file.'
		write(*,*) 'Number of rows in m is:',size(m,1)
		write(*,*) 'Number of columns in m is:',size(m,2)
 		write(*,*) 'Values in m:',m
- Read a dense matrix with a specific set of rows and columns:
 		real(kind=8), allocatable :: m(:,:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(v,'m(i,j)'))	stop 'Could not extract parameter m(i,j) from the GDX file.'
		write(*,*) 'Number of elements in set i is:',size(m,1)
		write(*,*) 'Number of elements in set j is:',size(m,2)
 		write(*,*) 'Values in m(i,j) are:',m
- Read a slice through a multidimensional parameter.
 		real(kind=8), allocatable :: x(:,:)
		if (.not.gdxread('data.gdx'))		stop 'Could not read data.gdx'
		if (.not.gdxdata(x,'y("1",*,j)'))	stop 'Could not first row of y.'
 		write(*,*) 'Value of y("1",*,j) is:',x

readsparse

private logical function readsparse (d, e, ident)
    real (kind=8), intent (out), allocatable, dimension (:) :: d
    integer, intent (out), allocatable, dimension (:,:) :: e
    character (len=*) :: ident
    ! Calls: findargs
end function readsparse
Read numeric data from the GDX file in sparse format. Only nonzeros are returned and the associated indices. Some examples of usage:

- Read a two-dimensional matrix with an explicit domain.

 		real(kind=8), allocatable :: a(:)
		integer, allocatable :: ia(:,:)
		if (.not.gdxread('data.gdx'))		stop 'Could not read data.gdx'
		if (.not.gdxdata(a,ia,'a(i,j)'))	stop 'Could not read a(i,j) from the GDX file.'
		write(*,*) 'Nonzeros in a:'
 		do k=1,size(a); write(*,*) ia(k,1),ia(k,2),a(k); end do

Note that the indices returned refer to the indices in sets i and j.

- Read a three-dimensional matrix with an implicit domain.

 		real(kind=8), allocatable :: b(:)
		integer, allocatable :: ib(:,:)
		integer :: k,j
		if (.not.gdxread('data.gdx'))		stop 'Could not read data.gdx'
		if (.not.gdxdata(b,ib,'b)'))	stop 'Could not read b from the GDX file.'
		write(*,*) 'Number of dimensions in b:', size(ib,2)
		write(*,*) 'Nonzeros in b:'
 		do k=1,size(b); write(*,*) (ib(k,j),j=1,size(ib,2)),b(k); end do

Note that the indices returned refer to the indices in sets i and j.

readset

private logical function readset (uel, ident)
    integer, allocatable, dimension (:) :: uel
    character (len=*) :: ident
    ! Calls: findargs
end function readset
Read elements of a single dimensional set. Associated set labels are returned in the specified array. The identifier may refer to explicit and implicit sets defined in the GDX file. Some examples of usage:

- Read an explicitly-defined single dimensional set i which exists in the GDX file.

 		integer, allocatable :: i(:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(i,'i'))	stop 'Could not extract set i from the GDX file.'
		write(*,*) 'Number of elements in i is:',size(i)
 		write(*,*) 'UEL indices for elements in i are:',i
- Read an implicitly-defined single dimensional set xnz defined by the nonzeros in x:
 		integer, allocatable :: xnz(:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(xnz,'x(.)'))	stop 'Could not extract set x(.) from the GDX file.'
		write(*,*) 'Number of elements in set xnz(.) is:',size(xnz)
 		write(*,*) 'UEL indices of xnz(.) are:',xnz
- Read an implicitly-defined single dimensional set mr defined by the rows returned for two-dimensional matrix m:
 		integer, allocatable :: mr(:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(mr,'m(.,)'))	stop 'Could not extract set m(.,) from the GDX file.'
		write(*,*) 'Number of elements in set m(.,) is:',size(mr)
 		write(*,*) 'UEL indices of m(.,) are:',mr

readstext

private logical function readstext (sarray, tarray, ident)
    character (len=*), allocatable, dimension (:) :: sarray
    character (len=*), allocatable, dimension (:) :: tarray
    character (len=*) :: ident
end function readstext
Read labels and associated element text for a single dimensional set. Set element labels are returned in the first array, and set element descriptive text (if present) is returned in the second array.

readslabels

private logical function readslabels (sarray, ident)
    character (len=*), allocatable, dimension (:) :: sarray
    character (len=*) :: ident
end function readslabels
Read labels for set elements. See readset() for documentation. Set element labels in GAMS may be as many as 32 characters in length, but an array of shorter strings may be used. An error is produced if a set element label exceeds the length of the argument array elements. In this example, an error is generated if any label for set i exceeds 12 characters: - Read labels for an explicitly-defined single dimensional set i which exists in the GDX file. Set elements in GAMS may be as many as 32 characters in length, but an array of shorter strings may be used. An error is produced if a set element label exceeds the length of the argument array elements. In this example, an error is generated if any label for set i exceeds 12 characters:

 		character (len=12), allocatable :: i(:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(i,'i'))	stop 'Could not extract set i from the GDX file.'
		write(*,*) 'Number of elements in i is:',size(i)
 		write(*,*) 'Labels for elements in i are:',i
- Read an implicitly-defined single dimensional set xnz defined by the nonzeros in x:
 		character (len=32), allocatable :: xnz(:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(xnz,'x(.)'))	stop 'Could not extract set x(.) from the GDX file.'
		write(*,*) 'Number of elements in set xnz(.) is:',size(xnz)
 		write(*,*) 'Elements of xnz(.) are:',xnz
- Read an implicitly-defined single dimensional set mr defined by the rows returned for two-dimensional matrix m:
 		character (len=32), allocatable :: mr(:)
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(mr,'m(.,)'))	stop 'Could not extract set m(.,) from the GDX file.'
		write(*,*) 'Number of elements in set m(.,) is:',size(mr)
 		write(*,*) 'Elements of m(.,) are:',mr

readdomain

private logical function readdomain (uel, item, i)
    integer, allocatable, dimension (:) :: uel
    character (len=*) :: item
    integer :: i
end function readdomain

readtuple

private logical function readtuple (e, ident)
    integer, intent (out), allocatable, dimension (:,:) :: e
    character (len=*) :: ident
    ! Calls: findargs
end function readtuple
Read elements of a tuple from the GDX file. The first argument must be a two-dimensional, allocatable, integer array. The second argument is a character string describing the set to be returned. Some examples of usage:

- Read elements of a two-dimensional tuple k(i,j):

 		integer, allocatable :: k(:,:)
		integer :: i
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(k,'k(i,j)'))	stop 'Could not extract set k from the GDX file.'
		write(*,*) 'Number of elements in tuple k:',size(k,1)
		write(*,*) 'Number of dimensions of k (must be two):',size(k,2)
		write(*,*) 'Pairs in k:'
 		do i=1,size(k,1); write(*,*) k(i,1),k(i,2); end do
- Return elements of m which are in j:

 		integer, allocatable :: j(:,:)
		integer :: i
		if (.not.gdxread('data.gdx'))	stop 'Could not read data.gdx'
		if (.not.gdxdata(j,'j(m)'))	stop 'Could not extract set j from the GDX file.'
		write(*,*) 'Number of elements from m which are in set j:',size(j,1)
		write(*,*) 'Number of dimensions of j (must be one):',size(j,2)
 		write(*,*) 'Elements of m which are in j:',j

readttext

private logical function readttext (e, tarray, ident)
    integer, intent (out), allocatable, dimension (:,:) :: e
    character (len=*), intent (out), allocatable, dimension (:) :: tarray
    character (len=*) :: ident
    ! Calls: findargs
end function readttext
Read elements of a tuple and associated element text from the GDX file. The first argument must be a two-dimensional, allocatable, integer array. The second argument must be a single dimensional, allocatable character array. The third argument is a character string describing the set to be returned. This routine is identical to readtuple apart from the fact that it returns both indices and descriptive element text. The element text array is always allocated, even when no elemental text is found. If there is no text for a particular element, the corresponding component of t() is assigned a blank (' '=char(32));

defineset

public logical function defineset (sarray, ident)
    character (len=*), dimension (:) :: sarray
    character (len=*) :: ident
end function defineset
A public function which may be used to introduce a user-defined set. This function can be used to reorder or filter the index positions for data returned from the GDX file.

findset

private logical function findset (ident)
    character (len=*) :: ident
end function findset
Bring into focus the set with a particular identifier. This function differs from _finds()_ in that it first examines set identifiers which have been defined by the user, and then scans the sets which are defined explicitly in the GDX file. When a set is defined by the user to control data indices, it takes precedence over any set of the same name defined in the GDX file.

findargs

private subroutine findargs (ident)
    character (len=*) :: ident
end subroutine findargs
A local routine which parses arguments from an identifier. This array assigns integer counts for the number of arguments (nargs), the number of singleton arguments (nsing), and the text strings corresponding to each of the arguments.

Some examples:

 
	findargs('a(i,j)')
 
returns nargs=2, _nsing=0, args = /'i','j',' ',.../
 
	findargs('a("i1",j)')
 
returns nargs=2, nsing=1, args = /'"i"','j',' ',.../
 
	findargs('a(*,j)')
 
returns nargs=2, nsing=0, args = /'*','j',' ',.../

eqv

public logical function eqv (t1, t2)
    character (len=*) :: t1
    character (len=*) :: t2
end function eqv
Public function determines whether two strings are identical apart from case.

quoted

private logical function quoted (arg)
    character (len=*) :: arg
end function quoted
Returns .true. if the argument is quoted text, i.e. a character string beginning and ending with a pair of single or double quotes.

findp

private logical function findp (ident)
    character (len=*) :: ident
end function findp
Local routine which brings a specified parameter into focus. Returns .false. if the argument identifier is not a parameter.

finds

private logical function finds (ident)
    character (len=*) :: ident
end function finds
Local routine which brings a specified set into focus. Returns .false. if the argument identifier is not a set.

findv

private logical function findv (ident)
    character (len=*) :: ident
end function findv
Local routine which brings a specified variable into focus. Returns .false. if the argument identifier is not a variable.