• Main Page
  • Classes
  • Files
  • File List
  • File Members

prob/streaming2d_multi.c

Go to the documentation of this file.
00001 #include "copyright.h"
00002 /*============================================================================*/
00003 /*! \file streaming2d_multi.c
00004  *  \brief Problem generator for non-linear streaming instability in
00005  *   non-stratified disks.
00006  *
00007  * PURPOSE: Problem generator for non-linear streaming instability in
00008  *   non-stratified disks. This code works in 2D ONLY. It generalizes the NSH
00009  *   equilibrium solution to allow multiple-species dust components. Isothermal
00010  *   eos is assumed, and the value etavk/iso_sound is fixed.
00011  *
00012  * Perturbation modes:
00013  * -  ipert = 0: multi-nsh equilibtium
00014  * -  ipert = 1: white noise within each grid cell
00015  * -  ipert = 2: white noise within the entire grid
00016  * -  ipert = 3: non-nsh velocity
00017  *
00018  *  Must be configured using --enable-shearing-box and --with-eos=isothermal.
00019  *  FARGO is recommended.
00020  *
00021  * Reference:
00022  * - Johansen & Youdin, 2007, ApJ, 662, 627
00023  * - Bai & Stone, 2009, in preparation */
00024 /*============================================================================*/
00025 
00026 #include <float.h>
00027 #include <math.h>
00028 #include <stdio.h>
00029 #include <stdlib.h>
00030 #include <string.h>
00031 #include <time.h>
00032 #include "defs.h"
00033 #include "athena.h"
00034 #include "globals.h"
00035 #include "prototypes.h"
00036 #include "particles/particle.h"
00037 
00038 #ifndef SHEARING_BOX
00039 #error : The streaming2d problem requires shearing-box to be enabled.
00040 #endif /* SHEARING_BOX */
00041 
00042 #ifndef PARTICLES
00043 #error : The streaming2d problem requires particles to be enabled.
00044 #endif /* PARTICLES */
00045 
00046 #ifndef ISOTHERMAL
00047 #error : The streaming2d problem requires isothermal equation of state.
00048 #endif /* ISOTHERMAL */
00049 
00050 /*------------------------ filewide global variables -------------------------*/
00051 /* NSH equilibrium/perturbation parameters */
00052 Real rho0, mratio, etavk, *epsilon, uxNSH, uyNSH, *wxNSH, *wyNSH;
00053 int ipert;
00054 /* particle number related variables */
00055 int Npar,Npar2;
00056 /* output variables */
00057 long ntrack;   /* number of tracer particles */
00058 long nlis;     /* number of output particles for list output */
00059 int mytype;    /* specific particle type for output */
00060 
00061 /*==============================================================================
00062  * PRIVATE FUNCTION PROTOTYPES:
00063  * ran2()            - random number generator
00064  * MultiNSH()        - multiple component NSH equilibrium solver
00065  * ShearingBoxPot()  - shearing box tidal gravitational potential
00066  * hst_rho_Vx_dVy()  - total Reynolds stress for history dump
00067  * property_???()    - particle property selection function
00068  *============================================================================*/
00069 double ran2(long int *idum);
00070 
00071 void MultiNSH(int n, Real *tstop, Real *epsilon, Real etavk,
00072                      Real *uxNSH, Real *uyNSH, Real *wxNSH, Real *wyNSH);
00073 
00074 static Real hst_rho_Vx_dVy(const Grid *pG,const int i,const int j,const int k);
00075 
00076 static Real ShearingBoxPot(const Real x1, const Real x2, const Real x3);
00077 
00078 static int property_limit(const Grain *gr, const GrainAux *grsub);
00079 static int property_trace(const Grain *gr, const GrainAux *grsub);
00080 static int property_type(const Grain *gr, const GrainAux *grsub);
00081 
00082 extern Real expr_dpar(const Grid *pG, const int i, const int j, const int k);
00083 extern Real expr_V1par(const Grid *pG, const int i, const int j, const int k);
00084 extern Real expr_V2par(const Grid *pG, const int i, const int j, const int k);
00085 extern Real expr_V3par(const Grid *pG, const int i, const int j, const int k);
00086 extern Real expr_V2(const Grid *pG, const int i, const int j, const int k);
00087 
00088 /*=========================== PUBLIC FUNCTIONS =================================
00089  *============================================================================*/
00090 /*----------------------------------------------------------------------------*/
00091 /* problem:   */
00092 
00093 void problem(Grid *pGrid, Domain *pDomain)
00094 {
00095   int i,j,ip,jp,pt;
00096   long p;
00097   Real x1,x2,x3,t,x1l,x1u,x2l,x2u,x1p,x2p,x3p;
00098   Real x1min,x1max,x2min,x2max,Lx,Lz;
00099   Real tsmin,tsmax,tscrit,pwind,epsum;
00100   long int iseed = pGrid->my_id; /* Initialize on the first call to ran2 */
00101 
00102   if (par_geti("grid","Nx2") == 1) {
00103     ath_error("[streaming2d]: streaming2D only works for 2D problem.\n");
00104   }
00105   if (par_geti("grid","Nx3") > 1) {
00106     ath_error("[streaming2d]: streaming2D only works for 2D problem.\n");
00107   }
00108 
00109 /* Initialize boxsize */
00110 
00111   x1min = pGrid->x1_0 + (pGrid->is + pGrid->idisp)*pGrid->dx1;
00112   x1max = pGrid->x1_0 + (pGrid->ie + pGrid->idisp + 1.0)*pGrid->dx1;
00113   Lx = x1max - x1min;
00114 
00115   x2min = pGrid->x2_0 + (pGrid->js + pGrid->jdisp)*pGrid->dx2;
00116   x2max = pGrid->x2_0 + (pGrid->je + pGrid->jdisp + 1.0)*pGrid->dx2;
00117   Lz = x2max - x2min;
00118 
00119 /* Read initial conditions */
00120   rho0 = 1.0;
00121   Omega_0 = par_getd("problem","omega");
00122   qshear = par_getd_def("problem","qshear",1.5);
00123   ipert = par_geti_def("problem","ipert", 2);
00124   etavk = par_getd_def("problem","etavk",0.05);/* in unit of iso_sound (N.B.) */
00125 
00126   /* particle number */
00127   Npar  = (int)(sqrt(par_geti("particle","parnumcell")));
00128   Npar2 = SQR(Npar);
00129 
00130   pGrid->nparticle = Npar2*pGrid->Nx1*pGrid->Nx2;
00131   for (i=0; i<pGrid->partypes; i++)
00132     pGrid->grproperty[i].num = pGrid->nparticle;
00133   pGrid->nparticle = pGrid->partypes*pGrid->nparticle;
00134 
00135   if (pGrid->nparticle+2 > pGrid->arrsize)
00136     particle_realloc(pGrid, pGrid->nparticle+2);
00137 
00138   /* particle stopping time */
00139   tsmin = par_getd("problem","tsmin"); /* in code unit */
00140   tsmax = par_getd("problem","tsmax"); 
00141   tscrit= par_getd("problem","tscrit");
00142   if (par_geti("particle","tsmode") != 3)
00143     ath_error("[streaming2d]: This test works only for fixed stopping time!\n");
00144 
00145   for (i=0; i<pGrid->partypes; i++) {
00146     tstop0[i] = tsmin*exp(i*log(tsmax/tsmin)/MAX(pGrid->partypes-1,1.0));
00147 
00148     /* use fully implicit integrator for well coupled particles */
00149     if (tstop0[i] < tscrit) pGrid->grproperty[i].integrator = 3;
00150   }
00151 
00152   /* assign particle effective mass */
00153   epsilon= (Real*)calloc_1d_array(pGrid->partypes, sizeof(Real));
00154   wxNSH  = (Real*)calloc_1d_array(pGrid->partypes, sizeof(Real)); 
00155   wyNSH  = (Real*)calloc_1d_array(pGrid->partypes, sizeof(Real));
00156 
00157 #ifdef FEEDBACK
00158   mratio = par_getd_def("problem","mratio",0.0); /* total mass fraction */
00159   pwind = par_getd_def("problem","pwind",0.0);
00160   if (mratio < 0.0)
00161     ath_error("[streaming2d]: mratio must be positive!\n");
00162 
00163   epsum = 0.0;
00164   for (i=0; i<pGrid->partypes; i++)
00165   {
00166     epsilon[i] = pow(tstop0[i],pwind);  epsum += epsilon[i];
00167   }
00168 
00169   for (i=0; i<pGrid->partypes; i++)
00170   {
00171     epsilon[i] = mratio*epsilon[i]/epsum;
00172     pGrid->grproperty[i].m = rho0*epsilon[i]/Npar2;
00173   }
00174 #else
00175   mratio = 0.0;
00176   for (i=0; i<pGrid->partypes; i++)
00177     epsilon[i] = 0.0;
00178 #endif
00179 
00180   etavk = etavk * Iso_csound; /* switch to code unit */
00181 
00182   /* calculate NSH equilibrium velocity */
00183   MultiNSH(pGrid->partypes, tstop0, epsilon, etavk,
00184                             &uxNSH, &uyNSH, wxNSH, wyNSH);
00185 
00186 /* Now set initial conditions for the gas */
00187   for (j=pGrid->js; j<=pGrid->je; j++) {
00188   for (i=pGrid->is; i<=pGrid->ie; i++) {
00189     cc_pos(pGrid,i,j,pGrid->ks,&x1,&x2,&x3);
00190 
00191     pGrid->U[pGrid->ks][j][i].d = rho0;
00192 
00193     if (ipert != 3) {
00194       pGrid->U[pGrid->ks][j][i].M1 = rho0 * uxNSH;
00195       pGrid->U[pGrid->ks][j][i].M3 = rho0 * uyNSH;
00196     } else {
00197       pGrid->U[pGrid->ks][j][i].M1 = 0.0;
00198       pGrid->U[pGrid->ks][j][i].M3 = 0.0;
00199     }
00200 
00201     pGrid->U[pGrid->ks][j][i].M2 = 0.0;
00202 #ifndef FARGO
00203     pGrid->U[pGrid->ks][j][i].M3 -= qshear*rho0*Omega*x1;
00204 #endif
00205 
00206   }}
00207 
00208 /* Now set initial conditions for the particles */
00209   p = 0;
00210   x3p = pGrid->x3_0 + (pGrid->ks+pGrid->kdisp)*pGrid->dx3;
00211 
00212   for (j=pGrid->js; j<=pGrid->je; j++)
00213   {
00214     x2l = pGrid->x2_0 + (j+pGrid->jdisp)*pGrid->dx2;
00215     x2u = pGrid->x2_0 + ((j+pGrid->jdisp)+1.0)*pGrid->dx2;
00216 
00217     for (i=pGrid->is; i<=pGrid->ie; i++)
00218     {
00219       x1l = pGrid->x1_0 + (i + pGrid->idisp)*pGrid->dx1;
00220       x1u = pGrid->x1_0 + ((i + pGrid->idisp) + 1.0)*pGrid->dx1;
00221 
00222         for (pt=0; pt<pGrid->partypes; pt++)
00223         {
00224           for (ip=0;ip<Npar;ip++)
00225           {
00226 
00227             if (ipert == 0)
00228               x1p = x1l+pGrid->dx1/Npar*(ip+0.5);
00229 
00230             for (jp=0;jp<Npar;jp++)
00231             {
00232               if (ipert == 0)
00233                 x2p = x2l+pGrid->dx2/Npar*(jp+0.5);
00234               else if (ipert == 1)
00235               { /* ramdom particle position in the grid */
00236                 x1p = x1l + pGrid->dx1*ran2(&iseed);
00237                 x2p = x2l + pGrid->dx2*ran2(&iseed);
00238               }
00239               else
00240               {
00241                 x1p = x1min + Lx*ran2(&iseed);
00242                 x2p = x2min + Lz*ran2(&iseed);
00243               }
00244 
00245               pGrid->particle[p].property = pt;
00246               pGrid->particle[p].x1 = x1p;
00247               pGrid->particle[p].x2 = x2p;
00248               pGrid->particle[p].x3 = x3p;
00249 
00250               if (ipert != 3) {
00251                 pGrid->particle[p].v1 = wxNSH[pt];
00252                 pGrid->particle[p].v3 = wyNSH[pt];
00253               } else {
00254                 pGrid->particle[p].v1 = 0.0;
00255                 pGrid->particle[p].v3 = etavk;
00256               }
00257 
00258               pGrid->particle[p].v2 = 0.0;
00259 #ifndef FARGO
00260               pGrid->particle[p].v3 -= qshear*Omega*x1p;
00261 #endif
00262               pGrid->particle[p].pos = 1; /* grid particle */
00263               pGrid->particle[p].my_id = p;
00264 #ifdef MPI_PARALLEL
00265               pGrid->particle[p].init_id = pGrid->my_id;
00266 #endif
00267               p += 1;
00268             }
00269           }
00270         }
00271     }
00272   }
00273 
00274 /* enroll gravitational potential function, shearing sheet BC functions */
00275   StaticGravPot = ShearingBoxPot;
00276 
00277   dump_history_enroll(hst_rho_Vx_dVy, "<rho Vx dVy>");
00278 
00279   /* set the # of the particles in list output
00280    * (by default, output 1 particle per cell)
00281    */
00282   nlis = par_geti_def("problem","nlis",pGrid->Nx1*pGrid->Nx2);
00283 
00284   /* set the number of particles to keep track of */
00285   ntrack = par_geti_def("problem","ntrack",2000);
00286 
00287   return;
00288 }
00289 
00290 /*==============================================================================
00291  * PROBLEM USER FUNCTIONS:
00292  * problem_write_restart() - writes problem-specific user data to restart files
00293  * problem_read_restart()  - reads problem-specific user data from restart files
00294  * get_usr_expr()          - sets pointer to expression for special output data
00295  * get_usr_out_fun()       - returns a user defined output function pointer
00296  * Userwork_in_loop        - problem specific work IN     main loop
00297  * Userwork_after_loop     - problem specific work AFTER  main loop
00298  *----------------------------------------------------------------------------*/
00299 
00300 void problem_write_restart(Grid *pG, Domain *pD, FILE *fp)
00301 {
00302   fwrite(&rho0, sizeof(Real),1,fp);
00303   fwrite(&mratio, sizeof(Real),1,fp); fwrite(epsilon, sizeof(Real),pG->partypes,fp);
00304   fwrite(&etavk, sizeof(Real),1,fp);
00305   fwrite(&uxNSH, sizeof(Real),1,fp);
00306   fwrite(&uyNSH, sizeof(Real),1,fp);
00307   fwrite(wxNSH, sizeof(Real),pG->partypes,fp);
00308   fwrite(wyNSH, sizeof(Real),pG->partypes,fp);
00309 
00310   return;
00311 }
00312 
00313 void problem_read_restart(Grid *pG, Domain *pD, FILE *fp)
00314 {
00315   Real singleintvl,tracetime,traceintvl;
00316 
00317   StaticGravPot = ShearingBoxPot;
00318 
00319   Omega_0 = par_getd("problem","omega");
00320   qshear = par_getd_def("problem","qshear",1.5);
00321   ipert = par_geti_def("problem","ipert", 1);
00322 
00323   Npar  = (int)(sqrt(par_geti("particle","parnumcell")));
00324   Npar2 = SQR(Npar);
00325   nlis = par_geti_def("problem","nlis",pG->Nx1*pG->Nx2);
00326   ntrack = par_geti_def("problem","ntrack",2000);
00327 
00328   /* assign particle effective mass */
00329   epsilon= (Real*)calloc_1d_array(pG->partypes, sizeof(Real));
00330   wxNSH  = (Real*)calloc_1d_array(pG->partypes, sizeof(Real));
00331   wyNSH  = (Real*)calloc_1d_array(pG->partypes, sizeof(Real));
00332 
00333   fread(&rho0, sizeof(Real),1,fp);
00334   fread(&mratio, sizeof(Real),1,fp);
00335   fread(epsilon,sizeof(Real),pG->partypes,fp);
00336   fread(&etavk, sizeof(Real),1,fp);
00337   fread(&uxNSH, sizeof(Real),1,fp);
00338   fread(&uyNSH, sizeof(Real),1,fp);
00339   fread(wxNSH, sizeof(Real),pG->partypes,fp);
00340   fread(wyNSH, sizeof(Real),pG->partypes,fp);
00341 
00342   dump_history_enroll(hst_rho_Vx_dVy, "<rho Vx dVy>");
00343 
00344   return;
00345 }
00346 
00347 /*! \fn static Real expr_rhopardif(const Grid *pG, 
00348  *                           const int i, const int j, const int k)
00349  *  \brief Particle density difference */
00350 static Real expr_rhopardif(const Grid *pG, 
00351                            const int i, const int j, const int k)
00352 {
00353   Real x1,x2,x3;
00354   cc_pos(pG,i,j,k,&x1,&x2,&x3);
00355   return pG->Coup[k][j][i].grid_d - rho0*mratio;
00356 }
00357 
00358 /*----------------------------------------------------------------------------*/
00359 /*! \fn static Real hst_rho_Vx_dVy(const Grid *pG,
00360  *                         const int i, const int j, const int k)
00361  *  \brief Reynolds stress, added as history variable.
00362  */
00363 
00364 static Real hst_rho_Vx_dVy(const Grid *pG,
00365                            const int i, const int j, const int k)
00366 {
00367   Real x1,x2,x3;
00368   cc_pos(pG,i,j,k,&x1,&x2,&x3);
00369 #ifdef FARGO
00370   return pG->U[k][j][i].M1*pG->U[k][j][i].M3/pG->U[k][j][i].d;
00371 #else
00372   return pG->U[k][j][i].M1*(pG->U[k][j][i].M3/pG->U[k][j][i].d
00373                             + qshear*Omega_0*x1);
00374 #endif
00375 }
00376 
00377 Gasfun_t get_usr_expr(const char *expr)
00378 {
00379   if(strcmp(expr,"difdpar")==0) return expr_rhopardif;
00380   return NULL;
00381 }
00382 
00383 VGFunout_t get_usr_out_fun(const char *name){
00384   return NULL;
00385 }
00386 
00387 #ifdef PARTICLES
00388 PropFun_t get_usr_par_prop(const char *name)
00389 {
00390   if (strcmp(name,"limit")==0)    return property_limit;
00391   if (strcmp(name,"trace")==0)    return property_trace;
00392   if (strcmp(name,"type")==0)    return property_type;
00393   return NULL;
00394 }
00395 
00396 /*! \fn void gasvshift(const Real x1, const Real x2, const Real x3,
00397  *                                  Real *u1, Real *u2, Real *u3)
00398  *  \brief Gas velocity shift */
00399 void gasvshift(const Real x1, const Real x2, const Real x3,
00400                                     Real *u1, Real *u2, Real *u3)
00401 {
00402   return;
00403 }
00404 
00405 void Userforce_particle(Vector *ft, const Real x1, const Real x2, const Real x3,
00406                                     const Real v1, const Real v2, const Real v3)
00407 {
00408   ft->x1 -= 2.0*etavk*Omega_0;
00409   return;
00410 }
00411 #endif
00412 
00413 void Userwork_in_loop(Grid *pGrid, Domain *pDomain)
00414 {
00415   return;
00416 }
00417 
00418 /*---------------------------------------------------------------------------
00419  * Userwork_after_loop: computes L1-error in linear waves,
00420  * ASSUMING WAVE HAS PROPAGATED AN INTEGER NUMBER OF PERIODS
00421  * Must set parameters in input file appropriately so that this is true
00422  */
00423 
00424 void Userwork_after_loop(Grid *pGrid, Domain *pDomain)
00425 {
00426   free(epsilon);
00427   free(wxNSH);    free(wyNSH);
00428   return;
00429 }
00430 
00431 /*=========================== PRIVATE FUNCTIONS ==============================*/
00432 /*--------------------------------------------------------------------------- */
00433 /*! \fn static Real ShearingBoxPot(const Real x1, const Real x2, const Real x3)
00434  *  \brief shearing box tidal gravitational potential*/
00435 static Real ShearingBoxPot(const Real x1, const Real x2, const Real x3)
00436 {
00437   Real phi=0.0;
00438 #ifndef FARGO
00439   phi -= qshear*SQR(Omega_0*x1);
00440 #endif
00441   return phi;
00442 }
00443 
00444 /*! \fn static int property_limit(const Grain *gr, const GrainAux *grsub)
00445  *  \brief user defined particle selection function (1: true; 0: false) */
00446 static int property_limit(const Grain *gr, const GrainAux *grsub)
00447 {
00448   if ((gr->pos == 1) && (gr->my_id<nlis))
00449     return 1;
00450   else
00451     return 0;
00452 }
00453 
00454 /*! \fn static int property_trace(const Grain *gr, const GrainAux *grsub)
00455  *  \brief user defined particle selection function (1: true; 0: false) */
00456 static int property_trace(const Grain *gr, const GrainAux *grsub)
00457 {
00458   if ((gr->pos == 1) && (gr->my_id<ntrack))
00459     return 1;
00460   else
00461     return 0;
00462 }
00463 
00464 /*! \fn static int property_type(const Grain *gr, const GrainAux *grsub)
00465  *  \brief user defined particle selection function (1: true; 0: false) */
00466 static int property_type(const Grain *gr, const GrainAux *grsub)
00467 {
00468   if ((gr->pos == 1) && (gr->property == mytype))
00469     return 1;
00470   else
00471     return 0;
00472 }
00473 
00474 /*--------------------------------------------------------------------------- */
00475 /*! \fn void MultiNSH(int n, Real *tstop, Real *mratio, Real etavk,
00476  *                   Real *uxNSH, Real *uyNSH, Real *wxNSH, Real *wyNSH)
00477  *  \brief Multi-species NSH equilibrium
00478  *
00479  * Input: # of particle types (n), dust stopping time and mass ratio array, and
00480  *        drift speed etavk.
00481  * Output: gas NSH equlibrium velocity (u), and dust NSH equilibrium velocity
00482  *         array (w).
00483  */
00484 void MultiNSH(int n, Real *tstop, Real *mratio, Real etavk,
00485                      Real *uxNSH, Real *uyNSH, Real *wxNSH, Real *wyNSH)
00486 {
00487   int i,j;
00488   Real *Lambda1,**Lam1GamP1, **A, **B, **Tmp;
00489 
00490   Lambda1 = (Real*)calloc_1d_array(n, sizeof(Real));     /* Lambda^{-1} */
00491   Lam1GamP1=(Real**)calloc_2d_array(n, n, sizeof(Real));/* Lambda1*(1+Gamma) */
00492   A       = (Real**)calloc_2d_array(n, n, sizeof(Real));
00493   B       = (Real**)calloc_2d_array(n, n, sizeof(Real));
00494   Tmp     = (Real**)calloc_2d_array(n, n, sizeof(Real));
00495 
00496   /* definitions */
00497   for (i=0; i<n; i++){
00498     for (j=0; j<n; j++)
00499       Lam1GamP1[i][j] = mratio[j];
00500     Lam1GamP1[i][i] += 1.0;
00501     Lambda1[i] = 1.0/(tstop[i]+1.0e-16);
00502     for (j=0; j<n; j++)
00503       Lam1GamP1[i][j] *= Lambda1[i];
00504   }
00505 
00506   /* Calculate A and B */
00507   MatrixMult(Lam1GamP1, Lam1GamP1, n,n,n, Tmp);
00508   for (i=0; i<n; i++) Tmp[i][i] += 1.0;
00509   InverseMatrix(Tmp, n, B);
00510   for (i=0; i<n; i++)
00511   for (j=0; j<n; j++)
00512     B[i][j] *= Lambda1[j];
00513   MatrixMult(Lam1GamP1, B, n,n,n, A);
00514 
00515   /* Obtain NSH velocities */
00516   *uxNSH = 0.0;  *uyNSH = 0.0;
00517   for (i=0; i<n; i++){
00518     wxNSH[i] = 0.0;
00519     wyNSH[i] = 0.0;
00520     for (j=0; j<n; j++){
00521       wxNSH[i] -= B[i][j];
00522       wyNSH[i] -= A[i][j];
00523     }
00524     wxNSH[i] *= 2.0*etavk;
00525     wyNSH[i] *= etavk;
00526     *uxNSH -= mratio[i]*wxNSH[i];
00527     *uyNSH -= mratio[i]*wyNSH[i];
00528     wyNSH[i] += etavk;
00529   }
00530 
00531   free(Lambda1);
00532   free_2d_array(A);         free_2d_array(B);
00533   free_2d_array(Lam1GamP1); free_2d_array(Tmp);
00534 
00535   return;
00536 }
00537 
00538 /*------------------------------------------------------------------------------
00539  */
00540 
00541 #define IM1 2147483563
00542 #define IM2 2147483399
00543 #define AM (1.0/IM1)
00544 #define IMM1 (IM1-1)
00545 #define IA1 40014
00546 #define IA2 40692
00547 #define IQ1 53668
00548 #define IQ2 52774
00549 #define IR1 12211
00550 #define IR2 3791
00551 #define NTAB 32
00552 #define NDIV (1+IMM1/NTAB)
00553 #define RNMX (1.0-DBL_EPSILON)
00554 
00555 /*! \fn double ran2(long int *idum)
00556  *  \brief Extracted from the Numerical Recipes in C (version 2) code.  Modified
00557  *   to use doubles instead of floats. -- T. A. Gardiner -- Aug. 12, 2003
00558  *
00559  * Long period (> 2 x 10^{18}) random number generator of L'Ecuyer
00560  * with Bays-Durham shuffle and added safeguards.  Returns a uniform
00561  * random deviate between 0.0 and 1.0 (exclusive of the endpoint
00562  * values).  Call with idum = a negative integer to initialize;
00563  * thereafter, do not alter idum between successive deviates in a
00564  * sequence.  RNMX should appriximate the largest floating point value
00565  * that is less than 1.
00566  */
00567 
00568 double ran2(long int *idum)
00569 {
00570   int j;
00571   long int k;
00572   static long int idum2=123456789;
00573   static long int iy=0;
00574   static long int iv[NTAB];
00575   double temp;
00576 
00577   if (*idum <= 0) { /* Initialize */
00578     if (-(*idum) < 1) *idum=1; /* Be sure to prevent idum = 0 */
00579     else *idum = -(*idum);
00580     idum2=(*idum);
00581     for (j=NTAB+7;j>=0;j--) { /* Load the shuffle table (after 8 warm-ups) */
00582       k=(*idum)/IQ1;
00583       *idum=IA1*(*idum-k*IQ1)-k*IR1;
00584       if (*idum < 0) *idum += IM1;
00585       if (j < NTAB) iv[j] = *idum;
00586     }
00587     iy=iv[0];
00588   }
00589   k=(*idum)/IQ1;                 /* Start here when not initializing */
00590   *idum=IA1*(*idum-k*IQ1)-k*IR1; /* Compute idum=(IA1*idum) % IM1 without */
00591   if (*idum < 0) *idum += IM1;   /* overflows by Schrage's method */
00592   k=idum2/IQ2;
00593   idum2=IA2*(idum2-k*IQ2)-k*IR2; /* Compute idum2=(IA2*idum) % IM2 likewise */
00594   if (idum2 < 0) idum2 += IM2;
00595   j=(int)(iy/NDIV);              /* Will be in the range 0...NTAB-1 */
00596   iy=iv[j]-idum2;                /* Here idum is shuffled, idum and idum2 */
00597   iv[j] = *idum;                 /* are combined to generate output */
00598   if (iy < 1) iy += IMM1;
00599   if ((temp=AM*iy) > RNMX) return RNMX; /* No endpoint values */
00600   else return temp;
00601 }
00602 
00603 #undef IM1
00604 #undef IM2
00605 #undef AM
00606 #undef IMM1
00607 #undef IA1
00608 #undef IA2
00609 #undef IQ1
00610 #undef IQ2
00611 #undef IR1
00612 #undef IR2
00613 #undef NTAB
00614 #undef NDIV
00615 #undef RNMX

Generated on Mon Sep 27 2010 23:03:08 for Athena by  doxygen 1.7.1