/* 
* Copyright (C) 2001-2008, CompHEP Collaboration
* Copyright (C) 1997, Alexander Kryukov 
* ------------------------------------------------------
* $Id: cweight_old.c,v 1.4 2003/06/25 18:46:41 kryukov Exp $
*
* $Log: cweight_old.c,v $
* Revision 1.4  2003/06/25 18:46:41  kryukov
* *** empty log message ***
*
* Revision 1.3  2003/04/22 09:01:20  kryukov
* Apply indent to improve readability of files
*
* Revision 1.2  2003/04/20 17:55:02  kryukov
* Clean up warnings during make
*/

/**********************************************************/
/*  CopyRight (C) 1990, SCL                               */
/*  Author        A.Kryukov                               */
/*  E-mail        kryukov@theory.npi.msu.su               */
/*  Version       4.61                                    */
/*--------------------------------------------------------*/
/*  Last Rev.     08/01/90                                */
/*                18/02/94    t2k - gluon transfer vert.  */
/*                19/03/99    findl fix tedpole bug       */
/**********************************************************/

#include "service2/include/chep_limits.h"
#include "service2/include/tptcmac.h"
#include "service2/include/getmem.h"
#include "service2/include/syst.h"
#include "chep_crt/include/chep_crt.h"

#include "physics.h"
#include "cweight.h"

#define NCOLOR   3		/*  SU(3)                           */
#define MAXE     3		/*  Standard QCD                    */
#define MAXVT    3		/*                                  */
#define MAXGLEN  (2*MAXINOUT+2)	/*  16? Maximum length of CGraph        */
#define REVSP2T  2		/*  Sp(Ta*Tb)=1/RevSp2T*Delta(a,b)  */
#define CERRLEV1 0		/*  Run time error level            */
#define CERRLEV2 0		/*  Halt level                      */
#define CDEBLEV  0		/*  Total debug level               */


/*################################################################ */

typedef enum
  {
    zv = 1, tv, g2, qg, g3
  }
vtype;				/*  02/01/90                 */
				      /* ZV    Zero vertex         */
				      /* TV    Tranfer vertex      */
				      /* G2    Transfer gluon vertex  */
				      /* G3    Three gluon vertex  */
				      /* QG    Qark-gluon vertex   */
			  /*  Range for C-graph length  */

typedef struct vertex
  {
    vtype vt;			/* vertex type: zv, tv, g2, qg, g3 */
    int e[MAXE];		/* array of edges (linked vrtex numbers) */
  }
vertex;

typedef struct cgraph
  {
    long n;			/* Numerator of c-weight */
    long d;			/* Denumerator           */
    int en;			/* Name of next edge */
    int gl;			/* Number of vertecies (graph length) */
    vertex vl[MAXGLEN];		/* array of verticies */
  }
cgraph;

typedef struct glist
  {
    cgraph cg;
    struct glist *next;
  }
glist;

typedef struct weight
  {
    long n;
    long d;
    glist *pgl;
  }
weight;


/* ************************** Cross reference ************************* */
/* *                                                                  * */
/* *  GevV                                                            * */
/* *    +-----> CError                                                * */
/* *                                                                  * */
/* *  GetEN                                                           * */
/* *                                                                  * */
/* *  CError                                                          * */
/* *                                                                  * */
/* *  WrCG                                                            * */
/* *                                                                  * */
/* ******************************************************************** */

static int 
cerror (int n, char *s)
/*  - generate error message occur in color package - 08/01/90  */
{
  fprintf (stderr, "***** %s\n", s);
  if (n > CERRLEV1)
    fprintf (stderr, "Runtime error %u\n", n), exit (1313);
  else if (n > CERRLEV2)
    exit (99);
  return 0;
}				/* CError */

#if (CDEBLEV > DEBLEV)
static char vtarr[5][4] =
{"ZV", "TV", "G2", "QG", "G3"};

static void 
vcs_print (vcsect * vcs)
{
  int i, j, next_i, next_j, np, cdim;
  fprintf (stderr, "Tar: [sizet=%d\n", vcs->sizet);
  for (i = 0; i < vcs->sizet; i++)
    {
      fprintf (stderr, "   V=%d", i + 1);
      for (j = 0; j < vcs->valence[i]; j++)
	{
	  next_i = vcs->vertlist[i][j].nextvert.vno;
	  next_j = vcs->vertlist[i][j].nextvert.edno;
	  np = vcs->vertlist[i][j].partcl;
	  cdim = prtclbase[np - 1].cdim;
	  fprintf (stderr, " e%d=(v%d,e%d,c=%d), ", j + 1, next_i, next_j, cdim);
	};
      fprintf (stderr, "\n");
    };
  fprintf (stderr, "]\n");
}

