module mpsge ! Types public type line public type linelist public type symbol public type domain public type field public type record public type taxlist public type netput public type endowment public type endowmentlist public type netputlist public type nest public type nestlist public type function public type GPCoeffVarReal public type GPDeclaration ! Variables type (line), public, pointer :: inputfile type (function), public, pointer :: functionlist type (symbol), public, pointer :: idlist type (symbol), public, pointer :: idlast character (len=32), public :: modelname integer, public :: nfun = 0 integer, public, parameter :: iomps = 10 integer, public, parameter :: iogms = 11 logical, public :: splitlog = .false. logical, public :: log = .true. logical, public :: readvars integer, public, parameter :: iotabgp = 11 integer, public, parameter :: iocmfgp = 12 integer, public :: NHeaderGP = 0 integer, public :: LengthGPDeclarationName type (GPDeclaration), public, pointer :: GPDeclarationList type (GPDeclaration), public, pointer :: GPDeclarationLast ! Subroutines and functions public subroutine readmps () public subroutine readline (L, input, lineno) public subroutine readfield (input, f) public subroutine lower (word) public subroutine upper (word) public subroutine tab2blank (line) public integer function dimension (d) public subroutine echoprint () public subroutine parse () public subroutine findid (name, id) public subroutine addid (name, type, s, L) public subroutine domaincopy (d1, d2) public subroutine addlineref (L, s) public subroutine domainadd (name, dm, L) public logical function indomain (s, dm) public logical function subset (d1, d2) public subroutine split (field, ident, arg, span, condtn) public subroutine readdomain (dtext, d, L) public subroutine newline (L) public subroutine newsymbol (s) public subroutine newfunction (fn) public subroutine newdomain (d) public subroutine newfield (f) public subroutine newrecord (r) public subroutine newtax (t) public subroutine newnetput (np) public subroutine newnest (n) public subroutine union (d1, u) public subroutine findsubdomain (d1, d2, subdomain) public logical function singleton (string) public subroutine writeparam (ident, index, d, string) public subroutine domainlabels (d, dl) public subroutine writedomain (d, string) public subroutine readvar () public subroutine chkprod () public subroutine chkfield (f, fieldno, pfield) public subroutine readnest () public subroutine parsenestid (nestid, ident, parentid) public subroutine readcoef () public subroutine nesttype (fn, n, output) public subroutine readelem (np, f, taxagent, lastfield) public subroutine sectors () public logical function numeric (string) public subroutine addnetput (np, n, f) public subroutine addtax (np, t) public subroutine lasttax (np, t) public subroutine findnest (nestid, fn, n) public subroutine addsubnest (n, np) public logical function quoted (arg) public logical function eqv (t1, t2) public subroutine consumers () public subroutine chkdemand () public subroutine chkdfield (f, fieldno, e) public subroutine ConvertToGP () public subroutine StartTABGP () public subroutine WriteProdQuantityFormula (OutputQuantity, InputQuantity, InputsSubDomain) public subroutine WriteSumsGP (ThisDomain, OutputString, NSum) public subroutine EndSumsGP (NSum, OutputString) public subroutine WriteProdDemandEquation (ThisProdFunction) public subroutine WriteProdZeroProfitEquation (ProdDemandVariable, OutputQuantity, OutputPrice, InputQuantity, InputPrice, InputsSubDomain) public subroutine WriteProdUpdate (InputQuantity, InputPrice, ThisProdVar) public subroutine GPCommentFunction (ThisFunction) public subroutine NewGPCoeffVar (ThisCoeffVar) public logical function IsReal (ThisString) public subroutine GetProdTopVariableElast (ThisFunction, ThisVariable, ThisElasticity) public subroutine GetProdPriceQuantity (ThisFunction, IOType, ThisPrice, ThisQuantity) public subroutine GetInputsSubDomain (ThisFunction, ThisSubdomain) public subroutine ReadCoeffGP (ThisCoefficient) public subroutine DeclareGPCoeffVar (ThisGPCoeffVar) public subroutine GetProdVariableGP (ThisProdFunction, ThisVar) public subroutine GetDemandPriceQuantities (ThisDemandFunction, DemandPrice, DemandQuantity, DFieldExists, EndowmentPrice, EndowmentQuantity, EFieldExists, DemandTopVariable) public subroutine GetDemandVariableGP (ThisTopVar, EndowmentPrice, ThisDemandVar) public subroutine WriteDemandUpdate (ThisDemandVar, EndowmentPrice, EndowmentQuantity) public subroutine WriteDemandMarketClearingEquation (DemandTopVar, DemandPrice) public subroutine WriteDemandIncomeBalanceEquation (ThisDemandTopVar, EndowmentPrice, EndowmentQuantity, ThisDemandVar) public subroutine WriteArguments (FirstArg, OutputText, LenOutput) public subroutine WriteRecord (DescText, ThisRecord) public subroutine WriteField (DescText, ThisField) public subroutine GPSet2Index (CurrentSet, CurrentIndex) public subroutine MarkAsDeclaredGP (ThisSymbol) public subroutine ArgToAllsGP (TheseArgs, OutputString) public subroutine CoeffVarToGP (ThisCoeffVar, OutputString) public subroutine ArgToGP (TheseArgs, OutputString) public subroutine DeclareFieldGP (DeclarationType, ThisField) public subroutine WriteNest (DescText, ThisNest) public subroutine NewGPDeclaration (ThisGPDeclaration) public subroutine AddGPDeclaration (type, name) public logical function HasBeenDeclaredGP (type, name) end module mpsgeRoutines for constructing and manipulating general equilibrium models implemented with MPSGE
Author: Thomas Rutherford
Version: 1.0
public type line character (len=2048) :: text
integer :: lineno
type (record), pointer :: record
type (line), pointer :: next
end type lineDefines a line of MPSGE source code.
public type linelist type (line), pointer :: line type (linelist), pointer :: next end type linelistDefines a list of input lines as they have been read from the input file.
public type symbol character (len=31) :: name
character (len=9) :: type
type (linelist), pointer :: lines
type (symbol), pointer :: next
integer :: dim
logical :: DeclaredGP
end type symbolElements of the symbol table include various MPSGE variables (commodity prices, sectoral activity level, consumer incomes and auxiliary variables). The symbol table also includes sets and parameters which are encountered in the input file. This list is maintained to provide some context checking on input.
public type domain type (symbol), pointer :: s
type (domain), pointer :: next
integer :: dim
end type domainA domain is simply a list of sets. This list may include quoted singletons as well as references to GAMS sets. Each element of the set is represented by a pointer to the set in the symbol table
public type field character (len=255) :: label
character (len=255) :: data
character (len=255) :: identtext
character (len=255) :: argtext
character (len=255) :: spantext
character (len=255) :: condtn
type (symbol), pointer :: ident
type (domain), pointer :: arg
type (domain), pointer :: span
type (line), pointer :: line
type (field), pointer :: next
end type fieldAn MPSGE input file consists of a series of records. Each record is composed of one or more fields. An input field consist of a label and some field text. A field in an MPSGE model consists of two primary components: the label and the field data. The field data in turn consists of the identifier, the identifier argument, the spanning sets and the condition clause.
public type record type (field), pointer :: firstfield
type (line), pointer :: line
integer :: nfield
type (record), pointer :: next end type recordThis type describes a record in an MPSGE function, possibly spanning multiple lines if there are continuations (lines "+" in the first column)
public type taxlist type (field), pointer :: a
type (field), pointer :: t
type (field), pointer :: n
type (field), pointer :: m
type (taxlist), pointer :: next
end type taxlistA tax coefficient on a production input or output consists of:
public type netput type (field), pointer :: f
type (field), pointer :: qref
type (field), pointer :: pref
type (domain), pointer :: d
type (domain), pointer :: sd
type (taxlist), pointer :: t
character (len=1024) :: nestcount integer :: nestfields logical :: output
integer :: index
end type netputThis type defines an input or output in a production block. The domain associated with a netput consists of the union of sets in the function declaration block and the commodity price. For example, if we have
$prod:y(i,t) o:p(j,t) q:y0(i) ...then the domain of the netput, d, is (i,t,j), and the subdomain of the netput, sd, is (j).
public type endowment type (field), pointer :: f
type (field), pointer :: q
type (field), pointer :: r
type (domain), pointer :: d
type (domain), pointer :: sd
integer :: index end type endowment
public type endowmentlist type (endowment), pointer :: e type (endowmentlist), pointer :: next end type endowmentlistList of endowment records
public type netputlist type (netput), pointer :: np
type (field), pointer :: f
type (netputlist), pointer :: next
end type netputlistList of netputs references from the associated nest.
public type nest character (len=255) :: ident
character (len=255) :: parentid
character (len=255) :: value
logical :: output
type (field), pointer :: f
type (nest), pointer :: parent
type (nestlist), pointer :: nlist
type (netputlist), pointer :: elements
type (nestlist), pointer :: subnests
type (nest), pointer :: next
integer :: index
integer :: level
logical :: assigned
end type nestNest type characterizes a CES nest in a cost function.
public type nestlist type (nest), pointer :: n
type (nestlist), pointer :: next
end type nestlistLinked list of nests used to represent the nested CES substitution structure:
public type function type (record), pointer :: firstrecord
integer :: nrecord
integer :: nfield
type (nest), pointer :: inputs
type (nest), pointer :: outputs
type (field), pointer :: demand
type (endowmentlist), pointer :: endowments
type (function), pointer :: next
end type functionAn MPSGE production or demand function
public type GPCoeffVarReal character :: type character (len=15) :: name type (domain), pointer :: arg end type GPCoeffVarReal
public type GPDeclaration character (len=2) :: type
character (len=LengthGPDeclarationName) :: name
type (GPDeclaration), pointer :: next
end type GPDeclaration
type (line), public, pointer :: inputfilePointer to first line in the linked list of input file lines
type (function), public, pointer :: functionlistPointer to the first function in linked list
type (symbol), public, pointer :: idlistPointer to the first symbol
type (symbol), public, pointer :: idlastPointer to the last symbol
character (len=32), public :: modelname
integer, public :: nfun = 0Number of functions in the MPSGE file
integer, public, parameter :: iomps = 10Unit number of the MPSGE file
integer, public, parameter :: iogms = 11Unit number of the resulting GAMS file
logical, public :: splitlog = .false.Flag for log output of field parsing operation
logical, public :: log = .true.Flag for general log output
logical, public :: readvarsFlag for current input ot declaration records
integer, public, parameter :: iotabgp = 11Unit number of the output GEMPACK TAB file
integer, public, parameter :: iocmfgp = 12Unit number of the output GEMPACK Command file
integer, public :: NHeaderGP = 0Number of headers data is read from in TAB file
integer, public :: LengthGPDeclarationName
type (GPDeclaration), public, pointer :: GPDeclarationListPointer to first in list
type (GPDeclaration), public, pointer :: GPDeclarationLastPointer to last in list
public subroutine readmps () ! Calls: newfield, newfunction, newrecord, readfield, readline end subroutine readmpsMaster routine to read an MPSGE input file:
public subroutine readline (L, input, lineno) type (line), pointer :: L character (len=*) :: input integer :: lineno ! Calls: newline, tab2blank end subroutine readlineRead to the next non-blank line from the input file, incrementing the line count:
public subroutine readfield (input, f) character (len=*) :: input type (field), pointer :: f ! Calls: lower end subroutine readfieldRead the last field from a line of input, using the colon to locate the label and the data components:
public subroutine lower (word) character (len=*) :: word
end subroutine lowerFold a character string to lower case.
public subroutine upper (word) character (len=*) :: word
end subroutine upperFold a character string to upper case.
public subroutine tab2blank (line) character (len=*) :: line
end subroutine tab2blankConvert tabs on an input line to spaces:
public integer function dimension (d) type (domain), pointer :: d
end function dimensionEvaluate the dimension of a domain by counting the number of set identifiers in the linked list defining the domain:
public subroutine echoprint () end subroutine echoprintGenerate an echoprint of the file. This is currently very preliminary, and will later be recoded to produce a more carefully formatted report.
public subroutine parse () ! Calls: findid, readdomain, split end subroutine parseParse all fields in the file into constituent elements:
public subroutine findid (name, id) character (len=*), intent(in) :: name
type (symbol), pointer :: id
end subroutine findidReturn pointer to given identifier
public subroutine addid (name, type, s, L) character (len=*), intent(in) :: name
character (len=*), intent(in) :: type
type (symbol), pointer :: s type (line), pointer :: L ! Calls: newsymbol end subroutine addidIntroduce a new identifier in the master list.
public subroutine domaincopy (d1, d2) type (domain), pointer :: d1
type (domain), pointer :: d2
! Calls: newdomain end subroutine domaincopy
public subroutine addlineref (L, s) type (line), pointer :: L
type (symbol), pointer :: s
end subroutine addlinerefAdd an entry in the linked list of line numbers which refer to a given symbol.
public subroutine domainadd (name, dm, L) character (len=*), intent (in) :: name
type (domain), pointer :: dm
type (line), pointer :: L
! Calls: addid, addlineref, findid, newdomain end subroutine domainaddAdd a set element to the domain
public logical function indomain (s, dm) type (symbol), pointer :: s
type (domain), pointer :: dm
end function indomainLogical function which reports whether a set with a given name is in a domain:
public logical function subset (d1, d2) type (domain), pointer :: d1
type (domain), pointer :: d2
end function subsetTets whether one domain (d1) is a subst of another (d2).
public subroutine split (field, ident, arg, span, condtn) character (len=*), intent(in) :: field character (len=*), intent(out) :: ident character (len=*), intent(out) :: arg character (len=*), intent(out) :: span character (len=*), intent(out) :: condtn end subroutine splitSplit up an input field into the constituent elements
For example:
i:p(i,t)#(s)$betaparses into:
Field identifier: p Argument text: i,t Spanning domain text: s Condition text: beta
public subroutine readdomain (dtext, d, L) character (len=*), intent(in) :: dtext
type (domain), pointer :: d
type (line), pointer :: L
! Calls: domainadd, lower end subroutine readdomainRead a domain and parse into a series of set elements.
public subroutine newline (L) type (line), pointer :: L end subroutine newlineAllocate a new line and assign default values
public subroutine newsymbol (s) type (symbol), pointer :: s end subroutine newsymbolAllocate a new symbol and assign default values for all the symbol characteristics
public subroutine newfunction (fn) type (function), pointer :: fn end subroutine newfunctionAllocate a new function pointer with default values
public subroutine newdomain (d) type (domain), pointer :: d end subroutine newdomainAllocate a new domain pointer with default values
public subroutine newfield (f) type (field), pointer :: f end subroutine newfieldAllocate a new field with default values
public subroutine newrecord (r) type (record), pointer :: r end subroutine newrecordAllocate a new record with default values
public subroutine newtax (t) type (taxlist), pointer :: t end subroutine newtaxAllocate a new tax record with default values
public subroutine newnetput (np) type (netput), pointer :: np end subroutine newnetputAllocate a new netput with default values
public subroutine newnest (n) type (nest), pointer :: n end subroutine newnestAllocate a new nest with default values
public subroutine union (d1, u) type (domain), pointer :: d1 type (domain), pointer :: u ! Calls: newdomain end subroutine unionAdd d1 to union, excluding quoted singletons
public subroutine findsubdomain (d1, d2, subdomain) type (domain), pointer :: d1 type (domain), pointer :: d2 type (domain), pointer :: subdomain ! Calls: newdomain end subroutine findsubdomainDetermine the subdomain of d1 in d2, i.e. those element of d1 which are not in d2:
subdomain = d1 \ (d1 ^ d2)The output is the set of elements in d1 which are not singletons and not in d2.
public logical function singleton (string) character (len=*) :: string end function singleton
public subroutine writeparam (ident, index, d, string) character (len=*) :: ident integer :: index type (domain), pointer :: d character (len=*) :: string ! Calls: writedomain end subroutine writeparam
public subroutine domainlabels (d, dl) type (domain), pointer :: d character (len=32), dimension (10) :: dl end subroutine domainlabels
public subroutine writedomain (d, string) type (domain), pointer :: d character (len=*) :: string end subroutine writedomain
public subroutine readvar () ! Calls: addid, findid end subroutine readvarRead through variable declarations
public subroutine chkprod () ! Calls: chkfield end subroutine chkprodRead through records for each of the functions and add symbols to the master list as they are encountered. Check that the input data conforms to syntax rules.
public subroutine chkfield (f, fieldno, pfield) type (field), pointer :: f integer :: fieldno logical :: pfield ! Calls: addid, findid end subroutine chkfieldEvaluate fields in a production block record: - identifier dimension and type must be consistent - i: and o: must only appear as leading fields and reference prices - q: field must be second and reference a parameter - p: fields may appear only once and must reference parameter - a: field must reference a consumer - n: field must reference an auxiliary variable - m: field must reference a parameter - t: field must reference a parameter
public subroutine readnest () ! Calls: addsubnest, findnest, newnest, parsenestid end subroutine readnestRead nest assignments from the first record of each $prod block
public subroutine parsenestid (nestid, ident, parentid) character (len=*) :: nestid
character (len=*) :: ident
character (len=*) :: parentid
end subroutine parsenestidSplit a nest elasticity field into a nest identifier and a parent identifier:
public subroutine readcoef () ! Calls: addnetput, findid, findnest, findsubdomain, nesttype, newfield, newnetput, readelem, union end subroutine readcoefRead through the production function coefficients: - Create netput descriptions of each production input and output - Create linked list data structure characterizing the nested CES function
public subroutine nesttype (fn, n, output) type (function), pointer :: fn
type (nest), pointer :: n
logical :: output
end subroutine nesttypeIntroduce type definitions for nests beginning at n and proceeding to the top of the tree.
public subroutine readelem (np, f, taxagent, lastfield) type (netput), pointer :: np
type (field), pointer :: f
type (field), pointer :: taxagent
type (field), pointer :: lastfield
! Calls: addtax, lasttax end subroutine readelemRead a single field and introduce the associated logic in a netput descriptor:
public subroutine sectors () ! Calls: findid end subroutine sectorsCreate symbol table entries for the production sectors
public logical function numeric (string) character (len=*) :: string
end function numericDetermine which a string is numeric:
public subroutine addnetput (np, n, f) type (netput), pointer :: np
type (nest), pointer :: n
type (field), pointer :: f
end subroutine addnetputAdd a netput to a nest.
public subroutine addtax (np, t) type (netput), pointer :: np
type (taxlist), pointer :: t
! Calls: lasttax, newtax end subroutine addtaxAdd a tax coefficient to the associated linked list for a production netput:
public subroutine lasttax (np, t) type (netput), pointer :: np
type (taxlist), pointer :: t
end subroutine lasttaxSet pointer to the last tax applied to a given netput:
public subroutine findnest (nestid, fn, n) character (len=*) :: nestid
type (function), pointer :: fn
type (nest), pointer :: n
end subroutine findnestGenerate a pointer to the nest with a given name in a particular function:
public subroutine addsubnest (n, np) type (nest), pointer :: n
type (nest), pointer :: np
end subroutine addsubnestAt a subnest to a nest. This requires creation of a nestlist if one does not already exist
public logical function quoted (arg) character (len=*) :: arg end function quotedReturns .true. if the argument is quoted text, i.e. a character string beginning and ending with a pair of single or double quotes.
public logical function eqv (t1, t2) character (len=*) :: t1 character (len=*) :: t2 end function eqvPublic function determines whether two strings are identical apart from case.
public subroutine consumers () end subroutine consumers
public subroutine chkdemand () ! Calls: chkdfield, findsubdomain, union end subroutine chkdemandRead through records for each of the demand functions and add symbols to the master list as they are encountered. Check that the input data conforms to syntax rules.
public subroutine chkdfield (f, fieldno, e) type (field), pointer :: f integer :: fieldno type (endowment), pointer :: e ! Calls: addid, findid end subroutine chkdfieldEvaluate fields in a demand block record:
public subroutine ConvertToGP () ! Calls: DeclareGPCoeffVar, GPCommentFunction, GetDemandPriceQuantities, GetDemandVariableGP, GetInputsSubDomain, GetProdPriceQuantity, GetProdTopVariableElast, GetProdVariableGP, ReadCoeffGP, StartTABGP, WriteDemandIncomeBalanceEquation, WriteDemandMarketClearingEquation, WriteDemandUpdate, WriteNest, WriteProdDemandEquation, WriteProdQuantityFormula, WriteProdUpdate, WriteProdZeroProfitEquation, WriteRecord, findid end subroutine ConvertToGP
public subroutine StartTABGP () ! Calls: upper end subroutine StartTABGP
public subroutine WriteProdQuantityFormula (OutputQuantity, InputQuantity, InputsSubDomain) type (GPCoeffVarReal) :: OutputQuantity type (GPCoeffVarReal) :: InputQuantity type (domain), pointer :: InputsSubDomain ! Calls: ArgToAllsGP, CoeffVarToGP, EndSumsGP, WriteSumsGP end subroutine WriteProdQuantityFormula
public subroutine WriteSumsGP (ThisDomain, OutputString, NSum) type (domain), pointer :: ThisDomain character (len=*), intent(out) :: OutputString integer, intent(out) :: NSum ! Calls: GPSet2Index end subroutine WriteSumsGP
public subroutine EndSumsGP (NSum, OutputString) integer, intent(in) :: NSum character (len=*), intent(out) :: OutputString end subroutine EndSumsGP
public subroutine WriteProdDemandEquation (ThisProdFunction) type (function), pointer :: ThisProdFunction ! Calls: AddGPDeclaration, ArgToAllsGP, CoeffVarToGP, GetProdPriceQuantity, GetProdTopVariableElast, GetProdVariableGP end subroutine WriteProdDemandEquation
public subroutine WriteProdZeroProfitEquation (ProdDemandVariable, OutputQuantity, OutputPrice, InputQuantity, InputPrice, InputsSubDomain) type (GPCoeffVarReal) :: ProdDemandVariable type (GPCoeffVarReal) :: OutputQuantity type (GPCoeffVarReal) :: OutputPrice type (GPCoeffVarReal) :: InputQuantity type (GPCoeffVarReal) :: InputPrice type (domain), pointer :: InputsSubDomain ! Calls: ArgToAllsGP, CoeffVarToGP, EndSumsGP, WriteSumsGP end subroutine WriteProdZeroProfitEquation
public subroutine WriteProdUpdate (InputQuantity, InputPrice, ThisProdVar) type (GPCoeffVarReal), intent(in) :: InputQuantity type (GPCoeffVarReal), intent(in) :: InputPrice type (GPCoeffVarReal), intent(in) :: ThisProdVar ! Calls: ArgToAllsGP, CoeffVarToGP end subroutine WriteProdUpdate
public subroutine GPCommentFunction (ThisFunction) type (function), pointer :: ThisFunction end subroutine GPCommentFunction
public subroutine NewGPCoeffVar (ThisCoeffVar) type (GPCoeffVarReal) :: ThisCoeffVar end subroutine NewGPCoeffVar
public logical function IsReal (ThisString) character (len=*) :: ThisString end function IsReal
public subroutine GetProdTopVariableElast (ThisFunction, ThisVariable, ThisElasticity) type (function), pointer :: ThisFunction type (GPCoeffVarReal) :: ThisVariable type (GPCoeffVarReal) :: ThisElasticity ! Calls: findid end subroutine GetProdTopVariableElast
public subroutine GetProdPriceQuantity (ThisFunction, IOType, ThisPrice, ThisQuantity) type (function), pointer :: ThisFunction character, intent(in) :: IOType type (GPCoeffVarReal) :: ThisPrice type (GPCoeffVarReal) :: ThisQuantity end subroutine GetProdPriceQuantity
public subroutine GetInputsSubDomain (ThisFunction, ThisSubdomain) type (function), pointer :: ThisFunction type (domain), pointer :: ThisSubdomain end subroutine GetInputsSubDomain
public subroutine ReadCoeffGP (ThisCoefficient) type (GPCoeffVarReal) :: ThisCoefficient ! Calls: upper end subroutine ReadCoeffGP
public subroutine DeclareGPCoeffVar (ThisGPCoeffVar) type (GPCoeffVarReal), intent(in) :: ThisGPCoeffVar ! Calls: DeclareFieldGP, newfield, newsymbol end subroutine DeclareGPCoeffVar
public subroutine GetProdVariableGP (ThisProdFunction, ThisVar) type (function), pointer :: ThisProdFunction type (GPCoeffVarReal) :: ThisVar ! Calls: GetProdPriceQuantity, GetProdTopVariableElast end subroutine GetProdVariableGP
public subroutine GetDemandPriceQuantities (ThisDemandFunction, DemandPrice, DemandQuantity, DFieldExists, EndowmentPrice, EndowmentQuantity, EFieldExists, DemandTopVariable) type (function), pointer :: ThisDemandFunction type (GPCoeffVarReal), intent(out) :: DemandPrice type (GPCoeffVarReal), intent(out) :: DemandQuantity logical :: DFieldExists type (GPCoeffVarReal), intent(out) :: EndowmentPrice type (GPCoeffVarReal), intent(out) :: EndowmentQuantity logical :: EFieldExists type (GPCoeffVarReal), intent(out) :: DemandTopVariable ! Calls: lower end subroutine GetDemandPriceQuantities
public subroutine GetDemandVariableGP (ThisTopVar, EndowmentPrice, ThisDemandVar) type (GPCoeffVarReal), intent(in) :: ThisTopVar type (GPCoeffVarReal), intent(in) :: EndowmentPrice type (GPCoeffVarReal), intent(out) :: ThisDemandVar end subroutine GetDemandVariableGP
public subroutine WriteDemandUpdate (ThisDemandVar, EndowmentPrice, EndowmentQuantity) type (GPCoeffVarReal), intent(in) :: ThisDemandVar type (GPCoeffVarReal), intent(in) :: EndowmentPrice type (GPCoeffVarReal), intent(in) :: EndowmentQuantity ! Calls: ArgToAllsGP, CoeffVarToGP end subroutine WriteDemandUpdate
public subroutine WriteDemandMarketClearingEquation (DemandTopVar, DemandPrice) type (GPCoeffVarReal), intent(in) :: DemandTopVar type (GPCoeffVarReal), intent(in) :: DemandPrice ! Calls: ArgToAllsGP, CoeffVarToGP, GetProdPriceQuantity, GetProdTopVariableElast, lower end subroutine WriteDemandMarketClearingEquation
public subroutine WriteDemandIncomeBalanceEquation (ThisDemandTopVar, EndowmentPrice, EndowmentQuantity, ThisDemandVar) type (GPCoeffVarReal), intent(in) :: ThisDemandTopVar type (GPCoeffVarReal), intent(in) :: EndowmentPrice type (GPCoeffVarReal), intent(in) :: EndowmentQuantity type (GPCoeffVarReal), intent(in) :: ThisDemandVar ! Calls: CoeffVarToGP, EndSumsGP, WriteSumsGP end subroutine WriteDemandIncomeBalanceEquation
public subroutine WriteArguments (FirstArg, OutputText, LenOutput) type (domain), pointer :: FirstArg character (len=255) :: OutputText integer :: LenOutput end subroutine WriteArguments
public subroutine WriteRecord (DescText, ThisRecord) character (len=*), intent(in) :: DescText type (record), pointer :: ThisRecord ! Calls: WriteField end subroutine WriteRecord
public subroutine WriteField (DescText, ThisField) character (len=*), intent(in) :: DescText type (field), pointer :: ThisField ! Calls: WriteArguments end subroutine WriteField
public subroutine GPSet2Index (CurrentSet, CurrentIndex) type (symbol), pointer :: CurrentSet character (len=*) :: CurrentIndex end subroutine GPSet2Index
public subroutine MarkAsDeclaredGP (ThisSymbol) type (symbol), pointer :: ThisSymbol ! Calls: lower end subroutine MarkAsDeclaredGP
public subroutine ArgToAllsGP (TheseArgs, OutputString) type (domain), pointer :: TheseArgs character (len=*), intent(out) :: OutputString ! Calls: GPSet2Index end subroutine ArgToAllsGP
public subroutine CoeffVarToGP (ThisCoeffVar, OutputString) type (GPCoeffVarReal) :: ThisCoeffVar character (len=*), intent(out) :: OutputString ! Calls: ArgToGP, upper end subroutine CoeffVarToGP
public subroutine ArgToGP (TheseArgs, OutputString) type (domain), pointer :: TheseArgs character (len=*), intent(out) :: OutputString ! Calls: GPSet2Index end subroutine ArgToGP
public subroutine DeclareFieldGP (DeclarationType, ThisField) character (len=*), intent(in) :: DeclarationType type (field), pointer :: ThisField ! Calls: AddGPDeclaration, ArgToAllsGP, ArgToGP, MarkAsDeclaredGP, lower, upper end subroutine DeclareFieldGP
public subroutine WriteNest (DescText, ThisNest) character (len=*) :: DescText type (nest), pointer :: ThisNest ! Calls: WriteField end subroutine WriteNest
public subroutine NewGPDeclaration (ThisGPDeclaration) type (GPDeclaration), pointer :: ThisGPDeclaration end subroutine NewGPDeclarationAllocate a new GPDeclaration and assign default values for all the characteristics
public subroutine AddGPDeclaration (type, name) character (len=*), intent(in) :: type character (len=*), intent(in) :: name ! Calls: NewGPDeclaration end subroutine AddGPDeclarationIntroduce a new GPDeclaration in the master list.
public logical function HasBeenDeclaredGP (type, name) character (len=*), intent(in) :: type character (len=*), intent(in) :: name ! Calls: lower end function HasBeenDeclaredGP