static void MakeQ(int n, int spl, const Matrix_t **endo)
{
int i;
int dim = endo[0]->Nor;
Matrix_t *q = MatAlloc(endo[0]->Field,spl,dim*dim);
char fn[200];
for (i = 0; i < spl; ++i)
{
int j;
Matrix_t *y = MatInverse(Trans[n]), *x;
MatMul(y,endo[i]);
x = MatTransposed(y);
MatFree(y);
for (j = 0; j < dim; ++j)
MatCopyRegion(q,i,j * dim,x,j,0,1,-1);
MatFree(x);
}
sprintf(fn,"%s.q.%d",TkiName,n+1);
MESSAGE(2,("Writing %s\n",fn));
#if 0
if (InfoM.Cf[TKInfo.CfIndex[0][n]].peakword < 0)
MatMulScalar(q,FF_ZERO);
#endif
MatSave(q,fn);
MatFree(q);
}
Matrix_t *QAction(const Matrix_t *subspace, const Matrix_t *gen)
{
int k;
int dim, sdim, qdim;
int *piv, *non_piv;
/* Check arguments.
---------------- */
if (!MatIsValid(subspace) || !MatIsValid(gen)) {
return NULL;
}
if (subspace->Noc != gen->Nor) {
MTX_ERROR1("subspace and gen: %E",MTX_ERR_INCOMPAT);
return NULL;
}
if (gen->Nor != gen->Noc) {
MTX_ERROR1("gen: %E",MTX_ERR_NOTSQUARE);
return NULL;
}
/* Initialize
---------- */
dim = subspace->Noc;
sdim = subspace->Nor;
qdim = dim - sdim;
Matrix_t *action = MatAlloc(subspace->Field,qdim,qdim);
if (action == NULL) {
return NULL;
}
/* Calculate the action on the quotient
------------------------------------ */
FfSetNoc(dim);
PTR tmp = FfAlloc(1);
if (tmp == NULL) {
MatFree(action);
return NULL;
}
piv = subspace->PivotTable;
non_piv = piv + subspace->Nor;
for (k = 0; k < qdim; ++k) {
int l;
PTR qx = MatGetPtr(action,k);
FfCopyRow(tmp,MatGetPtr(gen,non_piv[k]));
FfCleanRow(tmp,subspace->Data,sdim,piv);
for (l = 0; l < qdim; ++l) {
FfInsert(qx,l,FfExtract(tmp,non_piv[l]));
}
}
SysFree(tmp);
return action;
}
static Matrix_t *makekernel(const Poly_t *pol)
{
Matrix_t *materg;
PTR rowptr;
FEL *xbuf, *pbuf = pol->Data;
long pdeg = pol->Degree;
int k, xshift;
long fl = pol->Field;
materg = MatAlloc(fl,pdeg,pdeg);
rowptr = materg->Data;
xbuf = NALLOC(FEL,pdeg+1);
for (k = 0; k <= pdeg; ++k)
xbuf[k] = FF_ZERO;
xbuf[0] = FF_ONE;
for (k = 0; k < pdeg; ++k)
{
int l;
for (l = 0; l < pdeg; ++l)
FfInsert(rowptr,l,xbuf[l]);
FfInsert(rowptr,k,FfSub(xbuf[k],FF_ONE));
FfStepPtr(&rowptr);
for (xshift = (int) fl; xshift > 0; )
{
FEL f;
int d;
/* Find leading pos */
for (l = pdeg-1; xbuf[l] == FF_ZERO && l >= 0; --l);
/* Shift left as much as possible */
if ((d = pdeg - l) > xshift) d = xshift;
for (; l >= 0; l--) xbuf[l+d] = xbuf[l];
for (l = d-1; l >= 0; --l) xbuf[l] = FF_ZERO;
xshift -= d;
if (xbuf[pdeg] == FF_ZERO) continue;
/* Reduce with pol */
f = FfNeg(FfDiv(xbuf[pdeg],pbuf[pdeg]));
for (l = pdeg-1; l >= 0; --l)
xbuf[l] = FfAdd(xbuf[l],FfMul(pbuf[l],f));
xbuf[pdeg] = FF_ZERO;
}
}
SysFree(xbuf);
return MatNullSpace__(materg);
}
static int LoadModules()
{
int i;
/* Set the number of modules.
-------------------------- */
NumMods = App->ArgC;
if (NumMods > MAX_MODULES)
{
MTX_ERROR1("Too many modules (max. %d allowed)",MAX_MODULES);
return -1;
}
/* Read the .cfinfo files and load the generators (if needed).
----------------------------------------------------------- */
for (i = 0; i < NumMods; ++i)
{
int k;
if (Lat_ReadInfo(&ModList[i].Info,App->ArgV[i]) != 0)
return -1;
if (!IsCompatible(i))
return -1;
/* Clear any existing peak words.
------------------------------ */
for (k = 0; k < ModList[i].Info.NCf; ++k)
ModList[i].Info.Cf[k].peakword = -1;
/* Read the generators, set up ss bases and word generators.
--------------------------------------------------------- */
if (!opt_n || opt_k || opt_b)
{
ModList[i].Rep = MrLoad(App->ArgV[i],ModList[i].Info.NGen);
ModList[i].Wg = WgAlloc(ModList[i].Rep);
if (opt_b)
{
int dim = ModList[i].Rep->Gen[0]->Nor;
ModList[i].SsBasis = MatAlloc(FfOrder,dim,dim);
}
}
}
return 0;
}
static int ReadSeed()
{
MtxFile_t *sf;
int skip = 0;
int num_seed;
if ((sf = MfOpen(SeedName)) == NULL)
return -1;
if (sf->Field < 2)
{
MTX_ERROR2("%s: %E",SeedName,MTX_ERR_NOTMATRIX);
return -1;
}
if (Permutations)
{
FfSetField(sf->Field);
FfSetNoc(sf->Noc);
}
if (sf->Noc != FfNoc || sf->Field != FfOrder)
{
MTX_ERROR3("%s and %s: %E",GenName[0],SeedName,MTX_ERR_INCOMPAT);
return -1;
}
if (!TryLinearCombinations && SeedVecNo > 0)
skip = SeedVecNo - 1;
FfSeekRow(sf->File,skip);
if (TryOneVector)
num_seed = 1;
else
num_seed = sf->Nor - skip;
Seed = MatAlloc(FfOrder,num_seed,FfNoc);
if (Seed == NULL)
return -1;
if (MfReadRows(sf,Seed->Data,Seed->Nor) != Seed->Nor)
{
MTX_ERROR("Error reading seed vectors");
return -1;
}
MfClose(sf);
return 0;
}
Matrix_t *MatNullSpace_(Matrix_t *mat, int flags)
{
long dim;
Matrix_t *nsp;
// check arguments
if (!MatIsValid(mat)) {
return NULL;
}
// allocate workspace
nsp = MatAlloc(mat->Field,mat->Nor,mat->Nor);
if (nsp == NULL) {
return NULL;
}
nsp->PivotTable = NREALLOC(nsp->PivotTable,int,mat->Nor);
if (nsp->PivotTable == NULL)
{
MatFree(nsp);
return NULL;
}
// calculate the null-space
FfSetNoc(mat->Noc);
dim = znullsp(mat->Data,mat->Nor,nsp->PivotTable,nsp->Data,flags);
if (dim == -1)
{
MatFree(nsp);
return NULL;
}
if (flags) {
SysFree(nsp->PivotTable);
nsp->PivotTable = NULL;
}
// resize the result buffer to its actual size
nsp->Nor = dim;
nsp->Data = (PTR) SysRealloc(nsp->Data,nsp->RowSize * dim);
return nsp;
}
static void MakePQ(int n, int mj, int nj)
{
MatRep_t *rep_m;
Matrix_t *estar[MAXENDO], *endo[MAXENDO], *e, *ei;
char fn[200];
int dim = InfoM.Cf[mj].dim;
int spl = InfoM.Cf[mj].spl;
int i;
Matrix_t *p;
MESSAGE(1,("Condensing %s%s x ",InfoM.BaseName,Lat_CfName(&InfoM,mj)));
MESSAGE(1,("%s%s, [E:k]=%d\n",InfoN.BaseName,Lat_CfName(&InfoN,nj),spl));
/* Read the generators for the constituent of M and make the
endomorphism ring.
--------------------------------------------------------- */
rep_m = Lat_ReadCfGens(&InfoM,mj,InfoM.Cf[mj].peakword >= 0 ? LAT_RG_STD : 0);
MESSAGE(2,("Calculating endomorphism ring\n"));
MkEndo(rep_m,InfoM.Cf + mj,endo,MAXENDO);
MrFree(rep_m);
/* Calculate the Q matrix
---------------------- */
MESSAGE(2,("Calculating embedding of E\n"));
MakeQ(n,spl,(const Matrix_t **)endo);
/* Calculate the E* matrices
Note: We should use the symmetry under i<-->k here!
--------------------------------------------------- */
MESSAGE(2,("Calculating projection on E\n"));
MESSAGE(2,(" E* matrices\n"));
e = MatAlloc(FfOrder,spl,spl);
for (i = 0; i < spl; ++i)
{
PTR pptr = MatGetPtr(e,i);
int k;
for (k = 0; k < spl; ++k)
{
FEL f;
Matrix_t *x = MatDup(endo[i]);
MatMul(x,endo[k]);
f = MatTrace(x);
FfInsert(pptr,k,f);
MatFree(x);
}
}
ei = MatInverse(e);
MatFree(e);
for (i = 0; i < spl; ++i)
{
int k;
PTR p;
estar[i] = MatAlloc(FfOrder,dim,dim);
p = MatGetPtr(ei,i);
for (k = 0; k < spl; ++k)
MatAddMul(estar[i],endo[k],FfExtract(p,k));
}
MatFree(ei);
/* Transpose the E* matrices. This simplifies the
calculation of tr(z E*) below.
----------------------------------------------- */
MESSAGE(2,(" Transposing E* matrices\n"));
for (i = 0; i < spl; ++i)
{
Matrix_t *x = MatTransposed(estar[i]);
MatFree(estar[i]);
estar[i] = x;
}
/* Calculate the P matrix
---------------------- */
MESSAGE(2,(" P matrix\n"));
p = MatAlloc(FfOrder,dim*dim,spl);
for (i = 0; i < dim; ++i)
{
int j;
for (j = 0; j < dim; ++j)
{
int r;
PTR pptr = MatGetPtr(p,i*dim + j);
Matrix_t *x = MatAlloc(FfOrder,dim,dim);
MatCopyRegion(x,0,i,Trans[n],0,j,dim,1);
for (r = 0; r < spl; ++r)
{
FEL f = MatProd(x,estar[r]);
FfInsert(pptr,r,f);
}
MatFree(x);
}
}
sprintf(fn,"%s.p.%d",TkiName,n+1);
MESSAGE(2,("Writing %s\n",fn));
#if 0
if (InfoM.Cf[mj].peakword < 0)
MatMulScalar(p,FF_ZERO);
#endif
MatSave(p,fn);
/* Clean up
-------- */
MatFree(p);
for (i = 0; i < spl; ++i)
MatFree(endo[i]);
}
/*******************************+++*******************************/
int CalcCV(KrigingModel *KrigMod, real *YHatCV, real *SE)
/*****************************************************************/
/* Purpose: Compute kriging cross-validation predictions and, */
/* optionally, their standard errors. */
/* */
/* Args: KrigMod Input: Kriging model without */
/* decompositions. */
/* Output: Decompositions are garbage. */
/* YHatCV Output: Cross-validation predictions. */
/* SE Output: Standard errors (computed only */
/* if SE != NULL). */
/* */
/* Returns: OK or an error number. */
/* */
/* Comment: Calling routine must allocate space for YHatCV */
/* and SE. */
/* Better matrix updating for doing this? */
/* KrigMod decompositions are changed. */
/* Standard errors include contribution from epsilon */
/* in predicted observation. */
/* 1995.02.21: SigmaSq not recomputed. */
/* 1996.04.12: Temporary output showing progress. */
/* */
/* Version: 1996.04.12 */
/*****************************************************************/
{
int ErrNum;
Matrix C, FTilde;
Matrix *Chol, *F, *Q, *R;
real c, s, t;
real *Col, *Beta, *f, *r, *RBeta, *ResTilde, *Y, *YTilde;
size_t i, ii, j, k, m, n;
Y = KrigY(KrigMod);
F = KrigF(KrigMod);
Chol = KrigChol(KrigMod);
Q = KrigQ(KrigMod);
R = KrigR(KrigMod);
/* Use workspace in KrigMod. */
f = KrigMod->fRow;
r = KrigMod->r;
RBeta = KrigMod->RBeta;
Beta = KrigMod->Beta;
ResTilde = KrigMod->ResTilde;
n = MatNumRows(F);
k = MatNumCols(F);
if (n == 0)
return OK;
else if (n == 1)
{
YHatCV[0] = NA_REAL;
if (SE != NULL)
SE[0] = NA_REAL;
return OK;
}
MatAlloc(n, n, UP_TRIANG, &C);
MatAlloc(n, k, RECT, &FTilde);
YTilde = AllocReal(n, NULL);
MatPutNumRows(Q, n - 1);
/* Put correlation matrix in C. */
KrigCorMat(0, NULL, KrigMod);
MatCopy(Chol, &C);
/* Overwrite correlation matrix with Cholesky decomposition. */
if (TriCholesky(Chol, 0, Chol) != OK)
{
Error("Ill-conditioned Cholesky factor.\n");
ErrNum = NUMERIC_ERR;
}
else
ErrNum = OK;
/* Compute FTilde and YTilde for all n rows. */
if (ErrNum == OK)
ErrNum = KrigSolve(Chol, F, Y, &FTilde, YTilde);
/* Delete case i and predict Y[i]. */
for (i = n - 1, ii = 0; ii < n && ErrNum == OK; ii++, i--)
{
OutputTemp("Cross validating variable: %s Run: %d",
yName, i + 1);
/* Permute adjacent columns of Chol until */
/* column i is moved to the last column. */
for (j = i; j < n - 1; j++)
{
TriPerm(j, j + 1, Chol, &c, &s);
/* Apply the same rotation to YTilde and FTilde. */
t = c * YTilde[j] + s * YTilde[j+1];
YTilde[j+1] = -s * YTilde[j] + c * YTilde[j+1];
YTilde[j] = t;
for (m = 0; m < k; m++)
{
Col = MatCol(&FTilde, m);
t = c * Col[j] + s * Col[j+1];
Col[j+1] = -s * Col[j] + c * Col[j+1];
Col[j] = t;
}
}
/* Correlations between case i and the other cases. */
/* Note that cases after i are now in reverse order. */
for (j = 0; j < i; j++)
r[j] = MatElem(&C, j, i);
for (j = 0; j < n - 1 - i; j++)
r[i+j] = MatElem(&C, i, n - 1 - j);
/* Linear model terms for case i. */
MatRow(F, i, f);
/* Pretend we have only n - 1 cases. */
MatPutNumRows(Chol, n - 1);
MatPutNumCols(Chol, n - 1);
MatPutNumRows(&FTilde, n - 1);
/* Gram-Schmidt QR orthogonalization of FTilde. */
if (QRLS(&FTilde, YTilde, Q, R, RBeta, ResTilde) != OK)
{
Error("Cannot perform QR decomposition.\n");
ErrNum = NUMERIC_ERR;
}
else
{
/* Leave-one-out beta's can be obtained as follows. */
/*
if (TriBackSolve(R, RBeta, Beta) != OK)
Error("Cannot compute regression beta's.\n");
else
{
for (j = 0; j < k; j++)
Output(" %e", Beta[j]);
Output("\n");
}
*/
if (SE != NULL)
{
/* Standard error required. */
/* KrigMod->SigmaSq is not updated. */
/* RAve = 1.0 for epsilon contribution. */
ErrNum = KrigYHatSE(KrigMod, 1.0, f, r,
&YHatCV[i], &SE[i]);
}
else
/* No standard error. */
ErrNum = KrigYHatSE(KrigMod, 1.0, f, r,
&YHatCV[i], NULL);
}
/* Restore sizes of Chol and FTilde. */
MatPutNumRows(Chol, n);
MatPutNumCols(Chol, n);
MatPutNumRows(&FTilde, n);
}
OutputTemp("");
if (ErrNum != OK)
for (i = 0; i < n; i++)
YHatCV[i] = SE[i] = NA_REAL;
MatPutNumRows(Q, n);
MatFree(&C);
MatFree(&FTilde);
AllocFree(YTilde);
return ErrNum;
}
int main(int argc,char *argv[])
{
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
//VARIABLE DEFINITION
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
float cp,S,sigma,gamma,pp,Topt;
float q,Ab,Aw,Agf,grad_T,fi,mm,nn,Pmax,EVPmax;
float Ec,Es,deltat,t_integracion,t_modelacion;
float Lini,Lfin,deltaL;
int niter,niterL,nzc;
Vector zc_vector;
int zczc,ii;
float Ac,L,zc;
float aclouds,awhite,ablack,Ts,d;
float t,xx,As;
float k1,k2,k3,k4;
int j;
float Tc,Tlb,Tlw,Tanual,I,a,EVP,E;
float P;
float k1c,k2c,k3c,k4c;
float k1w,k2w,k3w,k4w;
float k1b,k2b,k3b,k4b;
float Bw,Bb;
int it;
Vector time,temperature,white_temperature,
black_temperature,white_area,black_area,clouds_area,evap,prec;
Matrix resultados;
FILE *fl;
char fname[1000];
float k1p1,k1p2,k1p3,k1p4,k1p5;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
//PARAMETERS
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
cp = 3.e13; //erg*cm-2*K-1
S = 2.89e13; //erg*cm-2*año-1
sigma = 1789.; //erg*cm-2*año-1*K-4
gamma = 0.3; //año-1
pp = 1.; //adimensional
Topt = 295.5; //K
q = 20.; //K
Ab = 0.25; //adimensinal
Aw = 0.75; //adimensinal
Agf = 0.50; //adimensinal
grad_T = (-0.0065); //K*m-1, Trenberth 95, p.10
fi = 0.1;
mm = 0.35;
nn = 0.1;
Pmax = pow((1./mm),(1/nn)); //=36251 [mm/año], cuando ac=1.0
EVPmax = Pmax;
//EVPmax = 1511.; //[mm/año] corresponde a Ts=26 grados centígrados
//Pmax = EVPmax; //[mm/año]
//ac_crit = mm*Pmax^nn;
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
//experimento otro: cambiando estos parámetros
Ec=1.; //emisividad de las nubes
Es=1.; //emisividad de la superficie
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
deltat = 0.01; //[años] tamaño de paso temporal para dTsdt y dadt
t_integracion = 1; //[año] cada cuanto se guardan valores de las variables
t_modelacion = 10000; //[años] período de modelación por cada L
niter = t_integracion/deltat; //# de iteraciones en los RK4
/*
Lini = 1.992;
Lfin = 4.004;
deltaL = 0.004;
*/
Lini = 1.000;
Lfin = 1.000;
deltaL = 0.004;
niterL = (Lfin-Lini)/deltaL;
////zc_vector = [1000.,2000.,3000.,4000.,5000.,6000.,7000.,8000.]
zc_vector=VecAlloc(1);
VecSet(zc_vector,0,6000.);
nzc=1;
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
//LOOP IN HEIGHTS
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
FILE *ft=fopen("hdw-legacy.dat","w");
for(zczc=0;zczc<=nzc-1;zczc++){
zc=VecGet(zc_vector,zczc);
//Ac=1.-fi*(zc/1000.);
Ac=0.6;
resultados=MatAlloc(niterL+1,19);
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
//LOOP IN SOLAR FORCING
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
for(ii=0;ii<=niterL;ii++){
L = deltaL*ii+Lini;
printf("%d de %d, L = %.4lf\n",ii,niterL,L);
//valores iniciales
aclouds = 0.01 ;//adimensional, 0 para reproducir modelo original, 0.01 para iniciar con area de nubes
awhite = 0.01 ;//adimensional
ablack = 0.01 ;//adimensional
Ts=295.5 ;//temperatura en la superficie, valor inicial para rk4
d = t_modelacion ;//numero de años en el eje de las abscisas - iteraciones de t - dimension de los vectores de resultados
//printf("Tam:%d\n",(int)(d+1)/2);
time=VecAlloc((d+1)/2);
temperature=VecAlloc((d+1)/2);
white_temperature=VecAlloc((d+1)/2);
black_temperature=VecAlloc((d+1)/2);
white_area=VecAlloc((d+1)/2);
black_area=VecAlloc((d+1)/2);
clouds_area=VecAlloc((d+1)/2);
evap=VecAlloc((d+1)/2);
prec=VecAlloc((d+1)/2);
it=0;
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
//LOOP IN MODELLING TIME
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
for(t=0;t<=t_modelacion;t+=t_integracion){
//if(it>5000){
if(it>-1){
fprintf(ft,"%e %e %e %e %e\n",
t,Ts,aclouds,awhite,ablack);
}
xx = pp - awhite - ablack;
As = xx*Agf + ablack*Ab + awhite*Aw;
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
//TIME INTEGRATION
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
for(j=1;j<=niter;j++){
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
//TEMPERATURE
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
k1=(1/cp)*(S*L*((1-Ac)*aclouds+(1-aclouds))*(1-As)+sigma*Ec*aclouds*gsl_pow_int((Ts+grad_T*zc),4)-sigma*Es*gsl_pow_int(Ts,4));
k2=(1/cp)*(S*L*((1-Ac)*aclouds+(1-aclouds))*(1-As)+sigma*Ec*aclouds*gsl_pow_int(((Ts+k1/2)+grad_T*zc),4)-sigma*Es*gsl_pow_int((Ts+k1/2),4));
k3=(1/cp)*(S*L*((1-Ac)*aclouds+(1-aclouds))*(1-As)+sigma*Ec*aclouds*gsl_pow_int(((Ts+k2/2)+grad_T*zc),4)-sigma*Es*gsl_pow_int((Ts+k2/2),4));
k4=(1/cp)*(S*L*((1-Ac)*aclouds+(1-aclouds))*(1-As)+sigma*Ec*aclouds*gsl_pow_int(((Ts+k3)+grad_T*zc),4)-sigma*Es*gsl_pow_int((Ts+k3),4));
Ts = Ts+deltat*(k1/6+k2/3+k3/3+k4/6);
//CLOUD TEMPERATURE
Tc=Ts+zc*grad_T;
Tlb=q*(As-Ab)+Ts;
Tlw=q*(As-Aw)+Ts;
//EVAPORATION
if(Ts>277){
Tanual = Ts - 273. ;//(°C)
I = 12.*pow((Tanual/5.),1.5);
a = (6.7e-7)*gsl_pow_int(I,3) - (7.7e-5)*PowInt(I,2) + (1.8e-2)*I + 0.49;
EVP = 12.*16*pow((10.*(Ts - 273.)/I),a);
E = Min(1.,EVP/EVPmax);
}else{
E = 0.;
}
//PRECIPITATION
P = (1./Pmax)*pow((aclouds/mm),(1./nn));
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
//CLOUD COVERING
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
k1c=(1-aclouds)*E-aclouds*P;
k2c=(1-(aclouds+k1c/2))*E-(aclouds+k1c/2)*P;
k3c=(1-(aclouds+k2c/2))*E-(aclouds+k2c/2)*P;
k4c=(1-(aclouds+k3c))*E-(aclouds+k3c)*P;
aclouds=aclouds+deltat*(k1c/6+k2c/3+k3c/3+k4c/6);
//REPRODUCTIVE FITNESS
//WHITE DAISIES
if((Tlw>278)&&(Tlw<313))
Bw=1-0.003265*PowInt((Topt-Tlw),2);
else Bw=0;
//BLACK DAISIES
if((Tlb>278)&&(Tlb<313))
Bb=1-0.003265*PowInt((Topt-Tlb),2);
else Bb=0;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
//WHITE AREA
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
k1w=awhite*(xx*Bw-gamma);
k2w=(awhite+k1w/2)*(xx*Bw-gamma);
k3w=(awhite+k2w/2)*(xx*Bw-gamma);
k4w=(awhite+k3w)*(xx*Bw-gamma);
awhite=awhite+deltat*(k1w/6+k2w/3+k3w/3+k4w/6);
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
//BLACK AREA
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
k1b=ablack*(xx*Bb-gamma);
k2b=(ablack+k1b/2)*(xx*Bb-gamma);
k3b=(ablack+k2b/2)*(xx*Bb-gamma);
k4b=(ablack+k3b)*(xx*Bb-gamma);
ablack=ablack+deltat*(k1b/6+k2b/3+k3b/3+k4b/6);
xx = pp - awhite - ablack;
As = xx*Agf + ablack*Ab + awhite*Aw;
}//end for time integration
if(it>5000){
VecSet(time,it-5001,t);
VecSet(temperature,it-5001,Ts-273);
VecSet(white_temperature,it-5001,Tlw-273);
VecSet(black_temperature,it-5001,Tlb-273);
VecSet(white_area,it-5001,awhite);
VecSet(black_area,it-5001,ablack);
VecSet(clouds_area,it-5001,aclouds);
VecSet(evap,it-5001,E*(1-aclouds));
VecSet(prec,it-5001,P*aclouds);
}
it++;
}//end for modelling time t
if(VERBOSE){
fprintf(stdout,"Valor %s = %.6e\n",VARS[0],L);
fprintf(stdout,"Valor %s = %.6e\n",VARS[1],VecMin(temperature)) ;//Ts
fprintf(stdout,"Valor %s = %.6e\n",VARS[2],VecMean(temperature)) ;//Ts
fprintf(stdout,"Valor %s = %.6e\n",VARS[3],VecMax(temperature)) ;//Ts
fprintf(stdout,"Valor %s = %.6e\n",VARS[4],VecMin(white_area)) ;//aw
fprintf(stdout,"Valor %s = %.6e\n",VARS[5],VecMean(white_area)) ;//aw
fprintf(stdout,"Valor %s = %.6e\n",VARS[6],VecMax(white_area)) ;//aw
fprintf(stdout,"Valor %s = %.6e\n",VARS[7],VecMin(black_area)) ;//ab
fprintf(stdout,"Valor %s = %.6e\n",VARS[8],VecMean(black_area)) ;//ab
fprintf(stdout,"Valor %s = %.6e\n",VARS[9],VecMax(black_area)) ;//ab
fprintf(stdout,"Valor %s = %.6e\n",VARS[10],VecMin(clouds_area)) ;//ac
fprintf(stdout,"Valor %s = %.6e\n",VARS[11],VecMean(clouds_area)) ;//ac
fprintf(stdout,"Valor %s = %.6e\n",VARS[12],VecMax(clouds_area)) ;//ac
fprintf(stdout,"Valor %s = %.6e\n",VARS[13],VecMin(evap)) ;//E
fprintf(stdout,"Valor %s = %.6e\n",VARS[14],VecMean(evap)) ;//E
fprintf(stdout,"Valor %s = %.6e\n",VARS[15],VecMax(evap)) ;//E
fprintf(stdout,"Valor %s = %.6e\n",VARS[16],VecMin(prec)) ;//P
fprintf(stdout,"Valor %s = %.6e\n",VARS[17],VecMean(prec)) ;//P
fprintf(stdout,"Valor %s = %.6e\n",VARS[18],VecMax(prec)) ;//P
}
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
//RESULTADOS
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
MatSet(resultados,ii,0,L);
MatSet(resultados,ii,1,VecMin(temperature)) ;//Ts
MatSet(resultados,ii,2,VecMean(temperature)) ;//Ts
MatSet(resultados,ii,3,VecMax(temperature)) ;//Ts
MatSet(resultados,ii,4,VecMin(white_area)) ;//aw
MatSet(resultados,ii,5,VecMean(white_area)) ;//aw
MatSet(resultados,ii,6,VecMax(white_area)) ;//aw
MatSet(resultados,ii,7,VecMin(black_area)) ;//ab
MatSet(resultados,ii,8,VecMean(black_area)) ;//ab
MatSet(resultados,ii,9,VecMax(black_area)) ;//ab
MatSet(resultados,ii,10,VecMin(clouds_area)) ;//ac
MatSet(resultados,ii,11,VecMean(clouds_area)) ;//ac
MatSet(resultados,ii,12,VecMax(clouds_area)) ;//ac
MatSet(resultados,ii,13,VecMin(evap)) ;//E
MatSet(resultados,ii,14,VecMean(evap)) ;//E
MatSet(resultados,ii,15,VecMax(evap)) ;//E
MatSet(resultados,ii,16,VecMin(prec)) ;//P
MatSet(resultados,ii,17,VecMean(prec)) ;//P
MatSet(resultados,ii,18,VecMax(prec)) ;//P
VecFree(time);
VecFree(temperature);
VecFree(white_temperature);
VecFree(black_temperature);
VecFree(white_area);
VecFree(black_area);
VecFree(clouds_area);
VecFree(evap);
VecFree(prec);
}//end for ii
sprintf(fname,"DAWHYC2_EXP2_L0416_%.2f_%d_activa.txt",Ac,(int)zc/1000);
fl=fopen(fname,"w");
fprintf(fl,"zc= %.0lf\n",zc);
fprintf(fl,"Ac= %.2lf\n",Ac);
for(j=0;j<NVARS;j++)
fprintf(fl,"%10s ",VARS[j]);
MatrixFprintf(fl,resultados,"%10.4f ");
fclose(fl);
MatFree(resultados);
}//end for heights
fclose(ft);
}//end program
MTX_DEFINE_FILE_INFO
/// @addtogroup spinup
/// @{
////////////////////////////////////////////////////////////////////////////////////////////////////
/// Projection on quotient.
/// This function calculates the projection of a matrix onto the quotient by a
/// subspace. The first matrix, @a subspace must be in echelon form, while the
/// second argument can be any matrix. Of course both matrices must be over the
/// same field and have the same number of columns. The return value is a
/// pointer to a matrix containing the projections the @a vectors. This matrix
/// is not in echelon form and may even contain null rows.
///
/// The projection depends on the basis for the subspace and is calculated as
/// follows. Let V=F<sup>n×n</sup> and (w<sub>1</sub>,...w<sub>s</sub>) be a basis
/// for the subspace W≤V. The basis, written as a matrix of row vectors,
/// is assumed to be in semi-echelon form. By looking at the pivot columns we
/// can construct the vectors w<sub>s+1</sub>,...w<sub>n</sub> by taking all vectors which
/// have a exactly one 1 at any non-pivot position and are zero otherwise.
/// Then, (w<sub>1</sub>,...,w<sub>s</sub>,w<sub>s+1</sub>,...,w<sub>n</sub>)
/// is a basis for V in semi-echelon form and defines the decomposition of any
/// vector into subspace and quotient part.
///
/// @param subspace The invariant subspace.
/// @param vectors The vectors to project.
/// @return Projection of @a vectors on the quotient by @a subspace, or NULL on error.
Matrix_t *QProjection(const Matrix_t *subspace, const Matrix_t *vectors)
{
int i, sdim, qdim;
int *non_piv;
Matrix_t *result;
PTR tmp;
// Check the arguments
if (!MatIsValid(subspace) || !MatIsValid(vectors)) {
return NULL;
}
if ((subspace->Field != vectors->Field) || (subspace->Noc != vectors->Noc)) {
MTX_ERROR1("%E",MTX_ERR_INCOMPAT);
return NULL;
}
if (subspace->PivotTable == NULL) {
MTX_ERROR1("%E",MTX_ERR_NOTECH);
return NULL;
}
// Initialize
sdim = subspace->Nor;
qdim = subspace->Noc - sdim;
result = MatAlloc(subspace->Field,vectors->Nor,qdim);
if (result == NULL) {
return NULL;
}
// Calculate the projection
FfSetNoc(subspace->Noc);
tmp = FfAlloc(1);
if (tmp == NULL) {
MatFree(result);
return NULL;
}
non_piv = subspace->PivotTable + subspace->Nor;
for (i = 0; i < vectors->Nor; ++i) {
int k;
PTR q = MatGetPtr(result,i);
MTX_FAIL_IF_NOT(q != NULL);
FfCopyRow(tmp,MatGetPtr(vectors,i));
FfCleanRow(tmp,subspace->Data,sdim,subspace->PivotTable);
for (k = 0; k < qdim; ++k) {
FfInsert(q,k,FfExtract(tmp,non_piv[k]));
}
}
SysFree(tmp);
return result;
}
