/**************************************************************************/
/*                                                                        */
/*                                 Sources                                */
/*                                from  the                               */
/*                           XSC SOFTWARE PACKAGE                         */
/*                                                                        */
/*                Copyright (c) 1997 University of Karlsruhe              */
/*                     Institute for Appl. Mathematics                    */
/*                                                                        */
/* This program is free software for non-commercial use. For details, see */
/* the file LICENSE.XSC, distributed with this software package.          */
/*                                                                        */
/* This program is distributed WITHOUT ANY WARRANTY. For details, see the */
/* file LICENSE.XSC, distributed with this software package.              */
/*                                                                        */
/**************************************************************************/

/* RCS $Id: b_gini.c,v 1.2 1997/09/25 17:02:42 ae59 Exp $ */
/*
$Log: b_gini.c,v $
 * Revision 1.2  1997/09/25  17:02:42  ae59
 * Copyright-message
 *
 * Revision 1.1  1994/01/27  13:21:25  ae59
 * Put under RCS control
 *
 */
/************************************************************************
 *                                                                      *
 *   Global Constants and Variables common to all Standardfunctions     *
 *   ==============================================================     *
 *                                                                      *
 *   Initialization of constants and variables common to all standard   *
 *   function routines.                                                 *
 *                                                                      *
 *   The routine is called only once by the first standard function     *
 *   routine using one of the constants or variables defined in this    *
 *   routine.                                                           *
 *                                                                      *
 *   Future calls are avoided by setting the global flag variable       *
 *   Lgiflag.                                                           *
 *                                                                      */
/*      Date            : 1991-09-09                            */
/*      1991-09-09 : reduce max. line length                    */
/*      1991-08-01 : INT_HPREC introduced                       *
 *      1991-04-22 : real assignment replaced by R_ASSIGN()     *
 *      1991-01-07 : real value explicitly assigned/sett removed*
 *      1990-09-04 : Larith.h replaced by b_lari.h              *
 *                   Lpi.h    replaced by b_lpi_.h              *
 *      1990-07-17 : LPiov4, L4ovPi added from b_pi__.c         *
 ************************************************************************/

#ifdef AIX
#include "/u/p88c/runtime/base/b_lari.h"
#else
#include "b_lari.h"
#endif

extern a_btyp  Maxl;

static a_btyp  mone[3] = { 1, 0, 0 };
static a_btyp  mmid[3] = { 4, 0, 0 };
static a_btyp  mmsq[3] = { Minsqrm, 0, 0 };
        
dynamic  LhF, LhE, LhD;
dynamic  LhV[numvar];
dynamic  Llnbase;
dynamic *baseptr = &Llnbase;
dynamic  Lone     = { 0, 0, 0, 0,       0, Minl, &mone[0] };
dynamic  Leps     = { 0, 0, 0, 0,       0, Minl, &mone[0] };
dynamic  Lmindbl  = { 0, 0, 0, 0,       0, Minl, &mmid[0] };
dynamic  LFminsq  = { 0, 0, 0, 0, Minsqre, Minl, &mmsq[0] };
dynamic  LMinreal = { 0, 0, 0, 0,-EFUFfac, Minl, &mone[0] };
        
a_real  FUFfac, FIUFfac, Fln2, Flnb;
        
a_btyp  Lcurrprec;
a_btyp  Lgiflag  = false;
a_btyp  LhI;
/* Uebergangsweise : */
a_btyp  LFulp    = 0;
/* */
a_btyp  EUFfac   = EFUFfac;
a_btyp  Lintern  = false;
a_btyp  Lversion = false;

/****************************************************************
 * Initial Values for PI, 4/PI and 2/PI                         *
 ****************************************************************/

#ifdef AIX
#include  "/u/p88c/runtime/base/b_lpi_.h"
#else
#include  "b_lpi_.h"
#endif

dynamic  LPiov4   = { 0, 0, 1, 0, -1, Lpi_init, &mPiov4[0] };
dynamic  L4ovPi   = { 0, 0, 1, 0,  0, Lpi_init, &m4ovPi[0] };

int   Ldebug    = 100;

#if INT_HPREC
int   b_case    = 0;
dynamic *b_farg = NULL;
#endif
        
rounding  Lrnd;

#ifdef LINT_ARGS
int b_gini(void)
#else
int b_gini()
#endif
#define  LRoutine    "Lginit"
{
   int       i;
   extern a_real *r_fln2,*r_flnb;

#ifdef Debug
   Ldebug -= 1;                 /* Diminish Debug Level      */
   if (Ldebug >= 0) printf("\n Entering Routine %s",LRoutine);
#endif

   Lgiflag = true;
        
   (void)b_bini(&LhF);
   (void)b_bini(&LhE);
   (void)b_bini(&LhD);

   for (i=0; i<numvar; i++) (void)b_bini(&LhV[i]);

   (void)b_bini(&Llnbase);

   R_ASSIGN(Fln2,*r_fln2);
   R_ASSIGN(Flnb,*r_flnb);

   (void)b_bcdi(Flnb,&baseptr,(a_intg)0);

   ((a_btyp *)&FUFfac)[B_HPART] = MFUFfac;
   ((a_btyp *)&FUFfac)[B_LPART] = ZERO;
   ((a_btyp *)&FIUFfac)[B_HPART] = MFIUFfac;
   ((a_btyp *)&FIUFfac)[B_LPART] = ZERO;
        
/* FMinsqr.u[0] = Minsqrd;  FMinsqr.u[1] = 0; */

   EXIT(0);
}
        
        
