#include "hc.h" /* // // compute Legendre function (l,m) evaluated on nlat points // in latitude and their derviatives with respect to theta, if // ivec is set to 1 // */ void shana_compute_allplm(int lmax,int ivec,double *plm, double *dplm, struct shana_module *shana) { int i,os; os = 0; for (i=0;i < shana->nlat;i++) { shana_plmbar1((plm),(dplm),ivec,lmax,shana->gauss_z[i],shana); os += shana->lmsize; } } /* // // detemine the colatidude and longitude of PIxel index // where index goes from 0 ... (nlon * nlat)-1 // */ void shana_pix2ang(int index, int lmax, double *theta,double *phi, struct shana_module *shana) { int i,j; if(!shana->initialized){ fprintf(stderr,"shana_pix2ang: error: shana module not initialized\n"); exit(-1); } j = index; i=0; while(j > shana->nlonm1) { /* */ j -= shana->nlon; i++; } *theta = shana=>dtheta * (HC_CPREC)i; *phi = shana->dphi * (HC_CPREC)j; } void shana_shc2d(HC_CPREC *cslm,HC_CPREC *dslm, int lmax,int ivec, HC_CPREC *rdatax,HC_CPREC *rdatay, struct shana_module *shana) { // // Transforms spherical harmonic coefficients of a scalar (ivec = 0) // or a vector (ivec=1) field // to data points on a grid. Reverse transform of subroutine // shd2c.f so long as the same degree is used and the points // in latitude are Gaussian integration points. Maximum degree // must be 2**n-1 in order for the FFT to work; this determines // the grid spacing in longitude. nlat = lmax+1, nlon = 2*nlat // // INPUT: // // lmax spherical harmonic degree used in expansion // cslm (lmsize2) spherical harmonic coefficients // dslm (lmsize2) // if ivec, will hold poloidal and toroidal coeff,else // dslm will not be referenced // // ivec 0: scalar 1: vector field // OUTPUT: // rdatax (nlon * nlat) values on grid points // rdatay (nlon * nlat). x and y will be theta and phi for // ivec = 1, else rdatay will not be referenced // // if Ivec is set, assume velocities to be expanded instead // // input: lmax,ivec // local double *plm,*dplm; if(!shana->initialized){ fprintf(stderr,"shana_shc2d: error: initialize first\n"); exit(-1); } // compute the Plm first if(lmax != shana->nlat-1){ fprintf(stderr,"shana_shc2d: error: lmax mismatch: nlat: %i lmax: %i\n", shana->nlat,lmax); exit(-1); } /* allocate memory */ hc_dvecalloc(&plm,shana->nlat*shana->lmsize,"shana_shc2d: mem 1"); if(ivec) hc_dvecalloc(&dplm,shana->nlat*shana->lmsize,"shana_shc2d: mem 2"); // // compute the Plm first shana_compute_allplm(lmax,ivec,plm,dplm,shana); // // call the precomputed subroutine shana_shc2d_pre(cslm,dslm,lmax,plm,dplm,ivec,rdatax,rdatay,shana); /* free legendre functions if not needed */ free(plm); if(ivec) free(dplm); } /* // // the actual routine to go from spectral to spatial: added structure shana // */ void shana_shc2d_pre(HC_CPREC *cslm,HC_CPREC *dslm, int lmax,double *plm, double *dplm, int ivec,float *rdatax,float *rdatay, struct shana_module *shana) { /* // // Legendre functions are precomputed // */ HC_CPREC *valuex, *valuey; double dpdt,dpdp; static int negunity = -1; int i,j,m,m2,j2,ios1,l,lmaxp1,lmaxp1t2,oplm,nlon2,lm1; if(!shana->initialized){ fprintf(stderr,"shana_shc2d_pre: error: initialize modules first\n"); exit(-1); } // check bounds lmaxp1 = lmax + 1; // this is nlat lmaxp1t2 = 2 * lmaxp1; // this is nlon if((shana->nlat != lmaxp1)||(shana->nlon != lmaxp1t2)){ fprintf(stderr,"shana_shc2d_pre: dimension mismatch: lmax: %i nlon: %i nlat:%i\n", lmax,shana->nlon,shana->nlat); exit(-1); } if(ivec){ if(!shana->vector_sh_fac_init){ fprintf(stderr,"shana_shc2d_pre: error: vector harmonics factors not initialized\n"); exit(-1); } } nlon2 = shana->nlon + 2; /* allocate value arrays */ shana_vecalloc(&valuex,nlon2,"shana_shc2d_pre 1"); if(ivec) shana_vecalloc(&valuey,nlon2,"shana_shc2d_pre 2"); for (i=0;i < shana->nlat; i++) { /* loop through latitudes */ oplm = i * shana->lmsize; /* offset for Plm array. (changed indices TWB) */ ios1 = i * shana->nlon; /* offset for data array */ if(!ivec){ /* scalar */ for(j=0;j < nlon2;j++) valuex[j] = 0.0; /* init with 0.0es */ l = 0; m = -1; for (j=j2=0; j < shana->lmsize; j++,j2+=2) { /* loop through l,m */ m++; if (m > l) { m=0; l++; } m2 = 2*m; //fprintf(stderr,"%11i %11i %11g %11g\n",l,m,cslm[j2],cslm[j2+1]); /* add up contributions from all l,m */ valuex[m2] += /* cos term */ plm[oplm+j] * (double)cslm[j2]; /* A coeff */ valuex[m2+1] += /* sin term */ plm[oplm+j] * (double)cslm[j2+1]; /* B coeff */ } /* compute inverse FFT */ #ifdef NO_SHANA_FORTRAN shana_cs2ab(valuex,shana->nlon); shana_realft_nr((valuex-1),shana->nlat,negunity); #else shana_f90_cs2ab(valuex,&shana->nlon); shana_f90_realft(valuex,&shana->nlat,&negunity); #endif for (j=0; j < shana->nlon; j++) { /* can't vectorize */ rdatax[ios1 + j] = valuex[j]/(HC_CPREC)(shana->nlat); } /* end scalar part */ } else { /* vector harmonics */ for(j=0;j < nlon2;j++){ valuex[j] = valuey[j] = 0.0; } l = 1; m = -1; /* start at l = 1 */ for (j=1,j2=2; j < shana->lmsize; j++,j2+=2) { /* loop through l,m */ m++; if (m > l) { m=0; l++; } m2 = 2*m; /* derivative factors */ lm1 = l - 1; dpdt = dplm[oplm+j] * (double)shana->ell_factor[lm1]; /* d_theta(P_lm) factor */ dpdp = ((double)m) * plm[oplm+j]/ (double)shana->sin_theta[i]; dpdp *= (double)shana->ell_factor[lm1]; /* d_phi (P_lm) factor */ /* add up contributions from all l,m u_theta */ valuex[m2] += /* cos term */ cslm[j2] * dpdt + dslm[j2+1] * dpdp; valuex[m2+1] += /* sin term */ cslm[j2+1] * dpdt - dslm[j2] * dpdp; /* u_phi */ valuey[m2] += // cos term cslm[j2+1] * dpdp - dslm[j2] * dpdt; valuey[m2+1] += // sin term - cslm[j2] * dpdp - dslm[j2+1] * dpdt; } /* end l,m loop */ /* do inverse FFTs */ #ifdef NO_SHANA_FORTRAN shana_cs2ab(valuex,shana->nlon); shana_cs2ab(valuey,shana->nlon); shana_realft_nr((valuex-1),shana->nlat,negunity); shana_realft_nr((valuey-1),shana->nlat,negunity); #else shana_f90_cs2ab(valuex,&shana->nlon); shana_f90_cs2ab(valuey,&shana->nlon); shana_f90_realft(valuex,&shana->nlat,&negunity); shana_f90_realft(valuey,&shana->nlat,&negunity); #endif /* assign to output array */ for (j=0; j < shana->nlon; j++) { rdatax[ios1 + j] = valuex[j]/(HC_CPREC)(shana->nlat); rdatay[ios1 + j] = valuey[j]/(HC_CPREC)(shana->nlat); } } } /* end latitude loop */ /* free temporary arrays */ free(valuex); if(ivec) free(valuey); } void shana_shd2c(HC_CPREC *rdatax,HC_CPREC *rdatay, int lmax,int ivec,HC_CPREC *cslm, HC_CPREC *dslm,struct shana_module *shana) { // // Calculates spherical harmonic coefficients cslm(l,m) of // a scalar (ivec = 0) or vector (ivec=1) function on a sphere. // // if ivec == 1, then cslm will be poloidal, and dslm toroidal // rdata will be nlon*nlat // // Coefficients stored with // cosine term and sine term alternating, starting at l=0 // and m=0 with m ranging from 0 to l before l is incremented. // // Harmonics normalized with mean square = 1.0. Expansion is: // SUM( Plm(cos(theta))*(cp(l,m)*cos(m*phi)+sp(l,m)*sin(m*phi)) // // Uses FFT in longitude and gaussian integration of spectral // coefficients (for fixed m) times associated Legendre // functions (of same order m) to get expansion coefficients. // // Uses Num Rec routine for Gaussian points and weights, which should // be initialized first by a call to shana_init. // // Uses recursive routine to generate associated Legendre functions. // // INPUT: // // lmax maximum possible degree of expansion (2**n-1). There // are nlon = 2*lmax+2 data points in longitude for each latitude // which has nlat = lmax+1 points // // rdatax,rdatay data((nlon * nlat)) arrays for theta and phi // components // // ic_pd: should be either 0.0_cp or 1.0_cp // if set to 1.0_cp, will expand velocities instead // in this case, data should hold the theta and phi components // of a vector field and cslm will hold the poloidal and toroidal // on output components, respectively // // OUTPUT: // // cslm,dslm coefficients, (2*lmsize) // // dslm and rdatay will only be referenced when ivec = 1 // // // local double *plm,*dplm; /* allocate memory */ hc_dvecalloc(&plm,shana->nlat*shana->lmsize,"shana_shd2c: mem 1"); hc_dvecalloc(&dplm,shana->nlat*shana->lmsize,"shana_shd2c: mem 2"); // check if(!shana->initialized){ fprintf(stderr,"shana_shd2c: error: initialize first\n"); exit(-1); } if(lmax != shana->nlat-1){ fprintf(stderr,"shana_shd2c: error: lmax mismatch: nlat: %i lmax: %i\n", shana->nlat,lmax); exit(-1); } // compute the Plm first shana_compute_allplm(lmax,ivec,plm,dplm,shana); // // call the precomputed version shana_shd2c_pre(rdatax,rdatay,lmax,plm,dplm,ivec,cslm,dslm,shana); /* free legendre functions if not needed */ free(plm); free(dplm); } // // the actual routine to go from spatial to spectral, // for comments, see above // void shana_shd2c_pre(HC_CPREC *rdatax,HC_CPREC *rdatay, int lmax,double *plm,double *dplm,int ivec, HC_CPREC *cslm,HC_CPREC *dslm, struct shana_module *shana) { // local HC_CPREC *valuex, *valuey; double dfact,dpdt,dpdp; static int unity = 1; // int lmaxp1,lmaxp1t2,i,j,l,m,ios1,m2,j2,oplm,nlon2,lm1; // check if(!shana->initialized){ fprintf(stderr,"shana_shd2c_pre: error: initialize first\n"); exit(-1); } // check some more and compute bounds lmaxp1 = lmax + 1; lmaxp1t2 = lmaxp1 * 2; nlon2 = shana->nlon + 2; if((lmaxp1 != shana->nlat)||(shana->nlon != lmaxp1t2)|| ((lmax+1)*(lmax+2)/2 != shana->lmsize)){ fprintf(stderr,"shana_shd2c_pre: dimension error, lmax %i\n",lmax); fprintf(stderr,"shana_shd2c_pre: nlon %i nlat %i\n",shana->nlon,shana->nlat); fprintf(stderr,"shana_shd2c_pre: lmsize %i\n",shana->lmsize); exit(-1); } /* allocate */ shana_vecalloc(&valuex,nlon2,"shana_shd2c_pre 1"); if(ivec) shana_vecalloc(&valuey,nlon2,"shana_shd2c_pre 2"); // // initialize the coefficients // for(i=0;i < shana->lmsize2;i++) cslm[i] = 0.0; if(ivec){ if(! shana->vector_sh_fac_init){ fprintf(stderr,"shana_shd2c_pre: error: vector harmonics factors not initialized\n"); exit(-1); } for(i=0;i < shana->lmsize2;i++) dslm[i] = 0.0; } for(i=0;i < shana->nlat;i++){ // // loop through latitudes // ios1 = i * shana->nlon; // offset for data array oplm = i * shana->lmsize; // offset for Plm array // if(!ivec){ // // scalar expansion // for(j=0;j < shana->nlon;j++){ valuex[j] = rdatax[ios1 + j]; } // // compute the FFT // #ifdef NO_SHANA_FORTRAN shana_realft_nr((valuex-1),shana->nlat,unity); shana_ab2cs(valuex,shana->nlon); #else shana_f90_realft(valuex,&shana->nlat,&unity); shana_f90_ab2cs(valuex,&shana->nlon); #endif // sum up for integration l = 0;m = -1; for(j=j2=0;j < shana->lmsize;j++,j2+=2){ m++; if( m > l ) { l++;m=0; } // we incorporate the Gauss integration weight and Plm factors here if (m == 0) { dfact = ((double)shana->gauss_w[i] * plm[oplm+j])/2.0; }else{ dfact = ((double)shana->gauss_w[i] * plm[oplm+j])/4.0; } m2 = m * 2; cslm[j2] += valuex[m2] * dfact; // A coefficient cslm[j2+1] += valuex[m2+1] * dfact; // B coefficient } /* end lmsize loop */ /* end scalar */ }else{ // // vector field expansion // for(j=0;j < shana->nlon;j++){ valuex[j] = rdatax[ios1 + j]; // theta valuey[j] = rdatay[ios1 + j]; // phi } // perform the FFTs on both components #ifdef NO_SHANA_FORTRAN shana_realft_nr((valuex-1),shana->nlat,unity); shana_realft_nr((valuey-1),shana->nlat,unity); shana_ab2cs(valuex,shana->nlon); shana_ab2cs(valuey,shana->nlon); #else shana_f90_realft(valuex,&shana->nlat,&unity); shana_f90_realft(valuey,&shana->nlat,&unity); shana_f90_ab2cs(valuex,&shana->nlon); shana_f90_ab2cs(valuey,&shana->nlon); #endif // l=1;m=-1; // there's no l=0 term // for(j = 1,j2 = 2;j < shana->lmsize;j++,j2+=2){ m++; if( m >l ) { l++;m=0; } lm1 = l - 1; if (m == 0){ // ell_factor is 1/sqrt(l(l+1)) dfact = shana->gauss_w[i] * shana->ell_factor[lm1]/2.0; }else{ dfact = shana->gauss_w[i] * shana->ell_factor[lm1]/4.0; } // // some more factors // // d_theta(P_lm) factor dpdt = dplm[oplm+j]; // d_phi (P_lm) factor dpdp = ((double)m) * plm[oplm+j]/(double)shana->sin_theta[i]; // m2 = m * 2; // print *,m,l,dpdt*dfact,dpdp*dfact /* poloidal */ cslm[j2] += // poloidal A (dpdt * valuex[m2] - dpdp * valuey[m2+1])*dfact; cslm[j2+1] += // poloidal B (dpdt * valuex[m2+1] + dpdp * valuey[m2] )*dfact; /* toroidal */ dslm[j2] += // toroidal A (-dpdp * valuex[m2+1] - dpdt * valuey[m2] )*dfact; dslm[j2+1] += // toroidal B ( dpdp * valuex[m2] - dpdt * valuey[m2+1])*dfact; } } // end vector field } // end latitude loop free(valuex); if(ivec) free(valuey); } // // initialize all necessary arrays for Shana type expansion // // if ivec == 1, will initialize for velocities/polarizations // void shana_init(int lmax,int ivec,int *npoints,int *nplm, int *tnplm, struct shana_module *shana) { // input: lmax,ivec // output: npoints,nplm,tnplm // local HC_CPREC xtemp; int i,l; if(!shana->was_called){ if(lmax == 0){ fprintf(stderr,"shana_init: error: lmax is zero: %i\n",lmax); exit(-1); } // // test if lmax is 2**n-1 // xtemp = log((HC_CPREC)(lmax+1))/log(2.0); if(fabs((int)(xtemp+.5)-xtemp) > 1e-7){ fprintf(stderr,"shana_init: error: lmax has to be 2**n-1\n"); fprintf(stderr,"shana_init: maybe use lmax = %i\n", (int)pow(2,(int)(xtemp)+1)-1); fprintf(stderr,"shana_init: instead of %i\n",lmax); exit(-1); } // // number of longitudinal and latitudinal points // shana->nlat = lmax + 1; shana->nlon = 2 * shana->nlat; // // number of points in one layer // *npoints = shana->nlat * shana->nlon; shana->old_npoints = *npoints; // // // for coordinate computations // shana->dphi = TWOPI / (HC_CPREC)(shana->nlon); shana->nlonm1 = shana->nlon - 1; // // size of tighly packed arrays with l,m indices shana->lmsize = (lmax+1)*(lmax+2)/2; shana->lmsize2 = shana->lmsize * 2; //for A and B // // // size of the Plm array *nplm = shana->lmsize * shana->nlat; *tnplm = *nplm * (1+ivec); // for all layers shana->old_tnplm = *tnplm; shana->old_nplm = *nplm; // // initialize the Gauss points, at which the latitudes are // evaluated // shana_vecalloc(&shana->gauss_z,shana->nlat,"shana_init 1"); shana_vecalloc(&shana->gauss_w,shana->nlat,"shana_init 2"); shana_vecalloc(&shana->gauss_theta,shana->nlat,"shana_init 3"); /* gauss weighting */ shana_gauleg(-1.0,1.0,shana->gauss_z,shana->gauss_w,shana->nlat); // // theta values of the Gauss quadrature points // for(i=0;i < shana->nlat;i++) shana->gauss_theta[i] = acos(shana->gauss_z[i]); // // those will be used by plmbar to store some of the factors // hc_dvecalloc(&shana->plm_f1,shana->lmsize,"shana_init 4"); hc_dvecalloc(&shana->plm_f2,shana->lmsize,"shana_init 5"); hc_dvecalloc(&shana->plm_fac1,shana->lmsize,"shana_init 6"); hc_dvecalloc(&shana->plm_fac2,shana->lmsize,"shana_init 7"); hc_dvecalloc(&shana->plm_srt,shana->nlon,"shana_init 8"); if(ivec){ // // additional arrays for vector spherical harmonics // (perform the computations in HC_CPREC precision) // shana_vecalloc(&shana->ell_factor,shana->nlat,"shana init 9"); shana_vecalloc(&shana->sin_theta,shana->nlat,"shana init 9"); // 1/(l(l+1)) factors for(i=0,l=1;i < shana->nlat;i++,l++){ // no l=0 term, obviously // go from l=1 to l=lmax+1 shana->ell_factor[i] = 1.0/sqrt((HC_CPREC)(l*(l+1))); shana->sin_theta[i] = sqrt((1.0 - shana->gauss_z[i])* (1.0+shana->gauss_z[i])); shana->vector_sh_fac_init = TRUE; } }else{ shana->vector_sh_fac_init = FALSE; } // // logic flags // shana->computed_legendre = FALSE; shana->initialized = TRUE; shana->was_called = TRUE; /* save initial call lmax and ivec settings */ shana->old_lmax = lmax; shana->old_ivec = ivec; /* end initial branch */ }else{ if(lmax != shana->old_lmax){ fprintf(stderr,"shana_init: error: was init with lmax %i, now: %i. (ivec: %i, now: %i)\n", shana->old_lmax,lmax,shana->old_ivec,ivec); exit(-1); } if(ivec > shana->old_ivec){ fprintf(stderr,"shana_init: error: original ivec %i, now %i\n",shana->old_ivec,ivec); exit(-1); } *npoints = shana->old_npoints; *nplm = shana->old_nplm; *tnplm = shana->old_tnplm; } } /* end shana init */ // // free all arrays that were allocate for the module // void shana_free_module(struct shana_module *shana, int ivec) { // input: ivec free(shana->gauss_z); free(shana->gauss_w); free(shana->gauss_theta); if(shana->computed_legendre){ // those are from the Legendre function action free(shana->plm_f1);free(shana->plm_f2); free(shana->plm_fac1);free(shana->plm_fac2); free(shana->plm_srt); } if(ivec){ free(shana->ell_factor);free(shana->sin_theta); } } void shana_plmbar1(double *p,double *dp,int ivec,int lmax, HC_CPREC z, struct shana_module *shana) { double plm,pm1,pm2,pmm,sintsq,fnum,fden; // int i,l,m,k,kstart,l2,mstop,lmaxm1; if(!shana->initialized){ fprintf(stderr,"shana_plmbar1: error: module not initialized, call shana_init first\n"); exit(-1); } if ((lmax < 0) || (fabs(z) > 1.0)) { fprintf(stderr,"shana_plmbar1: error: bad arguments\n"); exit(-1); } if(!shana->computed_legendre) { /* need to initialize the legendre factors */ if(shana->nlon != (lmax+1)*2){ fprintf(stderr,"shana_plmbar1: factor mismatch, lmax: %i vs nlon: %i (needs to be (lmax+1)*2)\n", lmax,shana->nlon); exit(-1); } // // first call, set up some factors. the arrays were allocated in shana_init // for(k=0,i=1;k < shana->nlon;k++,i++){ shana->plm_srt[k] = sqrt((double)(i)); } // initialize plm factors for(i=0;i < shana->lmsize;i++){ shana->plm_f1[i] = shana->plm_fac1[i] = 0.0; shana->plm_f2[i] = shana->plm_fac2[i] = 0.0; } // --case for m > 0 kstart = 0; for(m=1;m <= lmax;m++){ // --case for P(m,m) kstart += m+1; if (m != lmax) { // --case for P(m+1,m) k = kstart+m+1; // --case for P(l,m) with l > m+1 if (m < (lmax-1)) { for(l = m+2;l <= lmax;l++){ l2 = l * 2; k = k+l; shana->plm_f1[k] = shana->plm_srt[l2] * shana->plm_srt[l2-2]/ (shana->plm_srt[l+m-1] * shana->plm_srt[l-m-1]); shana->plm_f2[k]=(shana->plm_srt[l2] * shana->plm_srt[l-m-2]*shana->plm_srt[l+m-2])/ (shana->plm_srt[l2-4] * shana->plm_srt[l+m-1] * shana->plm_srt[l-m-1]); } } } } if(ivec){ // // for derivative of Plm with resp. to theta // (if we forget to call Plm with ivec=1, but use // ivec=1 later, we will notice as all should be zero) // k=2; for(l=2;l<=lmax;l++){ k++; mstop = l - 1; for(m=1;m <= mstop;m++){ k++; shana->plm_fac1[k] = shana->plm_srt[l-m-1] * shana->plm_srt[l+m]; shana->plm_fac2[k] = shana->plm_srt[l+m-1] * shana->plm_srt[l-m]; if(m == 1){ shana->plm_fac2[k] = shana->plm_fac2[k] * shana->plm_srt[1]; } } k++; } } /* end ivec==1 */ shana->old_lmax = lmax; shana->old_ivec = ivec; shana->computed_legendre = TRUE; /* end first call */ }else{ /* subsequent call */ // test if lmax has changed if(lmax != shana->old_lmax){ fprintf(stderr,"shana_plmbar1: error: factors were computed for lmax %in",shana->old_lmax); fprintf(stderr,"shana_plmbar1: error: now, lmax is %i\n",lmax); exit(-1); } if(ivec > shana->old_ivec){ fprintf(stderr,"shana_plmbar1: error: init with %i, now ivec %i\n",shana->old_ivec,ivec); exit(-1); } } /* what follows will be executed for each z */ // --start calculation of Plm etc. // --case for P(l,0) pm2 = 1.0; p[0] = 1.0; // (0,0) if(ivec) dp[0] = 0.0;// else, don't refer to this array if (lmax == 0){ fprintf(stderr,"lmax is zero. what the hell?//\n"); exit(-1); } pm1 = z; p[1] = shana->plm_srt[2] * pm1; // (1,0) k=1; for(l = 2;l<=lmax;l++){ // now all (l,0) k += l; l2 = l * 2; plm = ((double)(l2-1) * z * pm1 - (double)(l-1) * pm2)/((double)l); p[k] = shana->plm_srt[l2] * plm; pm2 = pm1; pm1 = plm; } // --case for m > 0 pmm = 1.0; sintsq = (1.0 - z) * (1.0 + z); fnum = -1.0; fden = 0.0; kstart = 0; lmaxm1 = lmax - 1; for(m = 1;m<=lmax;m++){ // --case for P(m,m) kstart += m+1; fnum += 2.0; fden += 2.0; pmm = pmm * sintsq * fnum / fden; pm2 = sqrt((HC_CPREC)(4*m+2)*pmm); p[kstart] = pm2; if (m != lmax) { // --case for P(m+1,m) pm1 = z * shana->plm_srt[2*m+2]*pm2; k = kstart + m + 1; p[k] = pm1; // --case for P(l,m) with l > m+1 if (m < lmaxm1) { for(l = m+2;l <= lmax;l++){ k += l; plm = z * shana->plm_f1[k] * pm1 - shana->plm_f2[k] * pm2; p[k] = plm; pm2 = pm1; pm1 = plm; } } } } if(ivec){ // // derivatives // ---derivatives of P(z) wrt theta, where z=cos(theta) // dp[1] = -p[2]; dp[2] = p[1]; k = 2; for(l=2;l <= lmax;l++){ k++; // treat m=0 and m=l separately dp[k] = -shana->plm_srt[l-1] * shana->plm_srt[l] / shana->plm_srt[1] * p[k+1]; dp[k+l] = shana->plm_srt[l-1] / shana->plm_srt[1] * p[k+l-1]; mstop = l-1; for(m=1;m <= mstop;m++){ k++; dp[k] = shana->plm_fac2[k] * p[k-1] - shana->plm_fac1[k] * p[k+1]; dp[k] *= 0.5; } k++; } } }