static void 
wrcg (cgraph * cg)
/*  Write C-graph on standard device - 04/01/90 */
{
  int i;
  fprintf (stderr, "Kr: [(%d,%d) %ld/%ld ", cg->en, cg->gl, cg->n, cg->d);
  for (i = MAXGLEN; i >= 1; i--)
    if (cg->vl[i - 1].vt != zv)
      {
	fprintf (stderr, "(%d/%s ", i, vtarr[cg->vl[i - 1].vt - 1]);
	fprintf (stderr, "%d,%d,%d)",
		 cg->vl[i - 1].e[0], cg->vl[i - 1].e[1], cg->vl[i - 1].e[2]);
      }				/* if */
  fprintf (stderr, "]\n");
}				/* WrCG */

#endif

static int 
geten (cgraph * cg)
/*  - return next edge name - 08/01/90  */
{
  return ++(cg->en);
}				/* GetEN */


static int 
getv (cgraph * cg)
{
  int ok;
  int n;
/* return number of first free vertex in C-graph - 04/01/90 */

  ok = FALSE;
  n = 1;
  while (n <= MAXGLEN && !ok)
    if (cg->vl[n - 1].vt == zv)
      ok = TRUE;
    else
      n++;
  if (n > MAXGLEN)
    return cerror (254, "GetV: no free vertex in C-graph");
  else
    {
      ++(cg->gl);
      return n;
    }				/* if */
}				/* GetV */


/* ************************** Cross reference ************************* */
/* *                                                                  * */
/* *  T2K                                                             * */
/* *    +-----> WrTarG (TarStruct)                                    * */
/* *    +-----> InitCG                                                * */
/* *    +-----> FindCE                                                * */
/* *    |       +------> TypeE                                        * */
/* *    |                                                             * */
/* *    +-----> TypeE                                                 * */
/* *    +-----> TypeV                                                 * */
/* *            +------> CError (Color)                               * */
/* *                                                                  * */
/* ******************************************************************** */


#define SINGL   1		/* Colour singlet */
#define TRIPL  -3		/* Colour triplet */
#define ATRIPL  3		/* Colour antitriplet */
#define OCTET   8		/* Colour octet   */
#define DEBLEV 10		/*  Debug level   */


static char 
typee (edgeinvert * e)
/*  - return type of edge E - 08/01/90  */
{
  return
    e->nextvert.vno == nullvert ? SINGL : prtclbase[e->partcl - 1].cdim;
}				/* TypeE */


static int 
findce (vert0 v, int *n)
{
  int k;
  int ok;
/* Return first color edge stared at n in vertex V - 07/01/90  */

  ok = FALSE;
  k = *n;
  do
    if (typee (&v[k - 1]) != SINGL)
      ok = TRUE;
    else
      k++;
  while (!(ok || k > MAXVALENCE));
  if (k <= MAXVALENCE)
    *n = k;
  return ok;
}				/* FindCE */


#ifdef NOT_USED
static void 
cg_copy (cgraph * out, cgraph * in)
{
  int i;
/* Initiate color graph - 04/01/90 */

  out->n = in->n;
  out->d = in->d;
  out->en = in->en;
  out->gl = in->gl;
  for (i = 1; i <= MAXGLEN; i++)
    {
      out->vl[i - 1].vt = in->vl[i - 1].vt;
      out->vl[i - 1].e[0] = in->vl[i - 1].e[0];
      out->vl[i - 1].e[1] = in->vl[i - 1].e[1];
      out->vl[i - 1].e[2] = in->vl[i - 1].e[2];
    }
}				/* cg_copy */

#endif

static void 
initcg (cgraph * cg)
{
  int i;
/* Initiate color graph - 04/01/90 */

  cg->n = 1;
  cg->d = 1;
  cg->en = 0;
  cg->gl = 0;
  for (i = 1; i <= MAXGLEN; i++)
    {
      cg->vl[i - 1].vt = zv;
      cg->vl[i - 1].e[0] = 0;
      cg->vl[i - 1].e[1] = 0;
      cg->vl[i - 1].e[2] = 0;
    }
}				/* InitCG */


