/* routines dealing with input, pass sol initialized as NULL returns shps, the number of expansions. should be 3 for velocities and tractions, and 1 for density anomalies $Id: hc_input.c,v 1.8 2004/12/20 05:18:12 becker Exp $ */ int hc_read_sh_solution(struct hcs *hc, struct sh_lms **sol, FILE *in, hc_boolean binary, hc_boolean verbose) { int nset,ilayer,shps,lmax,type,ivec,nsol,i,os,n; HC_PREC zlabel,unity[3]={1.,1.,1.}; /* read all layes as spherical harmonics assuming real Dahlen & Tromp (physical) normalization */ n = os = 0; while(sh_read_parameters_from_stream(&type,&lmax,&shps,&ilayer, &nset,&zlabel,&ivec,in, FALSE,binary,verbose)){ hc->sh_type = type; if(ilayer != n){ fprintf(stderr,"hc_read_sh_solution: error: ilayer %i n %i\n", ilayer,n); exit(-1); } if(n == 0){ /* initialize */ /* solution expansions */ nsol = shps * nset; *sol = (struct sh_lms *)realloc(*sol,nsol * sizeof(struct sh_lms)); if(!(*sol)) HC_MEMERROR("hc_read_sh_solution: sol"); hc->sh_type = type; for(i=0;i < nsol;i++) /* init expansions on irregular grid */ sh_init_expansion((*sol+i),lmax,hc->sh_type,1,verbose,FALSE); hc->nrad = nset - 2; hc->nradp2 = hc->nrad + 2; hc_vecrealloc(&hc->r,nset,"hc_read_sh_solution"); } /* assign depth */ hc->r[ilayer] = HC_ND_RADIUS(zlabel); /* read coefficients */ sh_read_coefficients_from_stream((*sol+os),shps,-1,in, binary,unity,verbose); if(verbose){ if(shps == 3) fprintf(stderr,"hc_read_sh_solution: z: %8.3f |r|: %12.5e |pol|: %12.5e |tor|: %12.5e\n", (double)HC_Z_DEPTH(hc->r[ilayer]), (double)sqrt(sh_total_power((*sol+os))), (double)sqrt(sh_total_power((*sol+os+1))), (double)sqrt(sh_total_power((*sol+os+2)))); else fprintf(stderr,"hc_read_sh_solution: z: %8.3f |scalar|: %12.5e\n", (double)HC_Z_DEPTH(hc->r[ilayer]), (double)sqrt(sh_total_power((*sol+os)))); } n++; os += shps; } if(n != nset) HC_ERROR("hc_read_sh_solution","read error"); if(verbose){ fprintf(stderr,"hc_read_sh_solution: read %i solution layer\n",nset); if(shps != 3) fprintf(stderr,"hc_read_sh_solution: WARNING: only scalar field read\n"); } return shps; }
// // // these subroutines deal with the toroidal part of the // kinematic solution of a Hager & // O'Connell flow code. they are based on Brad's original code, and later // Bernhard Steinberger's modifications // // will incorporate the poloidal part of the plate velocities // // // Thorsten Becker, [email protected] // // $Id: hc_torsol.c,v 1.8 2006/01/22 01:11:34 becker Exp becker $ // // **************************************************************** // * THIS IS THE MAIN PROGRAM FOR THE COMPONENT OF FLOW WITHOUT * // * DENSITY CONTRASTS. IT USES SEVERAL INPUT/OUTPUT SUBROUTINES * // * AND FUNCTIONS TO OBTAIN, CORRECT AND VERIFY A MODEL FROM THE * // * USER. THE FINAL VERSION OF EACH MODEL IS STORED IN A FILE * // * BEFORE THE PROGRAM EXECUTES POLSOL AND TORSOL TO OBTAIN THE * // * POLOIDAL AND TOROIDAL COMPONENTS, RESPECTIVELY, OF THE * // * EQUATIONS OF MOTION. * // **************************************************************** // Modified such that only toroidal component is calculated // Poloidal component is included in densub.f // // input: r: radii on which output is defined (nrad+2) // // visc,rvisc: normalized viscosities and their radii (nvis) // // lmax: MAXIMUM DEGREES, // nrad: NUMBER OF OUTPUT RADII // (without top and bottom layers) // nvis: NUMBER OF VISCOSITIES. // // pvel_tor: toroidal part of the plate velocities // pkernel: print the two solution vectors to file // // input/output: // // tvec[nradp2 * lmaxp1 * 2 ]: solution kernel // // output: // // tor_sol[nradp2 * 2] SHOULD BE PASSED INITIALIZED AS ZEROES // // // // void hc_torsol(struct hcs *hc, int nrad,int nvis,int lmax,HC_PREC *r, HC_PREC **rv,HC_PREC **visc, struct sh_lms *pvel_tor, struct sh_lms *tor_sol,HC_HIGH_PREC *tvec, hc_boolean verbose) { // // **************************************************************** // * evaluates AND PROPAGATES THE TWO TOROIDAL COMPONENTS IN THE * // * EQUATIONS OF MOTION, AND NORMALIZES THESE SUCH THAT THE * // * FIRST ELEMENT AT THE SURFACE IS 1.0. * // **************************************************************** // HC_HIGH_PREC coef,*vecnor,hold,rlast,rnext,tloc[2],*tvec1,*tvec2; HC_HIGH_PREC exp_fac[2],p[2][2],diflog,el,elp2,elm1,efdiff; int l,jvisp1,jvis,i,j,nvisp1,lmaxp1,os; hc_boolean qvis; // // PASSED PARAMETERS: NRADP2: NUMBER OF OUTPUT RADII, // NVIS: NUMBER OF VISCOSITIES, nvisp1 = nvis+1 // LMAX: MAXIMUM DEGREES. // ARRAYS: R: OUTPUT RADII, // RV: VISCOSITY RADII, // TVEC: TOROIDAL VECTORS, // VISC: normalized VISCOSITIES. // OTHER VAR: EXP_FAC[0],EXP_FAC[1]: EXPONENTIAL FACTORS IN PROPAGATOR, // COEF,ELP2,ELM1: PARAMETERS IN PROPAGATOR, // DIFLOG: DIFFERENCE IN LOGS OF RADII, // EL,L: DEGREE, // VECNOR: NORMALIZES TVEC_LOC TO TVEC(N,1), // HOLD: TEMPORARY VAR., // P[0][0],P[0][1],P[1][0],P[1][1]: ELEMENTS OF THE PROPAGATOR MATRIX CORRES- // PONDING TO P(1,1),P(1,2),P(2,1),P(2,2) RESPECTIVELY, // RLAST,RNEXT: RADII FOR PROPAGATOR, // TVEC_LOC1,TVEC_LOC2: VECTOR COMPONENTS. // /* set up some pointers (without those the TVECSOL macro won't work!) */ nvisp1 = nvis + 1; /* length of rv and visc */ //nradp2 = nrad + 2; /* radius array */ lmaxp1 = lmax+1; /* length of 0:lmax array */ /* add one item at end of rv and visc arrays */ hc_dvecrealloc(rv,nvisp1,"hc_torsol: rv"); hc_dvecrealloc(visc,nvisp1,"hc_torsol: visc"); /* local reference to viscosity and radii of viscosity */ #define HC_TVISC(i) (*(*visc+(i))) #define HC_TVR(i) (*(*rv+(i))) HC_TVR(nvis) = 1.1; /* last entry in radius array, why is this 1.1? probably because it has to be > 1 */ HC_TVISC(nvis) = HC_TVISC(nvis-1); /* last entry in viscosity array */ #ifdef DEBUG if(hc->nradp2 != nrad + 2){ fprintf(stderr,"hc_torsol: radius number mismatch\n"); exit(-1); } /* test size of expansions */ j = hc->nradp2 * 2; for(i=0;i < j;i++){ if(tor_sol[i].lmax < pvel_tor->lmax){ fprintf(stderr,"hc_torsol: error: toroidal expansion %i has lmax %i, plates have %i\n", i+1,tor_sol[i].lmax, pvel_tor->lmax); exit(-1); } if(tor_sol[i].type != pvel_tor->type) HC_ERROR("hc_torsol","torsol type error"); } #endif if(verbose) fprintf(stderr,"hc_torsol: toroidal velocities lmax %i and type %i\n", pvel_tor->lmax,pvel_tor->type); /* make room for toroidal scaling vectors f(l) and initialize as zeroes */ /* solution factors as f(l,r) */ /* set local pointes */ tvec1 = tvec; tvec2 = (tvec + hc->nradp2 * lmaxp1); // // (PREVENTS THE REQUESTING OF NON-EXISTANT VALUES) // // FOR EACH DEGREE (L) CALCULATE, NORMALIZE AND OUTPUT SOLUTION // for(l=1;l < lmaxp1;l++){ /* loop through all l > 0 */ el = (HC_PREC)l; // // SET THE PARAMETERS // elp2 = el + 2.0; elm1 = el - 1.0; coef = 1.0 / (2.0 * el + 1.0); // // INITIALIZE THE PROPAGATION AT THE CORE // jvisp1 = 1; /* viscosity layer counters */ jvis = 0; rlast = r[0]; /* radius of core */ /* initialize */ tloc[0] = 1.0; /* there seems to be no best ordering for addressing this array, later we need l to be the fastest increasing index */ tloc[1] = 0.0; // // FIND THE TWO TOROIDAL COMPONENTS AT EACH RADIUS // start radius loop // /* lowest level */ os = l; tvec1[os] = tloc[0]; tvec2[os] = tloc[1]; for(i=1;i < hc->nradp2;i++){ /* loop through radii */ os += lmaxp1; // // TEST FOR CHANGE IN VISCOSITY IN NEXT LAYER // qvis = FALSE; do{ if(HC_TVR(jvisp1) > r[i]) qvis = TRUE; rnext = HC_TVR(jvisp1); /* */ // // IF NO VISC. CHANGE BEFORE NEXT OUTPUT RADIUS, PROPAGATE DIRECTLY // if(qvis) rnext = r[i]; diflog = log(rnext / rlast); exp_fac[0] = exp( el * diflog); exp_fac[1] = exp(-(el + 1.0) * diflog); // // PROPAGATOR SET UP LINEARLY TO AVOID EXCESS MULTIPLICATIONS // efdiff = exp_fac[0] - exp_fac[1]; p[0][0] = elp2 * exp_fac[0] + elm1 * exp_fac[1]; p[0][1] = efdiff / HC_TVISC(jvis); p[1][0] = elp2 * elm1 * HC_TVISC(jvis) * efdiff; p[1][1] = elm1 * exp_fac[0] + elp2 * exp_fac[1]; // // PROPAGATE LAST VECTOR TO GET NEW VECTOR // rlast = rnext; hold = tloc[0]; tloc[0] = (p[0][0] * hold + p[0][1] * tloc[1]); tloc[1] = (p[1][0] * hold + p[1][1] * tloc[1]); tloc[0] *= coef; tloc[1] *= coef; if(!qvis){ jvis = jvisp1; jvisp1++; } }while(!qvis); tvec1[os] = tloc[0]; tvec2[os] = tloc[1]; } /* end layer loop */ } /* end l loop */ // // set tvec(l,nradp2-1,0) = 1.0 and normalize all vectors to // this // hc_hvecalloc(&vecnor,lmaxp1,"hc_torsol: vecnor"); os = (hc->nradp2-1) * lmaxp1; vecnor[0] = 1.0; for(l=1;l < lmaxp1;l++) vecnor[l] = 1.0 / tvec1[os+l]; /* normalize */ for(i=os=0;i < hc->nradp2;i++,os+=lmaxp1) for(l=0;l < lmaxp1;l++){ tvec1[os+l] *= vecnor[l]; tvec2[os+l] *= vecnor[l]; } free(vecnor); /* the toroidal solution corresponds to the toroidal part of the plate motions scaled by the toroidal solution vectors which are functions of l and depth */ for(os=i=j=0;i < hc->nradp2;i++,os+=lmaxp1,j+=2){ /* assign toroidal plate motion fields to solution expansion */ sh_aexp_equals_bexp_coeff((tor_sol+j+0),pvel_tor); sh_aexp_equals_bexp_coeff((tor_sol+j+1),pvel_tor); /* scale with the toroidal solution at this depth */ sh_scale_expansion_l_factor((tor_sol+j+0),(tvec1+os)); sh_scale_expansion_l_factor((tor_sol+j+1),(tvec2+os)); } if(verbose) fprintf(stderr,"hc_torsol: done\n"); }
/* compute the solution for the poloidal part of a Hager & O'Connell flow computation. the poloidal part has two contributions: density driven flow and plate motions this routine computes the y_i i=1,...,6 solutions for each layer and incorporates the poloidal part of the plate motions, which are passed as pvel_pol */ void hc_polsol(struct hcs *hc, /* general Hager & O'Connell solution structure, holds constants and such */ /* general output radii */ int nrad, /* number of output radii */ HC_PREC *rad, /* output radii, normalized by R */ /* density contribution */ int inho, /* number of density layers */ HC_PREC *dfact, /* density factors from layer thickness */ hc_boolean viscosity_or_layer_changed, /* if TRUE, will (re)compute the arrays that depend on the spacing of the density anomalies or the viscosity structure */ struct sh_lms *dens_anom, /* expansions of density anomalies has to be [inho] */ hc_boolean compressible, /* if TRUE, will use PREM densities, else, average mantle density */ int npb, /* number of phase boundaries */ HC_PREC *rpb, /* radius and F factor for phase boundaries */ HC_PREC *fpb, hc_boolean free_slip, /* include plate velocities? possible, if free_slip is FALSE */ struct sh_lms *pvel_pol, /* poloidal part of plate motions (only one expansion), only gets accessed if free_slip is false */ struct sh_lms *pol_sol, /* poloidal solution expansions [nout * 6] nout <= nrad SHOULD BE PASSED INITIALIZED AS ZEROES */ hc_boolean compute_geoid, /* additionally compute the geoid? */ struct sh_lms *geoid, /* geoid solution */ hc_boolean save_prop_mats, /* memory intensive speedup by saving all propagator matrices. this makes sense if the density anomalies changes between call, but nothing else */ hc_boolean verbose, /* output options */ hc_boolean calc_kernel_only /* only compute the kernels */ ) { // **************************************************************** // * THIS PROGRAM IS TO USED CALCULATE AND OUTPUT THE POLOIDAL * // * COMPONENTS OF THE FLOW WITH PLATE MOTIONS * // * AND DENSITY CONTRASTS. THIS PROGRAM REQUIRES THREE * // * INPUT FILES CONTAINING: (1) THE MODEL, (2) THE EXPANDED * // * DENSITY CONTRASTS, AND (3) DENSITY FACTORS (*DR) AND THEIR * // * RADII. GENERALLY TO BE USED AFTER PROGRAM NODENC, BUT CAN BE* // * USED BEFORE IT. * // * USES U(A) = P(A,C)*U(C)+SUM OVER I OF (P(A,R(I))*B(I)*DR(I)) * // * PROBLEM IS SEPARATED INTO TWO PARTS: U(1) THROUGH U(4), THE * // * VELOCITIES AND STRESSES, HAVE BEEN SEPARATED FROM THE * // * POTENTIAL AND DERIVATIVE USING U(3)NEW = U(3)OLD + RHO * U(5)* // * WHERE RHO IS THE AVERAGE DENSITY OF THE MANTLE. THE U(3) * // * IN OUTPUT IS U(3)NEW. RHO * U(5) MUST BE SUBTRACTED. * // **************************************************************** // This substraction is not being done in this program. This is, // because vertical stresses are used to calculate stresses // in the lithosphere, but in this case, not the actual elevation // but the elevation above the equipotential surface, therefore // u(3)new and not u(3)old matters. For the surface jump in gravity // however, u(3)old matters, this is incorporated below. // See e.g. Panasyuk and Hager (1996) // // // this routine has been modified from the orginial version, for which // you find the comments above. not all comments reflect these // changes, so beware. original code by B Hager, then modified by // RJO and Bernhard Steinberger // // // Thorsten Becker [email protected] // // // $Id: hc_polsol.c,v 1.12 2006/03/20 05:32:48 becker Exp becker $ // // // ARRAYS: // B: SPH. HARM. EXPANSION OF DENSITY CONTRASTS FOR EACH // INHOMOGENEOUS LAYER AND READ IN AT EACH NEW IND1 AND IND2, // pvel_pol: POLOIDAL PART OF PLATE VELOCITIES, // D: FROM SUBROUTINE GETDEN FOR USE IN U(A) = P(A,C)*U(C)+D, // DEN: THE FACTOR FACT*RDEN*RDEN*ALPHA WHICH IS MULTIPLIED // BY B, THE PRODUCT BEING ADDED TO U(3) AT EACH RADIUS DURING // PROPAGATION WITHIN THE M LOOP, (AT RADII WITH NO DENSITY // CONTRASTS, DEN IS SET TO ZERO), U3(R+)=U3(R-)+DEN*B, // DPOT: FROM GETDEN FOR POTEN(A) = PPOT(A,C)*POTEN(C)+DPOT // WHERE POTEN(A) = [GA,-(L+1)*GA]T, POTEN//= [GC,L*GC]T, // FACT: DENSITY FACTORS (ALLOW VAR. DENS. CONTRAST WITH DEPTH), // THESE ALSO INCLUDE DR, THE RATIO OF RADII MIDPOINTS // BETWEEN RDEN RADII, // PROP: PROPAGATOR, // POTDEN: PRODUCED BY PROPIH FOR USE IN GETDEN (POTENTIALS), // POTEN,POTNEW: THE POTENTIAL AND ITS DERIVATIVE, // PPOT: A POTENTIALS PROPAGATOR (FROM EVPPOT), // PPOTS: THE ARRAY OF ALL POTENTIALS PROPAGATORS TO OBTAIN // POTEN AT EACH DESIRED RADIUS FOR ALL M AT A GIVEN L, // PROPS: THE ARRAY OF ALL PROPAGATORS NECESSARY TO OBTAIN THE // U VECTOR AT EACH DESIRED RADIUS FOR ALL M AT A GIVEN L, // PRPDEN: FACTORS FROM SUBROUTINE PROPIH FOR SUBROUTINE GETDEN, // PVISC: THE VISCOSITY FOR EACH LAYER USED IN EVALUATING PROPS, // QWRITE: A LOGICAL ARRAY USED TO DECIDE WHETHER A GIVEN U // VECTOR IS ONE REQUIRED FOR OUTPUT, (AT AN OUTPUT RADIUS), // RAD: DESIRED OUTPUT RADII, // RDEN: RADII OF INHOMOGENEOUS DENSITY CONTRASTS, // RVISC: RADII OF VISCOSITIES, // U,UNEW: POLOIDAL COMPONENTS OF FLOW, // VISC_LOCAL: VISCOSITIES. // OTHER VAR: // DOUBLE PRECISION: // ALPHA: RE*GACC*180*SECYR*TIMESC*1/(VISNOR*PI) // CONVERSION FACTORS AS USED IN PROPIH, // BETA: -4*PI*G*RE/GACC, CONV. FACTORS AS USED IN PROPIH, // EL: DEGREE (L), // ELIM: PARAMETER USED IN SIMPLE ELIMINATION, // G: UNIVERSAL GRAVITY CONSTANT (SI), // GC: NON-EQUILIBRIUM GRAV. POTENTIAL AT CORE, // GACC: GRAVITATIONAL ACCELERATION AT SURFACE (SI), // RE: RADIUS OF THE EARTH = R_DEF*1e3 (SI), // RNEXT: NEXT RADIUS IN PROPAGATION, // SC: STRESS AT CORE, // SECYR: SECONDS PER YEAR, // TIMESC: TIMESCALE OF MOTION USUALLY 1 M.Y., // VC: VELOCITY AT CORE, // VISNOR: NORMALIZING VISCOSITY, // INTEGER: // INDEX: DETERMINES THE ARRAY INDICES FOR DEN,PVISC,QWRITE // AND RPROPS DURING ORDERING AND INITIALIZATION, // // INHO: NUMBER OF INHOMOGENEOUS RADII, // // IVIS: PRESENT VISCOSITY OR DENSITY LAYER, // L: DEGREE // M: ORDER // NEWPRP: DETERMINES INDEX OF PROPEQ IN STORING PROPAGATORS, // NIH: PRESENT INHOMOGENEOUS LAYER IN EVALUATING DEN, // NINHO: PRESENT INHOMOGENEOUS LAYER IN EVALUATING U, // NPROPS: THE TOTAL NUMBER OF PROPAGATORS TO GET U, // NRADP2: NUMBER OF OUTPUT RADII, // NVIS: NUMBER OF VISCOSITIES, // LOGICAL: // QINHO: DETERMINES IF NEXT RADIUS IS A DENSITY CONTRAST, // QVIS: DETERMINES IF NEXT RADIUS IS A VISCOSITY CHANGE, // integer: // a_or_b: ALLOWS CALCULATION OF S(LM) AFTER CALCULATION OF // C(LM) EXCEPT AT M=0.(a_or_b == 0: A, a_or_b == 1: B) // // SUBROUTINES AND FUNCTIONS: // SUBROUTINE EVPPOT (L,RATIO,PPOT): OBTAINS PROPAGATOR FOR // NON-EQUILIBRIUM POTENTIAL AND DERIVATIVE (RATIO IS R(I)/ // R(I+1), FOR PROPAGATION FROM R(I) TO R(I+1) AT L), int i,i2,i3,i6,j,l,m,nih,nxtv,ivis,os,pos1,pos2,gi,g1,g2,gic, prop_s1,prop_s2,nvisp1,nzero,n6,ninho,nl=0,ip1; int newprp,newpot,jpb,inho2,ibv,indx[3],a_or_b,ilayer,lmax, nprops_max,jsol,mmax; int klayer = 1; double *xprem; HC_HIGH_PREC *b,du1,du2,el,rnext,drho,dadd; HC_PREC rbound_kludge; HC_HIGH_PREC amat[3][3],bvec[3],u[4],poten[2], unew[4],potnew[2],clm[2]; /* structures which hold u[6][4] type arrays */ struct hc_sm cmb, *u3; hc_boolean qvis,qinho,hit,kludge_warned; /* define a few offset and size pointers */ #ifdef HC_DEBUG if(hc->nradp2 != nrad + 2){ fprintf(stderr,"hc_polsol: radius number mismatch\n"); exit(-1); } #endif inho2 = inho + 2; nvisp1 = hc->nvis+1; lmax = pol_sol[0].lmax ; /* max number of propagator levels, choose this generously */ nprops_max = hc->nradp2 * 3; /* for prop and ppot: one set of propagators for all layers, there lmax of those */ prop_s1 = nprops_max * 16; prop_s2 = nprops_max * 4; /* check if still same general number of layers */ if((hc->psp.prop_params_init)&&((inho2 != hc->inho2)|| (nvisp1 != hc->nvisp1))){ HC_ERROR("hc_polsol","layer structure changed from last call"); } /* allocate space for local arrays */ /* inho + 2 */ u3 = (struct hc_sm *)calloc(inho2,sizeof(struct hc_sm)); if(!u3) HC_MEMERROR("hc_polsol: u3"); hc_vecalloc(&b,inho2,"hc_polsol"); if(save_prop_mats){ /* propagators saved */ if(!hc->psp.prop_mats_init){ /* we will be saving all propagator matrices. this makes sense if the density structure is the only thing that changes this needs quite a bit more room (array goes from l=1 (not l=0) .... lmax) */ hc_hvecalloc(&hc->props,prop_s1 * lmax,"hc_polsol"); hc_hvecalloc(&hc->ppots,prop_s2 * lmax,"hc_polsol"); } }else{ /* propagator recomputed and reallocated each time */ hc_hvecalloc(&hc->props,prop_s1,"hc_polsol"); hc_hvecalloc(&hc->ppots,prop_s2,"hc_polsol"); } if(!hc->psp.abg_init){ // // SET alpha, beta and geoid factors // hc->psp.alpha = hc->psp.rho_scale * (hc->re*10.) * hc->gacc / hc->visnor; /* */ hc->psp.alpha *= ONEEIGHTYOVERPI * hc->secyr * hc->timesc; /* */ // hc->psp.beta = -4.0 * HC_PI * (hc->g*1e3) * (hc->re*1e2) / hc->gacc; if(verbose) fprintf(stderr,"hc_polsol: alpha: %.8f beta: %.8f\n", (double)hc->psp.alpha,(double)hc->psp.beta); /* geoid scaling factor hc->gacc shoud be grav[nprops] for compressibility */ hc->psp.geoid_factor = HC_PI * 10.0* hc->visnor/180./hc->secyr/hc->gacc/1.e8; hc->psp.abg_init = TRUE; } if((!hc->psp.prop_params_init) || (viscosity_or_layer_changed)){ /* intialize arrays that depend on viscosity and density layer spacing */ // // CREATE DEN,PVISC,QWRITE,RPROPS AS FOLLOWS: // 1) INITIALIZE PVISC=VISC(IVIS), DEN=ZERO, QWRITE=FALSE // 2) FIND WHICH RADIUS (RAD,RDEN,RVISC) IS NEXT IN SEQUENCE // TO SURFACE, NOTING THAT ANY TWO OR ALL THREE MAY BE EQUAL // 3) INCREMENT INDEX AND STORE RNEXT IN RPROPS // 4) IF AT RVISC(IVIS) INCREMENT IVIS // 5) IF AT RDEN(NIH) EVALUATE DEN, INCREMENT NIH // 6) IF AT RAD(I) QWRITE = TRUE, INCREMENT I // if(!hc->psp.prop_params_init){ if(verbose) fprintf(stderr,"hc_polsol: initializing for %i v layers and %i dens layers\n", nrad,inho); /* this is really the first call, allocate arrays arrays that go with nprops */ hc_hvecalloc(&hc->rprops,nprops_max,"hc_polsol: rprop"); hc_hvecalloc(&hc->pvisc,nprops_max,"hc_polsol"); hc_hvecalloc(&hc->den,nprops_max,"hc_polsol"); /* initialize qwrite with zeroes! */ hc->qwrite = (hc_boolean *)calloc(nprops_max,sizeof(hc_boolean)); if(!hc->qwrite) HC_MEMERROR("hc_polsol: qwrite"); /* those that go with (inho=nrad)+2 */ hc_vecrealloc(&hc->rden,inho2,"hc_polsol"); /* and those for nvis+1 */ hc_vecrealloc(&hc->rvisc,nvisp1,"hc_polsol"); hc_vecrealloc(&hc->visc,nvisp1,"hc_polsol"); /* save in case we want to check if parameters changed later */ hc->inho2 = inho2;hc->nvisp1=nvisp1; } // // SET RDEN(INHO+1) = 1.1 TO PREVENT TESTING OF THAT VALUE // hc->rden[inho] = 1.1; // // APPEND A FINAL RVISC_LOCAL = 1.0 TO PREVENT OUT OF BOUNDS // hc->rvisc[hc->nvis] = 1.0; // // INITIALIZE INDEX,IVIS,NIH // hc->nprops = ivis = nih = 0; hc->rprops[0] = rad[0]; hit = FALSE; for(i=1;(i < hc->nradp2)&&(!hit);i++){ // // INITIALIZE // do{ qinho = TRUE; /* is next radius a density contrast? */ qvis = TRUE; // new check, when two radii happen to be the same, exit the // loop if((hc->nprops > 0) && (fabs(hc->rprops[hc->nprops] - hc->rprops[hc->nprops-1]) <HC_EPS_PREC)){ hit = TRUE; /* bailout here */ }else{ /* normal operation */ hc->pvisc[hc->nprops] = hc->visc[ivis]; hc->den[hc->nprops] = 0.0; hc->qwrite[hc->nprops] = FALSE; // // FIND NEXT RADIUS // nxtv = ivis + 1; if((hc->rden[nih] <= rad[i])&& (hc->rden[nih] <= hc->rvisc[nxtv])) qinho = FALSE; if ((hc->rvisc[nxtv] <= hc->rden[nih])&& (hc->rvisc[nxtv] <= rad[i]) && (ivis < hc->nvis)) qvis = FALSE; rnext = hc->rden[nih]; if (!qvis) rnext = hc->rvisc[nxtv]; if(qinho && qvis) rnext = rad[i]; // // INCREMENT NPROPS, STORE RPROPS // hc->nprops++; if(hc->nprops > nprops_max){ /* check, if we have enough room */ fprintf(stderr,"hc_polsol: error: nprops: %i nprops_max: %i\n", hc->nprops,nprops_max); exit(-1); } hc->rprops[hc->nprops] = rnext; // // IF RVISC, INCREMENT IVIS // if (!qvis) ivis = nxtv; if (!qinho) { // // IF RDEN, EVALUATE DEN, INCREMENT NIH // hc->den[hc->nprops-1] = dfact[nih] * hc->rden[nih] * hc->rden[nih] * hc->psp.alpha; nih++; } } // // IF NOT RAD, DO NOT INCREMENT I // }while((!hit) && (fabs(rnext-rad[i])>HC_EPS_PREC)); if(!hit){ // // IF RAD, QWRITE = TRUE // hc->qwrite[hc->nprops-1] = TRUE; } } /* end of nrad loop */ hc->den[hc->nprops] = 0.0; hc->pvisc[hc->nprops] = hc->pvisc[hc->nprops-1]; /* to look nicer */ /* number of propagators is now nprops+1 */ if(verbose >= 3){ if(hc->psp.prop_params_init) fprintf(stderr,"hc_polsol: using old parameters: %i v layers and %i dens layers\n", nrad,inho); for(i=i2=0;i < hc->nprops+1;i++){ if(fabs(hc->den[i]) > HC_EPS_PREC) i2++; fprintf(stderr,"hc_polsol: prop: i: %3i(%3i) r: %8.5f v: %8.3f den: %12g ninho: %3i/%3i\n", i+1,hc->nprops,(double)hc->rprops[i], (double)hc->pvisc[i],(double)hc->den[i],i2,inho); } } if(!hc->psp.rho_init){ /* initialize the density factors, for incompressible, those are all constant, else from PREM */ hc_vecalloc(&hc->rho,nprops_max+2,"hc_polsol: rho"); /* this way, rho_zero can go from -1...nnprops_max */ hc->rho_zero = (hc->rho+1); if(compressible){ /* for compressible computation, assign densities from PREM, but only use the first 10 layers (below crust and ocean, I think) densities are in kg/m^3 */ if(!hc->prem_init) HC_ERROR("hc_polsol","PREM wasn't initialized for compressible"); hc_dvecalloc(&xprem,hc->prem->np,"hc_polsol: rho"); for(i=0;i < hc->nprops+1;i++){ ilayer = prem_find_layer_x((double)hc->rprops[i],1.0, hc->prem->r, 10,hc->prem->np, xprem); hc->rho_zero[i] = prem_compute_pval(xprem, (hc->prem->crho+ilayer*hc->prem->np), hc->prem->np,1.0); } free(xprem); }else{ /* for the incompressible computation, use average values of density for the mantle densities in kg/m^3 */ hc->rho_zero[-1] = hc->avg_den_core; for(i=0;i < hc->nprops+1;i++) hc->rho_zero[i] = hc->avg_den_mantle; } hc->rho_zero[hc->nprops+1] = 0.0; hc->psp.rho_init = TRUE; } /* end rho init */ hc->psp.prop_params_init = TRUE; /* end of the propagator factor section, this will only get executed once unless the density factors or viscosities change */ } hc->rprops[hc->nprops+1] = 1.0; if(verbose >= 3) for(i=0;i < hc->nprops+2;i++) fprintf(stderr,"i: %3i nprops: %3i r(i): %11g rho: %11g\n", i,hc->nprops,(double)hc->rprops[i],(double)hc->rho_zero[i]); // // begin l loop // if(verbose) fprintf(stderr,"hc_polsol: ncalled: %5i for lmax: %i dens lmax: %i, visc or layer %s changed\n", hc->psp.ncalled,pol_sol[0].lmax,dens_anom->lmax, ((viscosity_or_layer_changed)?(""):("not"))); if(free_slip) /* select which components of pol solvec to use */ nzero = 3; else nzero = 1; pos1 = pos2 = 0; /* offset pointers for propagators, non-zero only if the propagators are stored */ for(l = 1;l <= pol_sol[0].lmax;l++){ /* MAIN L LOOP, start at l = 1 (only anomalies) */ el = (HC_PREC)l; /* this will normally be a very small number so that all propagators will be computed above the regular CMB if solver_kludge_l is set to within the [0;L] domain, the depth of the bottom will depend on l (rprops(i).ge.(1.-(1.-0.5448)*50./l)) */ rbound_kludge = (1. - (1.-hc->r_cmb)*(HC_PREC)hc->psp.solver_kludge_l/el); kludge_warned = FALSE; if((!save_prop_mats) || (!hc->psp.prop_mats_init)|| (viscosity_or_layer_changed)){ // // get all propagators now, as they only depend on l // for(newprp = pos1, newpot = pos2, i = 0;i < hc->nprops;i++, newprp += 16, newpot += 4){ /* obtain and save propagators */ hc_evalpa(l,hc->rprops[i],hc->rprops[i+1], hc->pvisc[i],(hc->props+newprp)); hc_evppot(l,(hc->rprops[i]/hc->rprops[i+1]), (hc->ppots+newpot)); } /* i checked the propagator matrices again, those are as in Bernhard's code TWB */ } /* begin m loop */ mmax = (calc_kernel_only)?(0):(l); for(m=0;m <= mmax;m++){ /* START M LOOP */ // // CALCULATE C(LM) FOR ALL M, S(LM) FOR M>0 // a_or_b = 0; /* start with A coefficient */ do{ /* do loop for A/B evaluation */ if((!calc_kernel_only) && (l <= dens_anom[0].lmax)){ /* obtain the coefficients from the density field expansions */ for(i=0;i < inho;i++)/* A or B coeff, use the internal convention here, as stored before */ sh_get_coeff((dens_anom+i),l,m,a_or_b,FALSE,(b+i)); //hc_print_vector(b,inho,stderr); }else{ /* density is not expanded to that high an l */ for(i=0;i < inho;i++) b[i] = 0.0; } b[inho] = 0.0; if(calc_kernel_only) b[klayer] = 1.0; // // U(C) = [0,VC,SC,0], U(A) = [0,0,SA,SX] // POT(A) = [U5(A),-(L+1)*U5(A)]T, POT(C) = [U5(C),L*U5(C)]T // Find three linear independent solutions of homogeneous eqns and // one solution of inhomogeneous eqn., all satisfying boundary // conditions at core by integrating from core up to the surface. // Find linear combination that satisfies surface boundary conditions. // for(i6=0;i6 < 6;i6++) /* initialize cmb with zeroes */ for(ibv=0;ibv < 4;ibv++) cmb.u[i6][ibv] = 0.0; if(l > hc->psp.solver_kludge_l){ /* solver trick to ensure stabilty following Steinberger & Torsvik, doi:10.1029/2011GC003808 ucmb(4,1)=1.d0 */ cmb.u[3][1] = 1.0; /* make core fixed */ }else{ /* regular operation */ /* ucmb(2,1)=1.d0 */ cmb.u[1][1] = 1.0; /* set this to zero for no-slip, in general CMB is free slip */ } cmb.u[2][2] = 1.0; /* ucmb(3,2)=1.d0 */ cmb.u[4][3] = 1.0; /* ucmb(5,3)=1.d0 */ cmb.u[5][3] = el; /* ucmb(6,3)=float(l) */ for(ibv=0;ibv < 4;ibv++){ /* IBV LOOP */ for(i=0;i < 4;i++) u[i] = cmb.u[i][ibv]; poten[0] = cmb.u[4][ibv]; poten[1] = cmb.u[5][ibv]; // // Propagate gravity across CMB. Inside the core, surfaces of // constant pressure coincide with surfaces of constant potential. // /* if we were allowing for compressibility, would multi with hc->grav[i]/hc->grav here (beta incorporates 1/grav0) */ poten[1] += hc->psp.beta * hc->rprops[0] * (u[2] - (hc->rho_zero[0] - hc->rho_zero[-1]) * poten[0]); ilayer = 0; u3[ilayer].u[0][ibv] = u[0]; /* flow/stress */ u3[ilayer].u[1][ibv] = u[1]; u3[ilayer].u[2][ibv] = u[2]; u3[ilayer].u[3][ibv] = u[3]; u3[ilayer].u[4][ibv] = poten[0]; /* potential solution */ u3[ilayer].u[5][ibv] = poten[1]; ninho = jpb = 0; for(i=0,ip1=1;i < hc->nprops;i++,ip1++){ /* I NPROPS LOOP */ if(hc->rprops[ip1] >= rbound_kludge){ // // PROPAGATE U TO NEXT RADIUS IN RPROPS // for(os=pos1 + i*16,i2=0;i2 < 4;i2++,os += 4){ unew[i2] = 0.0; for(i3=0;i3 < 4;i3++){ unew[i2] += hc->props[os + i3] * u[i3]; } } hc_a_equals_b_vector(u,unew,4); // // PROPAGATE POTEN TO NEXT RADIUS // os = pos2 + i * 4; potnew[0] = poten[0] * hc->ppots[os+0] + poten[1] * hc->ppots[os+1]; poten[1] = poten[0] * hc->ppots[os+2] + poten[1] * hc->ppots[os+3]; poten[0] = potnew[0]; if(ibv == 0){ // // ADD DEN * B, WHERE DEN = 0 FOR NO DENSITY CONTRAST // dadd = hc->den[i] * b[ninho]; u[2] += dadd; /* this would have a factor grav(i)/hc->grav */ // // ADD DEN * BETA * B * RDEN // // fprintf(stderr,"%15.5e %15.5e %15.5e %15.5e\n", // beta, hc->den[i], b[ninho],hc->rden[ninho]); poten[1] += hc->psp.beta * dadd * hc->rden[ninho]; } // // Changes due to radial density variations // drho = hc->rho_zero[i] - hc->rho_zero[ip1]; du1 = u[0] * drho/hc->rho_zero[ip1]; du2 = du1 * (hc->pvisc[i]+hc->pvisc[ip1]); u[0] += du1; u[2] -= 2.0 * du2 + drho * poten[0]; u[3] += du2; //hc_print_vector(poten,2,stderr); //hc_print_vector(u,4,stderr); // // effects of phase boundary deflections // if ((jpb < npb)&&(hc->rprops[ip1] > rpb[jpb] - 0.0001)){ if (ibv == 0) { u[2] -= fpb[jpb] * b[ninho]; poten[1] -= hc->psp.beta * rpb[jpb] * fpb[jpb] * b[ninho] * hc->psp.rho_scale; } jpb++; } /* end of l-dependent solver kludge branch */ }else{ if((verbose)&&(!kludge_warned)){ fprintf(stderr,"hc_polsol: applying CMB fixed kludge above %i and shifting CMB to %g km depth for l %i\n", hc->psp.solver_kludge_l, (double)HC_Z_DEPTH(rbound_kludge),l); kludge_warned = TRUE; } } // // IF AT A DENSITY CONTRAST, INCREMENT NINHO FOR NEXT ONE if(fabs(hc->den[i]) > HC_EPS_PREC) ninho++; // // IF AT OUTPUT RADIUS, assign u, poten // if(hc->qwrite[i]){ ilayer++; //fprintf(stderr,"%4i %4i %13.6e %13.6e %13.6e %13.6e %13.6e %13.6e\n", //l,m,u[0],u[1],u[2],u[3],poten[0],poten[1]); u3[ilayer].u[0][ibv] = u[0]; u3[ilayer].u[1][ibv] = u[1]; u3[ilayer].u[2][ibv] = u[2]; u3[ilayer].u[3][ibv] = u[3]; u3[ilayer].u[4][ibv] = poten[0]; u3[ilayer].u[5][ibv] = poten[1]; } } /* end i,ip1 < nrprops loop */ // Propagate gravity across surface. Above surface, normal stress // is zero, which determines the surface elevation. Jump in gravity // is proportional to total surface elevation (not minus equipotential // surface) // poten[1] -= hc->psp.beta * hc->rprops[hc->nprops] * (u[2] - hc->rho_zero[hc->nprops] * poten[0]); nl = ilayer; u3[nl].u[5][ibv] = poten[1]; //fprintf(stderr,"%3i u %12.4e %12.4e %12.4e %12.4e p %12.4e %12.4e\n", //ilayer, u[0],u[1],u[2],u[3],poten[0],poten[1]); // end ibv loop } nl = ilayer+1; // // Here plate motions are incorporated // Distinguish between free-slip (nzero=4) and no-slip with // optional plate motions (nzero=2) // // // AP_l,m = cpol(l+1,m+1), AT_l,m = ctor(l+1,m+1) // and // BP_l,m = cpol(m,l+1), BT_l,m = ctor(m,l+1) // // u_2 = y_2 solution part // /* get one coefficient from the poloidal plate motion part */ if(!free_slip) sh_get_coeff(pvel_pol,l,m,a_or_b,FALSE,clm); /* use internal convention */ else clm[0] = 0.0; /* B vector */ bvec[0]= u3[ilayer].u[ 0][0]; bvec[1]= u3[ilayer].u[nzero][0] - clm[0]; bvec[2]=(el+1.0)*u3[ilayer].u[ 4][0] + u3[ilayer].u[5][0]; /* A matrix */ for(i=0,i2=1;i < 3;i++,i2++){ amat[0][i] = u3[ilayer].u[ 0][i2]; amat[1][i] = u3[ilayer].u[nzero][i2]; amat[2][i] = (el + 1.0) * u3[ilayer].u[4][i2] + u3[ilayer].u[5][i2]; } /* solve A x = b, where b will be modified */ if(l == 1){ jsol = 2; /* 2x2 solution */ }else{ jsol = 3; /* 3x3 solution */ } hc_ludcmp_3x3(amat,jsol,indx); hc_lubksb_3x3(amat,jsol,indx,bvec); /* assign solution */ for(os=ilayer=0;ilayer < nl;ilayer++,os+=6){ for(i6=0;i6 < 6;i6++){ /* sum up contributions from vector solution */ for(i2=1,j=0;j < jsol;j++,i2++){ u3[ilayer].u[i6][0] -= bvec[j]*u3[ilayer].u[i6][i2]; } //fprintf(stderr,"%i %i %i %i %g\n",l,m,ilayer,i6, u3[ilayer].u[i6][0]); /* adding vector components to spherical harmonic solution */ /* A or B coefficients */ sh_write_coeff((pol_sol+os+i6),l,m,a_or_b,FALSE, /* use internal convention */ &u3[ilayer].u[i6][0]); } } /* end layer loop */ /* chemical layering (e.g. phase boundaries) go here */ if((!a_or_b) && (m != 0)) // IF S(LM) IS REQUIRED, GO BACK AND CALCULATE IT a_or_b = 1; else a_or_b = 0; }while(a_or_b); } /* end m loop */ if(save_prop_mats){ /* we want save the propagator matrices */ pos1 += prop_s1; pos2 += prop_s2; } } /* end l loop */ if(save_prop_mats) /* only now can we set the propagator matrix storage scheme to TRUE */ hc->psp.prop_mats_init = TRUE; if(verbose) fprintf(stderr,"hc_polsol: assigned nl: %i nprop: %i nrad: %i layers\n", nl,hc->nprops,nrad); if(nl != hc->nradp2){ HC_ERROR("hc_polsol","nl not equal to nrad+2 at end of solution loop"); } if(compute_geoid){ // // Calculating geoid coefficients. The factor gf comes from // * u(5) is in units of r0 * pi/180 / Ma (about 111 km/Ma) // * normalizing density is presumably 1 g/cm**3 = 1000 kg / m**3 // * geoid is in units of meters // if(verbose > 1) fprintf(stderr,"hc_polsol: evaluating geoid%s\n", (compute_geoid == 1)?(" at surface"):(", all layers")); /* select geoid solution */ n6 = 4; //n6 = -iformat-1; /* first coefficients are zero */ clm[0] = clm[1] = 0.0; switch(compute_geoid){ case 1: g1 = hc->nrad+1;g2=hc->nradp2; /* only surface */ break; case 2: g1 = 0;g2=hc->nradp2; /* all layers */ break; default: fprintf(stderr,"hc_polsol: error, geoid = %i undefined\n",compute_geoid); exit(-1); } for(gic=0,gi=g1;gi < g2;gi++,gic++){ /* depth loop */ /* first coefficients */ sh_write_coeff((geoid+gic),0,0,0,FALSE,clm); /* 0,0 */ sh_write_coeff((geoid+gic),1,0,0,FALSE,clm); /* 1,0 */ sh_write_coeff((geoid+gic),1,1,2,FALSE,clm); /* 1,1 */ os = gi * 6 + n6; /* select component */ for(l=2;l <= pol_sol[0].lmax;l++){ mmax = (calc_kernel_only)?(0):(l); for(m=0;m <= mmax;m++){ /* will typically be <= l, but only 0 for kernel computation */ if (m != 0){ sh_get_coeff((pol_sol+os),l,m,2,FALSE,clm); /* internal convention */ clm[0] *= hc->psp.geoid_factor; clm[1] *= hc->psp.geoid_factor; sh_write_coeff((geoid+gic),l,m,2,FALSE,clm); }else{ /* m == 0 */ sh_get_coeff((pol_sol+os),l,m,0,FALSE,clm); clm[0] *= hc->psp.geoid_factor; sh_write_coeff((geoid+gic),l,m,0,FALSE,clm); } } } } if(verbose > 1) fprintf(stderr,"hc_polsol: assigned geoid\n"); } /* end geoid */ /* free the local arrays */ free(b);free(u3); if(!save_prop_mats){ /* destroy individual propagator matrices, if we don't want to keep them */ free(hc->props);free(hc->ppots); } /* all others should be saved */ hc->psp.ncalled++; if(verbose) fprintf(stderr,"hc_polsol: done\n"); }
int main(int argc, char **argv) { int ilayer,nvsol,ndsol=0,mode,shps,loop,i1,i2,nlat,nlon, ivec,lc,ndata,ndata_all,ndata_d,npoints,i,j, poff,shps_read=0,shps_read_d=0; FILE *in; struct sh_lms *vsol=NULL,*dsol=NULL; struct hcs *model; HC_PREC zlabel; hc_boolean binary_in = TRUE, verbose = FALSE,read_dsol=FALSE; HC_PREC *data,*plm=NULL,*xpos,*xvec,lon,lat,theta,phi,xtmp[3],pvec[3], *xscalar; HC_PREC polar_base[9]; hc_struc_init(&model); /* deal with parameters */ ilayer = 0; mode = 1; switch(argc){ case 3: sscanf(argv[2],"%i",&ilayer); break; case 4: sscanf(argv[2],"%i",&ilayer); sscanf(argv[3],"%i",&mode); break; case 5: sscanf(argv[2],"%i",&ilayer); sscanf(argv[3],"%i",&mode); read_dsol = TRUE; break; default: fprintf(stderr,"%s: usage\n%s sol.file layer [mode,%i] [scalar.sol]\n\n", argv[0],argv[0],mode); fprintf(stderr,"extracts spatial solution (velocity or stress, v) from output file sol.file\n"); fprintf(stderr," if scalar.sol argument is given, will also read in a scalar for VTK output\n"); fprintf(stderr,"layer: 1...nset\n"); fprintf(stderr,"\tif ilayer= 1..nset, will print one layer\n"); fprintf(stderr,"\t -1, will select nset (the top layer)\n"); fprintf(stderr,"\t -2, will print all layers\n"); fprintf(stderr,"mode: 1...4\n"); fprintf(stderr,"\tif mode = 1, will print lon lat z v_r \n"); fprintf(stderr,"\t 2, will print lon lat z v_theta v_phi \n"); fprintf(stderr,"\t 3, will print lon lat z v_r v_theta v_phi\n"); fprintf(stderr,"\t 4, will print the depth levels of all layers\n"); fprintf(stderr,"\t 5, compute all depth levels (set ilayer=-2) and write VTK file, ASCII\n"); fprintf(stderr,"\t 6, compute all depth levels (set ilayer=-2) and write VTK file, BINARY\n"); exit(-1); break; } if((mode == 4)||(mode==5)||(mode==6)) ilayer = -2; /* read in velocity/traction solution */ in = hc_fopen(argv[1],"r","hc_extract_spatial"); shps_read = hc_read_sh_solution(model,&vsol,in,binary_in,verbose); fclose(in); nvsol = model->nradp2 * shps_read; /* deal with selection */ loop = 0; if(ilayer == -1) ilayer = model->nradp2; else if(ilayer == -2){ ilayer = model->nradp2; loop =1; } if((ilayer < 1)||(ilayer > model->nradp2)){ fprintf(stderr,"%s: ilayer (%i) out of range, use 1 ... %i\n", argv[0],ilayer,model->nradp2); exit(-1); } /* set up layer bounds */ if(loop){ i1=0;i2=model->nradp2-1; }else{ i1=ilayer-1;i2 = i1; } /* detect number of expansions */ if(mode == 1){ shps = 1; /* r */ }else if(mode == 2){ shps = 2; /* theta,phi */ }else if((mode == 3)||(mode == 5)||(mode==6)){ shps = 3; /* r,theta,phi */ }else{ shps = 1; } if(shps > shps_read){ fprintf(stderr,"%s: solution file only had %i expansions, mode %i requests %i\n", argv[0],shps_read,mode,shps); exit(-1); } /* density solution or other scalar */ if(read_dsol){ if((mode != 5)&&(mode != 6)) HC_ERROR("hc_extract_spatial","error, only mode 5 and can handle scalar input"); in = hc_fopen(argv[4],"r","hc_extract_spatial"); shps_read_d = hc_read_sh_solution(model,&dsol,in,binary_in, verbose); fclose(in); ndsol = model->nradp2 * shps_read_d; } /* room for spatial expansion */ npoints = (vsol+i1*shps_read)->npoints; if((vsol+i1*shps_read)->type != SH_RICK) HC_ERROR("sh_extract_spatial","SH_RICK type required"); /* geographic set up */ nlat = (vsol+i1*shps_read)->rick.nlat; nlon = (vsol+i1*shps_read)->rick.nlon; ndata = npoints * shps ; ndata_d = npoints * shps_read_d; ndata_all = npoints * (shps + shps_read_d); if((mode == 5)||(mode==6)){ /* save all layers */ hc_vecalloc(&data,model->nradp2 * ndata_all,"hc_extract_spatial"); }else hc_vecalloc(&data, ndata_all,"hc_extract_spatial"); for(lc=0,ilayer=i1;ilayer <= i2;ilayer++,lc++){ /* output */ zlabel = HC_Z_DEPTH(model->r[ilayer]); switch(mode){ case 1: /* */ if(verbose) fprintf(stderr,"%s: printing v_r at layer %i (depth: %g)\n",argv[0],ilayer, (double)zlabel); ivec=FALSE;sh_compute_spatial((vsol+ilayer*shps_read),ivec,TRUE,&plm,data,verbose); sh_print_spatial_data_to_stream((vsol+ilayer*shps_read),shps,data,TRUE,zlabel,stdout); break; case 2: /* */ if(verbose) fprintf(stderr,"%s: printing v_theta v_phi SHE at layer %i (depth: %g)\n",argv[0],ilayer,(double)zlabel); ivec=TRUE;sh_compute_spatial((vsol+ilayer*shps_read+1),ivec,TRUE,&plm,data,verbose); sh_print_spatial_data_to_stream((vsol+ilayer*shps_read+1),shps,data,TRUE,zlabel,stdout); break; case 3: if(verbose) fprintf(stderr,"%s: printing v_r v_theta v_phi SHE at layer %i (depth: %g)\n",argv[0],ilayer,(double)zlabel); ivec=FALSE;sh_compute_spatial((vsol+ilayer*shps_read), ivec,TRUE,&plm,data,verbose); /* radial */ ivec=TRUE; sh_compute_spatial((vsol+ilayer*shps_read+1),ivec,TRUE,&plm,(data+npoints),verbose); /* theta,phi */ sh_print_spatial_data_to_stream((vsol+ilayer*shps_read),shps,data,TRUE,zlabel,stdout); break; case 4: fprintf(stdout,"%5i %11g\n",ilayer,(double)HC_Z_DEPTH(model->r[ilayer])); break; case 5: /* compute all and store */ case 6: ivec=FALSE;sh_compute_spatial((vsol+ilayer*shps_read), ivec,TRUE,&plm,(data+lc*ndata_all),verbose); /* radial */ ivec=TRUE; sh_compute_spatial((vsol+ilayer*shps_read+1),ivec,TRUE,&plm,(data+lc*ndata_all+npoints),verbose); /* theta,phi */ if(read_dsol){ if(!shps_read_d) HC_ERROR("sh_extract_spatial","logic error"); ivec=FALSE;sh_compute_spatial((dsol+ilayer*shps_read_d),ivec,TRUE,&plm,(data+lc*ndata_all+npoints*shps),verbose); /* radial */ } break; default: fprintf(stderr,"%s: error, mode %i undefined\n",argv[0],mode); exit(-1); break; } } /* clear and exit */ sh_free_expansion(vsol,nvsol); if(read_dsol) sh_free_expansion(dsol,ndsol); free(plm); /* */ if((mode == 5)||(mode==6)){ /* print the already stored properties */ if(shps != 3)HC_ERROR("hc_extract_spatial","shps has to be 3 for mode 5 and 6"); /* convert */ hc_vecalloc(&xpos,model->nradp2 * ndata,"hc_extract_spatial"); hc_vecalloc(&xvec,model->nradp2 * ndata,"hc_extract_spatial"); if(read_dsol) hc_vecalloc(&xscalar,model->nradp2 * ndata_d,"hc_extract_spatial"); for(i=0;i < npoints;i++){ /* loop through all points */ /* lon lat coordinates */ sh_get_coordinates((vsol+i1*3),i,&lon,&lat); theta = LAT2THETA(lat);phi = LON2PHI(lon); xtmp[0] = xtmp[1] = sin(theta); xtmp[0] *= cos(phi); /* x */ xtmp[1] *= sin(phi); /* y */ xtmp[2] = cos(theta); /* z */ /* for conversion */ calc_polar_base_at_theta_phi(theta,phi,polar_base); for(ilayer=0;ilayer < model->nradp2;ilayer++){ /* this is the slow data storage loop but it avoids recomputing the polar basis vector */ poff = ilayer * ndata + i*shps; /* point offset */ for(j=0;j < 3;j++){ xpos[poff+j] = xtmp[j] * model->r[ilayer]; /* cartesian coordinates */ } /* data are stored a bit weirdly, this makes for lots of jumping around in memory ... */ pvec[0] = data[ilayer*ndata_all + i]; pvec[1] = data[ilayer*ndata_all + npoints +i]; pvec[2] = data[ilayer*ndata_all + npoints*2+i]; lonlatpv2cv_with_base(pvec,polar_base,(xvec+poff)); /* assign scalar fata if any */ for(j=0;j < shps_read_d;j++) xscalar[j * model->nradp2 * ndata_d + ilayer * npoints + i] = data[ilayer * ndata_all + npoints*(shps+j) + i]; } } free(data); /* print in VTK format */ hc_print_vtk(stdout,xpos,xvec,npoints,model->nradp2,(mode==6), shps_read_d,xscalar,nlon,nlat); free(xvec);free(xpos); if(shps_read_d) free(xscalar); }else{ free(data); } return 0; }