Example #1
0
int main(int argc, char **argv)
{
  int type,lmax,shps,ilayer,nset,ivec,i,l;
  hc_boolean verbose = TRUE, short_format = FALSE ,binary = FALSE;
  HC_PREC *power = NULL;
  HC_PREC fac[3] = {1.,1.,1.},zlabel;
  struct sh_lms *exp;
  if(argc>1){
    if((strcmp(argv[1],"-h")==0)||(strcmp(argv[1],"--help")==0)||(strcmp(argv[1],"-help")==0)){
      fprintf(stderr,"usage: cat ab.sh_ana | %s [short_format, 0]\n", argv[0]);
      fprintf(stderr,"read in a spherical harmonic expansion in  Dahlen and Tromp normalization\n");
      fprintf(stderr, "and computer power per degree and unit area\n\n");
      fprintf(stderr,"if short format is 0, will expect\n");
      fprintf(stderr,"  type lmax shps ilayer nset zlabel ivec\n");
      fprintf(stderr,"  A-00 B-00\n");
      fprintf(stderr,"  A-10 B-10\n");
      fprintf(stderr,"  ...\n");
      fprintf(stderr,"format.\n\n");
      fprintf(stderr,"if short format is set, will expect\n");
      fprintf(stderr,"  lmax\n");
      fprintf(stderr,"  A-00 B-00\n");
      fprintf(stderr,"  A-10 B-10\n");
      fprintf(stderr,"  ...\n");
      fprintf(stderr,"format.\n");
      exit(-1);
    }else{
      sscanf(argv[1],"%i",&i);
      if(i)
        short_format = TRUE;
    }
  }
  fprintf(stderr,"%s: awaiting spherical harmonics expansion (%s) from stdin (use %s -h for help)\n",
	  argv[0],short_format ? "short format" : "long format",argv[0]);
  while(sh_read_parameters_from_stream(&type,&lmax,&shps,&ilayer,&nset,
				       &zlabel,&ivec,stdin,short_format,
				       binary,verbose)){
    fprintf(stderr,"%s: computing power per degree and unit area for lmax %i ivec: %i at z: %g\n",
	    argv[0],lmax,ivec,(double)zlabel);
    /* 
       input and init 
    */
    sh_allocate_and_init(&exp,shps,lmax, type,ivec,verbose,FALSE);
    sh_read_coefficients_from_stream(exp,shps,-1,stdin,binary,fac,verbose);
    /* get space */
    hc_vecrealloc(&power,exp->lmaxp1 * shps,"sh_power");
    /* compute the powers */
    for(i=0;i<shps;i++)
      sh_compute_power_per_degree((exp+i),(power+i*exp->lmaxp1));
    for(l=0;l<=exp->lmax;l++){
      fprintf(stdout,"%5i ",l);
      for(i=0;i<shps;i++)
	fprintf(stdout,"%15.7e",(double)power[l+i*exp->lmaxp1]);
      fprintf(stdout,"\n");
    }
    free(exp);
  }
  return 0;
}
Example #2
0
/* 

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;
}
Example #3
0
int main(int argc, char **argv)
{
  int type,lmax,shps,ilayer,nset,ivec,i,j,npoints,nphi,ntheta;
  /* 
     switches 
  */
  hc_boolean verbose = TRUE, short_format = FALSE ,short_format_ivec = FALSE ,binary = FALSE;
  int regular_basis = 0;
  HC_PREC w,e,s,n,dx,dy;
  /*  */
  FILE *in;
  HC_PREC *data,*theta,*phi;
  /* spacing for reg_ular output */
  HC_PREC dphi,x,y,dtheta;
  HC_PREC fac[3] = {1.,1.,1.},zlabel;
  SH_RICK_PREC *dummy;
  struct sh_lms *exp;
  dx = 1.0;
  w=0;e=360.;s=-90;n=90;
  if(argc > 1){
    if((strcmp(argv[1],"-h")==0)||(strcmp(argv[1],"--help")==0)||(strcmp(argv[1],"-help")==0))
      argc = -1000;
    else{
      sscanf(argv[1],"%i",&i);
      if(i)
	short_format = TRUE;
    }
  } 
  if(argc > 2){
    sscanf(argv[2],"%i",&i);
    if(i)
      short_format_ivec = TRUE;
  }
  if(argc > 3){
    sscanf(argv[3],HC_FLT_FORMAT,&w);
    if(w == 999)
      regular_basis = -1;
    else
      regular_basis = 1;
  }
  if(argc > 4)
    sscanf(argv[4],HC_FLT_FORMAT,&e);
  if(argc > 5)
    sscanf(argv[5],HC_FLT_FORMAT,&s);
  if(argc > 6)
    sscanf(argv[6],HC_FLT_FORMAT,&n);
   if(argc > 7)
    sscanf(argv[7],HC_FLT_FORMAT,&dx);
  if(argc > 8)
    sscanf(argv[8],HC_FLT_FORMAT,&dy);
  else
    dy = dx;
  if((argc > 9)|| (argc < 0)){
    fprintf(stderr,"usage: %s [short_format, %i] [short_ivec, %i] [w, %g] [e, %g] [s, %g] [n, %g] [dx, %g] [dy, dx] (in that order)\n",
	    argv[0],short_format,short_format_ivec,(double)w,(double)e,(double)s,(double)n,(double)dx);
    fprintf(stderr,"short_format:\n\t0: expects regular format with long header\n");
    fprintf(stderr,"\t1: expects short format with only lmax in header\n\n");
    fprintf(stderr,"short_ivec:\n\t0: for short format, expect AB for scalar expansion\n");
    fprintf(stderr,"\t1: for short format, expect poloidal toroidal AP BP AT BT for vector expansion\n\n");
    fprintf(stderr,"w,e,...\n\tif none of those are set, will use Gauss latitudes and FFT divided longitudes dependening on lmax\n");
    fprintf(stderr,"\tif w is set to anything but 999, will switch to regular spaced output with -Rw/e/s/n -Idx/dy type output\n");
    fprintf(stderr,"\tif w is set to 999, will read lon lat in deg from \"tmp.lonlat\", and expand on those locations\n\n");
    fprintf(stderr,"The output format will depend on the type of SH input.\n");
    fprintf(stderr,"\tfor scalara: lon lat scalar if a single SH is read in, else lon lat zlabel scalar.\n");
    fprintf(stderr,"\tfor vectors: lon lat v_theta v_phi if a single SH is read in, else lon lat zlabel v_theta v_phi.\n\n\n");
    exit(-1);
  }
  if(verbose)
    fprintf(stderr,"%s: waiting to read spherical harmonic coefficients from stdin (use %s -h for help)\n",
	    argv[0],argv[0]);
  while(sh_read_parameters_from_stream(&type,&lmax,&shps,&ilayer,&nset,
				       &zlabel,&ivec,stdin,short_format,
				       binary,verbose)){
    if(short_format_ivec){
      ivec = 1;
      shps = 2;
    }
    if(verbose)
      fprintf(stderr,"%s: converting lmax %i ivec: %i at z: %g\n",
	      argv[0],lmax,ivec,(double)zlabel);

    /* input and init */
    sh_allocate_and_init(&exp,shps,lmax,type,ivec,verbose,((regular_basis != 0)?(1):(0)));
    sh_read_coefficients_from_stream(exp,shps,-1,stdin,binary,fac,verbose);
    if(regular_basis == 1){
      /* 
	 regular basis output on regular grid
      */
      if(verbose)
	fprintf(stderr,"sh_syn: using regular spaced grid with -R%g/%g/%g/%g -I%g/%g spacing\n",
		(double)w,(double)e,(double)s,(double)n,(double)dx,(double)dy);
      if((w > e)||(s>n)||(s<-90)||(s>90)||(n<-90)||(n>90)){
	fprintf(stderr,"%s: range error\n",argv[0]);
	exit(-1);
      }

      if((ivec) && (s == -90)&&(n == 90)){
	s += dy/2;
	n -= dy/2;
	fprintf(stderr,"sh_syn: vector fields: adjusting to -R%g/%g/%g/%g\n",
		(double)w,(double)e,(double)s,(double)n);
      }
      /*  */
      dphi = DEG2RAD(dx);
      nphi = ((e-w)/dx) + 1;
      dtheta = DEG2RAD(dy);
      ntheta = ((n-s)/dy) + 1;
      npoints = nphi * ntheta;

      /*  */
      hc_vecalloc(&phi,nphi,"sh_shsyn");
      hc_vecalloc(&theta,ntheta,"sh_shsyn");
      for(x=LON2PHI(w),i=0;i < nphi;i++,x += dphi)
	phi[i] = x;
      for(y = LAT2THETA(n),j=0;j < ntheta;y += dtheta,j++)
	theta[j] = y;
      hc_vecalloc(&data,npoints * shps,"sh_shsyn data");
      /* compute the expansion */
      sh_compute_spatial_reg(exp,ivec,FALSE,&dummy,
			     theta,ntheta,phi,nphi,data,
			     verbose,FALSE);
      /* output */
      sh_print_reg_spatial_data_to_stream(exp,shps,data,
					  (nset>1)?(TRUE):(FALSE),
					  zlabel, theta,ntheta,
					  phi,nphi,stdout);
    }else if(regular_basis == -1){
      /* output on locations input lon lat file */
      if(verbose)
	fprintf(stderr,"sh_syn: reading locations lon lat from stdin for expansion\n");
      npoints = 0;
      hc_vecalloc(&phi,1,"sh_syn");
      hc_vecalloc(&theta,1,"sh_syn");
      in = fopen("tmp.lonlat","r");
      if(!in){
	fprintf(stderr,"sh_syn: error, could not open tmp.lonlat for reading lon lat locations\n");
	exit(-1);
      }
      while(fscanf(in,HC_TWO_FLT_FORMAT,&dphi,&dtheta)==2){
	phi[npoints] = LON2PHI(dphi);
	theta[npoints] = LAT2THETA(dtheta);
	npoints++;
	hc_vecrealloc(&phi,npoints+1,"sh_syn");
	hc_vecrealloc(&theta,npoints+1,"sh_syn");
      }
      if(verbose)
	fprintf(stderr,"sh_syn: read %i locations lon lat from tmp.lonlat for expansion\n",npoints);
      fclose(in);
      hc_vecalloc(&data,npoints * shps,"sh_shsyn data");
      sh_compute_spatial_irreg(exp,ivec,theta,phi,npoints,data,verbose);
      sh_print_irreg_spatial_data_to_stream(exp,shps,data,(nset>1)?(TRUE):(FALSE),
					    zlabel,theta,phi,npoints,stdout);
     }else{			/* use the built in spatial basis (Gaussian) */
      /* expansion */
      hc_vecalloc(&data,exp[0].npoints * shps,"sh_syn");
      sh_compute_spatial(exp,ivec,FALSE,&dummy,data,verbose);
      /* output */
      sh_print_spatial_data_to_stream(exp,shps,data,(nset>1)?(TRUE):(FALSE),
				      zlabel,stdout);
    }
    free(exp);free(data);
  }

  return 0;
}
Example #4
0
/* 

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