static vtype 
typev (vert0 v)
{
  int ng = 0, ne, nq = 0;
/* Return color type of vertex - 06/01/90  */

  for (ne = 1; ne <= MAXVALENCE; ne++)
    if (v[ne - 1].nextvert.vno != nullvert &&
	prtclbase[v[ne - 1].partcl - 1].cdim != SINGL)
      {
	if (prtclbase[v[ne - 1].partcl - 1].cdim == OCTET)
	  ng++;
	else
	  nq++;
      }
  switch (ng)
    {
    case 0:
      return nq == 2 ? tv : zv;
    case 1:
      return qg;
    case 2:
      return g2;
    case 3:
      return g3;
    default:
      return cerror (252, "TypeV: invalid vertex type");
    }				/* case */
}				/* TypeV */


static void 
t2k (vcsect * g, weight * w)
{
  cgraph *pcg;
  int nv, ne, i, k;
  int maptar[2 * maxvert][MAXVALENCE];
  int l;
  int nc = 0;
/* Transfer Taranov's representation of graph to Kryukov's representation  */
/* - 07/01/90  */

#if (CDEBLEV > DEBLEV)
  fprintf (stderr, "----------- T2K -------------\n");
  vcs_print (g);
#endif
  for (i = 1; i <= 2 * maxvert; i++)
    for (k = 1; k <= MAXVALENCE; k++)
      maptar[i - 1][k - 1] = 0;
  w->pgl = (glist *) m_alloc (sizeof (struct glist));
  pcg = &w->pgl->cg;
  w->pgl->next = NULL;
  initcg (pcg);
  for (i = 1; i <= g->sizet; i++)
    {
      if (typev (g->vertlist[i - 1]) != zv)
	{
	  if (typev (g->vertlist[i - 1]) != tv && typev (g->vertlist[i - 1]) != g2)
	    nc++;
	  nv = getv (pcg);
	  pcg->vl[nv - 1].vt = typev (g->vertlist[i - 1]);
	  k = 0;
	  for (ne = 1; ne <= MAXVALENCE && findce (g->vertlist[i - 1], &ne); ne++)
	    {
	      if (maptar[i - 1][ne - 1] == 0)
		{
		  l = geten (pcg);
		  maptar[i - 1][ne - 1] = l;
		  maptar[g->vertlist[i - 1][ne - 1].nextvert.vno - 1]
		    [g->vertlist[i - 1][ne - 1].nextvert.edno - 1] = l;
		}
	      else
		l = maptar[i - 1][ne - 1];
	      if (pcg->vl[nv - 1].vt == g3 || pcg->vl[nv - 1].vt == g2)
		k++;
	      else
		switch (typee (&g->vertlist[i - 1][ne - 1]))
		  {
		  case OCTET:
		    k = 1;
		    break;
		  case TRIPL:
		    k = 2;
		    break;
		  case ATRIPL:
		    k = 3;
		    break;
		  default:
		    fprintf (stderr, "***** T2K: Invalid leg number %d\n", k);
		    exit (99);
		  }		/* case */
	      pcg->vl[nv - 1].e[k - 1] = l;
#if (CDEBLEV > DEBLEV)
	      wrcg (pcg);
#endif
	    };			/* for */
	};			/* if */
#if (CDEBLEV > DEBLEV)
      wrcg (pcg);
#endif
    };				/* for */
  if (nc % 2 != 0)
    cerror (250, "T2K: Total coeffecient not even.");
  else
    nc /= 2;
  w->d = 1;
  while (nc != 0)
    {
      w->d *= REVSP2T;
      nc--;
    }				/* while */
  w->n = 0;
}				/* T2K */

/************************************************************/

static void 
rednd (long *n, long *d, int b)
/* - reduce N and D with respect to B - 08/01/90  */
{
  if (b != 1)
    while (*d != 1 && *n % b == 0 && *d % b == 0)
      {
	*n /= b;
	*d /= b;
      }				/* while */
}				/* RedND */


static void 
dispcg (weight * w)
{
  glist *pgl;
/* - remove and freemem first C-graph from weight structure - 08/01/90  */

  pgl = w->pgl;
  w->pgl = w->pgl->next;
  w->n = w->n * pgl->cg.d + w->d * pgl->cg.n;
  w->d *= pgl->cg.d;
  rednd (&w->n, &w->d, NCOLOR);
  rednd (&w->n, &w->d, REVSP2T);
  free (pgl);
}				/* DispCG */


