version 1.3, 2000/06/30 21:36:16
|
version 1.6, 2001/10/29 19:36:53
|
Line 2
|
Line 2
|
Copyright (C) 1992-2000 Michigan State University |
Copyright (C) 1992-2000 Michigan State University |
|
|
The CAPA system is free software; you can redistribute it and/or |
The CAPA system is free software; you can redistribute it and/or |
modify it under the terms of the GNU Library General Public License as |
modify it under the terms of the GNU General Public License as |
published by the Free Software Foundation; either version 2 of the |
published by the Free Software Foundation; either version 2 of the |
License, or (at your option) any later version. |
License, or (at your option) any later version. |
|
|
The CAPA system is distributed in the hope that it will be useful, |
The CAPA system is distributed in the hope that it will be useful, |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
Library General Public License for more details. |
General Public License for more details. |
|
|
You should have received a copy of the GNU Library General Public |
You should have received a copy of the GNU General Public |
License along with the CAPA system; see the file COPYING. If not, |
License along with the CAPA system; see the file COPYING. If not, |
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
Boston, MA 02111-1307, USA. */ |
Boston, MA 02111-1307, USA. |
|
|
|
As a special exception, you have permission to link this program |
|
with the TtH/TtM library and distribute executables, as long as you |
|
follow the requirements of the GNU GPL in regard to all of the |
|
software in the executable aside from TtH/TtM. |
|
*/ |
|
|
#include "ranlib.h" |
#include "ranlib.h" |
#include <stdio.h> |
#include <stdio.h> |
Line 56 static long qsame;
|
Line 62 static long qsame;
|
qsame = olda == aa && oldb == bb; |
qsame = olda == aa && oldb == bb; |
if(qsame) goto S20; |
if(qsame) goto S20; |
if(!(aa <= 0.0 || bb <= 0.0)) goto S10; |
if(!(aa <= 0.0 || bb <= 0.0)) goto S10; |
puts(" AA or BB <= 0 in GENBET - Abort!"); |
fprintf(stderr," AA or BB <= 0 in GENBET - Abort!\n"); |
printf(" AA: %16.6E BB %16.6E\n",aa,bb); |
fprintf(stderr," AA: %16.6E BB %16.6E\n",aa,bb); |
exit(1); |
exit(1); |
S10: |
S10: |
olda = aa; |
olda = aa; |
Line 207 float genchi(float df)
|
Line 213 float genchi(float df)
|
static float genchi; |
static float genchi; |
|
|
if(!(df <= 0.0)) goto S10; |
if(!(df <= 0.0)) goto S10; |
puts("DF <= 0 in GENCHI - ABORT"); |
fprintf(stderr,"DF <= 0 in GENCHI - ABORT\n"); |
printf("Value of DF: %16.6E\n",df); |
fprintf(stderr,"Value of DF: %16.6E\n",df); |
exit(1); |
exit(1); |
S10: |
S10: |
genchi = 2.0*gengam(1.0,df/2.0); |
genchi = 2.0*gengam(1.0,df/2.0); |
Line 263 float genf(float dfn,float dfd)
|
Line 269 float genf(float dfn,float dfd)
|
static float genf,xden,xnum; |
static float genf,xden,xnum; |
|
|
if(!(dfn <= 0.0 || dfd <= 0.0)) goto S10; |
if(!(dfn <= 0.0 || dfd <= 0.0)) goto S10; |
puts("Degrees of freedom nonpositive in GENF - abort!"); |
fprintf(stderr,"Degrees of freedom nonpositive in GENF - abort!\n"); |
printf("DFN value: %16.6EDFD value: %16.6E\n",dfn,dfd); |
fprintf(stderr,"DFN value: %16.6EDFD value: %16.6E\n",dfn,dfd); |
exit(1); |
exit(1); |
S10: |
S10: |
xnum = genchi(dfn)/dfn; |
xnum = genchi(dfn)/dfn; |
Line 273 S10:
|
Line 279 S10:
|
*/ |
*/ |
xden = genchi(dfd)/dfd; |
xden = genchi(dfd)/dfd; |
if(!(xden <= 9.999999999998E-39*xnum)) goto S20; |
if(!(xden <= 9.999999999998E-39*xnum)) goto S20; |
puts(" GENF - generated numbers would cause overflow"); |
fprintf(stderr," GENF - generated numbers would cause overflow\n"); |
printf(" Numerator %16.6E Denominator %16.6E\n",xnum,xden); |
fprintf(stderr," Numerator %16.6E Denominator %16.6E\n",xnum,xden); |
puts(" GENF returning 1.0E38"); |
fprintf(stderr," GENF returning 1.0E38\n"); |
genf = 1.0E38; |
genf = 1.0E38; |
goto S30; |
goto S30; |
S20: |
S20: |
Line 395 float gennch(float df,float xnonc)
|
Line 401 float gennch(float df,float xnonc)
|
static float gennch; |
static float gennch; |
|
|
if(!(df <= 1.0 || xnonc < 0.0)) goto S10; |
if(!(df <= 1.0 || xnonc < 0.0)) goto S10; |
puts("DF <= 1 or XNONC < 0 in GENNCH - ABORT"); |
fprintf(stderr,"DF <= 1 or XNONC < 0 in GENNCH - ABORT\n"); |
printf("Value of DF: %16.6E Value of XNONC%16.6E\n",df,xnonc); |
fprintf(stderr,"Value of DF: %16.6E Value of XNONC%16.6E\n",df,xnonc); |
exit(1); |
exit(1); |
S10: |
S10: |
gennch = genchi(df-1.0)+pow(gennor(sqrt(xnonc),1.0),2.0); |
gennch = genchi(df-1.0)+pow(gennor(sqrt(xnonc),1.0),2.0); |
Line 430 static long qcond;
|
Line 436 static long qcond;
|
|
|
qcond = dfn <= 1.0 || dfd <= 0.0 || xnonc < 0.0; |
qcond = dfn <= 1.0 || dfd <= 0.0 || xnonc < 0.0; |
if(!qcond) goto S10; |
if(!qcond) goto S10; |
puts("In GENNF - Either (1) Numerator DF <= 1.0 or"); |
fprintf(stderr,"In GENNF - Either (1) Numerator DF <= 1.0 or\n"); |
puts("(2) Denominator DF < 0.0 or "); |
fprintf(stderr,"(2) Denominator DF < 0.0 or \n"); |
puts("(3) Noncentrality parameter < 0.0"); |
fprintf(stderr,"(3) Noncentrality parameter < 0.0\n"); |
printf("DFN value: %16.6EDFD value: %16.6EXNONC value: \n%16.6E\n",dfn,dfd, |
fprintf(stderr,"DFN value: %16.6EDFD value: %16.6EXNONC value: \n%16.6E\n",dfn,dfd, |
xnonc); |
xnonc); |
exit(1); |
exit(1); |
S10: |
S10: |
Line 443 S10:
|
Line 449 S10:
|
*/ |
*/ |
xden = genchi(dfd)/dfd; |
xden = genchi(dfd)/dfd; |
if(!(xden <= 9.999999999998E-39*xnum)) goto S20; |
if(!(xden <= 9.999999999998E-39*xnum)) goto S20; |
puts(" GENNF - generated numbers would cause overflow"); |
fprintf(stderr," GENNF - generated numbers would cause overflow\n"); |
printf(" Numerator %16.6E Denominator %16.6E\n",xnum,xden); |
fprintf(stderr," Numerator %16.6E Denominator %16.6E\n",xnum,xden); |
puts(" GENNF returning 1.0E38"); |
fprintf(stderr," GENNF returning 1.0E38\n"); |
gennf = 1.0E38; |
gennf = 1.0E38; |
goto S30; |
goto S30; |
S20: |
S20: |
Line 513 float tmp_f;
|
Line 519 float tmp_f;
|
tmp_f = snorm(); |
tmp_f = snorm(); |
|
|
gen_num = sd*tmp_f+av; |
gen_num = sd*tmp_f+av; |
/* printf("SNORM()=%f,GENNOR()=%f,%f*%f+%f\n",tmp_f,gen_num,sd,tmp_f,av); */ |
/* fprintf(stderr,"SNORM()=%f,GENNOR()=%f,%f*%f+%f\n",tmp_f,gen_num,sd,tmp_f,av); */ |
*num_d = (double)gen_num; |
*num_d = (double)gen_num; |
|
|
gen_num = (float)37.358341; |
gen_num = (float)37.358341; |
Line 558 float genunf(float low,float high)
|
Line 564 float genunf(float low,float high)
|
static float genunf; |
static float genunf; |
|
|
if(!(low > high)) goto S10; |
if(!(low > high)) goto S10; |
printf("LOW > HIGH in GENUNF: LOW %16.6E HIGH: %16.6E\n",low,high); |
fprintf(stderr,"LOW > HIGH in GENUNF: LOW %16.6E HIGH: %16.6E\n",low,high); |
puts("Abort"); |
fprintf(stderr,"Abort\n"); |
exit(1); |
exit(1); |
S10: |
S10: |
genunf = low+(high-low)*ranf(); |
genunf = low+(high-low)*ranf(); |
Line 583 static long curntg = 1;
|
Line 589 static long curntg = 1;
|
if(getset == 0) *g = curntg; |
if(getset == 0) *g = curntg; |
else { |
else { |
if(*g < 0 || *g > numg) { |
if(*g < 0 || *g > numg) { |
puts(" Generator number out of range in GSCGN"); |
fprintf(stderr," Generator number out of range in GSCGN\n"); |
exit(0); |
exit(0); |
} |
} |
curntg = *g; |
curntg = *g; |
Line 1141 long ignuin(long low,long high)
|
Line 1147 long ignuin(long low,long high)
|
static long ignuin,ign,maxnow,range,ranp1; |
static long ignuin,ign,maxnow,range,ranp1; |
|
|
if(!(low > high)) goto S10; |
if(!(low > high)) goto S10; |
puts(" low > high in ignuin - ABORT"); |
fprintf(stderr," low > high in ignuin - ABORT\n"); |
exit(1); |
exit(1); |
|
|
S10: |
S10: |
range = high-low; |
range = high-low; |
if(!(range > maxnum)) goto S20; |
if(!(range > maxnum)) goto S20; |
puts(" high - low too large in ignuin - ABORT"); |
fprintf(stderr," high - low too large in ignuin - ABORT\n"); |
exit(1); |
exit(1); |
|
|
S20: |
S20: |
Line 1208 static long mltmod,a0,a1,k,p,q,qh,rh;
|
Line 1214 static long mltmod,a0,a1,k,p,q,qh,rh;
|
machine. On a different machine recompute H |
machine. On a different machine recompute H |
*/ |
*/ |
if(!(a <= 0 || a >= m || s <= 0 || s >= m)) goto S10; |
if(!(a <= 0 || a >= m || s <= 0 || s >= m)) goto S10; |
puts(" a, m, s out of order in mltmod - ABORT!"); |
fprintf(stderr," a, m, s out of order in mltmod - ABORT!\n"); |
printf(" a = %12ld s = %12ld m = %12ld\n",a,s,m); |
fprintf(stderr," a = %12ld s = %12ld m = %12ld\n",a,s,m); |
puts(" mltmod requires: 0 < a < m; 0 < s < m"); |
fprintf(stderr," mltmod requires: 0 < a < m; 0 < s < m\n"); |
exit(1); |
exit(1); |
S10: |
S10: |
if(!(a < h)) goto S20; |
if(!(a < h)) goto S20; |
Line 1394 float capa_ranf(void)
|
Line 1400 float capa_ranf(void)
|
and is currently 2147483563. If M1 changes, change this also. |
and is currently 2147483563. If M1 changes, change this also. |
*/ |
*/ |
my_ran = ignlgi(); |
my_ran = ignlgi(); |
/* printf("MY_ignlgi=%ld -- first time\n",my_ran); */ |
/* fprintf(stderr,"MY_ignlgi=%ld -- first time\n",my_ran); */ |
/* ran_f = my_ran * 4.656613057E-10; */ |
/* ran_f = my_ran * 4.656613057E-10; */ |
|
|
my_doub = (double)my_ran * (double)4.656613057E-10; |
my_doub = (double)my_ran * (double)4.656613057E-10; |
printf("MY_ranf in double=%.15g -- first time\n",my_doub); |
fprintf(stderr,"MY_ranf in double=%.15g -- first time\n",my_doub); |
ran_f = (float)my_doub; |
ran_f = (float)my_doub; |
return (ran_f); |
return (ran_f); |
} |
} |
Line 1435 static long i,icount,info,j,D2,D3,D4,D5;
|
Line 1441 static long i,icount,info,j,D2,D3,D4,D5;
|
TEST THE INPUT |
TEST THE INPUT |
*/ |
*/ |
if(!(p <= 0)) goto S10; |
if(!(p <= 0)) goto S10; |
puts("P nonpositive in SETGMN"); |
fprintf(stderr,"P nonpositive in SETGMN\n"); |
printf("Value of P: %12ld\n",p); |
fprintf(stderr,"Value of P: %12ld\n",p); |
exit(1); |
exit(1); |
S10: |
S10: |
*parm = p; |
*parm = p; |
Line 1449 S10:
|
Line 1455 S10:
|
*/ |
*/ |
spofa(covm,p,p,&info); |
spofa(covm,p,p,&info); |
if(!(info != 0)) goto S30; |
if(!(info != 0)) goto S30; |
puts(" COVM not positive definite in SETGMN"); |
fprintf(stderr," COVM not positive definite in SETGMN\n"); |
exit(1); |
exit(1); |
S30: |
S30: |
icount = p+1; |
icount = p+1; |