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; }