static int 
findv (vtype vt, cgraph * cg, int *n)
{
  int i = 1;
/* return True and number first vertex with type VT in C-graph - 06/01/90 */

  while (i <= MAXGLEN && cg->vl[i - 1].vt != vt)
    i++;
  if (i > MAXGLEN)
    return FALSE;
  else
    *n = i;
  return TRUE;
}				/* FindV */


static int 
findl (int e1, int n, cgraph * cg)
{
  int e;
  int i = 1;
  int ok;
/* - find number of vertex contane edge e1
   - 08/01/90  */
/* 19/03/99 */

/*   fprintf(stderr,"--> findl: e1,n=%d,%d\n",e1,n); */
  e = cg->vl[n - 1].e[e1 - 1];
  ok = FALSE;
  while (i <= MAXGLEN && !ok)
    if (i != n && cg->vl[i - 1].vt != zv &&
	(cg->vl[i - 1].e[0] == e ||
	 cg->vl[i - 1].e[1] == e ||
	 cg->vl[i - 1].e[2] == e))
      ok = TRUE;
    else if (i == n)
      {
	int j;
	for (j = 1; j < 3 && !ok; j++)
	  {
/*                fprintf(stderr,"    findl: i,(e1-1+j)mod3,e=%d,%d,%d\n",
   i,(e1-1+j)%3,cg->vl[i-1].e[(e1-1+j)%3]); */
	    if (cg->vl[i - 1].e[(e1 - 1 + j) % 3] == e)
	      ok = TRUE;
	  }
	if (!ok)
	  i++;
      }
    else
      i++;
  if (i > MAXGLEN)
    return cerror (253, "FindL: nonconnected edge");
/*   fprintf(stderr,"<-- findl=%d\n",i); */
  return i;
}				/* FindL */


static void 
addcg (cgraph * cg, weight * w)
{
  glist *pgl;
/* - addition C-graph CG to weight structure - 08/01/90  */

  pgl = (glist *) m_alloc (sizeof (struct glist));
  pgl->cg = *cg;
  pgl->next = w->pgl;
  w->pgl = pgl;
}				/* AddCG */


static void 
remqg_qg1 (cgraph * cg)
/* - remove subgraph (see figure) from C-graph - 08/01/90  */
{				/*         v1      */
  /*    -->--*--     */
  cg->n *= NCOLOR * NCOLOR - 1;	/*   |     :  |    */
  cg->d *= REVSP2T;		/*   |     :  |    */
  /* RedND(N,D,RevSp2T); *//*    --<--*--     */
  /*         v0      */
}				/* RemQG_QG1 */


static void 
remqg_qg2 (int n0, int n1, cgraph * cg)
{
  int n2;
/* - remove subgraph (see figure) from C-graph - 08/01/90  */
  /*           v1     */
  /*   v2 -->--*--    */
  /*           :  |   */
  cg->n *= NCOLOR * NCOLOR - 1;	/*           :  |   */
  cg->d *= NCOLOR * REVSP2T;	/*   v3 --<--*--    */
  /* RedND(N,D,RevSp2T); *//*           v0     */
  n2 = findl (2, n1, cg);
  cg->vl[n2 - 1].e[2] = cg->vl[n0 - 1].e[2];
}				/* RemQG_QG2 */


