/* SETUP ROUTINES */
static int initial_set(){
int prompt,status;
#ifdef FIX_NODE_GEOM
int i;
#endif
/* On node zero, read lattice size and send to others */
if(mynode()==0){
/* print banner */
printf("SU3 clover, staggered and naive valence fermions\n");
printf("MIMD version %s\n",MILC_CODE_VERSION);
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
gethostname(hostname, 128);
printf("Host(0) = %s\n",hostname);
printf("Username = %s\n", getenv("USER"));
time_stamp("start");
status = get_prompt(stdin, &prompt );
IF_OK status += get_i(stdin,prompt,"nx", ¶m.nx );
IF_OK status += get_i(stdin,prompt,"ny", ¶m.ny );
IF_OK status += get_i(stdin,prompt,"nz", ¶m.nz );
IF_OK status += get_i(stdin,prompt,"nt", ¶m.nt );
#ifdef FIX_NODE_GEOM
IF_OK status += get_vi(stdin, prompt, "node_geometry",
param.node_geometry, 4);
#ifdef FIX_IONODE_GEOM
IF_OK status += get_vi(stdin, prompt, "ionode_geometry",
param.ionode_geometry, 4);
#endif
#endif
IF_OK status += get_s(stdin, prompt,"job_id",param.job_id);
if(status>0) param.stopflag=1; else param.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)¶m,sizeof(param));
if( param.stopflag != 0 )
normal_exit(0);
nx=param.nx;
ny=param.ny;
nz=param.nz;
nt=param.nt;
iseed=param.iseed;
#ifdef FIX_NODE_GEOM
for(i = 0; i < 4; i++)
node_geometry[i] = param.node_geometry[i];
#ifdef FIX_IONODE_GEOM
for(i = 0; i < 4; i++)
ionode_geometry[i] = param.ionode_geometry[i];
#endif
#endif
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
return(prompt);
}
void setup_fixed_geom(int *geom, int n){
int i;
int node_count;
int len[4];
int status;
len[0] = nx; len[1] = ny; len[2] = nz; len[3] = nt;
node_count = 1;
status = 0;
for(i = 0; i < 4; i++){
nsquares[i] = geom[i];
node_count *= geom[i];
if(len[i] % nsquares[i] != 0)status++;
squaresize[i] = len[i]/nsquares[i];
}
if(node_count != numnodes()){
node0_printf("/nsetup_fixed_geom: Requested geometry %d %d %d %d ",
geom[0], geom[1], geom[2], geom[3]);
node0_printf("does not match number of nodes %d\n",numnodes());
terminate(1);
}
if(status){
node0_printf("setup_fixed_geom: Requested geometry %d %d %d %d ",
geom[0], geom[1], geom[2], geom[3]);
node0_printf("is not commensurate with the lattice dims %d %d %d %d\n",
nx, ny, nz, nt);
terminate(1);
}
}
/* SETUP ROUTINES */
int initial_set(){
int prompt,status;
/* On node zero, read lattice size and send to others */
if(mynode()==0){
/* print banner */
printf("SU3 Wilson valence fermion Schroedinger functional\n");
printf("MIMD version 4\n");
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
status=get_prompt(stdin, &prompt);
IF_OK status += get_i(stdin, prompt,"nx", &par_buf.nx );
IF_OK status += get_i(stdin, prompt,"ny", &par_buf.ny );
IF_OK status += get_i(stdin, prompt,"nz", &par_buf.nz );
IF_OK status += get_i(stdin, prompt,"nt", &par_buf.nt );
if(status>0) par_buf.stopflag=1; else par_buf.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)&par_buf,sizeof(par_buf));
if( par_buf.stopflag != 0 )
normal_exit(0);
nx=par_buf.nx;
ny=par_buf.ny;
nz=par_buf.nz;
nt=par_buf.nt;
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
return(prompt);
}
/* SETUP ROUTINES */
int initial_set() {
int prompt,status;
/* On node zero, read lattice size, seed, nflavors and send to others */
if(mynode()==0) {
/* print banner */
printf("SU3 with Wilson fermions\n");
printf("Microcanonical simulation with refreshing\n");
printf("MIMD version 6\n");
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
#ifdef HMC_ALGORITHM
printf("Hybrid Monte Carlo algorithm\n");
#endif
#ifdef PHI_ALGORITHM
printf("PHI algorithm\n");
#else
printf("R algorithm\n");
#endif
#ifdef SPECTRUM
printf("With spectrum measurements\n");
#endif
time_stamp("start");
status = get_prompt(stdin, &prompt);
IF_OK status += get_i(stdin, prompt, "nflavors", &par_buf.nflavors );
#ifdef PHI_ALGORITHM
if( par_buf.nflavors != 2) {
printf("Dummy! Use phi algorithm only for two flavors\n");
terminate(-1);
}
#endif
IF_OK status += get_i(stdin, prompt, "nx", &par_buf.nx );
IF_OK status += get_i(stdin, prompt, "ny", &par_buf.ny );
IF_OK status += get_i(stdin, prompt, "nz", &par_buf.nz );
IF_OK status += get_i(stdin, prompt, "nt", &par_buf.nt );
IF_OK status += get_i(stdin, prompt, "iseed", &par_buf.iseed );
if(status>0) par_buf.stopflag=1;
else par_buf.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)&par_buf,sizeof(par_buf));
if( par_buf.stopflag != 0 )
normal_exit(0);
nx=par_buf.nx;
ny=par_buf.ny;
nz=par_buf.nz;
nt=par_buf.nt;
iseed=par_buf.iseed;
nflavors=par_buf.nflavors;
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
total_iters=0;
return(prompt);
}
/* SETUP ROUTINES */
int initial_set(){
int prompt,status;
/* On node zero, read lattice size, seed, and send to others */
if(mynode()==0){
/* print banner */
printf("SU3 with improved KS action\n");
printf("Eigenvalues and eigenvectors\n");
printf("MIMD version 6\n");
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
gethostname(hostname, 128);
printf("Host(0) = %s\n",hostname);
printf("Username = %s\n", getenv("USER"));
time_stamp("start");
get_utc_datetime(utc_date_time);
/* Print list of options selected */
node0_printf("Options selected...\n");
show_generic_opts();
show_generic_ks_opts();
#if FERM_ACTION == HISQ
show_su3_mat_opts();
show_hisq_links_opts();
#elif FERM_ACTION == HYPISQ
show_su3_mat_opts();
show_hypisq_links_opts();
#endif
status=get_prompt(stdin, &prompt);
IF_OK status += get_i(stdin, prompt,"nx", &par_buf.nx );
IF_OK status += get_i(stdin, prompt,"ny", &par_buf.ny );
IF_OK status += get_i(stdin, prompt,"nz", &par_buf.nz );
IF_OK status += get_i(stdin, prompt,"nt", &par_buf.nt );
IF_OK status += get_i(stdin, prompt,"iseed", &par_buf.iseed );
if(status>0) par_buf.stopflag=1; else par_buf.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)&par_buf,sizeof(par_buf));
if( par_buf.stopflag != 0 )
normal_exit(0);
nx=par_buf.nx;
ny=par_buf.ny;
nz=par_buf.nz;
nt=par_buf.nt;
iseed=par_buf.iseed;
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
total_iters=0;
return(prompt);
}
// -----------------------------------------------------------------
static void setup_hyper_prime() {
int i, j, k, dir;
if (mynode()==0) {
printf("hyper_prime,");
printf("\n");
}
// Figure out dimensions of rectangle
squaresize[XUP] = nx;
squaresize[YUP] = ny;
squaresize[ZUP] = nz;
squaresize[TUP] = nt;
nsquares[XUP] = 1;
nsquares[YUP] = 1;
nsquares[ZUP] = 1;
nsquares[TUP] = 1;
i = 1; // Current number of hypercubes
while (i < numnodes()) {
// Figure out which prime to divide by starting with largest
k = MAXPRIMES - 1;
while ((numnodes() / i) % prime[k] != 0 && k > 0)
--k;
// Figure out which direction to divide
// Find largest even dimension of h-cubes
for (j = 1, dir = XUP; dir <= TUP; dir++) {
if (squaresize[dir] > j && squaresize[dir] % prime[k] == 0)
j = squaresize[dir];
}
/* if one direction with largest dimension has already been
divided, divide it again. Otherwise divide first direction
with largest dimension. */
for (dir = XUP; dir <= TUP; dir++) {
if (squaresize[dir] == j && nsquares[dir] > 1)
break;
}
if (dir > TUP) {
for (dir = XUP; dir <= TUP; dir++) {
if (squaresize[dir] == j)
break;
}
}
// This can fail if I run out of prime factors in the dimensions
if (dir > TUP) {
node0_printf("LAYOUT: Can't lay out this lattice, ");
node0_printf("not enough factors of %d\n", prime[k]);
terminate(1);
}
// Do the surgery
i *= prime[k];
squaresize[dir] /= prime[k];
nsquares[dir] *= prime[k];
}
}
void setup_layout(){
register int i,j,k,dir;
register int factor;
if(mynode()==0){
printf("LAYOUT = Hypercubes, options = ");
printf("EVENFIRST,");
printf("\n");
}
/* Figure out dimensions of rectangle */
squaresize[XUP] = nx; squaresize[YUP] = ny;
squaresize[ZUP] = nz; squaresize[TUP] = nt;
nsquares[XUP] = nsquares[YUP] = nsquares[ZUP] = nsquares[TUP] = 1;
i = 1; /* current number of hypercubes */
while(i<numnodes()){
/* decide whether to divide by three or two */
if( (numnodes()/i)%3 == 0 ) factor=3; else factor=2;
/* figure out which direction to divide */
/* find largest even dimension of h-cubes */
for(j=1,dir=XUP;dir<=TUP;dir++)
if( squaresize[dir]>j && squaresize[dir]%factor==0 )
j=squaresize[dir];
/* if one direction with largest dimension has already been
divided, divide it again. Otherwise divide first direction
with largest dimension. */
for(dir=XUP;dir<=TUP;dir++)
if( squaresize[dir]==j && nsquares[dir]>1 )break;
if( dir > TUP)for(dir=XUP;dir<=TUP;dir++)
if( squaresize[dir]==j )break;
/* This can fail if I run out of factors of 3 or 2 in the dimensions */
if(dir > TUP){
if(mynode()==0)printf(
"LAYOUT: Can't lay out this lattice, not enough factors of %d\n"
,factor);
terminate(1);
}
/* do the surgery */
i*=factor; squaresize[dir] /= factor; nsquares[dir] *= factor;
}
sites_on_node =
squaresize[XUP]*squaresize[YUP]*squaresize[ZUP]*squaresize[TUP];
/* Need even number of sites per hypercube */
if( mynode()==0)if( sites_on_node%2 != 0){
printf("SORRY, CAN'T LAY OUT THIS LATTICE\n");
terminate(0);
}
if( mynode()==0)
printf("ON EACH NODE %d x %d x %d x %d\n",squaresize[XUP],squaresize[YUP],
squaresize[ZUP],squaresize[TUP]);
if( mynode()==0 && sites_on_node%2 != 0)
printf("WATCH OUT FOR EVEN/ODD SITES ON NODE BUG!!!\n");
even_sites_on_node = odd_sites_on_node = sites_on_node/2;
}
static int
diff_r(Cellidx c1, Cellidx c2) {
int i;
int w1, w2, dif;
int a1[MAXTREEHEIGHT], a2[MAXTREEHEIGHT];
int lev1, lev2, bot;
if (Ctype(c1) == VAR && Ctype(c2) == VAR) {
w1 = Cbdist(c1);
w2 = Cbdist(c2);
if (w1 > 0 && w2 > 0) {
/* both bound; return difference */
return DIST(w1, w2);
} else if (w1 > 0) {
/* c1 is bound, c2 is free */
return w1 - w2;
} else if (w2 > 0) {
/* c2 is bound, c1 is free */
return w2 - w1;
} else {
/* both free */
return DIST(Cvar(c1), Cvar(c2));
}
} else if (Ctype(c1) == VAR && Ctype(c2) == ABST) {
return numnodes(c2);
} else if (Ctype(c1) == ABST && Ctype(c2) == VAR) {
return numnodes(c1);
} else if (Ctype(c1) == VAR && Ctype(c2) == APPL) {
return numnodes(c2);
} else if (Ctype(c1) == APPL && Ctype(c2) == VAR) {
return numnodes(c1);
} else if (Ctype(c1) == ABST && Ctype(c2) == ABST) {
return diff_r(Cbody(c1), Cbody(c2));
} else if ((Ctype(c1) == ABST && Ctype(c2) == APPL) ||
(Ctype(c1) == APPL && Ctype(c2) == ABST)) {
lev1 = arraynodes(c1, a1, MAXTREEHEIGHT);
lev2 = arraynodes(c2, a2, MAXTREEHEIGHT);
bot = max(lev1, lev2);
dif = 0;
for (i = 0; i < bot; i++)
dif += 2 + DIST(a1[i], a2[i]);
return dif;
} else if (Ctype(c1) == APPL && Ctype(c2) == APPL) {
return diff_r(Cleft(c1), Cleft(c2)) + diff_r(Cright(c1), Cright(c2));
} else {
fatal("diff_r: unexpected cell type %d and %d\n", Ctype(c1), Ctype(c2));
}
fatal("diff_r: cannot come here\n");
/*NOTREACHED*/
return 0;
}
// -----------------------------------------------------------------
// On node zero, read and distribute lattice size and random number seed
int initial_set() {
int prompt, status;
if (mynode() == 0) {
// Print banner
printf("SU3 Kogut--Susskind eigenvalue calculation\n");
printf("Machine = %s, with %d nodes\n", machine_type(), numnodes());
printf("nHYP links, reading alpha_smear parameters from infile\n");
printf(" IR_STAB = %.4g\n", (Real)IR_STAB);
printf(" EPS_SQ = %.4g\n", (Real)EPS_SQ);
#ifdef NHYP_DEBUG
printf("NHYP_DEBUG turned on\n");
#endif
#ifdef NO_UNIT_CHECK
printf("NOT checking unitarity when loading lattice\n");
#endif
time_stamp("start");
status = get_prompt(stdin, &prompt);
IF_OK status += get_i(stdin, prompt, "nx", &par_buf.nx);
IF_OK status += get_i(stdin, prompt, "ny", &par_buf.ny);
IF_OK status += get_i(stdin, prompt, "nz", &par_buf.nz);
IF_OK status += get_i(stdin, prompt, "nt", &par_buf.nt);
IF_OK status += get_i(stdin, prompt, "iseed", &par_buf.iseed);
if (status > 0)
par_buf.stopflag = 1;
else
par_buf.stopflag = 0;
}
// Broadcast parameter buffer from node 0 to all other nodes
broadcast_bytes((char *)&par_buf, sizeof(par_buf));
if (par_buf.stopflag != 0)
normal_exit(0);
nx = par_buf.nx;
ny = par_buf.ny;
nz = par_buf.nz;
nt = par_buf.nt;
iseed = par_buf.iseed;
this_node = mynode();
number_of_nodes = numnodes();
volume = nx * ny * nz * nt;
total_iters = 0;
return(prompt);
}
/* SETUP ROUTINES */
int initial_set(){
int prompt,status;
/* On node zero, read lattice size, seed, nflavors and send to others */
if(mynode()==0){
/* print banner */
printf("Schroedinger functional for pure gauge SU3\n");
#ifdef RMD_ALGORITHM
printf("Microcanonical simulation with refreshing\n");
#endif
#ifdef HMC_ALGORITHM
printf("Microcanonical simulation with refreshing\n");
#endif
printf("MIMD version 6\n");
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
#ifdef HMC_ALGORITHM
printf("Hybrid Monte Carlo algorithm\n");
#endif
#ifdef ORA_ALGORITHM
printf("Overrelaxed/quasi-heat bath algorithm\n");
#endif
status=get_prompt(stdin, &prompt);
IF_OK status += get_i(stdin, prompt,"nx", &par_buf.nx );
IF_OK status += get_i(stdin, prompt,"ny", &par_buf.ny );
IF_OK status += get_i(stdin, prompt,"nz", &par_buf.nz );
IF_OK status += get_i(stdin, prompt,"nt", &par_buf.nt );
IF_OK status += get_i(stdin, prompt,"iseed", &par_buf.iseed );
if(status>0) par_buf.stopflag=1; else par_buf.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)&par_buf,sizeof(par_buf));
if( par_buf.stopflag != 0 )
normal_exit(0);
nx=par_buf.nx;
ny=par_buf.ny;
nz=par_buf.nz;
nt=par_buf.nt;
iseed=par_buf.iseed;
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
return(prompt);
}
void setup_layout(){
register int i,j,k;
if(mynode()==0){
printf("LAYOUT = 2d-squares, options = ");
printf("EVENFIRST,");
printf("\n");
}
/* sort directions with longest ones first */
dirs[0]=XUP; dirs[1]=YUP; dirs[2]=ZUP; dirs[3]=TUP;
dims[XUP]=nx; dims[YUP]=ny; dims[ZUP]=nz; dims[TUP]=nt;
for(i=3;i>0;i--)for(j=0;j<i;j++){
if(dims[dirs[j]]<dims[dirs[j+1]]){
k=dirs[j]; dirs[j]=dirs[j+1]; dirs[j+1]=k;
}
}
nsites_per = dims[dirs[ZUP]]*dims[dirs[TUP]];
/* Figure out dimensions of rectangle */
i=1; /* current number of squares */
xsquaresize = dims[dirs[XUP]];
ysquaresize = dims[dirs[YUP]];
nxsquares = nysquares = 1;
while(i<numnodes()){
if( dims[dirs[XUP]]/nxsquares >= dims[dirs[YUP]]/nysquares ){
if( (dims[dirs[XUP]]/nxsquares)%2 == 0){ /* decrease x size */
i*=2; xsquaresize /= 2; nxsquares *= 2;
}
else if( (dims[dirs[YUP]]/nysquares)%2 == 0){ /* dec.. y size */
i*=2; ysquaresize /= 2; nysquares *= 2;
}
else {
if(mynode()==0)printf(
"LAYOUT: Can't lay out this lattice, not enough factors of 2\n");
terminate(1);
}
}
else {
if( (dims[dirs[YUP]]/nysquares)%2 == 0){ /* decrease y size */
i*=2; ysquaresize /= 2; nysquares *= 2;
}
else if( (dims[dirs[XUP]]/nxsquares)%2 == 0){ /* dec. x size */
i*=2; xsquaresize /= 2; nxsquares *= 2;
}
else {
if(mynode()==0)printf(
"LAYOUT: Can't lay out this lattice, not enough factors of 2\n");
terminate(1);
}
}
}
if( mynode()==0)if( dims[dirs[ZUP]]%2 != 0 || dims[dirs[TUP]]%2 != 0){
printf("SORRY, CAN'T LAY OUT THIS LATTICE\n");
terminate(0);
}
sites_on_node = nsites_per*(xsquaresize*ysquaresize);
even_sites_on_node = odd_sites_on_node = sites_on_node/2;
}
void get_parallel_info(int *proc, int *nprocs, int *dim)
{
*proc = mynode();
*nprocs = numnodes();
*dim = 0;
} /* get_parallel_info */
intrusive_list_base::size_type intrusive_list_base::size(void) const {
size_type numnodes(0);
const intrusive_list_node* iter = &m_root;
do {
iter = iter->next;
++numnodes;
} while (iter != &m_root);
return numnodes - 1;
}
static int ft_setup_layout(int nsquares[], int squaresize[], int dirp[],
int ndim, int dims[], int ft_dir){
int i,j,k,dir;
char myname[] = "ft_setup_layout";
int nodes = numnodes();
/* Starting layout */
for(dir = 0; dir < ndim; dir++){
squaresize[dir] = dims[dir];
nsquares[dir] = 1;
dirp[dir] = dir;
}
/* dirp is used to redefine the lexicographic ordering of
coordinates so the slowest varying (last one) is the FT
coordinate */
if(ndim-1 != ft_dir){
k = dirp[ft_dir];
dirp[ft_dir] = dirp[ndim-1];
dirp[ndim-1] = k;
}
/* We don't divide the coordinate in the ft_dir */
i = 1; /* current number of hypercubes */
while(i<nodes){
/* figure out which prime to divide by starting with largest */
k = MAXPRIMES-1;
while( (nodes/i)%prime[k] != 0 && k>0 ) --k;
/* figure out which direction to divide */
/* find largest dimension of h-cubes divisible by prime[k] */
for(j=0,dir=0;dir<=ndim-1;dir++)if(dir!=ft_dir)
if( squaresize[dir]>j && squaresize[dir]%prime[k]==0 )
j=squaresize[dir];
/* if one direction with largest dimension has already been
divided, divide it again. Otherwise divide first direction
with largest dimension. */
for(dir=0;dir<=ndim-1;dir++)if(dir!=ft_dir)
if( squaresize[dir]==j && nsquares[dir]>1 )break;
if( dir >= ndim)for(dir=0;dir<=ndim-1;dir++)if(dir!=ft_dir)
if( squaresize[dir]==j )break;
/* This can fail if I run out of prime factors in the dimensions */
if(dir >= ndim){
if(mynode()==0)
printf("%s: Can't lay out this lattice, not enough factors of %d\n",
myname,prime[k]);
return 1;
}
/* do the surgery */
i*=prime[k]; squaresize[dir] /= prime[k]; nsquares[dir] *= prime[k];
}
return 0;
}
void unreduce (double *x, int n)
{
int nprocs = numnodes(),
pid = mynode(),
k;
ROOTONLY
for (k = 1; k < nprocs; k++)
csend (MSGTAG + k, x, n*sizeof(double), k, 0);
else
/* SETUP ROUTINES */
int
initial_set()
{
int prompt, status;
if(mynode()==0){
/* print banner */
printf("Wilson/Symanzik Flow application\n");
printf("MIMD version 7\n");
printf("Machine = %s, with %d nodes\n", machine_type(), numnodes());
/* Read prompt type and lattice dimensions */
status=get_prompt(stdin, &prompt);
IF_OK status += get_i(stdin, prompt,"nx", &par_buf.nx );
IF_OK status += get_i(stdin, prompt,"ny", &par_buf.ny );
IF_OK status += get_i(stdin, prompt,"nz", &par_buf.nz );
IF_OK status += get_i(stdin, prompt,"nt", &par_buf.nt );
if(status>0)
par_buf.stopflag=1;
else
par_buf.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)&par_buf, sizeof(par_buf));
if( par_buf.stopflag != 0 )
normal_exit(0);
/* Update global variables with parameters */
nx=par_buf.nx;
ny=par_buf.ny;
nz=par_buf.nz;
nt=par_buf.nt;
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
return prompt;
}
void get_parallel_info(int *proc, int *nprocs, int *dim)
{
int dummy1, dummy2, dummy3;
int host, nodeID;
*proc = mynode();
*nprocs = numnodes();
*dim = 0;
} /* get_parallel_info */
void setup_layout(){
if(mynode()==0){
printf("LAYOUT = Timeslices, options = ");
printf("EVENFIRST,");
printf("\n");
}
if( nt%numnodes() !=0 ){ /* then maybe numnodes is a multiple of nt */
if (numnodes()%nt == 0 && nz%(numnodes()/nt) == 0 ) ;/* we can
do the layout */
elseif(mynode()==0)printf(
"LAYOUT: Can't lay out this lattice: nt not multiple of nummodes\n");
terminate(1);
}
if( nt >= numnodes() ) {/* we only have to divide in t-direction */
ntslices = nt / numnodes();
zcuts = 1;
nzslices = nz;
}
else {
ntslizes = 1;
zcuts = numnodes()/nt;
nzslices = nz/zcuts;
}
sites_on_node = nx*ny*nzslices*ntslices;
/* Need even number of sites per hypercube */
if( mynode()==0)if( sites_on_node%2 != 0){
printf("SORRY, CAN'T LAY OUT THIS LATTICE\n");
terminate(0);
}
even_sites_on_node = odd_sites_on_node = sites_on_node/2;
}
/* SETUP ROUTINES */
int initial_set(){
int prompt,status;
/* On node zero, read lattice size, seed, and send to others */
if(mynode()==0){
/* print banner */
printf("U1 with improved KS action\n");
printf("Eigenvalues and eigenvectors\n");
printf("MIMD version 6\n");
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
status=get_prompt(stdin, &prompt);
IF_OK status += get_i(stdin, prompt,"nx", &par_buf.nx );
IF_OK status += get_i(stdin, prompt,"ny", &par_buf.ny );
IF_OK status += get_i(stdin, prompt,"nz", &par_buf.nz );
IF_OK status += get_i(stdin, prompt,"nt", &par_buf.nt );
IF_OK status += get_i(stdin, prompt,"iseed", &par_buf.iseed );
if(status>0) par_buf.stopflag=1; else par_buf.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)&par_buf,sizeof(par_buf));
if( par_buf.stopflag != 0 )
normal_exit(0);
nx=par_buf.nx;
ny=par_buf.ny;
nz=par_buf.nz;
nt=par_buf.nt;
iseed=par_buf.iseed;
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
total_iters=0;
return(prompt);
}
/* SETUP ROUTINES */
int initial_set(){
int prompt,status;
/* On node zero, read lattice size, seed, and send to others */
if(mynode()==0){
/* print banner */
printf("Heavy-light spectroscpy with Kogut-Susskind light fermions\n");
printf("MIMD version 7\n");
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
time_stamp("start");
status = get_prompt(stdin, &prompt );
IF_OK status += get_i(stdin, prompt,"nx", &par_buf.nx );
IF_OK status += get_i(stdin, prompt,"ny", &par_buf.ny );
IF_OK status += get_i(stdin, prompt,"nz", &par_buf.nz );
IF_OK status += get_i(stdin, prompt,"nt", &par_buf.nt );
IF_OK status += get_s(stdin, prompt,"job_id",par_buf.job_id);
if(status>0) par_buf.stopflag=1; else par_buf.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)&par_buf,sizeof(par_buf));
if( par_buf.stopflag != 0 )
normal_exit(0);
nx=par_buf.nx;
ny=par_buf.ny;
nz=par_buf.nz;
nt=par_buf.nt;
strcpy(job_id,par_buf.job_id);
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
total_iters=0;
return(prompt);
}
void prnstats (Index S)
{ vpt *tree = (vpt*)S;
int nbucks = numbucks(&tree->node);
int sbucks = sizebucks(&tree->node);
int nnodes = numnodes(&tree->node);
printf ("number of elements: %i\n",sbucks+nnodes);
printf ("bucket size: %i\n",tree->bsize);
printf ("maximum height: %i\n",height(&tree->node));
printf ("number of nodes: %i\n",nnodes);
printf ("number of buckets: %i\n",nbucks);
printf ("average size of bucket: %0.2f\n",sbucks/(double)nbucks);
printf ("average depth of bucket: %0.2f\n",
profbucks(&tree->node,0)/(double)nbucks);
}
/* SETUP ROUTINES */
int initial_set(void)
{
int prompt,status;
/* On node zero, read lattice size, seed, nflavors and send to others */
if(mynode()==0)
{
/* print banner */
printf("SU3 Smoothing for Instantons\n");
printf("MIMD version 7\n");
printf("Machine = %s, with %d nodes\n", machine_type(), numnodes());
time_stamp("start");
status=get_prompt(stdin, &prompt);
IF_OK status += get_i(stdin, prompt,"nx", &par_buf.nx );
IF_OK status += get_i(stdin, prompt,"ny", &par_buf.ny );
IF_OK status += get_i(stdin, prompt,"nz", &par_buf.nz );
IF_OK status += get_i(stdin, prompt,"nt", &par_buf.nt );
if(status>0) par_buf.stopflag=1; else par_buf.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)&par_buf, sizeof(par_buf));
if( par_buf.stopflag != 0 )
normal_exit(0);
nx=par_buf.nx;
ny=par_buf.ny;
nz=par_buf.nz;
nt=par_buf.nt;
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
return prompt;
}
void setup_layout(){
register int i,j,dir;
if(mynode()==0){
printf("LAYOUT = Hypercubes, options = ");
printf("EVENFIRST,");
printf("\n");
}
/* Figure out dimensions of rectangle */
squaresize[XUP] = nx; squaresize[YUP] = ny;
squaresize[ZUP] = nz; squaresize[TUP] = nt;
nsquares[XUP] = nsquares[YUP] = nsquares[ZUP] = nsquares[TUP] = 1;
i = 1; /* current number of hypercubes */
while(i<numnodes()){
/* figure out which direction to divide */
/* find largest dimension of h-cubes divisible by 4 */
for(j=1,dir=XUP;dir<=TUP;dir++)
if( squaresize[dir]>j && squaresize[dir]%4==0 ) j=squaresize[dir];
/* if one direction with largest dimension has already been
divided, divide it again. Otherwise divide first direction
with largest dimension. */
for(dir=XUP;dir<=TUP;dir++)
if( squaresize[dir]==j && nsquares[dir]>1 )break;
if( dir > TUP)for(dir=XUP;dir<=TUP;dir++)
if( squaresize[dir]==j )break;
/* This can fail if I run out of factors of 2 in the dimensions */
if(dir > TUP){
if(mynode()==0)printf(
"LAYOUT: Can't lay out this lattice, not enough factors of 2\n");
terminate(1);
}
/* do the surgery */
i*=2; squaresize[dir] /= 2; nsquares[dir] *= 2;
}
sites_on_node =
squaresize[XUP]*squaresize[YUP]*squaresize[ZUP]*squaresize[TUP];
/* Need number of sites per hypercube divisible by 32 */
if( mynode()==0)if( sites_on_node%32 != 0){
printf("SORRY, CAN'T LAY OUT THIS LATTICE\n");
terminate(0);
}
subl_sites_on_node = sites_on_node/32;
}
/* SETUP ROUTINES */
int initial_set(){
int prompt,status;
/* On node zero, read lattice size, seed, nflavors and send to others */
if(mynode()==0){
/* print banner */
printf("SU3 with Clover fermions\n");
printf("Microcanonical simulation with refreshing\n");
printf("MIMD version 7\n");
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
#ifdef HMC_ALGORITHM
printf("Hybrid Monte Carlo algorithm\n");
#endif
#ifdef PHI_ALGORITHM
printf("PHI algorithm\n");
#else
printf("R algorithm\n");
#endif
#ifdef SPECTRUM
printf("With spectrum measurements\n");
#endif
time_stamp("start");
status = get_prompt(stdin, &prompt );
IF_OK status += get_i(stdin, prompt,"nflavors", &par_buf.nflavors );
#ifdef PHI_ALGORITHM
IF_OK if(par_buf.nflavors != 2){
printf("Dummy! Use phi algorithm only for two flavors\n");
terminate(-1);
}
#endif
IF_OK status += get_i(stdin, prompt,"nx", &par_buf.nx );
IF_OK status += get_i(stdin, prompt,"ny", &par_buf.ny );
IF_OK status += get_i(stdin, prompt,"nz", &par_buf.nz );
IF_OK status += get_i(stdin, prompt,"nt", &par_buf.nt );
IF_OK status += get_i(stdin, prompt,"iseed", &par_buf.iseed );
if(status>0) par_buf.stopflag=1; else par_buf.stopflag=0;
} /* end if(mynode()==0) */
/* SETUP ROUTINES */
int
initial_set()
{
int prompt,status;
int i;
/* On node zero, read lattice size, seed, nflavors1, nflavors2,
nflavors, and send to others */
if(mynode()==0){
/* print banner */
printf("SU3 gauge utility program\n");
printf("MIMD version 7\n");
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
status=get_prompt(stdin, &prompt);
IF_OK status += get_i(stdin, prompt,"nx", ¶m.nx );
IF_OK status += get_i(stdin, prompt,"ny", ¶m.ny );
IF_OK status += get_i(stdin, prompt,"nz", ¶m.nz );
IF_OK status += get_i(stdin, prompt,"nt", ¶m.nt );
#ifdef FIX_NODE_GEOM
IF_OK status += get_vi(stdin, prompt, "node_geometry",
param.node_geometry, 4);
#ifdef FIX_IONODE_GEOM
IF_OK status += get_vi(stdin, prompt, "ionode_geometry",
param.ionode_geometry, 4);
#endif
#endif
IF_OK status += get_i(stdin, prompt,"iseed", ¶m.iseed );
/* beta, quark masses */
IF_OK status += get_f(stdin, prompt,"beta", ¶m.beta );
IF_OK status += get_i(stdin, prompt,"n_dyn_masses", ¶m.n_dyn_masses );
IF_OK status += get_vf(stdin, prompt, "dyn_mass", param.dyn_mass, param.n_dyn_masses);
IF_OK status += get_vi(stdin, prompt, "dyn_flavors", param.dyn_flavors, param.n_dyn_masses);
/* Get tadpole factor */
IF_OK status += get_f(stdin, prompt, "u0", ¶m.u0);
/* Get translation vector */
if(status>0) param.stopflag=1; else param.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)¶m,sizeof(param));
if( param.stopflag != 0 )
normal_exit(0);
nx=param.nx;
ny=param.ny;
nz=param.nz;
nt=param.nt;
#ifdef FIX_NODE_GEOM
for(i = 0; i < 4; i++)
node_geometry[i] = param.node_geometry[i];
#ifdef FIX_IONODE_GEOM
for(i = 0; i < 4; i++)
ionode_geometry[i] = param.ionode_geometry[i];
#endif
#endif
iseed=param.iseed;
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
beta = param.beta;
n_dyn_masses = param.n_dyn_masses;
for(i = 0; i < n_dyn_masses; i++){
dyn_mass[i] = param.dyn_mass[i];
dyn_flavors[i] = param.dyn_flavors[i];
}
u0 = param.u0;
return prompt;
}
// Only load non-zero elements of remaining columns of Q
// Read from node0 only -- transfer data to all other nodes one by one
void loadQ(complex **Q, int ckpt_load) {
int i, j, savi = 0, savj = 0, ret = 1, Ndat = 4 * DIMF, Qlen;
int mynode = 0, destnode = 0, Nlines = 0;
char infile[80];
Real re, im;
complex **tbuf = NULL; // Only malloc on node0 if numnodes() > 1
FILE *fp = NULL;
// Total length of each column of Q
Qlen = sites_on_node * Ndat * sizeof(complex);
if (this_node == 0) {
node0_printf("Reloading columns %d--%d\n", ckpt_load + 1, volume * Ndat);
sprintf(infile, "%s.Q%d", startfile, ckpt_load);
fp = fopen(infile, "r"); // Open to read
if (fp == NULL) {
printf("loadQ: node%d can't open file %s\n", this_node, infile);
fflush(stdout);
terminate(1);
}
// Allocate temporary storage to be passed to other nodes
// Only need if numnodes() > 1, but hard-code it in any case
// to suppress compiler warnings
tbuf = malloc(sizeof(complex*) * volume * Ndat);
for (i = ckpt_load; i < volume * Ndat; i++) {
tbuf[i] = malloc(sizeof(complex) * sites_on_node * Ndat);
for (j = 0; j < sites_on_node * Ndat; j++)
tbuf[i][j] = cmplx(0.0, 0.0);
}
if (tbuf[volume * Ndat - 1] == NULL) {
printf("loadQ: can't malloc tbuf\n");
fflush(stdout);
terminate(1);
}
// Fill Q[i][j] on node0
while (ret != EOF && i > 0) {
ret = fscanf(fp, "%d\t%d\t%d\t%lg\t%lg\n", &mynode, &i, &j, &re, &im);
Nlines++;
if (mynode == 1) {
tbuf[i][j] = cmplx(re, im); // So we don't lose this
break;
}
else if (mynode == -1) {
savi = i;
break;
}
Q[i][j] = cmplx(re, im);
}
}
g_sync(); // Don't let other nodes race ahead
// Now fill in each other node in turn
for (destnode = 1; destnode < numnodes(); destnode++) {
// Fill rest of buffer on node0
if (this_node == 0) {
while (ret != EOF && i > 0) {
ret = fscanf(fp, "%d\t%d\t%d\t%lg\t%lg\n", &mynode, &i, &j, &re, &im);
Nlines++;
if (mynode != destnode) {
savi = i; // May still need to write below
savj = j;
break;
}
tbuf[i][j] = cmplx(re, im);
}
}
g_sync(); // Don't let other nodes race ahead
// Now send buffer to destnode
for (i = ckpt_load; i < volume * Ndat; i++) {
if (this_node == 0)
send_field((char *)tbuf[i], Qlen, destnode);
else if (this_node == destnode)
get_field((char *)Q[i], Qlen, 0);
g_sync(); // To be cautious
}
// Reset tbuf if we have another node to do
if (this_node == 0 && mynode != -1) {
for (i = ckpt_load; i < volume * Ndat; i++) {
for (j = 0; j < sites_on_node * Ndat; j++)
tbuf[i][j] = cmplx(0.0, 0.0);
}
tbuf[savi][savj] = cmplx(re, im);
}
g_sync(); // Don't let other nodes race ahead
}
// Now we should be done
if (this_node == 0) {
if (mynode != -1) {
printf("loadQ: should be done but tag = %d\n", mynode);
fflush(stdout);
terminate(1);
}
// Check that the correct number of elements were read
if (Nlines - 1 != savi) { // End of file key
printf("loadQ: read %d elements but should have had %d\n",
Nlines - 1, savi);
fflush(stdout);
terminate(1);
}
fclose(fp);
for (i = ckpt_load; i < volume * Ndat; i++)
free(tbuf[i]);
free(tbuf);
}
g_sync(); // Don't let other nodes race ahead
}
// Only save non-zero elements of remaining columns of Q
// Write from node0 only -- transfer data from all other nodes one by one
void saveQ(complex **Q, int ckpt_save) {
int i, j, Ndat = 4 * DIMF, mynode, Nlines = 0, Qlen;
char outfile[80];
FILE *fp = NULL;
// Total length of each column of Q
Qlen = sites_on_node * Ndat * sizeof(complex);
if (this_node == 0) {
printf("Dumping columns %d--%d\n", ckpt_save + 1, volume * Ndat);
sprintf(outfile, "%s.Q%d", startfile, ckpt_save);
fp = fopen(outfile, "w"); // Open to write
if (fp == NULL) {
printf("saveQ: node%d can't open file %s\n", this_node, outfile);
fflush(stdout);
terminate(1);
}
// node0 data ready to go
for (i = ckpt_save; i < volume * Ndat; i++) {
for (j = 0; j < sites_on_node * Ndat; j++)
if (Q[i][j].real != 0.0 || Q[i][j].real != 0.0) { // Loose condition
fprintf(fp, "0\t%d\t%d\t%.16g\t%.16g\n",
i, j, Q[i][j].real, Q[i][j].imag);
Nlines++;
}
}
fflush(fp);
}
g_sync(); // Don't let other nodes race ahead
// Overwrite node0 Q with elements of Q on mynode
for (mynode = 1; mynode < numnodes(); mynode++) {
for (i = ckpt_save; i < volume * Ndat; i++) {
if (this_node == mynode)
send_field((char *)Q[i], Qlen, 0);
else if (this_node == 0)
get_field((char *)Q[i], Qlen, mynode);
g_sync(); // To be cautious
}
if (this_node == 0) { // Now print, as above
for (i = ckpt_save; i < volume * Ndat; i++) {
for (j = 0; j < sites_on_node * Ndat; j++)
if (Q[i][j].real != 0.0 || Q[i][j].real != 0.0) { // Loose condition
fprintf(fp, "%d\t%d\t%d\t%.16g\t%.16g\n",
mynode, i, j, Q[i][j].real, Q[i][j].imag);
Nlines++;
}
}
fflush(fp);
}
g_sync(); // Don't let other nodes race ahead
}
if (this_node == 0) {
// Add a last line containing a unique tag (-1)
// and the number of elements that were written,
// so we can check that the correct number were reloaded
fprintf(fp, "-1\t%d\t-1\t-1\t-1\n", Nlines);
fflush(fp);
fclose(fp);
}
g_sync(); // Don't let other nodes race ahead
}
int main(int argc, char *argv[])
{
int ndim,dims[4];
gauge_file *gf;
gauge_header *gh;
FILE *fp;
char *filename_milc,*filename_scidac;
QIO_Layout layout;
QIO_Reader *infile;
QIO_RecordInfo rec_info;
char *datatype;
int status;
int datum_size;
int input_prec;
int count = 4;
int word_size;
int typesize;
w_serial_site_writer state;
if(argc < 3)
{
fprintf(stderr,"Usage %s <SciDAC file> <MILC file>\n",argv[0]);
exit(1);
}
filename_scidac = argv[1];
filename_milc = argv[2];
if(this_node == 0)printf("Converting file %s to MILC v5 file %s\n",
filename_scidac, filename_milc);
initialize_machine(&argc,&argv);
#ifdef HAVE_QDP
QDP_initialize(&argc, &argv);
#endif
this_node = mynode();
number_of_nodes = numnodes();
if(number_of_nodes != 1){
printf("This is single-processor code. Please rebuild as such.\n");
terminate(1);
}
/* Open the SciDAC file and discover the lattice dimensions. Then
close. */
status = read_lat_dim_scidac(filename_scidac, &ndim, dims);
if(status)terminate(1);
if(ndim != 4){
printf("Wanted ndims = 4 in %s but got %d\n",filename_scidac,ndim);
terminate(1);
}
nx = dims[0]; ny = dims[1]; nz = dims[2]; nt = dims[3];
volume = nx*ny*nz*nt;
/* Finish setting up, now we know the dimensions */
setup();
/* Build the QIO layout */
build_qio_layout(&layout);
/* Open the SciDAC file for reading */
infile = open_scidac_input(filename_scidac, &layout, 0, QIO_SERIAL);
if(infile == NULL)terminate(1);
/* Open the MILC v5 file for writing */
fp = fopen(filename_milc, "wb");
if(fp == NULL)
{
printf("Can't open file %s, error %d\n",
filename_milc,errno);fflush(stdout);
terminate(1);
}
gf = setup_output_gauge_file();
gh = gf->header;
/* Read the SciDAC record header. */
xml_record_in = QIO_string_create();
status = QIO_read_record_info(infile, &rec_info, xml_record_in);
if(status != QIO_SUCCESS)terminate(1);
node0_printf("Record info \n\"%s\"\n",QIO_string_ptr(xml_record_in));
/* Make sure this is a lattice field */
datatype = QIO_get_datatype(&rec_info);
typesize = QIO_get_typesize(&rec_info);
if(strcmp(datatype, "QDP_F3_ColorMatrix") == 0 ||
strcmp(datatype, "USQCD_F3_ColorMatrix") == 0 ||
typesize == 72){
datum_size = sizeof(fsu3_matrix);
input_prec = 1;
word_size = sizeof(float);
}
else if(strcmp(datatype, "QDP_D3_ColorMatrix") == 0 ||
strcmp(datatype, "USQCD_F3_ColorMatrix") == 0 ||
typesize == 144){
datum_size = sizeof(dsu3_matrix);
input_prec = 2;
word_size = sizeof(double);
}
else {
printf("Unrecognized datatype %s\n",datatype);
terminate(1);
}
/* Copy the time stamp from the SciDAC file */
strncpy(gh->time_stamp, QIO_get_record_date(&rec_info),
MAX_TIME_STAMP);
gh->time_stamp[MAX_TIME_STAMP-1] = '\0';
/* Write the MILC v5 header */
gh->order = NATURAL_ORDER;
/* Node 0 writes the header */
swrite_gauge_hdr(fp,gh);
/* Assign values to file structure */
gf->fp = fp;
gf->filename = filename_milc;
gf->byterevflag = 0; /* Not used for writing */
gf->rank2rcv = NULL; /* Not used for writing */
gf->parallel = 0;
/* Initialize writing the lattice data */
w_serial_start_lattice(gf, &state, input_prec);
/* Read the SciDAC record data. The factory function writes the
site links to a file. */
status = QIO_read_record_data(infile, w_serial_site_links,
datum_size*count, word_size,
(void *)&state);
if(status != QIO_SUCCESS)terminate(1);
node0_printf("SciDAC checksums %x %x\n",
QIO_get_reader_last_checksuma(infile),
QIO_get_reader_last_checksumb(infile));
/* Close the SciDAC file */
QIO_close_read(infile);
/* Finish the MILC v5 file */
w_serial_finish_lattice(&state);
w_serial_f(gf);
QIO_string_destroy(xml_record_in);
#ifdef HAVE_QDP
QDP_finalize();
#endif
normal_exit(0);
return 0;
}
/* SETUP ROUTINES */
static int
initial_set(){
int prompt,status;
#ifdef FIX_NODE_GEOM
int i;
#endif
/* On node zero, read lattice size and send to others */
if(mynode()==0){
/* print banner */
printf("SU3 staggered fermion measurements\n");
printf("MIMD version %s\n",MILC_CODE_VERSION);
printf("Machine = %s, with %d nodes\n",machine_type(),numnodes());
gethostname(hostname, 128);
printf("Host(0) = %s\n",hostname);
printf("Username = %s\n", getenv("USER"));
time_stamp("start");
get_utc_datetime(utc_date_time);
/* Print list of options selected */
node0_printf("Options selected...\n");
show_generic_opts();
show_generic_ks_opts();
#if FERM_ACTION == HISQ
show_su3_mat_opts();
show_hisq_links_opts();
#elif FERM_ACTION == HYPISQ
show_su3_mat_opts();
show_hypisq_links_opts();
#endif
status = get_prompt(stdin, &prompt );
IF_OK status += get_i(stdin,prompt,"nx", ¶m.nx );
IF_OK status += get_i(stdin,prompt,"ny", ¶m.ny );
IF_OK status += get_i(stdin,prompt,"nz", ¶m.nz );
IF_OK status += get_i(stdin,prompt,"nt", ¶m.nt );
#ifdef FIX_NODE_GEOM
IF_OK status += get_vi(stdin, prompt, "node_geometry",
param.node_geometry, 4);
#ifdef FIX_IONODE_GEOM
IF_OK status += get_vi(stdin, prompt, "ionode_geometry",
param.ionode_geometry, 4);
#endif
#endif
IF_OK status += get_i(stdin, prompt,"iseed", ¶m.iseed );
IF_OK status += get_s(stdin, prompt,"job_id",param.job_id);
if(status>0) param.stopflag=1; else param.stopflag=0;
} /* end if(mynode()==0) */
/* Node 0 broadcasts parameter buffer to all other nodes */
broadcast_bytes((char *)¶m,sizeof(param));
if( param.stopflag != 0 )
normal_exit(0);
if(prompt==2)return prompt;
nx=param.nx;
ny=param.ny;
nz=param.nz;
nt=param.nt;
iseed=param.iseed;
#ifdef FIX_NODE_GEOM
for(i = 0; i < 4; i++)
node_geometry[i] = param.node_geometry[i];
#ifdef FIX_IONODE_GEOM
for(i = 0; i < 4; i++)
ionode_geometry[i] = param.ionode_geometry[i];
#endif
#endif
this_node = mynode();
number_of_nodes = numnodes();
volume=nx*ny*nz*nt;
return(prompt);
}
int AUTO(AutoData *Data)
{
struct timeval *time0,*time1;
integer icp[NPARX2];
doublereal par[NPARX2], thl[NPARX];
iap_type *iap;
rap_type *rap;
doublereal *thu;
integer *iuz;
doublereal *vuz;
function_list list;
integer i, j, k;
// Initialize structures and constants
gData = Data;
iap = &(Data->iap);
rap = &(Data->rap);
Data->sp_len = Data->num_sp + (1 + floor(iap->nmx/iap->npr));
Data->sp_inc = 5;
#ifdef USAGE
struct rusage *init_usage,*total_usage;
usage_start(&init_usage);
usage_start(&total_usage);
#endif
#ifdef FLOATING_POINT_TRAP
trapfpe();
#endif
#ifdef PTHREADS
global_conpar_type = CONPAR_PTHREADS;
global_setubv_type = SETUBV_PTHREADS;
global_reduce_type = REDUCE_PTHREADS;
#endif
fp9 = fopen("fort.9","w");
if(fp9 == NULL) {
fprintf(stderr,"Error: Could not open fort.9\n");
exit(1);
}
/* Initialization : */
iap->mynode = mynode();
iap->numnodes = numnodes();
if (iap->numnodes > 1) {
iap->parallel_flag = 1;
} else {
iap->parallel_flag = 0;
}
/* NOTE: thu is allocated inside this function, and the
pointer is passed back. I know this is ugly, but
this function does a bit of work to get thu setup correctly,
as well as figuring out the size the array should be.
What really should happen is to have one function which
reads fort.2 and another fuction which initializes the array.
That way the allocation could happen between the two calls.
*/
init0(iap, rap, par, icp, thl, &thu, &iuz, &vuz);
/* Find restart label and determine type of restart point. */
if (iap->irs > 0) {
logical found = FALSE_;
findlb(iap, rap, iap->irs, &(iap->nfpr), &found);
if (! found) {
if (iap->mynode == 0) {
fprintf(stderr,"\nRestart label %4ld not found\n",iap->irs);
}
exit(0);
}
}
set_function_pointers(*iap,&list);
init1(iap, rap, icp, par);
chdim(iap);
/* Create the allocations for the global structures used in
autlib3.c and autlib5.c. These are purely an efficiency thing.
The allocation and deallocation of these scratch areas takes
up a nontrivial amount of time if done directly in the
wrapper functions in autlib3.c*/
allocate_global_memory(*iap);
/* ---------------------------------------------------------- */
/* ---------------------------------------------------------- */
/* One-parameter continuations */
/* ---------------------------------------------------------- */
/* ---------------------------------------------------------- */
#ifdef USAGE
usage_end(init_usage,"main initialization");
#endif
if (Data->print_input)
PrintInput(Data, par, icp);
// Initialize output variables
if(list.type==AUTOAE)
Data->u = DMATRIX(iap->nmx, iap->ndim);
else {
// Solution measures
Data->usm = (doublereal ***)MALLOC((2+(int)(log2(Data->nsm)))*sizeof(doublereal **));
Data->usm[0] = DMATRIX(iap->nmx, iap->ndim); // MAX
Data->usm[1] = DMATRIX(iap->nmx, iap->ndim); // MIN
for (i=0; i<(int)(log2(Data->nsm)); i++)
Data->usm[2+i] = DMATRIX(iap->nmx, iap->ndim);
// Jacobian of flow
if (Data->sjac) {
Data->c0 = DMATRIX_3D(iap->nmx, iap->ndim, iap->ndim);
Data->c1 = DMATRIX_3D(iap->nmx, iap->ndim, iap->ndim);
}
// Jacobian of flow along cycles (temporary storage)
if (Data->sflow) {
Data->a1 = DMATRIX_3D(iap->ntst, iap->ndim, iap->ndim);
Data->a2 = DMATRIX_3D(iap->ntst, iap->ndim, iap->ndim);
}
}
Data->par = DMATRIX(iap->nmx, iap->nicp);
if (iap->isp >= 1) {
Data->ev = DCMATRIX(iap->nmx, iap->ndim);
for (i=0; i<iap->nmx; i++) {
for (j=0; j<iap->ndim; j++) {
Data->ev[i][j].r = NAN; // This is a flag for bad floquet multipliers
Data->ev[i][j].i = NAN;
}
}
}
Data->num_u = 0;
if (Data->sp == NULL)
Data->num_sp = 0;
Data->sp = (AutoSPData *)REALLOC(Data->sp, (Data->sp_len)*sizeof(AutoSPData));
for (i=Data->num_sp; i<Data->sp_len; i++) {
Data->sp[i].u = NULL;
Data->sp[i].icp = NULL;
Data->sp[i].ups = NULL;
Data->sp[i].udotps = NULL;
Data->sp[i].rldot = NULL;
Data->sp[i].a1 = NULL;
Data->sp[i].a2 = NULL;
}
if(list.type==AUTOAE)
autoae(iap, rap, par, icp, list.aelist.funi, list.aelist.stpnt, list.aelist.pvli, thl, thu, iuz, vuz);
if(list.type==AUTOBV)
autobv(iap, rap, par, icp, list.bvlist.funi, list.bvlist.bcni,
list.bvlist.icni, list.bvlist.stpnt, list.bvlist.pvli, thl, thu, iuz, vuz);
// Testing output
if (Data->print_output)
PrintOutput(Data);
#ifdef USAGE
usage_end(total_usage,"total");
#endif
//time_end(time0,"Total Time ",fp9);
fprintf(fp9,"----------------------------------------------");
fprintf(fp9,"----------------------------------------------\n");
//time_end(time1,"",stdout);
//}
FREE(thu);
FREE(iuz);
FREE(vuz);
fclose(fp9);
// Clean up special solution points that were allocated and not used
Data->sp = (AutoSPData *)REALLOC(Data->sp, (Data->num_sp)*sizeof(AutoSPData));
assert(Data->sp);
Data->sp_len = Data->num_sp;
return 1;
}