//! @file mathlib-blas-slatec.c
//
//! @section copyright
//
// This file is part of VIF - vintage fortran compiler.
// Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
//
//! @section license
//
// 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; either version 3 of the license, or 
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful, but 
// without any warranty; without even the implied warranty of merchantability 
// or fitness for a particular purpose. See the GNU general public license for 
// more details. you should have received a copy of the GNU general public 
// license along with this program. If not, see <http://www.gnu.org/licenses/>.
//
//! @Synopsis
//
//! 4 subprograms from BLAS-SLATEC

// Compiled from Fortran source code by VIF.
// Selected subprograms are:
//
// CDCDOT DCDOT  DCOPYM SCOPYM

/*
Generated by VIF - experimental VIntage Fortran compiler.
VIF release 1.2.16
*/
#include <vif.h>
static int_4 _km1 = -1, _k0 = 0, _k1 = 1;
static FORMAT *__fmt_a = NULL;
#define __ncalls 5
static CALLS __calls[__ncalls] = {
  {"cdcdot", 0}, // complex*8 function
  {"dcdot", 0}, // subroutine
  {"dcopym", 0}, // subroutine
  {"scopym", 0}, // subroutine
  {NULL, 0}
};

prototype complex_8 _cdcdot (int_4 _p_ n_, complex_8 _p_ cb_, complex_8 _p_ cx_, int_4 _p_ incx_, complex_8 _p_ cy_, 
int_4 _p_ incy_);
prototype int_4 _dcdot (int_4 _p_ n_, real_8 _p_ fm_, complex_8 _p_ cx_, int_4 _p_ incx_, complex_8 _p_ cy_, int_4 _p_ 
incy_, real_8 _p_ dcr_, real_8 _p_ dci_);
prototype int_4 _dcopym (int_4 _p_ n_, real_8 _p_ dx_, int_4 _p_ incx_, real_8 _p_ dy_, int_4 _p_ incy_);
prototype int_4 _scopym (int_4 _p_ n_, real_4 _p_ sx_, int_4 _p_ incx_, real_4 _p_ sy_, int_4 _p_ incy_);
complex_8 _cdcdot (int_4 _p_ n_, complex_8 _p_ cb_, complex_8 _p_ cx_, int_4 _p_ incx_, complex_8 _p_ cy_, int_4 _p_ 
incy_)
{
  static int_4 i_, kx_, ky_;
  static real_8 dsdotr_, dsdoti_, dt1_, dt2_, dt3_, dt4_;
  complex_8 cdcdot_;
  dsdotr_ = (real_8) ((real_4) (crealf ((*cb_))));
  dsdoti_ = (real_8) (cimagf ((*cb_)));
  if ((*n_) <= 0) {
    goto _l10;
  }
  kx_ = 1;
  ky_ = 1;
  if ((*incx_) < 0) {
    kx_ = 1 + (1 - (*n_)) * (*incx_);
  }
  if ((*incy_) < 0) {
    ky_ = 1 + (1 - (*n_)) * (*incy_);
  }
  for (i_ = 1; i_ <= (*n_); (i_)++) {
    dt1_ = (real_8) ((real_4) (crealf (cx_[kx_ - 1])));
    dt2_ = (real_8) ((real_4) (crealf (cy_[ky_ - 1])));
    dt3_ = (real_8) (cimagf (cx_[kx_ - 1]));
    dt4_ = (real_8) (cimagf (cy_[ky_ - 1]));
    dsdotr_ = dsdotr_ + (dt1_ * dt2_) - (dt3_ * dt4_);
    dsdoti_ = dsdoti_ + (dt1_ * dt4_) + (dt3_ * dt2_);
    kx_ = kx_ + (*incx_);
    ky_ = ky_ + (*incy_);
  }
  _l10:;
  cdcdot_ = CMPLXF ((real_4) (dsdotr_), (real_4) (dsdoti_));
  __calls[0].calls++;
  return cdcdot_;
}

int_4 _dcdot (int_4 _p_ n_, real_8 _p_ fm_, complex_8 _p_ cx_, int_4 _p_ incx_, complex_8 _p_ cy_, int_4 _p_ incy_, 
real_8 _p_ dcr_, real_8 _p_ dci_)
{
  static int_4 i_, kx_, ky_;
  static real_8 dt1_, dt2_, dt3_, dt4_;
  (*dcr_) = 0.0;
  (*dci_) = 0.0;
  if ((*n_) <= 0) {
    goto _l20;
  }
  kx_ = 1;
  ky_ = 1;
  if ((*incx_) < 0) {
    kx_ = 1 + (1 - (*n_)) * (*incx_);
  }
  if ((*incy_) < 0) {
    ky_ = 1 + (1 - (*n_)) * (*incy_);
  }
  for (i_ = 1; i_ <= (*n_); (i_)++) {
    dt1_ = (real_8) ((real_4) (crealf (cx_[kx_ - 1])));
    dt2_ = (real_8) ((real_4) (crealf (cy_[ky_ - 1])));
    dt3_ = (real_8) (cimagf (cx_[kx_ - 1]));
    dt4_ = (real_8) (cimagf (cy_[ky_ - 1]));
    (*dcr_) = (*dcr_) + (dt1_ * dt2_) - (*fm_) * (dt3_ * dt4_);
    (*dci_) = (*dci_) + (dt1_ * dt4_) + (*fm_) * (dt3_ * dt2_);
    kx_ = kx_ + (*incx_);
    ky_ = ky_ + (*incy_);
  }
  _l20:;
  __calls[1].calls++;
  return 0;
}