static void 
remqg_qg (int n0, int n1, weight * w)
{
  int n2, n5;
  cgraph cg1;
/* - remove gluon connected vertex n0 and n1 (see fugure)
   from first C-graph - 08/01/90  */

#if (CDEBLEV > DEBLEV)
  fprintf (stderr, ".......RemQG-QG........%u,%u\n", (unsigned int) n0,
	   (unsigned int) n1);
#endif
  w->pgl->cg.vl[n0 - 1].vt = zv;
  w->pgl->cg.vl[n1 - 1].vt = zv;
  w->pgl->cg.gl -= 2;
  if (w->pgl->cg.vl[n0 - 1].e[1] == w->pgl->cg.vl[n1 - 1].e[2] &&
      w->pgl->cg.vl[n0 - 1].e[2] == w->pgl->cg.vl[n1 - 1].e[1])
    remqg_qg1 ( /*n0,n1, */ &w->pgl->cg);
  else if (w->pgl->cg.vl[n0 - 1].e[1] == w->pgl->cg.vl[n1 - 1].e[2])
    remqg_qg2 (n0, n1, &w->pgl->cg);
  else if (w->pgl->cg.vl[n0 - 1].e[2] == w->pgl->cg.vl[n1 - 1].e[1])
    remqg_qg2 (n1, n0, &w->pgl->cg);
  else
    {				/*         v0        */
      /*  v2-->--*-->--v3  */
      /*         :         */
      /*         :         */
      /*  v4--<--*--<--v5  */
      /*         v1        */
      n2 = findl (2, n0, &w->pgl->cg);
      w->pgl->cg.vl[n2 - 1].e[2] = w->pgl->cg.vl[n1 - 1].e[2];
      n5 = findl (2, n1, &w->pgl->cg);
      w->pgl->cg.vl[n5 - 1].e[2] = w->pgl->cg.vl[n0 - 1].e[2];
      w->pgl->cg.d *= REVSP2T;
      /* RedND(CG.N,CG.D,RevSp2T); */
      cg1 = w->pgl->cg;
      cg1.n = -cg1.n;
      cg1.d *= NCOLOR;
      /* RedND(CG1.N,CG1.D,NColor); */
      cg1.vl[n2 - 1].e[2] = cg1.vl[n0 - 1].e[2];
      cg1.vl[n5 - 1].e[2] = cg1.vl[n1 - 1].e[2];
      addcg (&cg1, w);
    }				/* if */
#if (CDEBLEV > DEBLEV)
  wrcg (&w->pgl->cg);
  if (w->pgl->next != NULL)
    wrcg (&w->pgl->next->cg);
#endif
}				/* RemQG_QG */


static void 
rev3g (int en, vertex * v)
/* - reverse 3G vertex such that edge EN will be first - 08/01/90  */
{
  if (en != v->e[0])
    {
      if (en == v->e[1])
	{
	  v->e[1] = v->e[2];
	  v->e[2] = v->e[0];
	  v->e[0] = en;
	}
      else if (en == v->e[2])
	{
	  v->e[2] = v->e[1];
	  v->e[1] = v->e[0];
	  v->e[0] = en;
	}
      else
	cerror (255, "Rev3G: Invalid select edge");
    }
}				/* Rev3G */


static void 
remqg_3g (int n0, int n1, weight * w)
/* - remove gluon connected vertex n0 and n1 (see figure)
   from first C-graph - 08/01/90  */
{
  int n2, n3;			/*         v1        */
  int en;			/*  v2.....*.....v3  */
  cgraph cg1;			/*         :         */
  /*         :         */
  /*  v3-->--*-->--v4  */
  /*          v0       */
#if (CDEBLEV > DEBLEV)
  fprintf (stderr, ".......RemQG-3G........%u,%u\n", (unsigned int) n0,
	   (unsigned int) n1);
#endif
  rev3g (w->pgl->cg.vl[n0 - 1].e[0], &w->pgl->cg.vl[n1 - 1]);
  n2 = findl (2, n1, &w->pgl->cg);
  if (w->pgl->cg.vl[n2 - 1].vt == g3)
    rev3g (w->pgl->cg.vl[n1 - 1].e[1], &w->pgl->cg.vl[n2 - 1]);
  w->pgl->cg.vl[n0 - 1].vt = qg;
  w->pgl->cg.vl[n0 - 1].e[0] = w->pgl->cg.vl[n2 - 1].e[0];
  en = w->pgl->cg.vl[n0 - 1].e[2];
  w->pgl->cg.vl[n0 - 1].e[2] = w->pgl->cg.vl[n1 - 1].e[0];
  n3 = findl (3, n1, &w->pgl->cg);
  if (w->pgl->cg.vl[n3 - 1].vt == g3)
    rev3g (w->pgl->cg.vl[n1 - 1].e[2], &w->pgl->cg.vl[n3 - 1]);
  w->pgl->cg.vl[n1 - 1].vt = qg;
  w->pgl->cg.vl[n1 - 1].e[0] = w->pgl->cg.vl[n3 - 1].e[0];
  w->pgl->cg.vl[n1 - 1].e[1] = w->pgl->cg.vl[n0 - 1].e[2];
  w->pgl->cg.vl[n1 - 1].e[2] = en;
  cg1 = w->pgl->cg;
  cg1.n = -cg1.n;
  cg1.vl[n0 - 1].e[0] = w->pgl->cg.vl[n1 - 1].e[0];
  cg1.vl[n1 - 1].e[0] = w->pgl->cg.vl[n0 - 1].e[0];

  addcg (&cg1, w);
#if (CDEBLEV > DEBLEV)
  wrcg (&w->pgl->cg);
  wrcg (&w->pgl->next->cg);
#endif
}				/* RemQG_3G */


