/*
 * Automatically Tuned Linear Algebra Software v3.11.41
 * Copyright (C) 2018 R. Clint Whaley
 */
#define ATL_GLOBIDX 1
#include "atlas_amm.h"
#undef ATL_GLOBIDX
/*
 * D is kb*mb workspace
 * This guy will copy a block from col-major symmetric storage (A) to
 * access-major (in W).
 * The coordinates (KBLK,JBLK) are logical, and therefore indicate which
 * W block is being filled in.  Logical entry (K,J) is start of block,
 * with K=kb*KBLK, J=nb*JBLK.
 * If (K,J) is in the upper triangle, we need to copy an kbxmb block from it,
 * otherwise we copy a transposed block from the accessed triangle to create
 * the reflected block.  The actual block is kbxnb, so the transposed block
 * will be nbxkb.
 *
 * This version has to double copy blocks containing the diagonal so that it
 * can work if nb and kb are not multiples.  It is possible to avoid this
 * double copy if they are multiples, but since large SYMM rarely used, and
 * this is low order cost, we don't currently bother
 */
void Mjoin(PATL,heRU2ipBlk) /* left, upper hermitian copy to amm */
(
   ipinfo_t *ip,  /* gemm info to copy to */
   ATL_CUINT bv,  /* bitvec: 0:W is full mat, 1:W is Kpanel, else block only */
   cm2am_t cpN,   /* copy to use in Lower triangle */
   cm2am_t cpT,   /* copy to use in upper triangle (transpose of lower) */
   ATL_iptr_t KBLK, ATL_iptr_t JBLK,  /* ip block coordinates to copy */
   const TYPE *B, /* Right, upper Hermitian/symmetric matrix to copy */
   TYPE *W,       /* output array for amm B */
   TYPE *D        /* kb*nb workspace for handling diagonal blocks */
)
{
   unsigned int nb, kb;
   const ATL_iptr_t nfnblks = ip->nfnblks, ldb=ip->ldb;
   ATL_iptr_t J, K=KBLK*ip->kb, szB;
   TYPE *rw, *iw=W;

   if (bv&1)
      iw = IdxBw_ip(ip, W, KBLK, JBLK);
   else if (bv&2)
      iw = IdxBw_ip(ip, W, KBLK, 0);
   kb = (KBLK < ip->nfkblks) ? ip->kb : ip->kb0;
   if (JBLK < nfnblks)
   {
      nb = ip->nb;
      szB = ip->szB;
      J = JBLK*nb;
   }
   else
   {
      nb = (JBLK < nfnblks+ip->npnblks-1) ? ip->pnb : ip->nF;
      szB = ip->pszB;
      J = nfnblks*ip->nb + (JBLK-nfnblks)*ip->pnb;
   }
   rw = iw + szB;
   if (J >= K) /* block is in upper part, kb may extend to upper */
   {
      if (J > K+kb) /* block is all upper */
         cpN(kb, nb, ip->alpB, B+((K+ldb*J)SHIFT), ldb, rw, iw);
      else           /* block has diagonal in it! */
      {
         ATL_iptr_t j, k;
         TYPE *d = D;
         ATL_CUINT kb2=kb+kb;
/*
 *       Copy block to D, getting upper elts through reflection
 */
         for (j=0; j < nb; j++, d += kb2)
         {
            const ATL_iptr_t JJ=J+j;
            for (k=0; k < kb; k++)
            {
               const ATL_iptr_t KK=K+k;
               const ATL_iptr_t ii=k+k;
               if (JJ > KK) /* In Upper, not diagonal */
               {            /* just copy imaginary components */
                  const ATL_iptr_t IA = (KK+ldb*JJ)SHIFT;
                  d[ii] = B[IA];
                  d[ii+1] = B[IA+1];
               }
               else if (KK > JJ) /* In Lower, not diagonal */
               {                 /* Conjugate imaginary components */
                  const ATL_iptr_t IA = (JJ+ldb*KK)SHIFT;
                  d[ii] = B[IA];
                  d[ii+1] = -B[IA+1];
               }
               else              /* On diagonal */
               {                 /* Zero imaginary */
                  const ATL_iptr_t IA = (KK*(ldb+1))SHIFT;
                  d[ii] = B[IA];
                  d[ii+1] = ATL_rzero;
               }
            }
         }
         cpN(kb, nb, ip->alpB, D, kb, rw, iw);
      }
   }
/*
 * The block is actually at (J,K), and block to be copied is nbxkb, so danger
 * is that this block crosses the diagonal (J+kb > K).
 * Therefore, D is nbxkb in this case.
 */
   else if (J+nb < K) /* logical block is wholly contained in upper portion */
      cpT(kb, nb, ip->alpB, B+((J+ldb*K)<<1), ldb, rw, iw);
   else        /* block is reflected across diagonal! */
   {
      ATL_iptr_t j, k;
      TYPE *d = D;
      ATL_CUINT nb2=nb+nb;
/*
 *    Copy block to D, getting upper elts through reflection
 */
      for (j=0; j < kb; j++, d += nb2)
      {
         for (k=0; k < nb; k++)
         {
            const ATL_iptr_t KK=K+j, JJ=J+k;
            ATL_CUINT ii=k+k;
            if (JJ > KK)      /* In Upper section */
            {                 /* Conj imag, copy will Conj again */
               const ATL_iptr_t IA = (KK+ldb*JJ)SHIFT;
               d[ii] = B[IA];
               d[ii+1] = -B[IA+1];
            }
            else if (KK > JJ) /* In Lower section */
            {                 /* copy imag, copy will Conj as required */
               const ATL_iptr_t IA = (JJ+ldb*KK)SHIFT;
               d[ii] = B[IA];
               d[ii+1] = B[IA+1];
            }
            else              /* On diagonal */
            {                 /* zero imaginary component */
               const ATL_iptr_t IA = ((ldb+1)*KK)SHIFT;
               d[ii] = B[IA];
               d[ii+1] = ATL_rzero;
            }
         }
      }
      cpT(kb, nb, ip->alpB, D, nb, rw, iw);
   }
   #if 0
   {
      ATL_iptr_t MM=IBLK*ip->mb+mb, KK=KBLK*ip->kb+kb, K4=Mmin(KK,4);
      char nm[64];
      sprintf(nm, "S%lu_%lu", (unsigned long)MM, (unsigned long)KK);
      Mjoin(PATL,ipprint)(stdout, ip, 1, nm, MM, K4, W);
   }
   #endif
}
