Diff for /capa/capa51/pProj/ranlib.c between versions 1.3 and 1.6

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;

Removed from v.1.3  
changed lines
  Added in v.1.6


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>