static int 
istadpole (int n, cgraph * cg)
/* return True if vertex n is teadpole - 08/01/90  */
{
  return
    cg->vl[n - 1].e[0] == cg->vl[n - 1].e[1] ||
    cg->vl[n - 1].e[1] == cg->vl[n - 1].e[2] ||
    cg->vl[n - 1].e[0] == cg->vl[n - 1].e[2] ?
    TRUE : FALSE;
}				/* isTadpole */


static void 
remg (int n0, weight * w)
{
  int n1;
/* - remove gluon issue from vertex n0
   from first C-graph - 08/01/90  */

#if (CDEBLEV > DEBLEV)
  fprintf (stderr, ".......RemG........%u\n", (unsigned int) n0);
  wrcg (&w->pgl->cg);
#endif
  n1 = findl (1, n0, &w->pgl->cg);
  if (istadpole (n0, &w->pgl->cg) || istadpole (n1, &w->pgl->cg))
    {
      w->pgl->cg.n = 0;
      w->pgl->cg.gl = 0;
      w->pgl->cg.vl[n0 - 1].vt = zv;
      w->pgl->cg.vl[n1 - 1].vt = zv;
#if (CDEBLEV > DEBLEV)
      wrcg (&w->pgl->cg);
#endif
    }
  else if (w->pgl->cg.vl[n1 - 1].vt == qg)
    remqg_qg (n0, n1, w);
  else
    remqg_3g (n0, n1, w);

#if (CDEBLEV > DEBLEV)
  fprintf (stderr, ".......end RemG........\n");
#endif
}				/* RemG */


static void 
exp3g (int n0, weight * w)
{
  cgraph cg1;
  int n1, n2, n4, n5;
  int e04, e05, e45;
/* expand 3G vertex (see figure) - 08/01/90  */
/* 14/03/99: Check tadpole before expanding */
#if (CDEBLEV > DEBLEV)
  fprintf (stderr, ".......Exp3G........\n");
#endif
  n1 = findl (1, n0, &w->pgl->cg);
  if (istadpole (n0, &w->pgl->cg) || istadpole (n1, &w->pgl->cg))
    {
      w->pgl->cg.n = 0;
      w->pgl->cg.gl = 0;
      w->pgl->cg.vl[n0 - 1].vt = zv;
      w->pgl->cg.vl[n1 - 1].vt = zv;
#if (CDEBLEV > DEBLEV)
      wrcg (&w->pgl->cg);
#endif
      return;
    }
  /*      v0            v4  v5     */
  /*  v1..*...v2    v1..*-<-*..v2  */
  /*      :              \ /       */
  n1 = findl (1, n0, &w->pgl->cg);	/*      :      ->       *v0      */
  n2 = findl (2, n0, &w->pgl->cg);	/*      :               :        */
  /*      v3              v3       */
  n4 = getv (&w->pgl->cg);
  e45 = geten (&w->pgl->cg);
  e04 = geten (&w->pgl->cg);
  w->pgl->cg.vl[n4 - 1].vt = qg;
  if (w->pgl->cg.vl[n1 - 1].vt == g3)
    rev3g (w->pgl->cg.vl[n0 - 1].e[0], &w->pgl->cg.vl[n1 - 1]);
  w->pgl->cg.vl[n4 - 1].e[0] = w->pgl->cg.vl[n1 - 1].e[0];
  w->pgl->cg.vl[n4 - 1].e[1] = e45;
  w->pgl->cg.vl[n4 - 1].e[2] = e04;
  n5 = getv (&w->pgl->cg);
  e05 = geten (&w->pgl->cg);
  w->pgl->cg.vl[n5 - 1].vt = qg;
  if (w->pgl->cg.vl[n2 - 1].vt == g3)
    rev3g (w->pgl->cg.vl[n0 - 1].e[1], &w->pgl->cg.vl[n2 - 1]);
  w->pgl->cg.vl[n5 - 1].e[0] = w->pgl->cg.vl[n2 - 1].e[0];
  w->pgl->cg.vl[n5 - 1].e[1] = e05;
  w->pgl->cg.vl[n5 - 1].e[2] = e45;
  rev3g (w->pgl->cg.vl[n0 - 1].e[2], &w->pgl->cg.vl[n0 - 1]);
  w->pgl->cg.vl[n0 - 1].vt = qg;
  w->pgl->cg.vl[n0 - 1].e[1] = e04;
  w->pgl->cg.vl[n0 - 1].e[2] = e05;
  w->pgl->cg.n = -w->pgl->cg.n * REVSP2T;
  cg1 = w->pgl->cg;		/*  Second term  */
  cg1.vl[n0 - 1].e[1] = e05;
  cg1.vl[n0 - 1].e[2] = e04;
  cg1.vl[n4 - 1].e[1] = e04;
  cg1.vl[n4 - 1].e[2] = e45;
  cg1.vl[n5 - 1].e[1] = e45;
  cg1.vl[n5 - 1].e[2] = e05;
  cg1.n = -cg1.n;
  addcg (&cg1, w);
#if (CDEBLEV > DEBLEV)
  wrcg (&cg1);
  wrcg (&w->pgl->next->cg);
  fprintf (stderr, ".......end Exp3G........\n");
#endif
}				/* Exp3G */


