/******************************************************************************/
/* "HINT" -- Hierarchical INTegration.  SERIAL VERSION                        */
/* Copyright (C) 1994 by Iowa State University Research Foundation, Inc.      */
/*                                                                            */
/* This program is free software; you can redistribute it and/or modify       */
/* it under the terms of the GNU General Public License as published by       */
/* the Free Software Foundation.  You should have received a copy of the      */
/* GNU General Public License along with this program; if not, write to the   */
/* Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    */
/*                                                                            */
/* Files needed for use:                                                      */
/*     * hint.c             ---- Driver source                                */
/*     * hkernel.c          ---- Kernel source                                */
/*     * hint.h             ---- General include file                         */
/*     * typedefs.h         ---- Include file for DSIZE and ISIZE             */
/*     * README             ---- These are the rules. Follow them!!!          */
/******************************************************************************/

#include "hint.h"

DSIZE
Hint(DSIZE *scx, DSIZE *scy, DSIZE *dmax, ISIZE *mcnt, hRECT *hRECT, 
                           DSIZE *errs, ISIZE *ixes, hERROR *eflag)
{
    DSIZE   errio,       /* Error value for io                                */
            errjo,       /* Error value for jo                                */
            sh,          /* Sum of areas, high bound                          */
            sl,          /* Sum of areas, low bound                           */
            tm,          /* Temporary value for computing function            */
            tm2;         /* Temporary value for doubling tm                   */

    ISIZE   inc, jnc,    /* Indices of queue positions                        */
            io,          /* Index of left child                               */
            iq,          /* Index of end of the sorted error queue            */
            it,          /* Iteration counter                                 */
            itmp,        /* Temporary                                         */
            jo,          /* Index of right child                              */
            ma;          /* Index of parent                                   */


   /* Initialize the first interval.                                          */
      hRECT[0].xl = (DSIZE)0;    
      hRECT[0].xr = *scx;      
      hRECT[0].dx = *scx;     
      hRECT[0].fll = *scy;   
      hRECT[0].flh = *scy;  
      hRECT[0].frl = (DSIZE)0;
      hRECT[0].frh = (DSIZE)0;
      hRECT[0].ahi = *dmax;
      hRECT[0].alo = (DSIZE)0;
      iq = 0;
      errs[iq] = hRECT[0].ahi - hRECT[0].alo;
      ixes[iq] = iq;      
      sh = hRECT[0].ahi;
      sl = hRECT[0].alo;

      for (it = 0; ((it < *mcnt - 1) && (it <= iq)); it++) 
      {
          io = ma = ixes[it];        /* Head of list has maximum error        */
          jo = it + 1;               /* Find right child index                */

          tm = hRECT[ma].dx; 
       /* Since dx is always a power of 2, it halves evenly.                  */
          hRECT[io].dx  = hRECT[jo].dx = tm / (DSIZE)2;

       /* Right child gets right boundary.                                    */
          hRECT[jo].xr  = hRECT[ma].xr;
       /* New point in the middle is shared by child subintervals             */
          hRECT[io].xr  = hRECT[io].xl + 
                         hRECT[io].dx; 
          hRECT[jo].xl  = hRECT[io].xr;
       /* Right child gets right f value upper and lower bounds               */
          hRECT[jo].frl = hRECT[ma].frl;
          hRECT[jo].frh = hRECT[ma].frh;
       /* Note that the left child simply inherits much of its info from ma.  */

       /* This is the function evaluation.                                    */
          tm =  (*scx + hRECT[io].xr); 
          tm2 = (*scy * (*scx - hRECT[io].xr));
          itmp = tm2 / tm;
          hRECT[io].frl = itmp;

       /* Here we need boolean true == 1. Otherwise use if's.                 */
          hRECT[io].frh = hRECT[io].frl + ((tm * hRECT[io].frl) != tm2);
          hRECT[jo].fll = hRECT[io].frl;
          hRECT[jo].flh = hRECT[io].frh;

       /* Compute the left daughter error.                                    */
          tm = (hRECT[io].fll - hRECT[io].frh) * (hRECT[io].dx - (DSIZE)2);
          if (tm < (DSIZE)0)
              tm = (DSIZE)0;
          errio = (hRECT[io].flh - hRECT[io].frh  + 
                   hRECT[io].fll - hRECT[io].frl) * 
                  (hRECT[io].dx - (DSIZE)1) - tm;

       /* Repeat for the right daughter.                                      */
          tm = (hRECT[jo].fll - hRECT[jo].frh) * (hRECT[jo].dx - (DSIZE)2);
          if (tm < (DSIZE)0)
              tm = (DSIZE)0;
          errjo = (hRECT[jo].flh - hRECT[jo].frh  + 
                   hRECT[jo].fll - hRECT[jo].frl) * 
                  (hRECT[jo].dx - (DSIZE)1) - tm;

       /* Compute indices for io and jo on the queue.                         */
       /* This is done with a boolean. If boolean true is not 1 use if's.     */
          inc = (errio < errjo) + 1;
          jnc = 3 - inc;

       /* Put on both io and jo. If one is zero we will not use it.           */
          errs[iq + inc] = errio;
          ixes[iq + inc] = io;
          errs[iq + jnc] = errjo;
          ixes[iq + jnc] = jo;

       /* Decide how much to increment iq. Again we need boolean true == 1.   */
          iq = iq + (errs[iq + 2] != 0) + 1;

       /* Remove parent sum contributions. Replace with child contributions.  */
          tm = hRECT[ma].alo;
          hRECT[io].alo = hRECT[io].frl * hRECT[io].dx;
          hRECT[jo].alo = hRECT[jo].frl * hRECT[jo].dx;
          sl -= tm;                    
          sl += hRECT[io].alo + hRECT[jo].alo; 
          tm = hRECT[ma].ahi;
          hRECT[io].ahi = hRECT[io].flh * hRECT[io].dx;
          hRECT[jo].ahi = hRECT[jo].flh * hRECT[jo].dx;
          sh -= tm;
          sh += hRECT[io].ahi + hRECT[jo].ahi;
      }
      if (it > iq) 
          *eflag = DISCRET;
      else
          *eflag = NOERROR;

      return  (sh - sl);
}
