void Test(matrix A, matrix B, matrix Res)
/*
* Runs a multiplication test on an array. Calculates and prints the
* time it takes to multiply the matrices.
*/
{
#ifndef UPPSALAWCET
long StartTime, StopTime;
float TotalTime;
#endif
Initialize(A);
Initialize(B);
/* ***UPPSALA WCET***: don't print or time */
#ifndef UPPSALAWCET
StartTime = ttime ();
#endif
Multiply(A, B, Res);
/* ***UPPSALA WCET***: don't print or time */
#ifndef UPPSALAWCET
StopTime = ttime();
TotalTime = (StopTime - StartTime) / 1000.0;
printf(" - Size of array is %d\n", UPPERLIMIT);
printf(" - Total multiplication time is %3.3f seconds\n\n", TotalTime);
#endif
}
static TInt CreateScheduleMultipleL(TSchedulerItemRef& aRef, RScheduler& aScheduler)
{
aRef.iName = _L("Schedule created using CreateScheduleMultiple");
CSchConditionArray* conditionList = CreateMultipleConditionsLC();
TTime ttime(SchSvrHelpers::UtcTimeBasedOnOffset(0, 0, 0, 0, 0, 1));
TTsTime time(ttime, ETrue); //1 year in the future
TInt res = aScheduler.CreatePersistentSchedule(aRef, *conditionList, time);
CleanupStack::PopAndDestroy(); // conditionList
return res;
}
/*
* Send a tftp read request or acknowledgement
* mesgtype 0 is a read request, 1 is an
* acknowledgement
*/
void
do_send_tftp(int mesgtype)
{
u_long res, iptmp, lcv;
char *tot;
if (mesgtype == 0) {
tot = tftp_r + (sizeof(MSG) - 1);
myport = (u_short) ttime();
if (myport < 1000)
myport += 1000;
servport = FTP_PORT; /* to start */
} else {
tot = (char *) tftp_a + 4;
}
bcopy(servea, eh->ether_dhost, sizeof(servea));
bcopy(myea, eh->ether_shost, sizeof(myea));
eh->ether_type = ETYPE_IP;
iph->ip_v = IP_VERSION;
iph->ip_hl = IP_HLEN;
iph->ip_tos = 0; /* type of service is 0 */
iph->ip_id = 0; /* id field is 0 */
iph->ip_off = IP_DF;
iph->ip_ttl = 3; /* time to live is 3 seconds/hops */
iph->ip_p = IPP_UDP;
bcopy(myip, iph->ip_src, sizeof(myip));
bcopy(servip, iph->ip_dst, sizeof(servip));
iph->ip_sum = 0;
iph->ip_len = tot - (char *) iph;
res = oc_cksum(iph, sizeof(struct ip), 0);
iph->ip_sum = 0xffff & ~res;
udph->uh_sport = myport;
udph->uh_dport = servport;
udph->uh_sum = 0;
if (mesgtype) {
tftp_a->op_code = FTPOP_ACKN;
tftp_a->block = (u_short) (mesgtype);
} else {
bcopy(myip, &iptmp, sizeof(iptmp));
bcopy(MSG, tftp_r, (sizeof(MSG) - 1));
for (lcv = 9; lcv >= 2; lcv--) {
tftp_r[lcv] = "0123456789ABCDEF"[iptmp & 0xF];
iptmp = iptmp >> 4;
}
}
udph->uh_ulen = tot - (char *) udph;
le_put(buf, tot - buf);
}
int benchmark()
{
#ifdef POUT
long StartTime, StopTime;
float TotalTime;
#endif
double MeanA, MeanB, VarA, VarB, StddevA, StddevB /*, Coef*/;
int ttime();
void Initialize(), Calc_Sum_Mean(), Calc_Var_Stddev();
void Calc_LinCorrCoef();
InitSeed ();
#ifdef POUT
printf ("\n *** Statictics TEST ***\n\n");
StartTime = ttime();
#endif
Initialize(ArrayA);
Calc_Sum_Mean(ArrayA, &SumA, &MeanA);
Calc_Var_Stddev(ArrayA, MeanA, &VarA, &StddevA);
Initialize(ArrayB);
Calc_Sum_Mean(ArrayB, &SumB, &MeanB);
Calc_Var_Stddev(ArrayB, MeanB, &VarB, &StddevB);
/* Coef will have to be used globally in Calc_LinCorrCoef since it would
be beyond the 6 registers used for passing parameters
*/
Calc_LinCorrCoef(ArrayA, ArrayB, MeanA, MeanB /*, &Coef*/);
#ifdef POUT
StopTime = ttime();
TotalTime = (StopTime - StartTime) / 1000.0;
printf(" Sum A = %12.4f, Sum B = %12.4f\n", SumA, SumB);
printf(" Mean A = %12.4f, Mean B = %12.4f\n", MeanA, MeanB);
printf("Variance A = %12.4f, Variance B = %12.4f\n", VarA, VarB);
printf(" Std Dev A = %12.4f, Variance B = %12.4f\n", StddevA, StddevB);
printf("\nLinear Correlation Coefficient = %f\n", Coef);
#endif
}
//***********************************************************************************
static CSchEntryInfoArray* CreateScheduleArrayLC()
{
CSchEntryInfoArray* entryList = new (ELeave) CSchEntryInfoArray(3);
CleanupStack::PushL(entryList);
TTime ttime(SchSvrHelpers::TimeBasedOnOffset(0, 20));
TTsTime startTime (ttime,ETrue);
TScheduleEntryInfo2 entry1 (startTime, EDaily, 1, 20); // 20m from "now"
entryList->AppendL(entry1);
return entryList;
}
// single condition with default time set to Time::MaxTTime()
static TInt CreateScheduleSingle2L(TSchedulerItemRef& aRef,
RScheduler& aScheduler,
const TUid& aConditionUID,
TUint aConditionUInt)
{
aRef.iName = _L("Schedule created using CreateScheduleSingle");
CSchConditionArray* conditionList
= CreateSingleConditionLC(aConditionUID, aConditionUInt);
TTime ttime(Time::MaxTTime());
TTsTime time(ttime, ETrue);
TInt res = aScheduler.CreatePersistentSchedule(aRef, *conditionList, time);
CleanupStack::PopAndDestroy(); // conditionList
return res;
}
// A null schedule.
static TInt CreateScheduleSingleNull4L(TSchedulerItemRef& aRef,
RScheduler& aScheduler,
const TUid&,
TUint )
{
aRef.iName = _L("One schedule in the list with a NULL uid");
CSchConditionArray* conditionList
= CreateSingleConditionLC(KNullUid, 0);
TTime ttime(SchSvrHelpers::UtcTimeBasedOnOffset(0, 0, 0, 0, 0, 1));
TTsTime time(ttime, ETrue); //1 year in the future
TInt res = aScheduler.CreatePersistentSchedule(aRef, *conditionList, time);
CleanupStack::PopAndDestroy(); // conditionList
return res;
}
// An empty schedule list.
static TInt CreateScheduleEmpty3L(TSchedulerItemRef& aRef,
RScheduler& aScheduler,
const TUid&,
TUint )
{
aRef.iName = _L("Empty Schedule list created");
CSchConditionArray* conditionList = new (ELeave) CSchConditionArray(3);
CleanupStack::PushL(conditionList);
TTime ttime(SchSvrHelpers::UtcTimeBasedOnOffset(0, 0, 0, 0, 0, 1));
TTsTime time(ttime, ETrue); //1 year in the future
TInt res = aScheduler.CreatePersistentSchedule(aRef, *conditionList, time);
CleanupStack::PopAndDestroy(); // conditionList
return res;
}
int extract_matrices
(
Epetra_CrsMatrix *A, // i/p: A matrix
shylu_symbolic *ssym, // symbolic structure
shylu_data *data, // numeric structure, TODO: Required ?
shylu_config *config, // i/p: library configuration
bool insertValues // true implies values will be inserted and fill
// complete will be called. false implies values
// will be replaced.
)
{
Teuchos::RCP<Epetra_CrsMatrix> D = ssym->D;
Teuchos::RCP<Epetra_CrsMatrix> C = ssym->C;
Teuchos::RCP<Epetra_CrsMatrix> R = ssym->R;
Teuchos::RCP<Epetra_CrsMatrix> G = ssym->G;
Teuchos::RCP<Epetra_CrsGraph> Sg = ssym->Sg;
int *DColElems = data->DColElems;
int *gvals = data->gvals;
double Sdiagfactor = config->Sdiagfactor;
int *LeftIndex = new int[data->lmax];
double *LeftValues = new double[data->lmax];
int *RightIndex = new int[data->rmax];
double *RightValues = new double[data->rmax];
int err;
int lcnt, rcnt ;
int gcid;
int gid;
int *Ai;
double *Ax;
int nrows = A->RowMap().NumMyElements();
int *rows = A->RowMap().MyGlobalElements();
for (int i = 0; i < nrows ; i++)
{
int NumEntries;
err = A->ExtractMyRowView(i, NumEntries, Ax, Ai);
lcnt = 0; rcnt = 0;
// Place the entry in the correct sub matrix, Works only for sym
gid = rows[i];
int lcid;
for (int j = 0 ; j < NumEntries ; j++)
{ // O(nnz) ! Careful what you do inside
// Row permutation does not matter here
gcid = A->GCID(Ai[j]);
assert(gcid != -1);
//Either in D or R
if ((gvals[gid] != 1 && gvals[gcid] == 1)
|| (gvals[gid] == 1 && A->LRID(gcid) != -1 && gvals[gcid] == 1))
{
assert(lcnt < data->lmax);
if (insertValues)
LeftIndex[lcnt] = gcid;
else
{
//local column id
lcid = (gvals[gid] == 1 ? D->LCID(gcid) : R->LCID(gcid));
assert(lcid != -1);
LeftIndex[lcnt] = lcid;
}
LeftValues[lcnt++] = Ax[j];
}
else
{
assert(rcnt < data->rmax);
if (insertValues)
RightIndex[rcnt] = gcid;
else
{
//local column id
lcid = (gvals[gid] == 1 ? C->LCID(gcid) : G->LCID(gcid));
assert(lcid != -1);
RightIndex[rcnt] = lcid;
}
RightValues[rcnt++] = Ax[j];
}
}
if (gvals[gid] == 1)
{ // D or C row
if (insertValues)
{
err = D->InsertGlobalValues(gid, lcnt, LeftValues, LeftIndex);
assert(err == 0);
err = C->InsertGlobalValues(gid, rcnt, RightValues, RightIndex);
assert(err == 0);
}
else
{
err = D->ReplaceMyValues(D->LRID(gid), lcnt, LeftValues,
LeftIndex);
assert(err == 0);
err = C->ReplaceMyValues(C->LRID(gid), rcnt, RightValues,
RightIndex);
assert(err == 0);
}
}
else
{ // R or S row
//assert(lcnt > 0); // TODO: Enable this once using narrow sep.
if (insertValues)
{
assert(rcnt > 0);
err = R->InsertGlobalValues(gid, lcnt, LeftValues, LeftIndex);
assert(err == 0);
err = G->InsertGlobalValues(gid, rcnt, RightValues, RightIndex);
assert(err == 0);
if (config->schurApproxMethod == 1)
{
err = Sg->InsertGlobalIndices(gid, rcnt, RightIndex);
assert(err == 0);
}
}
else
{
assert(rcnt > 0);
err = R->ReplaceMyValues(R->LRID(gid), lcnt, LeftValues,
LeftIndex);
assert(err == 0);
err = G->ReplaceMyValues(G->LRID(gid), rcnt, RightValues,
RightIndex);
assert(err == 0);
}
}
}
if (insertValues)
{
/* ------------- Create the maps for the DBBD form ------------------ */
Epetra_Map *DRowMap, *SRowMap, *DColMap;
Epetra_SerialComm LComm;
if (config->sep_type != 1)
{
DRowMap = new Epetra_Map(-1, data->Dnr, data->DRowElems, 0,
A->Comm());
SRowMap = new Epetra_Map(-1, data->Snr, data->SRowElems, 0,
A->Comm());
DColMap = new Epetra_Map(-1, data->Dnc, DColElems, 0,
A->Comm());
}
else
{
DRowMap = new Epetra_Map(-1, data->Dnr, data->DRowElems, 0, LComm);
SRowMap = new Epetra_Map(-1, data->Snr, data->SRowElems, 0, LComm);
DColMap = new Epetra_Map(-1, data->Dnc, DColElems, 0, LComm);
}
D->FillComplete();
//config->dm.print(5, "Done D fillcomplete");
G->FillComplete();
//config->dm.print(5, "Done G fillcomplete");
C->FillComplete(*SRowMap, *DRowMap); //TODO:Won't work if permutation is
// unsymmetric SRowMap
//config->dm.print(5, "Done C fillcomplete");
R->FillComplete(*DColMap, *SRowMap);
//config->dm.print(5, "Done R fillcomplete");
int Sdiag = (int) data->Snr * Sdiagfactor;
Sdiag = MIN(Sdiag, data->Snr-1);
Sdiag = MAX(Sdiag, 0);
// Add the diagonals to Sg
for (int i = 0; config->schurApproxMethod == 1 && i < nrows ; i++)
{
gid = rows[i];
if (gvals[gid] == 1) continue; // not a row in S
if (data->Snr == 0) assert(0 == 1);
rcnt = 0;
//TODO Will be trouble if SNumGlobalCols != Snc
//assert(SNumGlobalCols == Snc);
//for (int j = MAX(i-Sdiag,0) ; j<MIN(SNumGlobalCols, i+Sdiag); j++)
for (int j = MAX(i-Sdiag, 0) ; j < MIN(data->Snr, i+Sdiag); j++)
{
// find the adjacent columns from the row map of S
//assert (j >= 0 && j < Snr);
RightIndex[rcnt++] = data->SRowElems[j];
}
err = Sg->InsertGlobalIndices(gid, rcnt, RightIndex);
assert(err == 0);
// Always insert the diagonals, if it is added twice that is fine.
err = Sg->InsertGlobalIndices(gid, 1, &gid);
assert(err == 0);
}
if (config->schurApproxMethod == 1)
Sg->FillComplete();
delete DRowMap;
delete SRowMap;
delete DColMap;
}
#if 0
if (insertValues)
{
#ifdef TIMING_OUTPUT
Teuchos::Time ttime("transpose time");
ttime.start();
#endif
bool MakeDataContiguous = true;
ssym->transposer = Teuchos::RCP<EpetraExt::RowMatrix_Transpose>(new EpetraExt::RowMatrix_Transpose(MakeDataContiguous));
ssym->DT = Teuchos::rcp( dynamic_cast<Epetra_CrsMatrix *>(&(*ssym->transposer)(*D)), false);
#ifdef TIMING_OUTPUT
ttime.stop();
cout << "Transpose Time" << ttime.totalElapsedTime() << endl;
ttime.reset();
#endif
}
else
{
ssym->transposer->fwd();
//ssym->ReIdx_LP->fwd(); // TODO: Needed ?
}
#endif
// A is no longer needed
delete[] LeftIndex;
delete[] LeftValues;
delete[] RightIndex;
delete[] RightValues;
//cout << msg << "S rows=" << S.NumGlobalRows() << " S cols=" <<
//S.NumGlobalCols() << "#cols in column map="<<
//S.ColMap().NumMyElements() << endl;
//cout << msg << "C rows=" << Cptr->NumGlobalRows() << " C cols=" <<
//Cptr->NumGlobalCols() << "#cols in column map="<<
//Cptr->ColMap().NumMyElements() << endl;
//cout << msg << "D rows=" << D.NumGlobalRows() << " D cols=" <<
//D.NumGlobalCols() << "#cols in column map="<<
//D.ColMap().NumMyElements() << endl;
//cout << msg << "R rows=" << Rptr->NumGlobalRows() << " R cols=" <<
//Rptr->NumGlobalCols() << "#cols in column map="<<
//Rptr->ColMap().NumMyElements() << endl;
// ]
return 0;
}
int main(int argc, char* argv[])
{
int ret_b = 0;
int ret_a = 0;
int dig = 0;
mpz_t test;
#define MAXDIGITS 10000
char input[MAXDIGITS];
FILE *fp;
if (argc < 2 || argc > 3)
{
printf("Usage:\n");
printf(" %s <num>\n", argv[0]);
printf(" Where <num> is a number to test for primality\n");
printf(" %s -inp <file>\n", argv[0]);
printf(" Where <file> contains one or more numbers to test for primality\n");
printf(" Note: This program returns the APR-CL and MPZ PRP status of the input number(s).\n");
printf(" Note: This program will also print out timing information for each check.\n");
printf(" Note: All input numbers are assumed to be base-10 numbers.\n");
return 0;
}
if (strcmp(argv[1], "-inp") == 0)
{
fp = fopen(argv[2], "r");
if(!fp)
{
printf("Error, invalid file: %s\n", argv[2]);
return 1; // bail out if file not found
}
while(fgets(input,sizeof(input),fp) != NULL)
{
/* make sure last character is 0 (null) */
if(input[MAXDIGITS-1] != 0)
input[MAXDIGITS-1] = 0;
if (strlen(input) == 0) continue;
if (input[0] == 0xd || input[0] == 0xa) continue;
if (input[0] < '0' || input[0] > '9')
{
printf("\n *** Notice, not testing the following line:\n");
printf("%s\n", input);
continue;
}
if (mpz_init_set_str(test, input, 10) < 0)
{
printf(" *** ERROR, invalid number: %s\n", input);
continue;
}
printf("===============================================================================\n");
dig = b10_digits(test);
gmp_printf("Testing: %Zd (%d digits)\n", test, dig); fflush(stdout);
printf("Running the MPZ PRP test with 5 iterations...\n"); fflush(stdout);
t0 = ttime(0);
ret_b = mpz_probab_prime_p(test, 5);
t1 = ttime(t0);
printf("Running the APRCL prime test...\n"); fflush(stdout);
t0 = ttime(0);
ret_a = mpz_aprtcle(test, 1);
t2 = ttime(t0);
printf("\n MPZ PRP took %.4f seconds\n", t1);
if (ret_b == APRTCLE_COMPOSITE)
printf(" MPZ PRP says the number is COMPOSITE\n");
else if (ret_b == APRTCLE_PRP)
printf(" MPZ PRP says the number is PRP\n");
else if (ret_b == APRTCLE_PRIME)
printf(" MPZ PRP says the number is PRIME\n");
printf("APRCL took %.4f seconds\n", t2);
if (ret_a == APRTCLE_COMPOSITE)
printf("APRCL says the number is COMPOSITE\n");
else if (ret_a == APRTCLE_PRP)
printf("APRCL says the number is PRP\n");
else if (ret_a == APRTCLE_PRIME)
printf("APRCL says the number is PRIME\n");
if ((ret_b == APRTCLE_COMPOSITE && ret_a != APRTCLE_COMPOSITE) ||
(ret_b != APRTCLE_COMPOSITE && ret_a == APRTCLE_COMPOSITE))
{
printf(" *** ATTENTION *** ATTENTION *** ATTENTION *** ATTENTION ***\n");
printf("MPZ PRP and APRCL do not agree on the status of this number!!!\n");
printf("Please report this to http://www.mersenneforum.org/showthread.php?t=18353\n");
gmp_printf("N = %Zd\n", test);
}
}
fclose(fp);
}
else
{
if (mpz_init_set_str(test, argv[1], 10) < 0)
{
mpz_clear(test);
printf("Error, invalid number: %s\n", argv[1]);
return 0;
}
dig = b10_digits(test);
gmp_printf("Testing: %Zd (%d digits)\n", test, dig); fflush(stdout);
printf("Running the MPZ PRP test with 5 iterations...\n"); fflush(stdout);
t0 = ttime(0);
ret_b = mpz_probab_prime_p(test, 5);
t1 = ttime(t0);
printf("Running the APRCL prime test...\n"); fflush(stdout);
t0 = ttime(0);
ret_a = mpz_aprtcle(test, 1);
t2 = ttime(t0);
printf("\n MPZ PRP took %.4f seconds\n", t1);
if (ret_b == APRTCLE_COMPOSITE)
printf(" MPZ PRP says the number is COMPOSITE\n");
else if (ret_b == APRTCLE_PRP)
printf(" MPZ PRP says the number is PRP\n");
else if (ret_b == APRTCLE_PRIME)
printf(" MPZ PRP says the number is PRIME\n");
printf("APRCL took %.4f seconds\n", t2);
if (ret_a == APRTCLE_COMPOSITE)
printf("APRCL says the number is COMPOSITE\n");
else if (ret_a == APRTCLE_PRP)
printf("APRCL says the number is PRP\n");
else if (ret_a == APRTCLE_PRIME)
printf("APRCL says the number is PRIME\n");
if ((ret_b == APRTCLE_COMPOSITE && ret_a != APRTCLE_COMPOSITE) ||
(ret_b != APRTCLE_COMPOSITE && ret_a == APRTCLE_COMPOSITE))
{
printf(" *** ATTENTION *** ATTENTION *** ATTENTION *** ATTENTION ***\n");
printf("MPZ PRP and APRCL do not agree on the status of this number!!!\n");
printf("Please report this to http://www.mersenneforum.org/showthread.php?t=18353\n");
gmp_printf("N = %Zd\n", test);
}
}
mpz_clear(test);
return 0;
}
/*-----------------*
* Function getsam |
*-----------------*
| Generates a gene genealogy for a locus.
*/
int gensam(struct params *pparam, char **list, int **pnbvariant, int *pS)
{
int nsegs=0, k=0, seg=0, ns=0, start=0, end=0, len=0, segsit=0, nsites=0, nsam=0;
/* The function returns ns, the number of sgregating sites.
* nsegs is the gametes were broken into in tracing back the history of the gametes.
* The histories of these segments are passed back to the calling function in the array of structures seglst[]
*/
struct segl *seglst=NULL;
double nsinv=0.0, tseg=0.0, tt=0.0, theta=0.0;
void make_gametes(int, struct node*, double, int, int, char**, int, int*, int**, int*, int*);
void inititable(int, int, int*);
void initimatrix(int, int, int, int**);
void biggerimatrix(int, int**);
void biggerlist(int, char**);
void locate(int, double, double, double*);
//// From make_gametes ////
void prtree(struct node*, int);
double ttime(struct node*, int);
int poisso(double);
//// From streec.c ////
struct segl*segtre_mig(struct c_params*, int*);
nsites=pparam->cp.nsites; // Locus lenght available for recombination
nsinv=1./nsites;
seglst=segtre_mig(&(pparam->cp), &nsegs); // Generate Xove and ARGr, record # segments
nsam=pparam->cp.nsam; // # chromo in the sample
theta=pparam->mp.theta; // mutation rate given by user
ns=0; // # seg sites
if(pparam->mp.treeflag) // Case output tree.
{
theta=pparam->mp.theta;
ns=0;
for(seg=0, k=0;k<nsegs;seg=seglst[seg].next, k++)
{
if((pparam->cp.r>0.0)||(pparam->cp.f>0.0))
{
end=(k<nsegs-1 ? seglst[seglst[seg].next].beg-1:nsites-1);
start=seglst[seg].beg;
len=end-start+1;
fprintf(stdout, "[%d]", len);
}
prtree(seglst[seg].ptree, nsam);
if((theta==0.0))
free(seglst[seg].ptree);
}
}
//--- Loop along all segments ---//
for(seg=0, k=0;k<nsegs; seg=seglst[seg].next, k++)
{
end=(k<nsegs-1 ? seglst[seglst[seg].next].beg-1:nsites-1); // End of segment
start=seglst[seg].beg; // beginning of segment
len=end-start+1; // Lengh of segment
tseg=len*(theta/nsites); // Mutation rate along the segment
tt=ttime(seglst[seg].ptree, nsam); // Total time in the tree for this segment
segsit=poisso(tseg*tt); // get # segsites along genealogy for the segment
//--- Realloc memory if # segsite bigger than max previously define ---//
if((segsit+ns)>=maxsites)
{
maxsites=segsit+ns+SITESINC; // Bigger Max sites
biggerlist(nsam, list); // Increase list of haplotype
typeseg=(int*)realloc(typeseg, maxsites*sizeof(int)); // Increase # seg sites in typeseg
biggerimatrix(pparam->cp.npop+1, pnbvariant); // Increase matrix of variant
}
//--- Initialize table of variant and segType ---//
initimatrix(ns, ns+segsit, pparam->cp.npop+1, pnbvariant);
inititable(ns, segsit+ns, typeseg);
make_gametes(nsam, seglst[seg].ptree, tt, segsit, ns, list, pparam->cp.npop, pparam->cp.config, pnbvariant, typeseg, pS); // Make gametes (Put segsites on gene genealogy)
free(seglst[seg].ptree); // Free memory
ns+=segsit; // Total # seg sites
}
for(k=0;k<nsam;k++) list[k][ns]='\0'; // End of haplotype strings
return(ns); // Total # segsites
}// End Gensam
int
gensam( char **list, double *pprobss, double *ptmrca, double *pttot )
{
int nsegs, h, i, k, j, seg, ns, start, end, len, segsit ;
struct segl *seglst, *segtre_mig(struct c_params *p, int *nsegs ) ; /* used to be: [MAXSEG]; */
double nsinv, tseg, tt, ttime(struct node *, int nsam), ttimemf(struct node *, int nsam, int mfreq) ;
double *pk;
int *ss;
int segsitesin,nsites;
double theta, es ;
int nsam, mfreq ;
void prtree( struct node *ptree, int nsam);
void make_gametes(int nsam, int mfreq, struct node *ptree, double tt, int newsites, int ns, char **list );
void ndes_setup( struct node *, int nsam );
nsites = pars.cp.nsites ;
nsinv = 1./nsites;
seglst = segtre_mig(&(pars.cp), &nsegs ) ;
nsam = pars.cp.nsam;
segsitesin = pars.mp.segsitesin ;
theta = pars.mp.theta ;
mfreq = pars.mp.mfreq ;
if( pars.mp.treeflag ) {
ns = 0 ;
for( seg=0, k=0; k<nsegs; seg=seglst[seg].next, k++) {
if( (pars.cp.r > 0.0 ) || (pars.cp.f > 0.0) ) {
end = ( k<nsegs-1 ? seglst[seglst[seg].next].beg -1 : nsites-1 );
start = seglst[seg].beg ;
len = end - start + 1 ;
fprintf(stdout,"[%d]", len);
}
prtree( seglst[seg].ptree, nsam ) ;
if( (segsitesin == 0) && ( theta == 0.0 ) && ( pars.mp.timeflag == 0 ) )
free(seglst[seg].ptree) ;
}
}
if( pars.mp.timeflag ) {
tt = 0.0 ;
for( seg=0, k=0; k<nsegs; seg=seglst[seg].next, k++) {
if( mfreq > 1 ) ndes_setup( seglst[seg].ptree, nsam );
end = ( k<nsegs-1 ? seglst[seglst[seg].next].beg -1 : nsites-1 );
start = seglst[seg].beg ;
if( (nsegs==1) || ( ( start <= nsites/2) && ( end >= nsites/2 ) ) )
*ptmrca = (seglst[seg].ptree + 2*nsam-2) -> time ;
len = end - start + 1 ;
tseg = len/(double)nsites ;
if( mfreq == 1 ) tt += ttime(seglst[seg].ptree,nsam)*tseg ;
else tt += ttimemf(seglst[seg].ptree,nsam, mfreq)*tseg ;
if( (segsitesin == 0) && ( theta == 0.0 ) )
free(seglst[seg].ptree) ;
}
*pttot = tt ;
}
if( (segsitesin == 0) && ( theta > 0.0) ) {
ns = 0 ;
for( seg=0, k=0; k<nsegs; seg=seglst[seg].next, k++) {
if( mfreq > 1 ) ndes_setup( seglst[seg].ptree, nsam );
end = ( k<nsegs-1 ? seglst[seglst[seg].next].beg -1 : nsites-1 );
start = seglst[seg].beg ;
len = end - start + 1 ;
tseg = len*(theta/nsites) ;
if( mfreq == 1) tt = ttime(seglst[seg].ptree, nsam);
else tt = ttimemf(seglst[seg].ptree, nsam, mfreq );
segsit = poisso( tseg*tt );
if( (segsit + ns) >= maxsites ) {
maxsites = segsit + ns + SITESINC ;
posit = (double *)realloc(posit, maxsites*sizeof(double) ) ;
biggerlist(nsam, list) ;
}
make_gametes(nsam,mfreq,seglst[seg].ptree,tt, segsit, ns, list );
free(seglst[seg].ptree) ;
locate(segsit,start*nsinv, len*nsinv,posit+ns);
ns += segsit;
}
}
else if( segsitesin > 0 ) {
pk = (double *)malloc((unsigned)(nsegs*sizeof(double)));
ss = (int *)malloc((unsigned)(nsegs*sizeof(int)));
if( (pk==NULL) || (ss==NULL) ) perror("malloc error. gensam.2");
tt = 0.0 ;
for( seg=0, k=0; k<nsegs; seg=seglst[seg].next, k++) {
if( mfreq > 1 ) ndes_setup( seglst[seg].ptree, nsam );
end = ( k<nsegs-1 ? seglst[seglst[seg].next].beg -1 : nsites-1 );
start = seglst[seg].beg ;
len = end - start + 1 ;
tseg = len/(double)nsites ;
if( mfreq == 1 ) pk[k] = ttime(seglst[seg].ptree,nsam)*tseg ;
else pk[k] = ttimemf(seglst[seg].ptree,nsam, mfreq)*tseg ;
tt += pk[k] ;
}
if( theta > 0.0 ) {
es = theta * tt ;
*pprobss = exp( -es )*pow( es, (double) segsitesin) / segfac ;
}
if( tt > 0.0 ) {
for (k=0; k<nsegs; k++) pk[k] /= tt ;
mnmial(segsitesin,nsegs,pk,ss);
}
else
for( k=0; k<nsegs; k++) ss[k] = 0 ;
ns = 0 ;
for( seg=0, k=0; k<nsegs; seg=seglst[seg].next, k++) {
end = ( k<nsegs-1 ? seglst[seglst[seg].next].beg -1 : nsites-1 );
start = seglst[seg].beg ;
len = end - start + 1 ;
tseg = len/(double)nsites;
make_gametes(nsam,mfreq,seglst[seg].ptree,tt*pk[k]/tseg, ss[k], ns, list);
free(seglst[seg].ptree) ;
locate(ss[k],start*nsinv, len*nsinv,posit+ns);
ns += ss[k] ;
}
free(pk);
free(ss);
}
for(i=0; i<nsam; i++) list[i][ns] = '\0' ;
return( ns ) ;
}