static void 
remtv (weight * w)
{
  glist *pgl;
  int n, n1;
  int vt0;			/* Original type */
  int ee;
/* Remove transfered vertex from all C-graphs - 06/01/90     */
  /*       v0        */
  pgl = w->pgl;			/*  -->--*-->--v1  */
#if (CDEBLEV > DEBLEV)		/*                 */
  fprintf (stderr, ".......RemTV........\n");	/*                 */
#endif /*       v0        */
  while (pgl != NULL)		/*  .....*.....v1  */
    {
      while (findv (tv, &pgl->cg, &n) || findv (g2, &pgl->cg, &n))
	{
#if (CDEBLEV > DEBLEV)
	  if (pgl != NULL)
	    wrcg (&pgl->cg);
#endif
	  vt0 = pgl->cg.vl[n - 1].vt;
	  pgl->cg.vl[n - 1].vt = zv;
	  pgl->cg.gl--;
	  if (istadpole (n, &pgl->cg))
	    if (pgl->cg.vl[n - 1].e[0] != 0)
	      pgl->cg.n *= NCOLOR * NCOLOR - 1;
	    else
	      pgl->cg.n *= NCOLOR;
	  else if (pgl->cg.vl[n - 1].e[0] != 0)
	    {
	      n1 = findl (1, n, &pgl->cg);
	      if (pgl->cg.vl[n1 - 1].vt == g2 &&
		  pgl->cg.vl[n1 - 1].e[0] != pgl->cg.vl[n - 1].e[0])
		{
		  ee = pgl->cg.vl[n1 - 1].e[0];
		  pgl->cg.vl[n1 - 1].e[0] = pgl->cg.vl[n1 - 1].e[1];
		  pgl->cg.vl[n1 - 1].e[1] = ee;
		}
	      else if (pgl->cg.vl[n1 - 1].vt == g3)
		rev3g (pgl->cg.vl[n - 1].e[0], &pgl->cg.vl[n1 - 1]);
	      pgl->cg.vl[n1 - 1].e[0] = pgl->cg.vl[n - 1].e[1];
/*             pgl->cg.vl[n-1].e[0] != 0 ? 
   pgl->cg.vl[n-1].e[0] : 
   pgl->cg.vl[n-1].e[1] != 0 ? 
   pgl->cg.vl[n-1].e[1] :
   pgl->cg.vl[n-1].e[2]; 
 */ 
	    }
	  else
	    {
	      n1 = findl (2, n, &pgl->cg);
	      pgl->cg.vl[n1 - 1].e[2] = pgl->cg.vl[n - 1].e[2];
	    }			/* if */
	}			/* while */
      pgl = pgl->next;
    }				/* while */
#if (CDEBLEV > DEBLEV)
  if (w->pgl != NULL)
    wrcg (&w->pgl->cg);
#endif
}				/* RemTV */


