RAMSES Science Library Modules
Copyright (c) 1989-2006 by Dimitrios Gyalistras, Andreas Fischlin,
Thomas Nemecek and ETH Zurich.
mailto://RAMSES@env.ethz.ch http://www.sysecol.ethz.ch/
(*****************************************************************)
(*##### S c i e n c e L i b M O D U L E S #####*)
(*****************************************************************)
The following modules are maintained by the Systems Ecology Group of the
Institute of Integrative Biology, ETH Zurich, Switzerland.
All rights reserved.
The authors reserve the right to make changes, additions, and improvements
to the software or documentation at any time without notice to any person or
organization; no guarantee is made that further versions of either will be
compatible with any other version.
The authors hereby disclaim any and all guarantees and warranties on the
software or its documentation, both expressed or implied. No liability
of any form shall be assumed by the authors. Any user of this sofware uses
it at his or her own risk and no fitness for any purpose whatsoever nor
waranty of merchantability are claimed or implied.
(*============================== AR1Fit ===============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
PROCEDURE GetCovMats( (*in*) data: LMatrix; errorIfMisCov: BOOLEAN;
(*out*) M: LVector; C0: LMatrix; C1: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE FitAR1 ( (*in*) C0: LMatrix; C1: LMatrix;
(*out*) A: LMatrix; B: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*=========================== BOUEstimLib =============================*)
CONST x=2; y=3; sqmDim=2; kronDim=4;
TYPE
Location= ARRAY[ x.. y] OF LONGREAL;
SquareMatrix= ARRAY[ x.. y],[ x.. y] OF LONGREAL;
GSquareMatrix= ARRAY[1.. kronDim],[1.. kronDim] OF LONGREAL;
PROCEDURE LEle ( m: Matrix; i, x: INTEGER ): LONGREAL;
PROCEDURE ZeroSqMat( VAR m: SquareMatrix );
PROCEDURE InvSqMat ( m: SquareMatrix; VAR n: SquareMatrix );
PROCEDURE Multiply ( VAR(*speed-up*) a, b: SquareMatrix; VAR p: SquareMatrix );
PROCEDURE InvertM ( VAR(*speed-up*) m: GSquareMatrix; VAR v: GSquareMatrix );
PROCEDURE LnMat ( m: SquareMatrix; VAR lnm: SquareMatrix );
(*============================= CanCor ===============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
CONST (* types of matrices supported *)
ccCoeffSqMatType = 201; (* squared canonical correlation coefficients *)
tvxXMatType = 202; (* X total variances explained by canonical modes *)
tvxYMatType = 203; (* Y total variances explained by canonical modes *)
mapXMatType = 210; (* X canonical maps *)
lvxXMatType = 211; (* X local variances explained by canonical modes *)
cmpXMatType = 212; (* X components of canonical modes *)
mapYMatType = 220; (* Y canonical maps *)
lvxYMatType = 221; (* Y local variances explained by canonical modes *)
cmpYMatType = 222; (* Y components of canonical modes *)
xEstCmpMatType = 230; (* X estimated components from CCA model application *)
yEstMatType = 231; (* Y estimated variables from CCA model application *)
yCrossVldMatType = 232; (* Y estimated variables from CCA model cross-validation *)
PROCEDURE MakeCCA ( (*in*) xDat, yDat: LMatrix;
(*in/out*) VAR nXEofs, nYEofs: INTEGER;
(*in*) minXCumulV, minYCumulV, maxXEigValREB, maxYEigValREB: LONGREAL;
(*in*) muX, wghtX, eigValX, pcX, muY, wghtY, eigValY, pcY: LMatrix;
(*out*) ccCoeffSq, mapX, cmpX, tvxX, lvxX, mapY, cmpY, tvxY, lvxY: LMatrix;
(*out*) VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE ApplyCCA( (*in*) xDat: LMatrix; areAnomalies: BOOLEAN;
(*in/out*) VAR nCanModes: INTEGER; ccCfSqTrshld: LONGREAL;
(*in*) ccCoeffSq, muX, wghtX, mapX, muY, wghtY, mapY: LMatrix;
(*out*) xEstCmp, yEst: LMatrix; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
TYPE
PCAResultsProc = PROCEDURE ( (*resultNr*) INTEGER, VAR (*mu*) LMatrix, VAR (*wght*) LMatrix,
VAR (*eigVal*) LMatrix, VAR (*pcX*) LMatrix,
VAR (*resCode*) INTEGER, VAR (*errTxt*) ARRAY OF CHAR );
PROCEDURE EmptyPCAResultsProc( resultNr: INTEGER; VAR mu, wght, eigVal, pc: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE CrossValidCCA ( (*in*) xDat, yDat: LMatrix; xWType: WeightingType; yWType: WeightingType;
(*in/out*) VAR nXEofs, nYEofs: INTEGER;
(*in*) minXCumulV, minYCumulV, maxXEigValREB, maxYEigValREB: LONGREAL;
(*in*) getXPCAResults, getYPCAResults: PCAResultsProc;
(*in*) nCanModes: INTEGER; ccCfSqTrshld: LONGREAL; progrReport: PROC;
(*out*) yCrossVld: LMatrix;
(*out*) VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(* Auxilary *)
PROCEDURE InDataMatsOK ( xDat, yDat: LMatrix; xGenericDescr, yGenericDescr, callee: ARRAY OF CHAR;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE NCanModesOK ( ccCoeffSq: LMatrix; nCanModes: INTEGER; genericDescr, callee: ARRAY OF CHAR;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GetNumCanModes ( ccCoeffSq: LMatrix; ccCfSqTrshld: LONGREAL;
VAR nCanModes: INTEGER; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE AllocCCAResVars ( nXEofs, nYEofs: INTEGER; xDat, yDat: LMatrix;
VAR ccCoeffSq, mapX, cmpX, tvxX, lvxX, mapY, cmpY, tvxY, lvxY: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DeallocCCAResVars( VAR ccCoeffSq, mapX, cmpX, tvxX, lvxX, mapY, cmpY, tvxY, lvxY: LMatrix );
(* I/O of CCA results *)
PROCEDURE WriteCCAResults( VAR outF: TextFile;
wrCcCoeffSq: BOOLEAN; ccCoeffSq: LMatrix;
wrTvxX: BOOLEAN; tvxX: LMatrix;
wrTvxY: BOOLEAN; tvxY: LMatrix;
wrMuX : BOOLEAN; muX : LMatrix; wrWghtX: BOOLEAN; wghtX: LMatrix; wrMapX: BOOLEAN; mapX: LMatrix;
wrMuY : BOOLEAN; muY : LMatrix; wrWghtY: BOOLEAN; wghtY: LMatrix; wrMapY: BOOLEAN; mapY: LMatrix;
wrLvxX: BOOLEAN; lvxX: LMatrix; wrCmpX: BOOLEAN; cmpX : LMatrix;
wrLvxY: BOOLEAN; lvxY: LMatrix; wrCmpY: BOOLEAN; cmpY : LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE ReadCCAResults( inFName: ARRAY OF CHAR; tryOpenFile: BOOLEAN; keepFileOpen: BOOLEAN;
rdCcCoeffSq: BOOLEAN; VAR ccCoeffSq: LMatrix;
rdTvxX: BOOLEAN; VAR tvxX: LMatrix;
rdTvxY: BOOLEAN; VAR tvxY: LMatrix;
rdMuX : BOOLEAN; VAR muX : LMatrix; rdWghtX: BOOLEAN; VAR wghtX: LMatrix;
rdMapX: BOOLEAN; VAR mapX: LMatrix;
rdMuY : BOOLEAN; VAR muY : LMatrix; rdWghtY: BOOLEAN; VAR wghtY: LMatrix;
rdMapY: BOOLEAN; VAR mapY: LMatrix;
rdLvxX: BOOLEAN; VAR lvxX: LMatrix; rdCmpX: BOOLEAN; VAR cmpX: LMatrix;
rdLvxY: BOOLEAN; VAR lvxY: LMatrix; rdCmpY: BOOLEAN; VAR cmpY: LMatrix;
VAR endOfFile: BOOLEAN; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================= CHCoord ===============================*)
PROCEDURE GetRefCoordinates( VAR refLong, refLat, scaleFctr, refX, refY: LONGREAL );
PROCEDURE SetRefCoordinates( refLong, refLat, scaleFctr, refX, refY: LONGREAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE LongLatToChCoord ( long, lat: LONGREAL; VAR x, y: LONGREAL );
PROCEDURE ChCoordToLongLat ( x, y: LONGREAL; VAR long, lat: LONGREAL );
(*============================ CycloStat ==============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
CONST MaxPeriodLgth = 512;
TYPE LMatrixArr = ARRAY [1..MaxPeriodLgth] OF LMatrix;
PROCEDURE NBasisFuncs ( periodLength, nHarmonics: INTEGER ): INTEGER;
PROCEDURE EvalBasisFunc ( bFuncNr, periodLength, phase: INTEGER ):REAL;
PROCEDURE Fourier ( (*in*) data: LVector; periodLength, nHarmonics: INTEGER;
(*out*) VAR mu: LONGREAL; VAR A, B, phase, prdgr, vxpl: LVector;
(*out*) VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE ReconstructCycle ( (*in*) mu: LONGREAL; A, B: LVector; periodLength, nHarmonics: INTEGER;
(*out*) cycle: LVector;
(*out*) VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetFixedPhaseCovs ( (*in*) data: LMatrix; periodLength: INTEGER; standardize: BOOLEAN;
(*out*) VAR M, S: LMatrix; VAR C0, C1: LMatrixArr;
(*out*) VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE FitFixedPhaseModel ( (*in*) periodLength: INTEGER; C0, C1: LMatrixArr;
(*out*) A, B: LMatrixArr;
(*out*) VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE FitPhaseAveragedModel( (*in*) data: LMatrix; periodLength: INTEGER; standardize: BOOLEAN; nHarmonics: INTEGER;
(*out*) M, S, A, B: LMatrixArr; VAR badBEigVal: BOOLEAN;
(*out*) VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================ DegreeDays =============================*)
PROCEDURE GetGDDPars( VAR temperThreshold: REAL );
PROCEDURE SetGDDPars( temperThreshold: REAL; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
(* monthly growing degree-days *)
PROCEDURE CalcMonthlyGDD ( monTemper: REAL; (* monthly mean temperature [degC] *) VAR monGDD: REAL );
PROCEDURE CalcMonthlyGDDT( monTemper: REAL; VAR monGDD: REAL; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
(* annual growing degree-days *)
PROCEDURE CalcAnnualGDD ( VAR monTemper: ARRAY OF REAL; VAR annGDD: REAL );
PROCEDURE CalcAnnualGDDT( VAR monTemper: ARRAY OF REAL; VAR annGDD: REAL; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
(*============================= EigVecs ===============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
PROCEDURE Jacobi ( (*in*) mat: LMatrix; (*out*) eigVals: LVector; eigVecs: LMatrix; VAR numRot: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE EigSort( (*in/out*) eigVals: LVector; (*in/out*) eigVecs: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================= FileInfos ==============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
TYPE FileInfo; FileVar; DataPtr = ADDRESS; FIObjAdrAttr = ADDRESS;
TYPE
FileFormatType = ( undefFileFormat, mat1, mat2, lola, other );
StatisticsType = ( undefStatistic, n, mean, sd, skw, min, p05, p10, p25, med, p75, p90, p95, max );
StatisticsSet = SET OF StatisticsType;
VAR (* read only *)
undefFileInfo: FileInfo; undefFileVar: FileVar; undefDataPtr: DataPtr; undefFIObjAdrAttr: FIObjAdrAttr;
TYPE
FileVarP = PROCEDURE ( FileInfo, FileVar );
(* Testing of object access *)
PROCEDURE ActivateFileInfosObjChecks;
PROCEDURE DeactivateFileInfosObjChecks;
PROCEDURE FileInfosObjChecksActivated(): BOOLEAN;
(* FileInfos *)
PROCEDURE DeclareFileInfo( VAR f: FileInfo; ident: ARRAY OF CHAR; fmt: FileFormatType; matCode: LONGINT;
stats: StatisticsSet; minFirstClass: REAL; maxLastClass: REAL; numClasses: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE FindFileInfo ( ident: ARRAY OF CHAR ): FileInfo;
PROCEDURE FileInfoExists ( f: FileInfo ): BOOLEAN;
PROCEDURE FirstFileInfo (): FileInfo;
PROCEDURE NextFileInfo ( f: FileInfo ): FileInfo;
PROCEDURE PrevFileInfo ( f: FileInfo ): FileInfo;
PROCEDURE LastFileInfo (): FileInfo;
PROCEDURE RemoveFileInfo ( VAR f: FileInfo );
PROCEDURE RemoveAllFileInfos;
(* FileInfo attributes *)
PROCEDURE SetFileInfoIdent ( f: FileInfo; ident: ARRAY OF CHAR; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetFileInfoIdent ( f: FileInfo; VAR ident: ARRAY OF CHAR );
PROCEDURE SetFileInfoFormatType ( f: FileInfo; fmt: FileFormatType );
PROCEDURE FileInfoFormatType ( f: FileInfo ): FileFormatType;
PROCEDURE SetFileInfoMatrixCode ( f: FileInfo; matCode: LONGINT );
PROCEDURE FileInfoMatrixCode ( f: FileInfo ): LONGINT;
PROCEDURE SetFileInfoStatisticsSet( f: FileInfo; stats: StatisticsSet );
PROCEDURE GetFileInfoStatisticsSet( f: FileInfo; VAR stats: StatisticsSet );
PROCEDURE SetFileInfoHistoParams ( f: FileInfo; minFirstClass: REAL; maxLastClass: REAL; numClasses: INTEGER );
PROCEDURE GetFileInfoHistoParams ( f: FileInfo; VAR minFirstClass: REAL; VAR maxLastClass: REAL; VAR numClasses: INTEGER );
PROCEDURE SetFileInfoAdrAttr ( f: FileInfo; a: FIObjAdrAttr );
PROCEDURE FileInfoAdrAttr ( f: FileInfo ): FIObjAdrAttr;
PROCEDURE SetFileInfoLongIntAttr ( f: FileInfo; l: LONGINT );
PROCEDURE FileInfoLongIntAttr ( f: FileInfo ): LONGINT;
(* FileVars *)
PROCEDURE DeclareFileVar ( f: FileInfo; VAR v: FileVar; ident: ARRAY OF CHAR; VAR resCode: INTEGER;
VAR errTxt: ARRAY OF CHAR );
PROCEDURE FindFileVar ( f: FileInfo; ident: ARRAY OF CHAR ): FileVar;
PROCEDURE ParentFileInfo ( v: FileVar ): FileInfo;
PROCEDURE FileVarExists ( v: FileVar ): BOOLEAN;
PROCEDURE FirstFileVar ( f: FileInfo ): FileVar;
PROCEDURE NextFileVar ( v: FileVar ): FileVar;
PROCEDURE PrevFileVar ( v: FileVar ): FileVar;
PROCEDURE LastFileVar ( f: FileInfo ): FileVar;
PROCEDURE RemoveFileVar ( v: FileVar );
PROCEDURE RemoveAllFileVars( f: FileInfo );
(* FileVar attributes *)
PROCEDURE SetFileVarIdent ( v: FileVar; ident: ARRAY OF CHAR; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetFileVarIdent ( v: FileVar; VAR ident: ARRAY OF CHAR );
PROCEDURE SetFileVarDataPtr ( v: FileVar; d: DataPtr );
PROCEDURE FileVarDataPtr ( v: FileVar ): DataPtr;
PROCEDURE SetFileVarProc ( v: FileVar; p: FileVarP );
PROCEDURE GetFileVarProc ( v: FileVar; VAR p: FileVarP );
PROCEDURE SetFileVarAdrAttr ( v: FileVar; a: FIObjAdrAttr );
PROCEDURE FileVarAdrAttr ( v: FileVar ): FIObjAdrAttr;
PROCEDURE SetFileVarLongIntAttr( v: FileVar; l: LONGINT );
PROCEDURE FileVarLongIntAttr ( v: FileVar ): LONGINT;
(* Operations on FileVars across all FileInfos *)
PROCEDURE GetFileVarsStatisticsSet( varsIdent: ARRAY OF CHAR; VAR stats: StatisticsSet );
PROCEDURE NumFileVarsWithIdent ( varsIdent: ARRAY OF CHAR ): INTEGER;
PROCEDURE NumFileVarsWithDataPtr ( d: DataPtr ): INTEGER;
PROCEDURE SetFileVarsDataPtr ( fmt: FileFormatType; varsIdent: ARRAY OF CHAR; d: DataPtr );
(* Auxiliary *)
PROCEDURE GetIdentOfFileFormatType ( ft: FileFormatType; VAR ident: ARRAY OF CHAR );
PROCEDURE FileFormatTypeOfIdent ( ident: ARRAY OF CHAR ): FileFormatType;
PROCEDURE GetIdentOfStatisticsType ( stat: StatisticsType; VAR ident: ARRAY OF CHAR );
PROCEDURE StatisticsTypeOfIdent ( ident: ARRAY OF CHAR ): StatisticsType;
PROCEDURE GetIdentsListForStatisticsSet( ss: StatisticsSet; VAR list: ARRAY OF CHAR );
PROCEDURE StatisticsSetCardinality ( ss: StatisticsSet ): INTEGER;
(* Retrieval of files and variables information from data frames *)
PROCEDURE ExtractFileContentsInfo ( fileContentsSpecif: ARRAY OF CHAR;
VAR stats: StatisticsSet;
VAR minFirstClass: REAL; VAR maxLastClass: REAL; VAR numClasses: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE ExtractVariablesList ( varsListSpecif: ARRAY OF CHAR;
VAR varsList: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetFileInfoParamsFromDataFrames( fileIdent: ARRAY OF CHAR;
VAR format: FileFormatType; VAR matCode: LONGINT;
VAR stats: StatisticsSet;
VAR minFirstClass: REAL; VAR maxLastClass: REAL; VAR numClasses: INTEGER;
VAR varsList: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DeclareFileInfosFromDataFrames ( outFilesSetId: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(* Event handling *)
TYPE
FileInfosEventType = ( undefFileInfosEvent, fileDeclared, fileRemoved, varDeclared, varRemoved );
FileInfosEventHandler = PROCEDURE( FileInfosEventType, FileInfo, FileVar );
PROCEDURE InstallFileInfosEventHandler( h: FileInfosEventHandler );
PROCEDURE RemoveFileInfosEventHandler ( h: FileInfosEventHandler );
(*=========================== ForSiteDatIO ============================*)
CONST allOk = DMLanguage.allOk; notDone = DMLanguage.onlyAnInsert;
TYPE ShortString= ARRAY[0..23] OF CHAR; ForSiteFileType=( notAForSiteFile, forSiteBaseClimFile, forSiteClimStepFile );
PROCEDURE GetForSiteFileTypeAndSite( fileName: ARRAY OF CHAR;
VAR fType: ForSiteFileType; VAR siteName: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE ReadForSiteBaseClimFile ( fileName: ARRAY OF CHAR;
VAR fcVersion, siteName: ARRAY OF CHAR;
VAR latitude, fieldCapOrBS, saQualif, annDegDays, annET, meanAnnT: REAL;
VAR soilMoistF, minWinT, meanDrStr, meanN, initFastHum, initSlowHum: REAL;
VAR mT, sdT, mP, sdP, corTP: ARRAY OF REAL;
VAR nSpecIdents: INTEGER; VAR specIdent: ARRAY OF ShortString;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE WriteForSiteBaseClimFile ( fileName: ARRAY OF CHAR;
fcVersion, siteName: ARRAY OF CHAR;
latitude, fieldCapOrBS, saQualif, annDegDays, annET, meanAnnT: REAL;
soilMoistF, minWinT, meanDrStr, meanN, initFastHum, initSlowHum: REAL;
VAR(*speed-up*) mT, sdT, mP, sdP, corTP: ARRAY OF REAL;
nSpecIdents: INTEGER; VAR(*speed-up*) specIdent: ARRAY OF ShortString;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE ReadForSiteClimStepFile ( fileName: ARRAY OF CHAR;
VAR siteName: ARRAY OF CHAR; VAR ccYear: INTEGER;
VAR dMTInPerCent, dSdTInPerCent, dMPInPerCent, dSdPInPerCent, dCorTPInPerCent: BOOLEAN;
VAR dMT, dSdT, dMP, dSdP, dCorTP: ARRAY OF REAL;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE WriteForSiteClimStepFile ( fileName: ARRAY OF CHAR;
siteName: ARRAY OF CHAR; ccYear: INTEGER;
dMTInPerCent, dSdTInPerCent, dMPInPerCent, dSdPInPerCent, dCorTPInPerCent: BOOLEAN;
VAR(*speed-up*) dMT, dSdT, dMP, dSdP, dCorTP: ARRAY OF REAL;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================ GlobIrrad ==============================*)
PROCEDURE SolarConst (): REAL; (* in [W m^/2] = [J/m^2/s] *)
PROCEDURE SetSolarConst ( solarConst: REAL ): BOOLEAN;
PROCEDURE Latitude (): REAL; (* in degrees [-90.0..90.0] *)
PROCEDURE SetLatitude ( latitude: REAL ): BOOLEAN;
PROCEDURE SinSolarAltitude( day: INTEGER; t: REAL ): REAL;
PROCEDURE SunRiseTime ( day: INTEGER ): REAL;
PROCEDURE EI ( day: INTEGER; t: REAL ): REAL; (* in [W/m^2] *)
PROCEDURE IEI( day: INTEGER; t1, t2: REAL ): REAL; (* in [Wh/m^2] *)
PROCEDURE DEI( day: INTEGER ): REAL; (* in [Wh/m^2] *)
(*=========================== GridDataSets ============================*)
CONST notDone = Errors.onlyAnInsert;
TYPE GridDataSet; DataMatrix;
GridDataSetChange=( gdsDefined, gdsReplaced, gdsRemoved );
AtGridDataSetChangeP= PROCEDURE( GridDataSetChange (*type of change*), GridDataSet );
VAR (* read only *) undefGridDataSet: GridDataSet; undefDataMatrix: DataMatrix;
(* Definition and removal of gridded data sets *)
PROCEDURE InstallAtGridDataSetChangedHandler( gch: AtGridDataSetChangeP );
PROCEDURE DefineGridDataSet ( VAR gds: GridDataSet; dataID: LONGINT; dataDescr: ARRAY OF CHAR;
sectorID: LONGINT; sectorDescr: ARRAY OF CHAR; nRows, nCols: INTEGER;
inDegrees: BOOLEAN; minLon, minLat, cellSize: REAL; nDataMats: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE RemoveGridDataSet ( VAR gds: GridDataSet );
PROCEDURE RemoveAllGridDataSets;
(* Retrieval of gridded data sets and their attributes *)
PROCEDURE NGridDataSets (): INTEGER;
PROCEDURE GetGridDataSets ( VAR gds: ARRAY OF GridDataSet; VAR nGridDataSets: INTEGER );
PROCEDURE GridDataSetExists ( gds: GridDataSet ): BOOLEAN;
PROCEDURE GetGridDataSetAttrs ( gds: GridDataSet; VAR dataID: LONGINT; VAR dataDescr: ARRAY OF CHAR;
VAR sectorID: LONGINT; VAR sectorDescr: ARRAY OF CHAR; VAR nRows, nCols: INTEGER;
VAR inDegrees: BOOLEAN; VAR minLon, maxLon, minLat, maxLat, cellSize: REAL;
VAR nDataMats: INTEGER );
PROCEDURE GetGridDataSetDim ( gds: GridDataSet; VAR nRows, nCols, nDataMats: INTEGER );
PROCEDURE GridDataSetDataID ( gds: GridDataSet ): LONGINT;
PROCEDURE GetGridDataSetDataDescr ( gds: GridDataSet; VAR dataDescr: ARRAY OF CHAR );
PROCEDURE GridDataSetSectorID ( gds: GridDataSet ): LONGINT;
PROCEDURE GetGridDataSetSectorDescr( gds: GridDataSet; VAR sectorDescr: ARRAY OF CHAR );
PROCEDURE GridDataSetNumRows ( gds: GridDataSet ): INTEGER;
PROCEDURE GridDataSetNumCols ( gds: GridDataSet ): INTEGER;
PROCEDURE GridDataSetIsInDegrees ( gds: GridDataSet ): BOOLEAN;
PROCEDURE GridDataSetMinLon ( gds: GridDataSet ): REAL;
PROCEDURE GridDataSetMaxLon ( gds: GridDataSet ): REAL;
PROCEDURE GridDataSetMinLat ( gds: GridDataSet ): REAL;
PROCEDURE GridDataSetMaxLat ( gds: GridDataSet ): REAL;
PROCEDURE GridDataSetCellSize ( gds: GridDataSet ): REAL;
PROCEDURE GridDataSetNumDataMats ( gds: GridDataSet ): INTEGER;
(* Setting of gridded data set attributes *)
PROCEDURE SetGridDataSetDataID ( gds: GridDataSet; dataID: LONGINT );
PROCEDURE SetGridDataSetDataDescr ( gds: GridDataSet; dataDescr: ARRAY OF CHAR );
PROCEDURE SetGridDataSetSectorID ( gds: GridDataSet; sectorID: LONGINT );
PROCEDURE SetGridDataSetSectorDescr( gds: GridDataSet; sectorDescr: ARRAY OF CHAR );
(* Testing of gridded datasets and attributes *)
PROCEDURE SetGridpointCoordRelTol( relTol: REAL );
PROCEDURE GridpointCoordRelTol (): REAL;
PROCEDURE GridDataSetOK ( gds: GridDataSet; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GridDataMatOK ( gds: GridDataSet; dataMatNr: INTEGER; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE XCoordOK ( gds: GridDataSet; xCoord: REAL; mustBeOnGrid: BOOLEAN;
VAR isInSector, isOnGrid: BOOLEAN; VAR closestCol: INTEGER;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE YCoordOK ( gds: GridDataSet; yCoord: REAL; mustBeOnGrid: BOOLEAN;
VAR isInSector,isOnGrid: BOOLEAN; VAR closestRow: INTEGER;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GridPointOK ( gds: GridDataSet; xCoord, yCoord: REAL; mustBeOnGrid: BOOLEAN;
VAR pointIsInSector, pointIsOnGrid: BOOLEAN; VAR closestRow, closestCol: INTEGER;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
(* Get/set gridpoint values *)
PROCEDURE GetGridpointValue( gds: GridDataSet; dataMatNr: INTEGER; xCoord, yCoord: REAL;
VAR value: REAL; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SetGridpointValue( gds: GridDataSet; dataMatNr: INTEGER; xCoord, yCoord: REAL;
value: REAL; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetDataMatrix ( gds: GridDataSet; dataMatNr: INTEGER ): DataMatrix;
PROCEDURE GetMatEle ( mat: DataMatrix; row, col: INTEGER; VAR r: REAL );
PROCEDURE SetMatEle ( mat: DataMatrix; row, col: INTEGER; r: REAL );
(*============================= GridDSIO ==============================*)
CONST notDone = Errors.onlyAnInsert;
TYPE AtReadDataPointP = PROCEDURE( VAR REAL, (* the data point *)
VAR ARRAY OF CHAR (* error text to pass on *)): BOOLEAN; (* if false, reading stops *)
TYPE GridDataSetOutputFormat=( notDefinedFormat, gdsStandardFormat, interchangeFormat, listFormat, fullListFormat, arcInfoFormat );
(* Auxiliary *)
PROCEDURE GetOutputFormatDescr( outputFormat: GridDataSetOutputFormat; VAR descrStr: ARRAY OF CHAR );
PROCEDURE GetOutputFormatIdent( outputFormat: GridDataSetOutputFormat; VAR identStr: ARRAY OF CHAR );
PROCEDURE OutputFormatForIdent( identStr: ARRAY OF CHAR ): GridDataSetOutputFormat;
(* I/O of gridded data sets *)
PROCEDURE IsGridDataSetFile ( inFName: ARRAY OF CHAR; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GetGridDataSetHeader( inFileName: ARRAY OF CHAR; VAR dataID: LONGINT; VAR dataDescr: ARRAY OF CHAR;
VAR sectorID: LONGINT; VAR sectorDescr: ARRAY OF CHAR;
VAR nRows, nCols: INTEGER; VAR minLon, minLat, cellSize: REAL;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE ReadGridDataSet ( inFileName: ARRAY OF CHAR; inDegrees: BOOLEAN; atReadDataPoint: AtReadDataPointP;
progrReprt: PROC; VAR gds: GridDataSet;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE WriteGridDataSet ( VAR outF: TextFile; gds: GridDataSet; format: GridDataSetOutputFormat;
noDataStr: ARRAY OF CHAR; nDecDigits: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================= GridDSOp ==============================*)
CONST notDone = Errors.onlyAnInsert;
(* Distance calculation and interpolation procedures *)
PROCEDURE Distance ( lon1, lat1, lon2, lat2: REAL ): REAL;
PROCEDURE EuclidDistance( x1, y1, x2, y2: REAL ): REAL;
PROCEDURE XGridpointDist( gds: GridDataSet; xCoord, yCoord: REAL ): REAL;
PROCEDURE YGridpointDist( gds: GridDataSet; xCoord, yCoord: REAL ): REAL;
(* Operations on gridded data sets *)
PROCEDURE GetZValue ( gds: GridDataSet; dataMatNr: INTEGER; xCoord, yCoord: REAL;
VAR zValue: REAL; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetSurfaceParams ( gds: GridDataSet; dataMatNr: INTEGER; xCoord, yCoord: REAL;
VAR slope, aspect, profCurv, planCurv: REAL;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SelectGridDataSetRowsCols ( parentGDS: GridDataSet; minRow, maxRow, minCol, maxCol: INTEGER;
VAR newGDS: GridDataSet; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SelectGridDataSetSector ( parentGDS: GridDataSet; minXCoord, maxXCoord, minYCoord, maxYCoord: REAL;
VAR newGDS: GridDataSet; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SmoothGridDataSet ( parentGDS: GridDataSet; smoothFactor: INTEGER;
VAR newGDS: GridDataSet; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE AggregateGridDataSet ( parentGDS: GridDataSet; aggregFactor: INTEGER;
VAR newGDS: GridDataSet; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE RegridDataSet ( parentGDS: GridDataSet; refXCoord, refYCoord, cellSize: REAL;
VAR newGDS: GridDataSet; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE MakeCHCoordsGridDataSet ( gds: GridDataSet; refXCoord, refYCoord, cellSize: REAL;
VAR newGDS: GridDataSet; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE MakeDegreeCoordsGridDataSet( gds: GridDataSet; refXCoord, refYCoord, cellSize: REAL;
VAR newGDS: GridDataSet; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(* Operations on pairs of gridded data sets *)
PROCEDURE GridsAreIdentical( gds1, gds2: GridDataSet; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE MergeGridDataSets( gds1, gds2: GridDataSet; allowOverwrWithMisVals: BOOLEAN;
VAR newGDS: GridDataSet; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================== Grids ================================*)
CONST notDone = Errors.onlyAnInsert;
TYPE
Grid; GridData; GridObjectPtr = ADDRESS; RealPtr = POINTER TO REAL;
GridObjectProc = PROCEDURE( (*x-coord*) INTEGER, (*y-coord*) INTEGER, (*pointer*) GridObjectPtr );
GridObjectsFilterProc = PROCEDURE( (*x-coord*) INTEGER, (*y-coord*) INTEGER ): BOOLEAN;
AttachedVarPtrProc = PROCEDURE( (*x-coord*) INTEGER, (*y-coord*) INTEGER, (*pointer*) RealPtr );
VAR
undefGrid: Grid; undefGridData: GridData;
(* Common attributes of all grids *)
PROCEDURE SetGridsAttributes ( sectorCode: LONGINT; sectorDescr: ARRAY OF CHAR;
nX, nY: INTEGER; inDegrees: BOOLEAN; minLon, minLat, cellSize: REAL;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GridsSectorCode (): LONGINT;
PROCEDURE GetGridsSectorDescr ( VAR descr: ARRAY OF CHAR );
PROCEDURE GridsNumX (): INTEGER;
PROCEDURE GridsNumY (): INTEGER;
PROCEDURE GridsUseDegreesCoords(): BOOLEAN;
PROCEDURE GridsMinLon (): REAL;
PROCEDURE GridsMinLat (): REAL;
PROCEDURE GridsCellSize (): REAL;
(* Testing of object access *)
PROCEDURE ActivateGridsObjChecks;
PROCEDURE DeactivateGridsObjChecks;
PROCEDURE GridsObjChecksActivated(): BOOLEAN;
(* Handling of grids *)
PROCEDURE DeclareGrid( VAR grid: Grid; gridIdent: ARRAY OF CHAR; gridObjectSize: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SetAllocGridObjectsFilterProc ( filterProc: GridObjectsFilterProc );
PROCEDURE CurAllocGridObjectsFilterProc (): GridObjectsFilterProc;
PROCEDURE FindGrid ( gridIdent: ARRAY OF CHAR ): Grid;
PROCEDURE GridExists ( grid: Grid ): BOOLEAN;
PROCEDURE GetGridIdent ( grid: Grid; VAR id: ARRAY OF CHAR );
PROCEDURE GridObjectSize ( grid: Grid ): INTEGER;
PROCEDURE RemoveGrid ( VAR grid: Grid );
PROCEDURE GetGridObjectPtr ( grid: Grid; xC, yC: INTEGER ): GridObjectPtr;
PROCEDURE DoWithAllGridObjects ( grid: Grid; action: GridObjectProc );
PROCEDURE SetDoWithAllGridObjectsFilterProc( filterProc: GridObjectsFilterProc );
PROCEDURE CurDoWithAllGridObjectsFilterProc(): GridObjectsFilterProc;
(* Handling of grid data *)
PROCEDURE DeclareGridData ( grid: Grid; VAR gridData: GridData;
dataIdent: ARRAY OF CHAR; dataCode: LONGINT; nDataLayers: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE FindGridData ( grid: Grid; dataIdent: ARRAY OF CHAR ): GridData;
PROCEDURE ParentGrid ( gridData: GridData ): Grid;
PROCEDURE GridDataExist ( gridData: GridData ): BOOLEAN;
PROCEDURE GetGridDataIdent ( gridData: GridData; VAR id: ARRAY OF CHAR );
PROCEDURE GridDataCode ( gridData: GridData ): LONGINT;
PROCEDURE NumGridDataLayers ( gridData: GridData ): INTEGER;
PROCEDURE SetGridDataLayerIdent( gridData: GridData; dataLayerNr: INTEGER; ident: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetGridDataLayerIdent( gridData: GridData; dataLayerNr: INTEGER; VAR ident: ARRAY OF CHAR );
PROCEDURE FindGridDataLayerNr ( gridData: GridData; ident: ARRAY OF CHAR ): INTEGER;
PROCEDURE SetGridDataVal ( gridData: GridData; dataLayerNo: INTEGER; xC, yC: INTEGER; val: REAL );
PROCEDURE GridDataVal ( gridData: GridData; dataLayerNo: INTEGER; xC, yC: INTEGER ): REAL;
PROCEDURE RemoveGridData ( VAR gridData: GridData );
(* Attach/detach variables *)
PROCEDURE AttachGridDataVar( gridData: GridData; dataLayerNo: INTEGER; xC, yC: INTEGER; VAR variable: REAL );
PROCEDURE DetachGridDataVar( gridData: GridData; dataLayerNo: INTEGER; xC, yC: INTEGER );
(* Load/unload data *)
PROCEDURE GridDataLoaded ( gridData: GridData ): BOOLEAN;
PROCEDURE LoadGridData ( gridData: GridData; inFileName: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE UnloadGridData ( gridData: GridData );
PROCEDURE LoadDataForGrid ( grid: Grid; dataFrameIdent: ARRAY OF CHAR; gridDataIdent: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE UnloadDataForGrid ( grid: Grid );
PROCEDURE LoadDataForAllGrids( dataFrameIdent: ARRAY OF CHAR; gridDataIdent: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE UnloadDataForAllGrids;
(* Assign/deassign data *)
PROCEDURE AssignGridData ( gridData: GridData );
PROCEDURE DeassignGridData ( gridData: GridData );
PROCEDURE AssignDataForGrid ( grid: Grid );
PROCEDURE DeassignDataForGrid( grid: Grid );
PROCEDURE AssignDataForAllGrids;
PROCEDURE DeassignDataForAllGrids;
(* Operate on attached variables *)
PROCEDURE AttachedVarPtr ( gridData: GridData; dataLayerNr: INTEGER; xC, yC: INTEGER ): RealPtr;
PROCEDURE AttachedVarVal ( gridData: GridData; dataLayerNr: INTEGER; xC, yC: INTEGER ): REAL;
PROCEDURE AttachedVarsSum ( gridData: GridData; dataLayerNr: INTEGER ): REAL;
PROCEDURE AttachedVarsMean ( gridData: GridData; dataLayerNr: INTEGER ): REAL;
PROCEDURE DoWithAllAttachedVarsPtrs( gridData: GridData; dataLayerNr: INTEGER; action: AttachedVarPtrProc );
(* Dumping of data to file *)
PROCEDURE WriteAttachedVarsToFile ( gridData: GridData; outFileName: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DumpAttachedVars ( VAR outFile: TextFile; gridData: GridData; dataLayerNr: INTEGER;
date, time: LONGINT; checkInputs: BOOLEAN;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DumpAttachedVarsForGridData( VAR outFile: TextFile; gridData: GridData;
date, time: LONGINT; checkInputs: BOOLEAN;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DumpAttachedVarsForGrid ( VAR outFile: TextFile; grid: Grid;
date, time: LONGINT; checkInputs: BOOLEAN;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DumpAttachedVarsForAllGrids( VAR outFile: TextFile;
date, time: LONGINT; checkInputs: BOOLEAN;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(* Retrieval of neighbour gridpoints *)
TYPE GridClosureType = ( undefGridClosureType, rectangle, cylinder, torus );
PROCEDURE SetGridClosure( gc: GridClosureType );
PROCEDURE CurGridClosure(): GridClosureType;
TYPE NeighboursSearchAreaType = ( undefNeighboursSearchAreaType, square, circle );
PROCEDURE SetTypeOfNeighboursSearchArea( nsat: NeighboursSearchAreaType );
PROCEDURE TypeOfNeighboursSearchArea (): NeighboursSearchAreaType;
PROCEDURE SetSizeOfNeighboursSearchArea( size: REAL );
PROCEDURE SizeOfNeighboursSearchArea (): REAL;
PROCEDURE GetNeighbourCellsCoords ( xCoord, yCoord: INTEGER;
VAR nNbrs: INTEGER; VAR nbrX, nbrY: ARRAY OF INTEGER; VAR nbrCAF: ARRAY OF REAL );
PROCEDURE GetNeighbourCellsObjects ( grid: Grid; xCoord, yCoord: INTEGER;
VAR nNbrs: INTEGER; VAR nbrCAF: ARRAY OF REAL; VAR nbrObj: ARRAY OF GridObjectPtr );
(*============================ JulianDays ================================*)
CONST Jan = 1; Feb = 2; Mar = 3; Apr = 4; Mai = 5; Jun = 6;
Jul = 7; Aug = 8; Sep = 9; Oct = 10; Nov = 11; Dec = 12;
Sun = 1; Mon = 2; Tue = 3; Wed = 4; Thur = 5; Fri = 6; Sat = 7;
TYPE
Month = [Jan..Dec]; WeekDay = [Sun..Sat];
DateAndTime = RECORD
year: INTEGER; month: Month; day: INTEGER; hour, min: INTEGER; sec: INTEGER;
dayOfWeek: WeekDay; secFrac: REAL;
END;
PROCEDURE DateTimeToJulDay( dt: DateAndTime ): LONGREAL;
PROCEDURE JulDayToDateTime( jd: LONGREAL; VAR dt: DateAndTime );
PROCEDURE DateToJulDay ( day, month, year: INTEGER ): LONGINT;
PROCEDURE JulDayToDate ( jd: LONGINT; VAR day: INTEGER; VAR month: Month; VAR year: INTEGER; VAR dayOfWeek: WeekDay );
PROCEDURE IsLeapYear ( yr: INTEGER ): BOOLEAN;
PROCEDURE SetCalendarRange( firstYear, lastYear, firstSunday: INTEGER );
PROCEDURE GetCalendarRange( VAR firstYear, lastYear, firstSunday: INTEGER );
PROCEDURE JulDayInCalendar( jd: LONGINT ): BOOLEAN;
(*============================ LgMatrices =============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
MaxElems = 4*1024-1; (* = 4'095 - MacMETH RAMSES *)
MaxElems = 8*1024-1; (* = 8'191 - StonyBrook RAMSES Windows *)
MaxElems = 8*512*1024; (* = 4'194'304 - EPC RASS-Sun, P1 RASS-OSX *)
TYPE
LVec = ARRAY[1.. MaxElems] OF LONGREAL; LVector = POINTER TO LVec;
LMat = ARRAY[1.. MaxElems] OF LVector; LMatrix = POINTER TO LMat;
MatrixType = LONGINT; MatrixCode = LONGINT; MatrixAttribute = ADDRESS;
VAR (* read only *)
notAllocatedLVector: LVector; notAllocatedLMatrix: LMatrix;
undefMatrixType: MatrixType; anyMatrixType: MatrixType;
undefMatrixCode: MatrixCode; anyMatrixCode: MatrixCode;
undefMatrixAttribute: MatrixAttribute;
(* Objects management *)
PROCEDURE AllocMatrix ( VAR mat: LMatrix; nRows, nCols: INTEGER; initVal: LONGREAL;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE MatrixExists ( mat: LMatrix ): BOOLEAN;
PROCEDURE DeallocMatrix ( VAR mat: LMatrix );
PROCEDURE AllocVector ( VAR vec: LVector; nElems: INTEGER; initVal: LONGREAL;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE VectorExists ( vec: LVector ): BOOLEAN;
PROCEDURE DeallocVector ( VAR vec: LVector );
(* Dimensions retrieval *)
PROCEDURE NRows ( mat: LMatrix ): INTEGER;
PROCEDURE NCols ( mat: LMatrix ): INTEGER;
PROCEDURE NElems( vec: LVector ): INTEGER;
(* Checking of objects *)
PROCEDURE GetQuotedMatDescr( mat: LMatrix; genericDescr: ARRAY OF CHAR; VAR quotedDescr: ARRAY OF CHAR );
PROCEDURE MatrixOK ( mat: LMatrix; genericDescr, callee: ARRAY OF CHAR; minRows, minCols: INTEGER;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE MatTypeOK ( mat: LMatrix; genericDescr, callee: ARRAY OF CHAR; expectedType: MatrixType;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE MatCodeOK ( mat: LMatrix; genericDescr, callee: ARRAY OF CHAR; expectedCode: MatrixCode;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GetQuotedVecDescr( vec: LVector; genericDescr: ARRAY OF CHAR; VAR quotedDescr: ARRAY OF CHAR );
PROCEDURE VectorOK ( vec: LVector; genericDescr, callee: ARRAY OF CHAR; minElems: INTEGER;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
(* Matrix attributes *)
PROCEDURE SetMatrixDescr ( mat: LMatrix; descr: ARRAY OF CHAR );
PROCEDURE GetMatrixDescr ( mat: LMatrix; VAR descr: ARRAY OF CHAR );
PROCEDURE SetMatrixType ( mat: LMatrix; type: MatrixType );
PROCEDURE MatType ( mat: LMatrix ): MatrixType;
PROCEDURE SetMatrixCode ( mat: LMatrix; code: MatrixCode );
PROCEDURE MatCode ( mat: LMatrix ): MatrixCode;
PROCEDURE SetColIds ( mat: LMatrix; VAR(*speed-up*) ids: ARRAY OF CHAR );
PROCEDURE GetColIds ( mat: LMatrix; VAR ids: ARRAY OF CHAR );
PROCEDURE SetRowIds ( mat: LMatrix; VAR(*speed-up*) ids: ARRAY OF CHAR );
PROCEDURE GetRowIds ( mat: LMatrix; VAR ids: ARRAY OF CHAR );
PROCEDURE SetMatrixAttr ( mat: LMatrix; attr: MatrixAttribute );
PROCEDURE MatrixAttr ( mat: LMatrix ): MatrixAttribute;
PROCEDURE CopyAllMatrixAttributes( from, to: LMatrix );
(* Manipulation of object data *)
PROCEDURE SetMatrix ( mat: LMatrix; val: LONGREAL );
PROCEDURE SetMatrixCol( mat: LMatrix; colNr: INTEGER; colData: LVector );
PROCEDURE GetMatrixCol( mat: LMatrix; colNr: INTEGER; colData: LVector );
PROCEDURE SetMatrixRow( mat: LMatrix; rowNr: INTEGER; rowData: LVector );
PROCEDURE GetMatrixRow( mat: LMatrix; rowNr: INTEGER; rowData: LVector );
PROCEDURE SetMatCol ( mat: LMatrix; colNr, nElems: INTEGER; VAR(*speed-up*) colData: ARRAY OF LONGREAL );
PROCEDURE GetMatCol ( mat: LMatrix; colNr: INTEGER; VAR nElems: INTEGER; VAR colData: ARRAY OF LONGREAL );
PROCEDURE SetMatRow ( mat: LMatrix; rowNr, nElems: INTEGER; VAR(*speed-up*) rowData: ARRAY OF LONGREAL );
PROCEDURE GetMatRow ( mat: LMatrix; rowNr: INTEGER; VAR nElems: INTEGER; VAR rowData: ARRAY OF LONGREAL );
PROCEDURE CopyMatrix ( mat: LMatrix; res: LMatrix );
PROCEDURE Transpose ( mat: LMatrix; res: LMatrix );
PROCEDURE SetVector ( vec: LVector; val: LONGREAL );
PROCEDURE CopyVector ( vec: LVector; res: LVector );
(*============================= LgMatCalc =============================*)
PROCEDURE SetToIdentityMatrix( mat: LMatrix );
PROCEDURE IsIdentityMatrix ( mat: LMatrix; tol: LONGREAL ): BOOLEAN;
PROCEDURE ScaleMatrix ( mat: LMatrix; fact: LONGREAL );
PROCEDURE MatrixProduct ( mat1: LMatrix; mat2: LMatrix; res: LMatrix );
PROCEDURE MatrixSum ( mat1: LMatrix; mat2: LMatrix; res: LMatrix );
PROCEDURE MatVecProduct ( mat: LMatrix; vec: LVector; res: LVector );
PROCEDURE GetColMuSig ( data: LMatrix; col: INTEGER; VAR nn: INTEGER; VAR mu, sig: LONGREAL );
PROCEDURE GetRowMuSig ( data: LMatrix; row: INTEGER; VAR nn: INTEGER; VAR mu, sig: LONGREAL );
PROCEDURE GetColsCov ( data: LMatrix; col1, col2, lag: INTEGER; VAR nn: INTEGER; VAR mu1, mu2, cov: LONGREAL );
PROCEDURE GetRowsCov ( data: LMatrix; row1, row2, lag: INTEGER; VAR nn: INTEGER; VAR mu1, mu2, cov: LONGREAL );
(*============================== LgMatIO ==============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
TYPE
ProgressReportP = PROCEDURE();
AtReadDataPointP = PROCEDURE( INTEGER, (* the row read *) INTEGER, (* the colum read *)
VAR LONGREAL, (* the data point read *)
VAR ARRAY OF CHAR (* error text passed on by client *)): BOOLEAN; (* if false, reading stops *)
OutputDataType = ( longReal, longInt );
(* I/O *)
PROCEDURE ReadMatrix ( inFName: ARRAY OF CHAR; tryOpenFile, keepFileOpen, readTransposed: BOOLEAN;
VAR mat: LMatrix; VAR eof: BOOLEAN;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE WriteMatrix( VAR outF: TextFile; mat: LMatrix; wrTransposed: BOOLEAN;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(* Control of output *)
PROCEDURE SetOutputRows ( frstRow, lastRow: INTEGER );
PROCEDURE GetOutputRows ( VAR frstRow, lastRow: INTEGER );
PROCEDURE SetOutputColumns ( frstCol, lastCol: INTEGER );
PROCEDURE GetOutputColumns ( VAR frstCol, lastCol: INTEGER );
PROCEDURE SetMatrixOutputParams( noDataStr: ARRAY OF CHAR; sciFormat: BOOLEAN; nOutChars, nDecDigits: INTEGER );
PROCEDURE GetMatrixOutputParams( VAR noDataStr: ARRAY OF CHAR; VAR sciFormat: BOOLEAN; VAR nOutChars, nDecDigits: INTEGER );
PROCEDURE SetColOutputDataType ( colNr: INTEGER; dataType: OutputDataType );
PROCEDURE ColOutputDataType ( colNr: INTEGER ): OutputDataType;
(* Run-time control *)
PROCEDURE InstallProgressReportP ( prp: ProgressReportP );
PROCEDURE InstallAtReadDataPointP( ardp: AtReadDataPointP );
(*============================= LgMatInv ==============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
PROCEDURE InvertMatrix ( mat, inv: LMatrix; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SolveLinEqu ( A: LMatrix; b, x: LVector; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetMatInvertTolerance( VAR tol: LONGREAL );
PROCEDURE SetMatInvertTolerance( tol: LONGREAL );
(*=========================== LicensesMgr =============================*)
TYPE LicenseType=( undefLicenseType, licenseGranted, noLicence );
PROCEDURE SetLicenseForNode( nodename: ARRAY OF CHAR; (* /usr/bin/uname -n *)
expirYear, expirMonth, expirDay: INTEGER; l: LicenseType );
PROCEDURE SetLicenseForHost( hostid: ARRAY OF CHAR; (* /usr/bin/hostid *)
expirYear, expirMonth, expirDay: INTEGER; l: LicenseType );
PROCEDURE SetLicenseForUser( userid: ARRAY OF CHAR; (* /usr/ucb/whoami *)
expirYear, expirMonth, expirDay: INTEGER; l: LicenseType );
PROCEDURE GetCurNodeName ( VAR nodename: ARRAY OF CHAR );
PROCEDURE GetCurHostId ( VAR hostid: ARRAY OF CHAR );
PROCEDURE GetCurUserId ( VAR userid: ARRAY OF CHAR );
PROCEDURE GetNodeNames ( VAR numNodes: INTEGER; VAR nodenames: ARRAY OF CHAR );
PROCEDURE LicenseForNode ( nodename: ARRAY OF CHAR ): LicenseType;
PROCEDURE ExpirYearForNode ( nodename: ARRAY OF CHAR ): INTEGER;
PROCEDURE ExpirMonthForNode( nodename: ARRAY OF CHAR ): INTEGER;
PROCEDURE ExpirDayForNode ( nodename: ARRAY OF CHAR ): INTEGER;
PROCEDURE GetHostIds ( VAR numHosts: INTEGER; VAR hostids: ARRAY OF CHAR );
PROCEDURE LicenseForHost ( hostid: ARRAY OF CHAR ): LicenseType;
PROCEDURE ExpirYearForHost ( hostid: ARRAY OF CHAR ): INTEGER;
PROCEDURE ExpirMonthForHost( hostid: ARRAY OF CHAR ): INTEGER;
PROCEDURE ExpirDayForHost ( hostid: ARRAY OF CHAR ): INTEGER;
PROCEDURE GetUserIds ( VAR numUsers: INTEGER; VAR userids: ARRAY OF CHAR );
PROCEDURE LicenseForUser ( userid: ARRAY OF CHAR ): LicenseType;
PROCEDURE ExpirYearForUser ( userid: ARRAY OF CHAR ): INTEGER;
PROCEDURE ExpirMonthForUser( userid: ARRAY OF CHAR ): INTEGER;
PROCEDURE ExpirDayForUser ( userid: ARRAY OF CHAR ): INTEGER;
PROCEDURE DateOK ( year, month, day: INTEGER ): BOOLEAN;
PROCEDURE NodenameOK(): BOOLEAN;
PROCEDURE HostidOK (): BOOLEAN;
PROCEDURE UseridOK (): BOOLEAN;
PROCEDURE LicenseOK (): BOOLEAN;
(*============================== LolaIO ===============================*)
CONST allOk = Errors.allOk; reachedEof = Errors.userBase + 1; notDone = Errors.onlyAnInsert;
CONST MaxCoords = 180;
TYPE
CoordsList = ARRAY [1..MaxCoords] OF LONGREAL;
LolaHeaderRec = RECORD
date, time, code, level, nLon, nLat, nListedLon, nListedLat, info1, info2: LONGINT; lon, lat: CoordsList;
END;
(* Auxiliary procedures *)
PROCEDURE ClearLolaHeaderRec( VAR hdr: LolaHeaderRec );
PROCEDURE CalcCoordsListsFromSectorInfo( nX, nY: LONGINT;
inputsInDegrees: BOOLEAN;
minLon, minLat, cellSize: LONGREAL;
VAR nLon, nLat, nListedLon, nListedLat: LONGINT;
VAR lon, lat: CoordsList;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE CalcSectorInfoFromCoordsLists( nLon, nLat, nListedLon, nListedLat: LONGINT;
lon, lat: CoordsList;
resultsInDegrees: BOOLEAN;
VAR nX, nY: LONGINT;
VAR minLon, minLat, cellSize: LONGREAL;
resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(* File I/O procedures *)
PROCEDURE ReadLolaRecord ( VAR inFile: TextFile; VAR hdr: LolaHeaderRec; VAR data: LVector;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE WriteLolaRecord( VAR outFile: TextFile; VAR hdr: LolaHeaderRec; data: LVector;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================ MapViewer ==============================*)
(* Usage *)
PROCEDURE MakeMapViewer;
PROCEDURE MapViewerExists(): BOOLEAN;
PROCEDURE DiscardMapViewer;
(* Customization *)
PROCEDURE EditPreferences;
PROCEDURE EditMenuAppearance;
PROCEDURE ResetToFactorySettings;
PROCEDURE DefineMenuAppearance ( title, aliasChars: ARRAY OF CHAR; sepEditMenu: BOOLEAN );
PROCEDURE RetrieveMenuAppearance( VAR title, aliasChars: ARRAY OF CHAR; VAR sepEditMenu: BOOLEAN );
PROCEDURE SetPreferences( omitLegend, drawRegNames, transpNames, preserveProp, sepEditMenu, globalAbout: BOOLEAN );
PROCEDURE GetPreferences( VAR omitLegend, drawRegNames, transpNames, preserveProp, sepEditMenu, globalAbout: BOOLEAN );
(* Error Retrieval *)
PROCEDURE GetLastMVResCode(): INTEGER;
(* Map Viewer's Window *)
PROCEDURE ShowMapWindow;
PROCEDURE PlaceMapWindow ( x, y, w, h: INTEGER; forceOnTop: BOOLEAN );
PROCEDURE GetMapWindowPlace( VAR x, y, w, h: INTEGER; VAR isOpen, isOnTop: BOOLEAN );
PROCEDURE HideMapWindow;
PROCEDURE SelectMapWindowForOutput;
PROCEDURE DrawMap;
PROCEDURE ClearMap;
PROCEDURE SetDrawRegion( xmin, xmax, ymin, ymax: REAL );
PROCEDURE GetDrawRegion( VAR xmin, xmax, ymin, ymax: REAL );
PROCEDURE ForgetDrawRegion;
(* Clipboard Support *)
PROCEDURE CopyMap;
PROCEDURE CutMap;
PROCEDURE PasteMap;
(*=========================== MonWeathGen =============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
CONST MaxMWGVars = 32; Jan = 1; Dec = 12;
TYPE
Month = [Jan..Dec];
MWGLRealVec = ARRAY [1..MaxMWGVars] OF LONGREAL;
MWGIntVec = ARRAY [1..MaxMWGVars] OF INTEGER;
MWGLnTrfTVec = ARRAY [1..MaxMWGVars] OF LnTrfType;
MWGLRealVecArr = ARRAY [Jan..Dec] OF MWGLRealVec;
MWGLnTrfTVecArr = ARRAY [Jan..Dec] OF MWGLnTrfTVec;
MWGLMatrixArr = ARRAY [Jan..Dec] OF LMatrix;
VAR mwgOutputOK: BOOLEAN;
(* Allocation of needed objects *)
PROCEDURE ResetMWGLMatrixArr ( VAR mwgLma: MWGLMatrixArr );
PROCEDURE AllocMWGLMatrixArr ( VAR mwgLma: MWGLMatrixArr; nVars: INTEGER; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DeallocMWGLMatrixArr( VAR mwgLma: MWGLMatrixArr );
(* Get/Set all parameters defining stochastic simulation *)
PROCEDURE MWGParamsHaveBeenSet():BOOLEAN;
PROCEDURE GetMWGParams( VAR nVars: INTEGER; VAR mu, sig: MWGLRealVecArr; VAR lnTrfType: MWGLnTrfTVecArr;
VAR lnTrfMu, lnTrfSig, lnTrfTheta: MWGLRealVecArr;
VAR A, B: MWGLMatrixArr; VAR allowedMin, allowedMax: MWGLRealVecArr;
VAR maxIters: INTEGER; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SetMWGParams( nVars: INTEGER; VAR(*speed-up*) mu, sig: MWGLRealVecArr; VAR(*speed-up*) lnTrfType: MWGLnTrfTVecArr;
VAR(*speed-up*) lnTrfMu, lnTrfSig, lnTrfTheta: MWGLRealVecArr;
VAR(*speed-up*) A, B: MWGLMatrixArr; VAR(*speed-up*) allowedMin, allowedMax: MWGLRealVecArr;
maxIters: INTEGER; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(* Get/Set selected parameters *)
PROCEDURE NumMWGVars ():INTEGER;
PROCEDURE GetMWGMu ( VAR mu: MWGLRealVecArr );
PROCEDURE SetMWGMu ( VAR(*speed-up*) mu: MWGLRealVecArr );
PROCEDURE GetMWGSig ( VAR sig: MWGLRealVecArr );
PROCEDURE SetMWGSig ( VAR(*speed-up*) sig: MWGLRealVecArr );
PROCEDURE GetMWGLnTrfPars( VAR lnTrfMu, lnTrfSig, lnTrfTheta: MWGLRealVecArr );
PROCEDURE SetMWGLnTrfPars( VAR(*speed-up*) lnTrfMu, lnTrfSig, lnTrfTheta: MWGLRealVecArr );
PROCEDURE GetMWGMatrices ( VAR A, B: MWGLMatrixArr );
PROCEDURE SetMWGMatrices ( VAR(*speed-up*) A, B: MWGLMatrixArr );
(* Control of stochastic simulation *)
PROCEDURE InitMWG ( VAR yInit: MWGLRealVec; month: Month; initRandGen: BOOLEAN; z0,z1,z2: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetLastMWGOutput( VAR yOld: MWGLRealVec );
PROCEDURE ClcNewMWGOutput ( VAR yNew: MWGLRealVec );
(*=========================== MWGFitParams ============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
TYPE MWGModelType = ( simple, crossCorr, fixedPhaseCyclostat, phaseAveragedCyclostat );
PROCEDURE FitMWGParams( (*in*) nVariables, nTimePoints: INTEGER; timeSeries: LMatrix; mwgModelType: MWGModelType;
(*in*) chi2SgnfLevForLnTrf: MWGLRealVec; nHarmonicsMuSig: MWGIntVec; nHarmonicsCycSt: INTEGER;
(*out*) VAR mu, sig: MWGLRealVecArr; VAR lnTrfType: MWGLnTrfTVecArr;
(*out*) VAR lnTrfMu, lnTrfSig, lnTrfTheta: MWGLRealVecArr;
(*out*) VAR A, B: MWGLMatrixArr; VAR nParsFitted: INTEGER;
(*out*) VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*=========================== MWGParamsIO =============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
TYPE VariableID = ARRAY [1..64] OF CHAR; VariableIDArr = ARRAY [1..MaxMWGVars] OF VariableID;
PROCEDURE WriteMWGParams( VAR outFile: TextFile; paramBlockID: LONGINT; nDecDigsVecs, nDecDigsMats, nVars: INTEGER;
VAR(*speed-up*) varID: VariableIDArr;
VAR(*speed-up*) mu, sig: MWGLRealVecArr; VAR(*speed-up*) lnTrfType: MWGLnTrfTVecArr;
VAR(*speed-up*) lnTrfMu, lnTrfSig, lnTrfTheta: MWGLRealVecArr;
VAR(*speed-up*) A, B: MWGLMatrixArr; VAR(*speed-up*) allowedMin, allowedMax: MWGLRealVecArr;
maxIters: INTEGER; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE RetrieveMWGParams( fName: ARRAY OF CHAR; paramBlockID: LONGINT;
VAR nVars: INTEGER; VAR varID: VariableIDArr;
VAR mu, sig: MWGLRealVecArr; VAR lnTrfType: MWGLnTrfTVecArr;
VAR lnTrfMu, lnTrfSig, lnTrfTheta: MWGLRealVecArr;
VAR A, B: MWGLMatrixArr; VAR allowedMin, allowedMax: MWGLRealVecArr;
VAR maxIters: INTEGER; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================ MultLinReg =============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
PROCEDURE FitMultLinReg( (*in*) xDat: LMatrix; yDat: LMatrix; nXVarsToUse, nDataRowsToUse: INTEGER;
(*out*) muX, sigX: LMatrix; VAR muY, sigY, alpha: LONGREAL;
(*out*) beta, eps: LMatrix; VAR smin, se, r2, fVal: LONGREAL;
(*out*) VAR df: INTEGER; VAR pVal: LONGREAL;
(*out*) VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================= PrinComp ==============================*)
CONST allOk = Errors.allOk; notDone = Errors.onlyAnInsert;
CONST (* types of matrices supported *)
muMatType = 10; (* column means used for calculation of anomalies *)
wghtMatType = 20; (* column weights used for weighting of data columns *)
eigValMatType = 101; (* Eigenvalues *)
tvxMatType = 102; (* Total variances explained by PCs *)
eofMatType = 103; (* EOFs *)
lvxMatType = 104; (* Local variances explained by PCs *)
pcMatType = 105; (* PCs *)
evREBMatType = 106; (* Eigenvalues relative error bounds *)
TYPE
CovCalcMethod = ( covUsesDivN, covUsesDivNLess1 );
WeightingType = ( noWeighting, equalWeights, userSpecfdWeights );
RescalingType = ( normalize, denormalize );
(* Main procedures *)
PROCEDURE SetCovCalcMethod( ccm: CovCalcMethod );
PROCEDURE CurCovCalcMethod(): CovCalcMethod;
PROCEDURE MakePCA ( (*in*) data: LMatrix; (*out*) mu: LMatrix; wType: WeightingType; (*in/out*) wght: LMatrix;
(*out*) eigVal, eof, pc: LMatrix; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE CalcPCsGlobExplVar ( (*in*) data, eigVal: LMatrix; (*out*) tvx: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE CalcEigValsRelErrBounds( (*in*) data, eigVal: LMatrix; (*out*) evREB: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE CalcPCsLocalExplVar ( (*in*) data, pc: LMatrix; (*out*) lvx: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetNumEofs1 ( eigVal: LMatrix; minCumulVar: LONGREAL; VAR nEofs: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetNumEofs2 ( data, eigVal: LMatrix; maxEigValREB: LONGREAL; VAR nEofs: INTEGER;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(* Auxilary *)
PROCEDURE NEofs ( data: LMatrix ): INTEGER;
PROCEDURE NEofsOK ( data: LMatrix; nEofs: INTEGER; genericDescr: ARRAY OF CHAR; callee: ARRAY OF CHAR;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE WeightsOK ( wght: LMatrix; genericDescr: ARRAY OF CHAR; callee: ARRAY OF CHAR;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE RescalePCs ( (*in*) eigVal, pc: LMatrix; (*out*) rscldPC: LMatrix; doWhat: RescalingType;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE RescaleEOFs ( (*in*) eigVal, eof: LMatrix; (*out*) rscldEof: LMatrix; doWhat: RescalingType;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE AllocPCAResVars ( data, mu, wght: LMatrix; VAR eigVal, eof, pc: LMatrix; allocAlsoVX: BOOLEAN; VAR tvx, lvx: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DeallocPCAResVars( VAR mu, wght, eigVal, eof, pc, tvx, lvx: LMatrix );
(* I/O of PCA results *)
PROCEDURE WritePCAResults( VAR outF: TextFile;
wrMu: BOOLEAN; mu: LMatrix; wrWght: BOOLEAN; wght: LMatrix;
wrEigVal: BOOLEAN; eigVal: LMatrix; wrEof: BOOLEAN; eof: LMatrix;
wrPc: BOOLEAN; pc: LMatrix; wrTvx: BOOLEAN; tvx: LMatrix; wrLvx: BOOLEAN; lvx: LMatrix;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE ReadPCAResults( inFName: ARRAY OF CHAR; tryOpenFile: BOOLEAN; keepFileOpen: BOOLEAN;
rdMu: BOOLEAN; VAR mu: LMatrix; rdWght: BOOLEAN; VAR wght: LMatrix;
rdEigVal: BOOLEAN; VAR eigVal: LMatrix; rdEof: BOOLEAN; VAR eof: LMatrix;
rdPc: BOOLEAN; VAR pc: LMatrix; rdTvx: BOOLEAN; VAR tvx: LMatrix; rdLvx: BOOLEAN; VAR lvx: LMatrix;
VAR endOfFile: BOOLEAN; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
(*============================= RegArcHdlr ===============================*)
CONST undefinedRegArc = MIN(INTEGER);
(* Management of region handler *)
PROCEDURE UseRegionArcHandler;
PROCEDURE RegionArcHandlerIsInUse(): BOOLEAN;
PROCEDURE UnuseRegionArcHandler;
(* Management of regions *)
PROCEDURE LoadRegArcs ( pfn: ARRAY OF CHAR );
PROCEDURE LoadRegions ( pfn: ARRAY OF CHAR );
PROCEDURE LoadArcs ( pfn: ARRAY OF CHAR );
PROCEDURE UnloadRegArcs;
PROCEDURE SaveRegions ( VAR (*In/Out*) pfn: ARRAY OF CHAR );
PROCEDURE SaveArcs ( VAR (*In/Out*) pfn: ARRAY OF CHAR );
PROCEDURE GetBaseRegion( VAR xmin, xmax, ymin, ymax: REAL );
(* Drawing of regions *)
PROCEDURE DrawRegionsArcs;
PROCEDURE DrawARegionOrArc ( raNr: INTEGER );
PROCEDURE EditRegArcAttributes( raNr: INTEGER );
(*============================= Regions ===============================*)
CONST MaxPoints = 8*1024-1; undefinedRegion = MIN(INTEGER);
TYPE
RealVecPtr = POINTER TO RealVec;
RealVec = ARRAY [1..MaxPoints] OF REAL;
RegionChange = ( regionDefined, regionReplaced, regionRemoved );
AtRegionChangeP = PROCEDURE( RegionChange, (* signifies type of change *)
INTEGER ); (* number of the region affected *)
AtReadDataPointP = PROCEDURE( VAR REAL, (* x-Coordinate *)
VAR REAL, (* y-Coordinate *)
VAR ARRAY OF CHAR (* error text to pass on *)
): BOOLEAN; (* if false, reading stops *)
CalcDistanceP = PROCEDURE( REAL, REAL, (* x1/y1 *)
REAL, REAL (* x2/y2 *)
): REAL; (* the distance *)
(* Calculation of distances *)
PROCEDURE SetCalcDistanceP( calcDistP: CalcDistanceP );
PROCEDURE GetCalcDistanceP( VAR calcDistP: CalcDistanceP );
(* Definition and removal of regions *)
PROCEDURE DefineRegionsFromFile ( fileName: ARRAY OF CHAR;
atReadDataPoint: AtReadDataPointP; progrReprt: PROC; replaceExisting: BOOLEAN;
VAR nDefined:INTEGER ; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SimplifyRegionBoundaries( inFileName: ARRAY OF CHAR; outFileName: ARRAY OF CHAR;
atReadDataPoint: AtReadDataPointP; progrReprt: PROC;
minDist: REAL; idOffset: INTEGER; VAR nSimplified: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DefineRegion ( rNr: INTEGER;
name: ARRAY OF CHAR; cntrX, cntrY: REAL; nPoints: INTEGER; xC, yC: ARRAY OF REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE RemoveRegion ( rNr: INTEGER );
PROCEDURE RemoveAllRegions;
PROCEDURE InstallAtRegionsChangedHandler( rch: AtRegionChangeP );
(* Retrieval of regions and their attributes *)
PROCEDURE NRegions ():INTEGER;
PROCEDURE RegionExists ( rNr: INTEGER ): BOOLEAN;
PROCEDURE GetRegionNumbers( VAR rNum: ARRAY OF INTEGER; VAR nRegions: INTEGER );
PROCEDURE GetRegionAttrs ( rNr: INTEGER; VAR name: ARRAY OF CHAR; VAR left: BOOLEAN;
VAR cntrX, cntrY, minX, minY, maxX, maxY, meanDist: REAL ): BOOLEAN;
PROCEDURE GetRegionCoords ( rNr: INTEGER; VAR nElems: INTEGER; VAR xC, yC: RealVecPtr ): BOOLEAN;
(* Geographical relationships *)
PROCEDURE InRegion ( rNr: INTEGER; xC, yC: REAL ): BOOLEAN;
PROCEDURE RegionOfPoint ( xC, yC: REAL ): INTEGER;
PROCEDURE ClosestBoundary ( rNr: INTEGER; xC, yC: REAL; VAR xB, yB, dist: REAL );
(*=========================== RegionsArcs =============================*)
CONST MaxPoints = 8*1024-1; undefinedRegArc = MIN(INTEGER);
TYPE
RealVecPtr = POINTER TO RealVec;
RealVec = ARRAY [1..MaxPoints] OF REAL;
RegArcChange = ( regArcDefined, regArcReplaced, regArcRemoved );
AtRegArcChangeP = PROCEDURE( RegArcChange, (* signifies type of change *)
INTEGER ); (* number of the region affected *)
AtReadDataPointP = PROCEDURE( VAR REAL, (* x-Coordinate *)
VAR REAL, (* y-Coordinate *)
VAR ARRAY OF CHAR (* error text to pass on *)
): BOOLEAN; (* if false, reading stops *)
AtWriteRegArcP = PROCEDURE( INTEGER, (* region/arc number *)
VAR ARRAY OF CHAR, (* region/arc name, VAR for speed-up only *)
VAR ARRAY OF CHAR (* error text to return if you return FALSE *)
): BOOLEAN; (* if false, writing stops *)
CalcDistanceP = PROCEDURE( REAL, REAL, (* x1/y1 *)
REAL, REAL (* x2/y2 *)
): REAL; (* the distance *)
OperateOnRegArcP = PROCEDURE( INTEGER (* region/arc number *)
): BOOLEAN; (* if false, operation stops *)
(* Definition and removal of regions / arcs - via files *)
PROCEDURE DefineRegionsFromFile ( fileName: ARRAY OF CHAR;
atReadDataPoint: AtReadDataPointP; progrReprt: PROC; replaceExisting: BOOLEAN;
VAR nDefined:INTEGER ; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DefineArcsFromFile ( fileName: ARRAY OF CHAR;
atReadDataPoint: AtReadDataPointP; progrReprt: PROC; replaceExisting: BOOLEAN;
VAR nDefined:INTEGER ; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DefineRegArcsFromFile ( fileName: ARRAY OF CHAR;
atReadDataPoint: AtReadDataPointP; progrReprt: PROC; replaceExisting: BOOLEAN;
VAR nDefined:INTEGER ; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DumpRegionsToFile ( fileName: ARRAY OF CHAR;
atWriteARegArc: AtWriteRegArcP; overwrite: BOOLEAN;
VAR nDumped: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DumpArcsToFile ( fileName: ARRAY OF CHAR;
atWriteARegArc: AtWriteRegArcP; overwrite: BOOLEAN;
VAR nDumped: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SimplifyRegArcBoundaries( inFileName: ARRAY OF CHAR; outFileName: ARRAY OF CHAR;
atReadDataPoint: AtReadDataPointP; progrReprt: PROC;
minDist: REAL; idOffset: INTEGER; VAR nSimplified: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE ConvertARCINFODump ( inFileName: ARRAY OF CHAR; outFileName: ARRAY OF CHAR; containsArcs: BOOLEAN;
atReadDataPoint: AtReadDataPointP; progrReprt: PROC; overwrite: BOOLEAN; idOffset: INTEGER;
VAR nConverted: INTEGER ; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DummyProgressReport;
PROCEDURE DummyAtReadDataPointP ( VAR x,y: REAL; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE DummyAtWriteARegArcP ( regNr: INTEGER; VAR regName, errTxt: ARRAY OF CHAR ): BOOLEAN;
(* Definition and removal of regions / arcs - via Client Interface *)
PROCEDURE DefineRegion( raNr: INTEGER; name: ARRAY OF CHAR; cntrX, cntrY: REAL; nPoints: INTEGER; xC, yC: ARRAY OF REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE DefineArc ( raNr: INTEGER; name: ARRAY OF CHAR; cntrX, cntrY: REAL; nPoints: INTEGER; xC, yC: ARRAY OF REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE RemoveRegArc( raNr: INTEGER );
PROCEDURE RemoveAllRegArcs;
PROCEDURE RemoveAllRegions;
PROCEDURE RemoveAllArcs;
PROCEDURE InstallAtRegArcsChangedHandler( rch: AtRegArcChangeP );
(* Accessing regions / arcs and their attributes *)
PROCEDURE RegArcExists( raNr:INTEGER ): BOOLEAN;
PROCEDURE NRegArcs (): INTEGER; (* 1, 2, ... NoRegArcs *)
PROCEDURE NRegions (): INTEGER; (* 1, 2, ... NoRegions *)
PROCEDURE NArcs (): INTEGER; (* 1, 2, ... NoArcs *)
PROCEDURE RegArcNr ( i: INTEGER ): INTEGER;
PROCEDURE RegionNr ( i: INTEGER ): INTEGER;
PROCEDURE ArcNr ( i: INTEGER ): INTEGER;
PROCEDURE SelectFromRegArcs( dowith: OperateOnRegArcP );
PROCEDURE GetRegionArcAttributes( raNr: INTEGER; VAR arcinfoNr: INTEGER; VAR name: ARRAY OF CHAR;
VAR attr: ARRAY OF CHAR; VAR isArc: BOOLEAN; VAR left: BOOLEAN;
VAR cntrX, cntrY, minX, minY, maxX, maxY, meanDist: REAL ): BOOLEAN;
PROCEDURE SetRegionArcAttributes( raNr: INTEGER; name, attr: ARRAY OF CHAR );
PROCEDURE GetRegArcCoords ( raNr: INTEGER; VAR nElems: INTEGER; VAR xC, yC: RealVecPtr ): BOOLEAN;
(* Calculation of distances *)
PROCEDURE SetCalcDistanceP( calcDistP: CalcDistanceP );
PROCEDURE GetCalcDistanceP( VAR calcDistP: CalcDistanceP );
(* Geographical relationships *)
PROCEDURE InRegion ( rNr: INTEGER; xC, yC: REAL ): BOOLEAN;
PROCEDURE RegionOfPoint ( xC, yC: REAL ): INTEGER;
PROCEDURE ClosestBoundary ( raNr: INTEGER; xC, yC: REAL; VAR xB, yB, dist: REAL );
(*============================ SoilWatBal =============================*)
TYPE ValueType = ( cur, deflt, min, max );
PROCEDURE GetSitePars ( VAR latitude, saModifier, fieldCap, bucketSize: REAL );
PROCEDURE SetSitePars ( latitude, saModifier, fieldCap, bucketSize: REAL; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GetSWBPars ( valueType: ValueType; VAR k1, k2, k3, k4, k5, k6, kPM, k7, k8, kIcpt, kCw: REAL );
PROCEDURE SetSWBPars ( k1, k2, k3, k4, k5, k6, kPM, k7, k8, kIcpt, kCw: REAL; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE CalcHeatIndex ( VAR(*speed-up*) monTemper: ARRAY OF REAL; VAR heatIndex: REAL );
PROCEDURE CalcHeatIndexT ( VAR(*speed-up*) monTemper: ARRAY OF REAL; VAR heatIndex: REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE CalcPET1 ( VAR(*speed-up*) monTemper: ARRAY OF REAL; heatIndex: REAL; VAR monPET: ARRAY OF REAL );
PROCEDURE CalcPET1T ( VAR(*speed-up*) monTemper: ARRAY OF REAL; heatIndex: REAL; VAR monPET: ARRAY OF REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE CalcMonthlySWB1 ( monthNr: INTEGER; initialSM, initialSWD, monPET, monPrecip: REAL; VAR monAET, newSM, newSWD: REAL );
PROCEDURE CalcMonthlySWB1T( monthNr: INTEGER; initialSM, initialSWD, monPET, monPrecip: REAL; VAR monAET, newSM, newSWD: REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE CalcAnnualSWB1 ( initialSM: REAL; VAR(*speed-up*) monPET, monPrecip: ARRAY OF REAL; VAR annPET, annAET, newSM: REAL );
PROCEDURE CalcAnnualSWB1T ( initialSM: REAL; VAR(*speed-up*) monPET, monPrecip: ARRAY OF REAL; VAR annPET, annAET, newSM: REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE CalcPET2 ( monthNr: INTEGER; heatIndex, monTemper: REAL; VAR monPET: REAL );
PROCEDURE CalcPET2T ( monthNr: INTEGER; heatIndex, monTemper: REAL; VAR monPET: REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE CalcMonthlySWB2 ( initialSM, monPET, monPrecip: REAL;
VAR monAET, monEvapOffVeg, monETFromSoil, monRunoff, newSM: REAL );
PROCEDURE CalcMonthlySWB2T( initialSM, monPET, monPrecip: REAL;
VAR monAET, monEvapOffVeg, monETFromSoil, monRunoff, newSM: REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE CalcAnnualSWB2 ( initialSM: REAL; VAR(*speed-up*) monPET, monPrecip: ARRAY OF REAL;
VAR annPET, annAET, annEvapOffVeg, annETFromSoil, annRunoff, newSM: REAL );
PROCEDURE CalcAnnualSWB2T ( initialSM: REAL; VAR(*speed-up*) monPET, monPrecip: ARRAY OF REAL;
VAR annPET, annAET, annEvapOffVeg, annETFromSoil, annRunoff, newSM: REAL;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
(*=========================== StatAuxFuncs ============================*)
PROCEDURE GammLn( xx: LONGREAL ): LONGREAL;
PROCEDURE BetaI ( a, b, x: LONGREAL ): LONGREAL;
PROCEDURE BetaCF( a, b, x: LONGREAL ): LONGREAL;
PROCEDURE FInv ( f: LONGREAL; df1, df2: INTEGER ): LONGREAL;
(*============================= SunPath ===============================*)
(* Angle transformations *)
PROCEDURE Rad( deg: REAL ): REAL;
PROCEDURE Deg( rad: REAL ): REAL;
(* Time transformations *)
PROCEDURE DayFraction ( hours, minutes, seconds: INTEGER ): REAL;
PROCEDURE DayFractionToTime ( dayFraction: REAL; VAR hours, minutes, seconds: INTEGER );
PROCEDURE FractionOfYear ( dayOfYear: INTEGER; dayfraction: REAL ): REAL;
(* Set location *)
PROCEDURE SetGeogrLocation ( latitude, longitude: REAL );
PROCEDURE GetGeogrLocation ( VAR latitude, longitude: REAL );
(* Set time *)
PROCEDURE SetTimeZone ( hours: REAL );
PROCEDURE GetTimeZone ( VAR hours: REAL );
PROCEDURE SetTimeDelay ( hours: REAL );
PROCEDURE GetTimeDelay ( VAR hours: REAL );
PROCEDURE SetDayOfYear ( dayOfYear: INTEGER);
PROCEDURE GetDayOfYear ( VAR dayOfYear: INTEGER);
PROCEDURE SetJulianDay ( julianDay: INTEGER );
PROCEDURE GetJulianDay ( VAR julianDay: INTEGER );
(* Sun's position *)
CONST delta0 = 0.4092797096; (* declination of the earth *)
PROCEDURE SolarTime ( localTime: REAL ): REAL;
PROCEDURE LocalTime ( solarTime: REAL ): REAL; (* returns the local time *)
PROCEDURE Noon (): REAL; (* in local time *)
PROCEDURE SunHeightMax (): REAL; (* SunHeight(Noon()) *)
PROCEDURE SunHeight ( localTime: REAL ): REAL;
PROCEDURE SunAzimuth ( localTime: REAL ): REAL;
VAR z0: REAL; (* = Rad(90.83); READ ONLY variable *)
PROCEDURE DayLength ( z: REAL ): REAL;
PROCEDURE SunRiseTime( z: REAL ): REAL;
PROCEDURE SunSetTime ( z: REAL ): REAL;
(* Auxiliary *)
PROCEDURE EquationOfTime(): REAL;
PROCEDURE Delta (): REAL;
(*============================= Tallies ===============================*)
TYPE
Tally; TallyAdrAttr = ADDRESS; TallyP = PROCEDURE( Tally );
StatisticsType = ( undefStatistic, n, mean, sd, skw, min, p05, p10, p25, med, p75, p90, p95, max );
VAR undefTally: Tally; undefTallyAdrAttr: Tally; (* read only *)
(* Testing of object access *)
PROCEDURE ActivateTalliesObjChecks;
PROCEDURE DeactivateTalliesObjChecks;
PROCEDURE TalliesObjChecksActivated(): BOOLEAN;
(* Tally declaration and removal *)
PROCEDURE DeclareTally( VAR t: Tally; ident: ARRAY OF CHAR; storeValues: BOOLEAN; maxIndex1, maxIndex2: INTEGER );
PROCEDURE FindTally ( ident: ARRAY OF CHAR ): Tally;
PROCEDURE TallyExists ( t: Tally ): BOOLEAN;
PROCEDURE FirstTally (): Tally;
PROCEDURE NextTally ( t: Tally ): Tally;
PROCEDURE LastTally (): Tally;
PROCEDURE PrevTally ( t: Tally ): Tally;
PROCEDURE RemoveTally ( VAR t: Tally );
PROCEDURE RemoveAllTallies;
(* Tally attributes *)
PROCEDURE TalliedValuesAreStored( t: Tally ): BOOLEAN;
PROCEDURE GetTallyIdent ( t: Tally; VAR ident: ARRAY OF CHAR );
PROCEDURE TallyMaxIndex1 ( t: Tally ): INTEGER;
PROCEDURE TallyMaxIndex2 ( t: Tally ): INTEGER;
PROCEDURE SetTallyProc ( t: Tally; p: TallyP );
PROCEDURE GetTallyProc ( t: Tally; VAR p: TallyP );
PROCEDURE SetTallyAddressAttr ( t: Tally; attr: TallyAdrAttr );
PROCEDURE TallyAddressAttr ( t: Tally ): TallyAdrAttr;
PROCEDURE SetTallyLongIntAttr ( t: Tally; l: LONGINT );
PROCEDURE TallyLongIntAttr ( t: Tally ): LONGINT;
PROCEDURE SetTallyIntAttr ( t: Tally; i: INTEGER );
PROCEDURE TallyIntAttr ( t: Tally ): INTEGER;
(* Values associated with indices *)
PROCEDURE SetAuxVal1 ( i1: INTEGER; val1: REAL );
PROCEDURE AuxVal1 ( i1: INTEGER ): REAL;
PROCEDURE ClearAuxVals1;
PROCEDURE SetAuxVal2 ( i2: INTEGER; val2: REAL );
PROCEDURE AuxVal2 ( i2: INTEGER ): REAL;
PROCEDURE ClearAuxVals2;
(* Tallying of variable values *)
PROCEDURE TallyValue ( t: Tally; i1, i2: INTEGER; r: REAL );
PROCEDURE ForgetTalliedValues( t: Tally );
PROCEDURE ForgetAllTalliedValues;
(* Retrieval of tallied data *)
PROCEDURE NumTalliedValues( t: Tally; i1, i2: INTEGER ): INTEGER;
PROCEDURE GetTalliedValues( t: Tally; i1, i2: INTEGER; VAR vals: ARRAY OF REAL; VAR nVals: INTEGER );
(* Retrieval of statistics *)
PROCEDURE GetIdentOfStatisticsType( stat: StatisticsType; VAR ident: ARRAY OF CHAR );
PROCEDURE StatisticsTypeOfIdent ( ident: ARRAY OF CHAR ): StatisticsType;
PROCEDURE GetStatistic ( t: Tally; i1, i2: INTEGER; st: StatisticsType ): REAL;
PROCEDURE GetHistogram ( t: Tally; i1, i2: INTEGER; minFirstClass, maxLastClass: REAL; numClasses: INTEGER;
VAR histogram: ARRAY OF INTEGER );
(*============================ TallyMonit =============================*)
CONST notDone = Errors. onlyAnInsert;
CONST tallyMonitIntAttrVal=-9999;
TYPE TalliedObject = ADDRESS;
(* Procedures for automated monitoring *)
PROCEDURE InitSimRuns ( outFilesSetId: ARRAY OF CHAR; numRuns, numMonitEventsPerRun: INTEGER; outFNamesPrfx: ARRAY OF CHAR;
VAR monitoredVarsList, skippedVarsList: ARRAY OF CHAR; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DoMonitoring( runNr: INTEGER; simTime: REAL; monitEventNr: INTEGER );
PROCEDURE TermSimRuns ( outFNamesPrfx: ARRAY OF CHAR; matrixDescr: ARRAY OF CHAR );
(* Support of explicit monitoring by client *)
TYPE
TallyingP = PROCEDURE ( Tally, (* tally *)
INTEGER, (* i1 = runNr *)
INTEGER, (* i2 = monitEventNr *)
TalliedObject, (* tallied object attribute *)
LONGINT ); (* tallied object attribute *)
PROCEDURE SetTallyingP ( varId: ARRAY OF CHAR; adrAttr: TalliedObject; liAttr: LONGINT; tp: TallyingP );
PROCEDURE GetTallyingP ( varId: ARRAY OF CHAR; VAR adrAttr: TalliedObject; VAR liAttr: LONGINT; VAR tp: TallyingP );
PROCEDURE GiveUpTallyingP( varId: ARRAY OF CHAR );
TYPE
GridDataMonitP = PROCEDURE ( VAR TextFile, (* outFile *)
GridData, (* gridData *)
INTEGER, (* dataLayerNr *)
LONGINT, (* date *)
LONGINT ); (* time *)
PROCEDURE SetGridDataMonitP ( varId: ARRAY OF CHAR; gdmp: GridDataMonitP );
PROCEDURE GetGridDataMonitP ( varId: ARRAY OF CHAR; VAR gdmp: GridDataMonitP );
PROCEDURE GiveUpGridDataMonitP( varId: ARRAY OF CHAR );
(*============================ TreePopuls =============================*)
CONST CohortMaxMemory = 10;
TYPE
TreePopulAttr = ADDRESS;
CohortMemoryRArr = ARRAY [1..CohortMaxMemory] OF REAL;
CohortPtr = POINTER TO CohortRec;
TreePopulPtr = POINTER TO TreePopulRec;
CohortRec = RECORD
parentPop: TreePopulPtr; params: TSParamsPtr; cohortId, attribute: LONGINT; next: CohortPtr;
(* cohort state *)
age: INTEGER; nrTrees: INTEGER; D: REAL; slowGrowth: INTEGER;
(* cohort growth / state change *)
gALGF, gSMGF, gDDGF, gSNGF, gF, DIncMax, DInc: REAL; relDInc, relBAInc: CohortMemoryRArr;
(* diagnostic variables *)
gH, gFolA, gSBio, gFolW, gTBio, gRBio, gFRBio, biomass: REAL;
(* mortality in cohort *)
totNumDeaths: INTEGER;
END;
TreePopulRec = RECORD
species: TreeSpecies; firstCoh, firstNewCoh: CohortPtr; attribute: TreePopulAttr; next: TreePopulPtr;
(* general state of population *)
nrTrees, biomass, stemWdBiom, twigBiom, foliageBiom, coarseRtBiom, fineRtBiom: REAL;
(* tree establishment for population *)
nWinTemperLim, nLightLim, nBrowsingLim, nDegDaysLim, nTreeEstblFailed: REAL;
(* mean growth factors for population *)
gALGF, gSMGF, gDDGF, gSNGF, gF: REAL;
(* mortality in population *)
totNumDeaths, nAgeRltdDeaths, nSlowGrwthDeaths, nSlowGrwthCond1, nSlowGrwthCond2, nDstrbRltdDeaths: REAL;
END;
VAR
undefCohortPtr: CohortPtr; undefTreePopulPtr: TreePopulPtr; undefTreePopulAttr: TreePopulAttr; (* read only *)
(* Cohorts *)
PROCEDURE AllocCohort ( VAR first: CohortPtr; parentPopul: TreePopulPtr; parameters: TSParamsPtr;
kInitDBH: REAL; nrOfTrees: INTEGER );
PROCEDURE DeallocCohort ( VAR first, cohort: CohortPtr );
PROCEDURE DeallocAllCohorts( VAR tp: TreePopulPtr );
PROCEDURE MergeCohortLists ( VAR tp: TreePopulPtr );
(* Tree populations *)
PROCEDURE AllocTreePopul ( VAR first: TreePopulPtr; species: TreeSpecies );
PROCEDURE FindTreePopul ( VAR first: TreePopulPtr; species: TreeSpecies ): TreePopulPtr;
PROCEDURE DeallocTreePopul ( VAR first: TreePopulPtr; species: TreeSpecies );
PROCEDURE DeallocAllTreePopuls( VAR first: TreePopulPtr );
(*=========================== TreeSpecies =============================*)
CONST notDone = Errors.onlyAnInsert;
CONST kB1 = 137.0; (* "breast height", cm *)
TYPE
TreeSpecies;
TreeSpeciesType = ( undefTSType, deciduous, evergreen );
FoliageCalcType = ( undefFCType, fcFC24, fcFC26 );
WinTemperLimType = ( undefWTLType, wtlFC24, wtlFC29 );
LightLimType = ( undefLLType, llFC24, llFC26 );
DegDaysLimType = ( undefDDLType, ddlFC24, ddlFC29 );
SoilMoistGFType = ( undefSMGFType, smgfFC24, smgfFC26, smgfFC29 );
DegDaysGFType = ( undefDDGFType, ddgfFC24, ddgfFC29 );
NitrogenGFType = ( undefNGFType, ngfFC24, ngfFC29 );
LitterProdType = ( undefLPType, lpFC24, lpFC26 );
TSParamsPtr = POINTER TO TSParamsRec;
TSParamsRec = RECORD
tsType: TreeSpeciesType;
(* 1.1 - Foliage and maximum growth *) folType, kDMax, kHMax, kAMax, kG: REAL;
(* 1.2 - Derived foliage and maximum growth *) kA1, kA2, kB2, kB3, kC1, kC2: REAL;
(* 2 - Tree establishment *) kWiTN, kWiTX, kLy, kBrow, kDDMinE, kDDMaxE: REAL;
(* 3.1 - Growth factor calculation *) kLa, kDrT, kFlTol, kDDMinG, kDDMaxG, kNTol: REAL;
(* 3.2 - Derived growth factor calculation *) kFl, kN1, kN2: REAL;
(* 4.1 - Litter production *) kLQ: REAL;
(* 4.2 - Derived litter production *) kFRT, kTwig, kAFW, kRSR: REAL;
END;
TSParamType = ( undefTSPType,
(* 1.1 - Foliage and maximum growth *) folType, kDMax, kHMax, kAMax, kG,
(* 1.2 - Derived foliage and maximum growth *) kA1, kA2, kB2, kB3, kC1, kC2,
(* 2 - Tree establishment *) kWiTN, kWiTX, kLy, kBrow, kDDMinE, kDDMaxE,
(* 3.1 - Growth factor calculation *) kLa, kDrT, kFlTol, kDDMinG, kDDMaxG, kNTol,
(* 3.2 - Derived growth factor calculation *) kFl, kN1, kN2,
(* 4.1 - Litter production *) kLQ,
(* 4.2 - Derived litter production *) kFRT, kTwig, kAFW, kRSR
);
VAR
undefTreeSpecies: TreeSpecies; (* read only *)
(* Auxiliary *)
PROCEDURE IsValidTSParamId( VAR (*speed-up*) id: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE TSParamTypeOfId ( ts: TreeSpecies; id: ARRAY OF CHAR ): TSParamType;
PROCEDURE ClearTSParamsRec( VAR params: TSParamsRec );
PROCEDURE CheckTSParamsRec( VAR(*speed-up*) callee: ARRAY OF CHAR; checkDrvd: BOOLEAN; VAR(*speed-up*) spIdent: ARRAY OF CHAR;
fcType: FoliageCalcType; wtlType: WinTemperLimType;
llType: LightLimType; ddlType: DegDaysLimType;
smgfType: SoilMoistGFType; ddgfType: DegDaysGFType;
ngfType: NitrogenGFType; lpType: LitterProdType;
VAR(*speed-up*) params: TSParamsRec; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE CheckTSParamsRecForTreeSpecies( VAR(*speed-up*) callee: ARRAY OF CHAR; checkDrvd: BOOLEAN; ts: TreeSpecies;
VAR(*speed-up*) params: TSParamsRec; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE CalcDerivedParams( ts: TreeSpecies; VAR params: TSParamsRec );
(* Declaration and removal of TreeSpecies *)
PROCEDURE DeclTreeSpecies( ident: ARRAY OF CHAR; scientificName, commonEnglishName, commonGermanName: ARRAY OF CHAR;
fcType: FoliageCalcType; wtlType: WinTemperLimType;
llType: LightLimType; ddlType: DegDaysLimType;
smgfType: SoilMoistGFType; ddgfType: DegDaysGFType;
ngfType: NitrogenGFType; lpType: LitterProdType;
params: TSParamsRec; calcDerivedParams: BOOLEAN;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE DeclTreeSpeciesFromDataFrames( fcType: FoliageCalcType; wtlType: WinTemperLimType;
llType: LightLimType; ddlType: DegDaysLimType;
smgfType: SoilMoistGFType; ddgfType: DegDaysGFType;
ngfType: NitrogenGFType; lpType: LitterProdType;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE UndeclTreeSpecies( ts: TreeSpecies );
PROCEDURE UndeclAllTreeSpecies;
(* Retrieval/Looping over TreeSpecies *)
PROCEDURE NumTreeSpecies (): INTEGER;
PROCEDURE FindTreeSpecies ( ident: ARRAY OF CHAR ): TreeSpecies;
PROCEDURE TreeSpeciesExists( ts: TreeSpecies ): BOOLEAN;
PROCEDURE FirstTreeSpecies (): TreeSpecies;
PROCEDURE NextTreeSpecies ( ts: TreeSpecies ): TreeSpecies;
(* Get/set attributes of TreeSpecies *)
PROCEDURE TreeSpeciesUniqueId( ts: TreeSpecies ): LONGINT;
PROCEDURE GetTreeSpeciesIdent( ts: TreeSpecies; VAR ident: ARRAY OF CHAR );
PROCEDURE SetTreeSpeciesIdent( ts: TreeSpecies; ident: ARRAY OF CHAR );
PROCEDURE GetTreeSpeciesNames( ts: TreeSpecies; VAR scientificName, commonEnglishName, commonGermanName: ARRAY OF CHAR );
PROCEDURE SetTreeSpeciesNames( ts: TreeSpecies; scientificName, commonEnglishName, commonGermanName: ARRAY OF CHAR );
PROCEDURE GetTreeSpeciesParameterizations( ts: TreeSpecies;
VAR fcType: FoliageCalcType; VAR wtlType: WinTemperLimType;
VAR llType: LightLimType; VAR ddlType: DegDaysLimType;
VAR smgfType: SoilMoistGFType; VAR ddgfType: DegDaysGFType;
VAR ngfType: NitrogenGFType; VAR lpType: LitterProdType );
PROCEDURE GetTSParamsPtr( ts: TreeSpecies ): TSParamsPtr;
PROCEDURE GetTSParamsRec( ts: TreeSpecies; VAR params: TSParamsRec );
PROCEDURE SetTSParamsRec( ts: TreeSpecies; params: TSParamsRec; calcDerivedParams: BOOLEAN;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE TSParamVal ( pType: TSParamType; VAR(*speed-up*) params: TSParamsRec ): REAL;
PROCEDURE SetTSParamVal ( pType: TSParamType; VAR params: TSParamsRec; value: REAL );
(* Attributes of tree species parameters *)
PROCEDURE GetTSParamAttrs( pType: TSParamType;
fcType: FoliageCalcType; wtlType: WinTemperLimType;
llType: LightLimType; ddlType: DegDaysLimType;
smgfType: SoilMoistGFType; ddgfType: DegDaysGFType;
ngfType: NitrogenGFType; lpType: LitterProdType;
VAR id: ARRAY OF CHAR; VAR used, drvd: BOOLEAN; VAR min, max: REAL );
PROCEDURE GetTSParamAttrsForTreeSpecies( ts: TreeSpecies; pType: TSParamType;
VAR id: ARRAY OF CHAR; VAR used, drvd: BOOLEAN; VAR min, max: REAL );
PROCEDURE GetTSParamId ( ts: TreeSpecies; pType: TSParamType; VAR id: ARRAY OF CHAR );
PROCEDURE TSParamUsed ( ts: TreeSpecies; pType: TSParamType ): BOOLEAN;
PROCEDURE IsDerivedTSParam( ts: TreeSpecies; pType: TSParamType ): BOOLEAN;
PROCEDURE TSParamMin ( ts: TreeSpecies; pType: TSParamType ): REAL;
PROCEDURE TSParamMax ( ts: TreeSpecies; pType: TSParamType ): REAL;
(* Handling of derived parameters *)
PROCEDURE GetAllometricParams24 ( VAR kC1Decid, kC2Decid, kC1Evrgr, kC2Evrgr: REAL );
PROCEDURE GetAllometricParams26 ( VAR kC1Decid, kC2Decid, kC1Evrgr, kC2Evrgr: REAL );
PROCEDURE SetAllometricParams24 ( kC1Decid, kC2Decid, kC1Evrgr, kC2Evrgr: REAL );
PROCEDURE SetAllometricParams26 ( kC1Decid, kC2Decid, kC1Evrgr, kC2Evrgr: REAL );
PROCEDURE GetLitterProductionParams24( VAR kFRTDecid, kFRTEvrgr, kTwig, kAFW, kRSR: REAL );
PROCEDURE GetLitterProductionParams26( VAR kFRTDecid, kFRTEvrgr, kTwig, kAFW: REAL );
PROCEDURE SetLitterProductionParams24( kFRTDecid, kFRTEvrgr, kTwig, kAFW, kRSR: REAL );
PROCEDURE SetLitterProductionParams26( kFRTDecid, kFRTEvrgr, kTwig, kAFW: REAL );
(* Event handling *)
TYPE
TreeSpeciesEventType = ( undefTSEType, tsDeclared, tsParamChanged, tsRemoved );
TreeSpeciesEventHandler = PROCEDURE( TreeSpeciesEventType, TreeSpecies );
PROCEDURE InstallTSEventHandler( h: TreeSpeciesEventHandler );
PROCEDURE RemoveTSEventHandler ( h: TreeSpeciesEventHandler );
(*=========================== TrSpecCalc =============================*)
(* Tree establishment *)
PROCEDURE WinterTemperLim24( uWiT, kWiTN: REAL ): BOOLEAN;
PROCEDURE WinterTemperLim29( uWiT, kWiTN, kWiTX: REAL ): BOOLEAN;
PROCEDURE LightLim24 ( kLy, kLAtt, gLAI: REAL ): BOOLEAN;
PROCEDURE LightLim26 ( kLy, kLAtt, gLAI: REAL ): BOOLEAN;
PROCEDURE BrowsingLim ( kBrow, uBrPr, browsU: REAL ): BOOLEAN;
PROCEDURE DegDaysLim24 ( uDD, kDDMin, kDDMax: REAL ): BOOLEAN;
PROCEDURE DegDaysLim29 ( uDD, kDDMin: REAL ): BOOLEAN;
(* Tree growth *)
PROCEDURE LightGrowthFactorForClim ( cumLA, kLAtt, kLa: REAL ): REAL;
PROCEDURE LightGrowthFactorZelig ( cumLA, kLAtt, kLa: REAL ): REAL;
PROCEDURE LightGrowthFactorDG ( cumLA, kLAtt, kLa: REAL ): REAL;
PROCEDURE SoilMoistureGrowthFactor24( kDrT, uDrStress: REAL ): REAL;
PROCEDURE SoilMoistureGrowthFactor29( kDrT, kFl, kWaTD, uDrStress: REAL ): REAL;
PROCEDURE DegreeDayGrowthFactor24 ( kDDMin, kDDMax, uDD: REAL ): REAL;
PROCEDURE DegreeDayGrowthFactor29 ( kDDMin, kDDSl, uDD: REAL ): REAL;
PROCEDURE SoilNitrogenGrowthFactor ( kN1, kN2, uAvN: REAL ): REAL;
PROCEDURE CalcTreeGrowth ( D, gH, kG, kHMax, kB2, kB3, gALGF, gSMGF, gDDGF, gSNGF: REAL; VAR gF, DIncMax, DInc: REAL );
(* Tree biomass *)
PROCEDURE CalcTreeBiomass24( D, kA1, kA2, kB2, kB3, kC1, kC2: REAL;
VAR gH, gSBio, gFolW, gFolA: REAL );
PROCEDURE CalcTreeBiomass26( specType: TreeSpeciesType;
D, kA1, kA2, kB2, kB3, kC1, kC2, kFRT, kAFW: REAL;
VAR gH, gSBio, gTBio, gRBio, gFRBio, gFolW, gFolA: REAL );
(* Litter production (FC24) *)
TYPE
LitterType24 = ( leafFast, leafMedium, leafSlow, fineRt24, twigs24, wood24 );
LitterRealArr24 = ARRAY [ MIN(LitterType24)..MAX(LitterType24) ] OF REAL;
PROCEDURE GetLitterTypeIdent24 ( l: LitterType24; VAR ident: ARRAY OF CHAR );
PROCEDURE SetLitterRealArr24 ( VAR litter: LitterRealArr24; val: REAL );
PROCEDURE AddLitterRealArr24 ( VAR litter1, litter2: LitterRealArr24 );
PROCEDURE ScalarMultLitterRealArr24 ( scalar: REAL; VAR litter: LitterRealArr24 );
PROCEDURE CalcLivingTreeLitterProduction24( kLQ: INTEGER; specType: TreeSpeciesType; D, gFolW, kFRT, kTwig, kAFW, kRSR: REAL;
VAR litter: LitterRealArr24 );
PROCEDURE CalcDeadTreeLitterProduction24 ( kLQ: INTEGER; D, gFolW, gSBio, kTwig, kAFW, kRSR: REAL;
VAR litter: LitterRealArr24 );
(* Litter production (FC26) *)
TYPE
LitterType26 = ( leaf1, leaf2, leaf3, leaf4, needle1, needle2, fineRt26, twigs26, wood26 );
LitterRealArr26 = ARRAY [ MIN(LitterType26)..MAX(LitterType26) ] OF REAL;
PROCEDURE GetLitterTypeIdent26 ( l: LitterType26; VAR ident: ARRAY OF CHAR );
PROCEDURE SetLitterRealArr26 ( VAR litter: LitterRealArr26; val: REAL );
PROCEDURE AddLitterRealArr26 ( VAR litter1, litter2: LitterRealArr26 );
PROCEDURE ScalarMultLitterRealArr26 ( scalar: REAL; VAR litter: LitterRealArr26 );
PROCEDURE CalcLivingTreeLitterProduction26 ( kLQ: INTEGER; specType: TreeSpeciesType; D, gFolW, kFRT, kTwig, kAFW: REAL;
VAR litter: LitterRealArr26 );
PROCEDURE CalcLivingTreesLitterProduction26( nTrees, kLQ: INTEGER; specType: TreeSpeciesType; D, gFolW, kFRT, kTwig, kAFW: REAL;
VAR litter: LitterRealArr26 );
PROCEDURE CalcDeadTreeLitterProduction26 ( kLQ: INTEGER; gFolW, gSBio, gTBio, gFRBio, gRBio, kAFW: REAL;
VAR litter: LitterRealArr26 );
(*=========================== TrSpecRSampl =============================*)
CONST notDone = Errors.onlyAnInsert;
TYPE
RandomSamplingDistribType = ( undefRSDType, uniform, normal );
RandomSamplingSpreadType = ( undefRSSType, absolute, relative );
PROCEDURE RandomSamplingPossible ( pType: TSParamType ): BOOLEAN;
PROCEDURE SetRandomSamplingForParam ( ts: TreeSpecies; pType: TSParamType;
distribSpecif: RandomSamplingDistribType;
spreadSpecif: RandomSamplingSpreadType; spread: REAL;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE SetRandomSamplingFromDataFrames ( VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetRandomSamplingForParam ( ts: TreeSpecies; pType: TSParamType;
VAR distribSpecif: RandomSamplingDistribType;
VAR spreadSpecif: RandomSamplingSpreadType; VAR spread: REAL );
PROCEDURE ClearRandomSamplingForParam ( ts: TreeSpecies; pType: TSParamType );
PROCEDURE ClearRandomSamplingForSpecies ( ts: TreeSpecies );
PROCEDURE ClearRandomSamplingForAllSpecies;
PROCEDURE SampleTSParamValue ( ts: TreeSpecies; pType: TSParamType ): REAL;
PROCEDURE SampleTSParamsRec ( ts: TreeSpecies; VAR params: TSParamsRec );
(* ============================ E N D ============================== *)
Please note, though freeware, ScienceLib is not offered on the Internet,
and it is only available upon specific request to the authors. It may not
be given to anyone without written consent by the authors. All copyrights
remain with the authors and ETH Zurich.