int_4 _dcopym (int_4 _p_ n_, real_8 _p_ dx_, int_4 _p_ incx_, real_8 _p_ dy_, int_4 _p_ incy_)
{
  static int_4 ix_, iy_, i_, m_, mp1_, ns_;
  int_4 $0_;
  if ((*n_) <= 0) {
    goto _l0;
  }
  if ((*incx_) == (*incy_)) {
    $0_ = (*incx_) - 1;
    if ($0_ < 0) {
      goto _l5;
    } else if ($0_ == 0) {
      goto _l20;
    } else {
      goto _l60;
    }
  }
  _l5:;
  ix_ = 1;
  iy_ = 1;
  if ((*incx_) < 0) {
    ix_ = (-(*n_) + 1) * (*incx_) + 1;
  }
  if ((*incy_) < 0) {
    iy_ = (-(*n_) + 1) * (*incy_) + 1;
  }
  for (i_ = 1; i_ <= (*n_); (i_)++) {
    dy_[iy_ - 1] = -dx_[ix_ - 1];
    ix_ = ix_ + (*incx_);
    iy_ = iy_ + (*incy_);
  }
  goto _l0;
  _l20:;
  m_ = _imod ((*n_), 7);
  if (m_ == 0) {
    goto _l40;
  }
  for (i_ = 1; i_ <= m_; (i_)++) {
    dy_[i_ - 1] = -dx_[i_ - 1];
  }
  if ((*n_) < 7) {
    goto _l0;
  }
  _l40:;
  mp1_ = m_ + 1;
  for (i_ = mp1_; (7 > 0 ? i_ <= (*n_) : i_ >= (*n_)); i_ += 7) {
    dy_[i_ - 1] = -dx_[i_ - 1];
    dy_[i_ + 1 - 1] = -dx_[i_ + 1 - 1];
    dy_[i_ + 2 - 1] = -dx_[i_ + 2 - 1];
    dy_[i_ + 3 - 1] = -dx_[i_ + 3 - 1];
    dy_[i_ + 4 - 1] = -dx_[i_ + 4 - 1];
    dy_[i_ + 5 - 1] = -dx_[i_ + 5 - 1];
    dy_[i_ + 6 - 1] = -dx_[i_ + 6 - 1];
  }
  goto _l0;
  _l60:;
  ns_ = (*n_) * (*incx_);
  for (i_ = 1; ((*incx_) > 0 ? i_ <= ns_ : i_ >= ns_); i_ += (*incx_)) {
    dy_[i_ - 1] = -dx_[i_ - 1];
  }
  _l0:;
  __calls[2].calls++;
  return 0;
}

int_4 _scopym (int_4 _p_ n_, real_4 _p_ sx_, int_4 _p_ incx_, real_4 _p_ sy_, int_4 _p_ incy_)
{
  static int_4 ix_, iy_, i_, m_, mp1_, ns_;
  int_4 $0_;
  if ((*n_) <= 0) {
    goto _l0;
  }
  if ((*incx_) == (*incy_)) {
    $0_ = (*incx_) - 1;
    if ($0_ < 0) {
      goto _l5;
    } else if ($0_ == 0) {
      goto _l20;
    } else {
      goto _l60;
    }
  }
  _l5:;
  ix_ = 1;
  iy_ = 1;
  if ((*incx_) < 0) {
    ix_ = (-(*n_) + 1) * (*incx_) + 1;
  }
  if ((*incy_) < 0) {
    iy_ = (-(*n_) + 1) * (*incy_) + 1;
  }
  for (i_ = 1; i_ <= (*n_); (i_)++) {
    sy_[iy_ - 1] = -sx_[ix_ - 1];
    ix_ = ix_ + (*incx_);
    iy_ = iy_ + (*incy_);
  }
  goto _l0;
  _l20:;
  m_ = _imod ((*n_), 7);
  if (m_ == 0) {
    goto _l40;
  }
  for (i_ = 1; i_ <= m_; (i_)++) {
    sy_[i_ - 1] = -sx_[i_ - 1];
  }
  if ((*n_) < 7) {
    goto _l0;
  }
  _l40:;
  mp1_ = m_ + 1;
  for (i_ = mp1_; (7 > 0 ? i_ <= (*n_) : i_ >= (*n_)); i_ += 7) {
    sy_[i_ - 1] = -sx_[i_ - 1];
    sy_[i_ + 1 - 1] = -sx_[i_ + 1 - 1];
    sy_[i_ + 2 - 1] = -sx_[i_ + 2 - 1];
    sy_[i_ + 3 - 1] = -sx_[i_ + 3 - 1];
    sy_[i_ + 4 - 1] = -sx_[i_ + 4 - 1];
    sy_[i_ + 5 - 1] = -sx_[i_ + 5 - 1];
    sy_[i_ + 6 - 1] = -sx_[i_ + 6 - 1];
  }
  goto _l0;
  _l60:;
  ns_ = (*n_) * (*incx_);
  for (i_ = 1; ((*incx_) > 0 ? i_ <= ns_ : i_ >= ns_); i_ += (*incx_)) {
    sy_[i_ - 1] = -sx_[i_ - 1];
  }
  _l0:;
  __calls[3].calls++;
  return 0;
}