void 
cwtarg_old (vcsect * g)
{
  weight w;
  int n0;
/* long     ma; */
/* - calculate color weight (two int n,d) - 08/01/90  */
  t2k (g, &w);
  remtv (&w);
  while (w.pgl != NULL)
    {
      while (w.pgl->cg.gl != 0)
	if (findv (qg, &w.pgl->cg, &n0))
	  remg (n0, &w);
	else if (findv (g3, &w.pgl->cg, &n0))
	  exp3g (n0, &w);
	else
	  cerror (251, "CWTarG: Invalid type of vertex.");
      dispcg (&w);
    }				/* while */
  g->clrnum = w.n;		/*  A.Pukhov  */
  g->clrdenum = w.d;		/*  A.Pukhov  */
}				/* CWTarG */

  /* *********************** Modules dependence ************************* */
  /* *                  +------------------+     +---------------+      * */
  /* *               +->|1. CWeight        |<--->|0. "CompHep"   |      * */
  /* *               |  +------------------+     +---------------+      * */
  /* *               |        A    |   A                 A              * */
  /* *               |        |    V   +-------+---------+              * */
  /* * +-----------+ |  +-----A------------+   | +---------------+      * */
  /* * |2. Color   |-+->|3.  Tar2Kr        |<--+-|4. Physics     |      * */
  /* * +-----------+    +------------------+     +---------------+      * */
  /* *                                                                  * */
  /* * 0. Module CWeight imported from "CompHEP" Feynman's graph in     * */
  /* *    Taranov's representation (see module Physics) by use          * */
  /* *    function CWTarG from module CWeight.                          * */
  /* * 1. Module CWeight transfer graph to module Tar2Kr for rebuildung * */
  /* *    in Kryukov's representation (see module Color) by use         * */
  /* *    function T2K, calculated color weight and return result       * */
  /* *    (pair of two int - num. and den. - to "CompHEP".          * */
  /* * 2. Module Color exported types, variables, constants and so on   * */
  /* *    for work with color graph.                                    * */
  /* * 3. Module Tar2Kr tranform graph from Taranov's to Kryukov's      * */
  /* *    representation by use T2K procedure.                          * */
  /* * 4. Module Physics exported types, variables, constants and so    * */
  /* *    to "CompHEP" and module Tar2Kr.                               * */
  /* *                              Good luck!                          * */
  /* ******************************************************************** */

  /* ************************** Cross reference ************************* */
  /* *                                                                  * */
  /* *  CWTarG                                                          * */
  /* *    +-----> T2K (Tar2Kr)                                          * */
  /* *    +-----> RemTV                                                 * */
  /* *    |       +------> FindV                                        * */
  /* *    |       +------> isTadpole                                    * */
  /* *    |       +------> FindL                                        * */
  /* *    |       +------> Rev3G                                        * */
  /* *    |       +------> WrCG (Color)                                 * */
  /* *    |                                                             * */
  /* *    +-----> FindV                                                 * */
  /* *    +-----> RemG                                                  * */
  /* *    |       +------> WrCG (Color)                                 * */
  /* *    |       +------> FindL                                        * */
  /* *    |       +------> isTadpole                                    * */
  /* *    |       +------> RemQG_QG                                     * */
  /* *    |       |        +------> RemQG_QG1                           * */
  /* *    |       |        +------> RemQG_QG2                           * */
  /* *    |       |        |        +-------> FindL                     * */
  /* *    |       |        |                                            * */
  /* *    |       |        +------> FindL                               * */
  /* *    |       |        +------> AddCG                               * */
  /* *    |       |        +------> WrCG (Color)                        * */
  /* *    |       |                                                     * */
  /* *    |       +------> RemQG_3G                                     * */
  /* *    |                +------> Rev3G                               * */
  /* *    |                +------> FindL                               * */
  /* *    |                +------> AddCG                               * */
  /* *    |                +------> WrCG                                * */
  /* *    |                                                             * */
  /* *    +-----> Exp3G                                                 * */
  /* *    |       +------> FindL                                        * */
  /* *    |       +------> GetV (Color)                                 * */
  /* *    |       +------> GetEN (Color)                                * */
  /* *    |       +------> Rev3G                                        * */
  /* *    |       +------> AddCG                                        * */
  /* *    |                                                             * */
  /* *    +-----> CError (Color)                                        * */
  /* *    +-----> DispCG                                                * */
  /* *            +------> RedND                                        * */
  /* *                                                                  * */
  /* ******************************************************************** */
