/***********************************************************************
* This file is part of OpenMolcas.                                     *
*                                                                      *
* OpenMolcas is free software; you can redistribute it and/or modify   *
* it under the terms of the GNU Lesser General Public License, v. 2.1. *
* OpenMolcas is distributed in the hope that it will be useful, but it *
* is provided "as is" and without any express or implied warranties.   *
* For more details see the full text of the license in the file        *
* LICENSE or in <http://www.gnu.org/licenses/>.                        *
*                                                                      *
* Copyright (C) 2002, Per-Olof Widmark                                 *
***********************************************************************/

/**************************************************************************/
/*                                                                        */
/* This routine performs run length encoding of floating point numbers    */
/* where all number less than a given threshold are treated as zeros.     */
/* These zeros are run length encoded.                                    */
/*                                                                        */
/*------------------------------------------------------------------------*/
/*                                                                        */
/* Author:  Per-Olof Widmark                                              */
/*          Lund University, Sweden                                       */
/* Written: October 2002                                                  */
/*                                                                        */
/**************************************************************************/

#include <math.h>
#include <molcastype.h>

#ifdef _CAPITALS_
# define rle_r8 RLE_R8
# define one_ulp ONE_ULP
#else
# ifndef ADD_
#   define rle_r8 rle_r8_
#   define one_ulp one_ulp_
# endif
#endif

#ifdef _BIG_ENDIAN_
# define IND 0
#else
# define IND 3
#endif

void one_ulp(double *);
void rle_r8(double in[], INT *n_in, double out[], INT *n_out, double *thr) {
  unsigned long long int *ptr_64;
  unsigned short *ptr_16;
  unsigned long long int mask[9]
      = { 0xffffffffffffffffLL, 0xffffffffffffff00LL, 0xffffffffffff0000LL, 0xffffffffff000000LL, 0xffffffff00000000LL,
          0xffffff0000000000LL, 0xffff000000000000LL, 0xffff000000000000LL, 0xffff000000000000LL };
  /* marked as volatile to prevent over-optimization */
  volatile union {
    double dbl;
    short i16[4];
  } share;
  static unsigned char tab[65536];
  double ulp;
  double screen[9];
  unsigned long long int count;
  static int do_setup = 1;
  INT i, k, n, skip;

  if (0) {
    ptr_64 = (unsigned long long int *)out;
    n = 0;
    count = 0;
    for (k = 0; k < *n_in; k++) {
      if (fabs(in[k]) > *thr) {
        if (count > 0) {
          ptr_64[n++] = count;
          count = 0;
        }
        out[n++] = in[k];
        continue;
      }
      count++;
    }
  } else if (0) {
    if (do_setup) {
      do_setup = 0;
      one_ulp(&ulp);
      screen[0] = *thr / ulp / 255.0;
      for (k = 1; k < 9; k++)
        screen[k] = screen[k - 1] / 256.0;
    }
    ptr_64 = (unsigned long long int *)out;
    n = 0;
    count = 0;
    for (k = 0; k < *n_in; k++) {
      if (fabs(in[k]) > *thr) {
        if (count > 0) {
          ptr_64[n++] = count;
          count = 0;
        }
        if (fabs(in[k]) > screen[0])
          skip = 0;
        else if (fabs(in[k]) > screen[1])
          skip = 1;
        else if (fabs(in[k]) > screen[2])
          skip = 2;
        else if (fabs(in[k]) > screen[3])
          skip = 3;
        else if (fabs(in[k]) > screen[4])
          skip = 4;
        else if (fabs(in[k]) > screen[5])
          skip = 5;
        else
          skip = 6;
        out[n] = in[k];
        ptr_64[n] = (mask[skip] & ptr_64[n]);
        n++;
        continue;
      }
      count++;
    }
  } else {
    if (do_setup) {
      do_setup = 0;
      one_ulp(&ulp);
      for (k = 0; k < 65536; k++)
        tab[k] = 0;
      for (k = 0; k < 65536; k++) {
        /* ifdef _FP_IEEE_ */
        if (k < 16)
          continue;
        if (k > 64879)
          continue;
        if (k > 32111 && k < 32784)
          continue;
        /* endif */
        share.dbl = 0.0;
        share.i16[IND] = (short)k;
        skip = 0;
        for (i = 0; i < 6; i++) {
          if (fabs(ulp * share.dbl * 255.0) < *thr)
            skip++;
          else
            break;
          share.dbl = share.dbl * 256.0;
        }
        if (skip > 6)
          skip = 6;
        tab[k] = skip;
      }
    }
    ptr_64 = (unsigned long long int *)out;
    n = 0;
    count = 0;
    for (k = 0; k < *n_in; k++) {
      if (fabs(in[k]) > *thr) {
        if (count > 0) {
          ptr_64[n++] = count;
          count = 0;
        }
        ptr_16 = (unsigned short *)&in[k];
        skip = tab[ptr_16[IND]];
        out[n] = in[k];
        /*
        ptr_64[n] = (mask[skip]&ptr_64[n]);
        */
        n++;
        continue;
      }
      count++;
    }
  }
  if (count > 0) {
    ptr_64[n++] = count;
    count = 0;
  }
  *n_out = n;
}
