/* ========================================================================
   MULTICOMMODITY (CONCURRENT) FLOW PROGRAM

   Uses the following files:
       MULTICOM3.C	main program
       MULTICOMIO.C	input / output routines
       ROUTE.C		routine to find initial routes
       DECONGEST3.C	iterated procedure
       MINCOST.C	minimum-cost flow routine (Bertsekas & Tseng)
       COMMON.H		include files; macro, type, struct definitions
       MCF.H		global variable and array declarations
       EXPINTEGERS	integral powers of e
       EXPHUNDRETHS	decimal powers of e (to the 2nd decimal place)
       LIBF2C.A		library functions from Fortran to C conversion

   Written:
       August 8, 1991 by Tishya A. Leong

   Usage:
       mcf3 inputfile outputfile
   ======================================================================== */


/* ------------------------------------------------------------------------
   File: MINCOST.C
   Purpose: Compute minimum-cost flows
   Contains functions called from: MULTICOMIO.C, ROUTE.C, DECONGEST3.C

   This file contains the relaxation method code of Bertsekas & Tseng 
   converted from Fortran to C.
   It includes an interface for use by the multicommodity flow program.
   The procedure called by the multicommodity flow program is min_cost_flow.
   ------------------------------------------------------------------------ */


/* relaxt3.f -- translated by f2c (version of 25 April 1991  12:21:52).
   You must link the resulting object file with the libraries:
	-lF77 -lI77 -lm -lc   (in that order)
*/


/* --------------------------------------------------------------- */

/* DEFINITIONS FOR RELAXT AND MIN_COST_FLOW */

/* --------------------------------------------------------------- */

/* #include "/v/include/f2c.h"   THIS WORKED AT ATT, NOT AT MIT */

/* #include "/src/local/f2c/src/f2c.h"  THiS WORKED AT MIT */

#include "f2c.h"

/* Common Block Declarations */

union {
    struct {
	integer n, na, large;
    } _1;
    struct {
	integer n, na;
    } _2;
} input_;

#define input_1 (input_._1)
#define input_2 (input_._2)

union {
    struct {
	integer startn[35000];
    } _1;
    struct {
	integer startn[1];
    } _2;
} arrays_;

#define arrays_1 (arrays_._1)
#define arrays_2 (arrays_._2)

union {
    struct {
	integer endn[35000];
    } _1;
    struct {
	integer endn[1];
    } _2;
} arraye_;

#define arraye_1 (arraye_._1)
#define arraye_2 (arraye_._2)

struct {
    integer c[35000];
} arrayc_;

#define arrayc_1 arrayc_

union {
    struct {
	integer u[35000];
    } _1;
    struct {
	integer u[1];
    } _2;
} arrayu_;

#define arrayu_1 (arrayu_._1)
#define arrayu_2 (arrayu_._2)

union {
    struct {
	integer b[15000];
    } _1;
    struct {
	integer dfct[1];
    } _2;
} arrayb_;

#define arrayb_1 (arrayb_._1)
#define arrayb_2 (arrayb_._2)

union {
    struct {
	integer x[35000];
    } _1;
    struct {
	integer x[1];
    } _2;
} arrayx_;

#define arrayx_1 (arrayx_._1)
#define arrayx_2 (arrayx_._2)

union {
    struct {
	integer rc[35000];
    } _1;
    struct {
	integer rc[1];
    } _2;
} array9_;

#define array9_1 (array9_._1)
#define array9_2 (array9_._2)

struct {
    integer nmultinode, iter, num_augm__, num_ascnt__, num_sp__;
} output_;

#define output_1 output_

union {
    struct {
	integer i1[15000];
    } _1;
    struct {
	integer tempin[1];
    } _2;
    struct {
	integer label[1];
    } _3;
    struct {
	integer d[1];
    } _4;
} blk1_;

#define blk1_1 (blk1_._1)
#define blk1_2 (blk1_._2)
#define blk1_3 (blk1_._3)
#define blk1_4 (blk1_._4)

union {
    struct {
	integer i2[15000];
    } _1;
    struct {
	integer tempou[1];
    } _2;
    struct {
	integer prdcsr[1];
    } _3;
} blk2_;

#define blk2_1 (blk2_._1)
#define blk2_2 (blk2_._2)
#define blk2_3 (blk2_._3)

union {
    struct {
	integer i3[15000];
    } _1;
    struct {
	integer fou[1];
    } _2;
} blk3_;

#define blk3_1 (blk3_._1)
#define blk3_2 (blk3_._2)

union {
    struct {
	integer i4[35000];
    } _1;
    struct {
	integer nxtou[1];
    } _2;
} blk4_;

#define blk4_1 (blk4_._1)
#define blk4_2 (blk4_._2)

union {
    struct {
	integer i5[15000];
    } _1;
    struct {
	integer fin[1];
    } _2;
} blk5_;

#define blk5_1 (blk5_._1)
#define blk5_2 (blk5_._2)

union {
    struct {
	integer i6[35000];
    } _1;
    struct {
	integer nxtin[1];
    } _2;
} blk6_;

#define blk6_1 (blk6_._1)
#define blk6_2 (blk6_._2)

union {
    struct {
	integer i7[35000];
    } _1;
    struct {
	integer save[1];
    } _2;
} blk7_;

#define blk7_1 (blk7_._1)
#define blk7_2 (blk7_._2)

union {
    struct {
	logical l1[15000];
    } _1;
    struct {
	logical scan[1];
    } _2;
} blk8_;

#define blk8_1 (blk8_._1)
#define blk8_2 (blk8_._2)

union {
    struct {
	logical l2[15000];
    } _1;
    struct {
	logical mark[1];
    } _2;
} blk9_;

#define blk9_1 (blk9_._1)
#define blk9_2 (blk9_._2)

union {
    struct {
	integer tfstou[15000];
    } _1;
    struct {
	integer tfstou[1];
    } _2;
    struct {
	integer hp[1];
    } _3;
} blk10_;

#define blk10_1 (blk10_._1)
#define blk10_2 (blk10_._2)
#define blk10_3 (blk10_._3)

union {
    struct {
	integer tnxtou[35000];
    } _1;
    struct {
	integer tnxtou[1];
    } _2;
    struct {
	integer q[1];
    } _3;
} blk11_;

#define blk11_1 (blk11_._1)
#define blk11_2 (blk11_._2)
#define blk11_3 (blk11_._3)

union {
    struct {
	integer tfstin[15000];
    } _1;
    struct {
	integer tfstin[1];
    } _2;
    struct {
	integer list[1];
    } _3;
} blk12_;

#define blk12_1 (blk12_._1)
#define blk12_2 (blk12_._2)
#define blk12_3 (blk12_._3)

union {
    struct {
	integer tnxtin[35000];
    } _1;
    struct {
	integer tnxtin[1];
    } _2;
} blk13_;

#define blk13_1 (blk13_._1)
#define blk13_2 (blk13_._2)

struct {
    logical repeat;
} blkr_;

#define blkr_1 blkr_

struct {
    integer cap[35000];
} blkcap_;

#define blkcap_1 blkcap_

struct {
    integer b;
} ascblk_;

#define ascblk_1 ascblk_

/* Table of constant values */

static integer c__9 = 9;
static integer c__1 = 1;
static integer c__3 = 3;
static integer c__5 = 5;


/* --------------------------------------------------------------- */

/* FUNCTION MIN_COST_FLOW:  I/O INTERFACE FOR RELAXT */

/* --------------------------------------------------------------- */


/***************************************************************************/
/***************************************************************************/
/* ------------------------------------------------------------------------
   min_cost_flow:  find a minimum-cost flow

   This is the procedure called by the multicommodity flow program.
   It provides an interface to the code of Bertsekas & Tseng.
   ------------------------------------------------------------------------ */
void min_cost_flow(n_nodes, n_edges, heads, tails, costs, capacities, demands,
	      flows)
    int n_nodes, n_edges, heads[], tails[], costs[], capacities[], demands[],
        flows[];
{
    int i;

    /* Copy inputs into unions */
    input_1.n = n_nodes;
    input_1.na = n_edges;
    for (i = 1; i <= input_1.na; ++i) {
        arrays_1.startn[i - 1] = tails[i - 1];
	arraye_1.endn[i - 1] = heads[i - 1];
	arrayc_1.c[i - 1] = costs[i - 1];
	arrayu_1.u[i - 1] = capacities[i - 1];
    }
    for (i = 1; i <= input_1.n; ++i) {
        arrayb_1.b[i - 1] = demands[i - 1];
    }

    /* Run main program for relaxt */
    main_min_cost_flow();

    /* Copy from unions to output arrays */
    for (i = 1; i <= input_1.na; ++i)
        flows[i - 1] = arrayx_1.x[i - 1];

    return;
}
/***************************************************************************/
/***************************************************************************/


/* ------------------------------------------------------------------------ */

/*     MAIN CALLING PROGRAM FOR RELAXT */

/* --------------------------------------------------------------- */

/*  PURPOSE - THIS PROGRAM CALLS THE ROUTINE RELAXT TO */
/*     SOLVE A LINEAR COST ORDINARY NETWORK FLOW PROBLEM. */

/* --------------------------------------------------------------- */

/* Main program */ 
main_min_cost_flow()
{
    /* Format strings */
    static char fmt_1000[] = "(i10)";

    /* System generated locals */
    integer i__1;
    olist o__1;
    cllist cl__1;
    alist al__1;

    /* Builtin functions */
    integer s_wsle(), do_lio(), e_wsle(), f_open(), f_rew(), s_rsfe(), do_fio(
	    ), e_rsfe(), f_clos();
    /* Subroutine */ int s_paus();

    /* Local variables */
    static integer node, i;
    static doublereal tcost;
    extern /* Subroutine */ int inidat_(), relaxt_();
    static integer arc;

    /* Fortran I/O blocks */
    static cilist io___1 = { 0, 6, 0, 0, 0 };
    static cilist io___2 = { 0, 12, 0, fmt_1000, 0 };
    static cilist io___3 = { 0, 12, 0, fmt_1000, 0 };
    static cilist io___5 = { 0, 12, 0, fmt_1000, 0 };
    static cilist io___6 = { 0, 12, 0, fmt_1000, 0 };
    static cilist io___7 = { 0, 12, 0, fmt_1000, 0 };
    static cilist io___8 = { 0, 12, 0, fmt_1000, 0 };
    static cilist io___9 = { 0, 12, 0, fmt_1000, 0 };
    static cilist io___10 = { 0, 6, 0, 0, 0 };
    static cilist io___11 = { 0, 6, 0, 0, 0 };
    static cilist io___12 = { 0, 6, 0, 0, 0 };
    static cilist io___13 = { 0, 6, 0, 0, 0 };
    static cilist io___15 = { 0, 6, 0, 0, 0 };
    static cilist io___17 = { 0, 6, 0, 0, 0 };
    static cilist io___18 = { 0, 6, 0, 0, 0 };
    static cilist io___20 = { 0, 6, 0, 0, 0 };
    static cilist io___21 = { 0, 6, 0, 0, 0 };
    static cilist io___22 = { 0, 6, 0, 0, 0 };
    static cilist io___23 = { 0, 6, 0, 0, 0 };
    static cilist io___24 = { 0, 6, 0, 0, 0 };
    static cilist io___25 = { 0, 6, 0, 0, 0 };
    static cilist io___26 = { 0, 6, 0, 0, 0 };
    static cilist io___27 = { 0, 6, 0, 0, 0 };



/*     MAXNN = DIMENSION OF NODE-LENGTH ARRAYS */
/*     MAXNA = DIMENSION OF ARC-LENGTH ARRAYS */


/*  INPUT PARAMETERS */

/*     N         = NUMBER OF NODES */
/*     NA        = NUMBER OF ARCS */
/*     LARGE     = A VERY LARGE INTEGER TO REPRESENT INFINITY */
/*     STARTN(I) = STARTING NODE FOR THE I-TH ARC,    I = 1,...,NA */
/*     ENDN(I)   = ENDING NODE FOR THE I-TH ARC,      I = 1,...,NA */
/*     C(I)      = COST OF I-TH ARC,                  I = 1,...,NA */


/*  UPDATED PARAMETERS */

/*     U(I)      = CAPACITY OF I-TH ARC ON INPUT,     I = 1,...,NA */
/*     B(I)      = DEMAND AT I-TH NODE ON INPUT,      I = 1,...,N */


/*  OUTPUT PARAMETERS */

/*     X(I)      = FLOW ON I-TH ARC,                  I = 1,...,NA */
/*     RC(I)     = REDUCED COST OF I-TH ARC,          I = 1,...,NA */
/*     NMULTINODE = NUMBER OF MULTINODE ITERATIONS IN RELAXT */
/*     ITER       = NUMBER OF ITERATIONS IN RELAXT */
/*     NUM_AUGM   = NUMBER OF FLOW AUGMENTATION STEPS IN RELAXT */
/*     NUM_ASCNT  = NUMBER OF MULTINODE ASCENT STEPS IN RELAXT */
/*     NUM_SP     = NUMBER OF SHORTEST PATH FLOW AUGMENTATIONS */


/*  WORKING PARAMETERS */


/*  OPTIONAL WORKING PARAMETERS (FOR SENSITIVITY ANALYSIS ONLY) */


/* --------------------------------------------------------------- */

/*     READ INPUT PARAMETERS FROM FILE NAMED `RELAXT.INP' */
/*
    s_wsle(&io___1);
    do_lio(&c__9, &c__1, "READING PROBLEM DATA", 20L);
    e_wsle();

    o__1.oerr = 0;
    o__1.ounit = 12;
    o__1.ofnmlen = 9;
    o__1.ofnm = "RELAX.INP";
    o__1.orl = 0;
    o__1.osta = "OLD";
    o__1.oacc = 0;
    o__1.ofm = "FORMATTED";
    o__1.oblnk = 0;
    f_open(&o__1);
    al__1.aerr = 0;
    al__1.aunit = 12;
    f_rew(&al__1);
    s_rsfe(&io___2);
    do_fio(&c__1, (char *)&input_1.n, (ftnlen)sizeof(integer));
    e_rsfe();
    s_rsfe(&io___3);
    do_fio(&c__1, (char *)&input_1.na, (ftnlen)sizeof(integer));
    e_rsfe();
    i__1 = input_1.na;
    for (i = 1; i <= i__1; ++i) {

	s_rsfe(&io___5);
	do_fio(&c__1, (char *)&arrays_1.startn[i - 1], (ftnlen)sizeof(integer)
		);
	e_rsfe();
    }
    i__1 = input_1.na;
    for (i = 1; i <= i__1; ++i) {

	s_rsfe(&io___6);
	do_fio(&c__1, (char *)&arraye_1.endn[i - 1], (ftnlen)sizeof(integer));

	e_rsfe();
    }
    i__1 = input_1.na;
    for (i = 1; i <= i__1; ++i) {

	s_rsfe(&io___7);
	do_fio(&c__1, (char *)&arrayc_1.c[i - 1], (ftnlen)sizeof(integer));
	e_rsfe();
    }
    i__1 = input_1.na;
    for (i = 1; i <= i__1; ++i) {

	s_rsfe(&io___8);
	do_fio(&c__1, (char *)&arrayu_1.u[i - 1], (ftnlen)sizeof(integer));
	e_rsfe();
    }
    i__1 = input_1.n;
    for (i = 1; i <= i__1; ++i) {

	s_rsfe(&io___9);
	do_fio(&c__1, (char *)&arrayb_1.b[i - 1], (ftnlen)sizeof(integer));
	e_rsfe();
    }
    cl__1.cerr = 0;
    cl__1.cunit = 12;
    cl__1.csta = 0;
    f_clos(&cl__1);

    s_wsle(&io___10);
    do_lio(&c__9, &c__1, "NUMBER OF NODES =", 17L);
    do_lio(&c__3, &c__1, (char *)&input_1.n, (ftnlen)sizeof(integer));
    do_lio(&c__9, &c__1, ", NUMBER OF ARCS =", 18L);
    do_lio(&c__3, &c__1, (char *)&input_1.na, (ftnlen)sizeof(integer));
    e_wsle();
*/

/*     SET VALUE OF LARGE */

    input_1.large = 200000000;

/* --------------------------------------------------------------- */

/*     CONSTRUCT ADDITIONAL NETWORK DATA STRUCTURE FOR RELAXT */

/*    s_wsle(&io___11);
    do_lio(&c__9, &c__1, "CONSTRUCT ADDITIONAL DATA STRUCTURE", 35L);
    e_wsle();
*/
    inidat_();

/* --------------------------------------------------------------- */

/*     INITIALIZE DUAL PRICES */
/*     (DEFAULT: ALL DUAL PRICES = 0, SO REDUCED COST IS SET */
/*     EQUAL TO COST) */

    i__1 = input_1.na;
    for (i = 1; i <= i__1; ++i) {
/* L60: */
	array9_1.rc[i - 1] = arrayc_1.c[i - 1];
    }

/*     SPECIFY WHETHER SENSITIVITY ANALYSIS IS ACTIVATED OR NOT */
/*     (DEFAULT: SENSITIVITY ANALYSIS NOT ACTIVATED) */

    blkr_1.repeat = FALSE_;

/*     STORE CAPACITY OF ARCS IN CAP */
/*     (OPTIONAL IF SENSITIVITY ANALYSIS IS NOT ACTIVATED) */

    i__1 = input_1.na;
    for (i = 1; i <= i__1; ++i) {
/* L70: */
	blkcap_1.cap[i - 1] = arrayu_1.u[i - 1];
    }

/* --------------------------------------------------------------- */

/*     CALL RELAXT TO SOLVE THE PROBLEM */
/*
    s_wsle(&io___12);
    do_lio(&c__9, &c__1, "CALLING RELAXT TO SOLVE THE PROBLEM", 35L);
    e_wsle();
    s_wsle(&io___13);
    do_lio(&c__9, &c__1, "***********************************", 35L);
    e_wsle();
*/
/*     INITIALIZE SYSTEM TIMER FOR VMS VAX */

/*      CALL LIB$INIT_TIMER */

    relaxt_();

/*     CALL SYSTEM TIMER FOR VMS VAX TO DISPLAY EXECUTION */
/*     TIME FOR RELAXT */

/*      CALL LIB$SHOW_TIMER */

/* --------------------------------------------------------------- */

/*     CHECK CORRECTNESS OF OUTPUT PARAMETERS */

    i__1 = input_1.n;
    for (node = 1; node <= i__1; ++node) {
	if (arrayb_1.b[node - 1] != 0) {
	    s_wsle(&io___15);
	    do_lio(&c__9, &c__1, "NONZERO SURPLUS AT NODE ", 24L);
	    do_lio(&c__3, &c__1, (char *)&node, (ftnlen)sizeof(integer));
	    e_wsle();
	    printf("Surplus is %d \n",arrayb_1.b[node-1]);
	}
/* L80: */
    }
    i__1 = input_1.na;
    for (arc = 1; arc <= i__1; ++arc) {
	if (arrayx_1.x[arc - 1] > 0) {
	    if (array9_1.rc[arc - 1] > 0) {
		s_wsle(&io___17);
		do_lio(&c__9, &c__1, "CS VIOLATED AT ARC ", 19L);
		do_lio(&c__3, &c__1, (char *)&arc, (ftnlen)sizeof(integer));
		e_wsle();
		printf("RC is %d\n",array9_1.rc[arc-1]);
	    }
	}
	if (arrayu_1.u[arc - 1] > 0) {
	    if (array9_1.rc[arc - 1] < 0) {
		s_wsle(&io___18);
		do_lio(&c__9, &c__1, "CS VIOLATED AT ARC ", 19L);
		do_lio(&c__3, &c__1, (char *)&arc, (ftnlen)sizeof(integer));
		e_wsle();
		printf("RC is %d\n",array9_1.rc[arc-1]);
	    }
	}
/* L90: */
    }

/*     COMPUTE AND DISPLAY COST OF FLOWS (IN DOUBLE PRECISION) */

    tcost = (float)0.;
    i__1 = input_1.na;
    for (i = 1; i <= i__1; ++i) {
	tcost += (doublereal) (arrayx_1.x[i - 1] * arrayc_1.c[i - 1]);
    }
/*
    s_wsle(&io___20);
    do_lio(&c__9, &c__1, "OPTIMAL COST = ", 15L);
    do_lio(&c__5, &c__1, (char *)&tcost, (ftnlen)sizeof(doublereal));
    e_wsle();
*/
/*     DISPLAY RELAXT STATISTICS */
/*
    s_wsle(&io___21);
    do_lio(&c__9, &c__1, "NUMBER OF ITERATIONS = ", 23L);
    do_lio(&c__3, &c__1, (char *)&output_1.iter, (ftnlen)sizeof(integer));
    e_wsle();
    s_wsle(&io___22);
    do_lio(&c__9, &c__1, "NUMBER OF MULTINODE ITERATIONS = ", 33L);
    do_lio(&c__3, &c__1, (char *)&output_1.nmultinode, (ftnlen)sizeof(integer)
	    );
    e_wsle();
    s_wsle(&io___23);
    do_lio(&c__9, &c__1, "NUMBER OF MULTINODE ASCENT STEPS = ", 35L);
    do_lio(&c__3, &c__1, (char *)&output_1.num_ascnt__, (ftnlen)sizeof(
	    integer));
    e_wsle();
    s_wsle(&io___24);
    do_lio(&c__9, &c__1, "NUMBER OF REGULAR AUGMENTATIONS = ", 34L);
    do_lio(&c__3, &c__1, (char *)&output_1.num_augm__, (ftnlen)sizeof(integer)
	    );
    e_wsle();
    s_wsle(&io___25);
    do_lio(&c__9, &c__1, "NUMBER OF SHORTEST PATH AUGMENTATIONS = ", 40L);
    do_lio(&c__3, &c__1, (char *)&output_1.num_sp__, (ftnlen)sizeof(integer));

    e_wsle();
    s_wsle(&io___26);
    do_lio(&c__9, &c__1, "**********************************", 34L);
    e_wsle();
    s_wsle(&io___27);
    do_lio(&c__9, &c__1, "PROGRAM ENDED; <CR> TO EXIT ", 28L);
    e_wsle();
    s_paus("", 0L);
*/
} /* MAIN__ */



/* --------------------------------------------------------------- */

/* Subroutine */ int inidat_()
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    static integer i, i1, i2;


/*  PURPOSE - THIS ROUTINE CONSTRUCTS TWO LINKED LISTS FOR */
/*     THE NETWORK TOPOLOGY: ONE LIST (GIVEN BY FOU, NXTOU) FOR */
/*     THE OUTGOING ARCS OF NODES AND ONE LIST (GIVEN BY FIN, */
/*     NXTIN) FOR THE INCOMING ARCS OF NODES.  THESE TWO LISTS */
/*     ARE REQUIRED BY RELAXT. */

/*  INPUT PARAMETERS */

/*     N         = NUMBER OF NODES */
/*     NA        = NUMBER OF ARCS */
/*     STARTN(I) = STARTING NODE FOR THE I-TH ARC,    I = 1,...,NA */
/*     ENDN(I)   = ENDING NODE FOR THE I-TH ARC,      I = 1,...,NA */


/*  OUTPUT PARAMETERS */

/*     FOU(I)    = FIRST ARC LEAVING I-TH NODE,       I = 1,...,N */
/*     NXTOU(I)  = NEXT ARC LEAVING THE STARTING NODE OF I-TH ARC, */
/*                                                    I = 1,...,NA */
/*     FIN(I)    = FIRST ARC ENTERING I-TH NODE,      I = 1,...,N */
/*     NXTIN(I)  = NEXT ARC ENTERING THE ENDING NODE OF I-TH ARC, */
/*                                                    I = 1,...,NA */


/*  WORKING PARAMETERS */


/* --------------------------------------------------------------- */

    i__1 = input_2.n;
    for (i = 1; i <= i__1; ++i) {
	blk5_2.fin[i - 1] = 0;
	blk3_2.fou[i - 1] = 0;
	blk1_2.tempin[i - 1] = 0;
/* L25: */
	blk2_2.tempou[i - 1] = 0;
    }
    i__1 = input_2.na;
    for (i = 1; i <= i__1; ++i) {
	blk6_2.nxtin[i - 1] = 0;
	blk4_2.nxtou[i - 1] = 0;
	i1 = arrays_2.startn[i - 1];
	i2 = arraye_2.endn[i - 1];
	if (blk3_2.fou[i1 - 1] != 0) {
	    blk4_2.nxtou[blk2_2.tempou[i1 - 1] - 1] = i;
	} else {
	    blk3_2.fou[i1 - 1] = i;
	}
	blk2_2.tempou[i1 - 1] = i;
	if (blk5_2.fin[i2 - 1] != 0) {
	    blk6_2.nxtin[blk1_2.tempin[i2 - 1] - 1] = i;
	} else {
	    blk5_2.fin[i2 - 1] = i;
	}
/* L27: */
	blk1_2.tempin[i2 - 1] = i;
    }
    return 0;
} /* inidat_ */



/* Subroutine */ int relaxt_()
{
    /* System generated locals */
    integer i__1, i__2, i__3, i__4;

    /* Builtin functions */
    integer s_wsle(), do_lio(), e_wsle();

    /* Local variables */
    static integer ndef, node_def__, narc, node, delx;
    static logical quit;
    static integer root, ndef1, node2, i, j;
#define ddneg ((integer *)&blk12_2)
    static integer t, indef, capin, ndfct, ntdef, nscan;
#define ddpos ((integer *)&blk10_2)
    static doublereal capfactor;
    static logical posit;
    static integer capthresh, t1, t2;
    extern /* Subroutine */ int ascnt1_(), ascnt2_();
    static integer numpasses, limit1, limit2, ib, nb, dm, dp;
    static logical feasbl;
    static integer nlabel, defcit, dx, tp, ts, maxcap, delprc, scapin, augnod,
	     tmparc, scapou, capout, passes, thresh;
    static logical switch_;
    static integer rdcost, nxtarc, prvarc, nxtbrk, nolist;
    extern /* Subroutine */ int short_path__();
    static integer thresh1, arc;
    extern /* Subroutine */ int printflows_();
    static integer numnonzero;
    static logical pchange;
    static integer trc, naugnod;

    /* Fortran I/O blocks */
    static cilist io___41 = { 0, 6, 0, 0, 0 };
    static cilist io___42 = { 0, 6, 0, 0, 0 };
    static cilist io___45 = { 0, 6, 0, 0, 0 };
    static cilist io___46 = { 0, 6, 0, 0, 0 };
    static cilist io___93 = { 0, 6, 0, 0, 0 };



/* --------------------------------------------------------------- */

/*                 RELAXT  (VERSION OF APRIL 1990) */

/*  RELEASE NOTE - THIS VERSION OF RELAXT USES SELECTIVELY */
/*     SHORTEST PATH ITERATIONS */
/*     FOR INITIALIZATION. ARCS WITH SMALL CAPACITY ARE NOT TAKEN */
/*     INTO ACCOUNT IN THE SHORTEST PATH COMPUTATIONS, AS SPECIFIED */
/*     BY THE PARAMETERS CAPFACTOR AND CAPTHRESH. */

/* --------------------------------------------------------------- */

/*  PURPOSE - THIS ROUTINE IMPLEMENTS THE RELAXATION METHOD */
/*     OF BERTSEKAS AND TSENG (SEE [1], [2]) FOR LINEAR */
/*     COST ORDINARY NETWORK FLOW PROBLEMS. */

/* [1] BERTSEKAS, D. P., "A UNIFIED FRAMEWORK FOR PRIMAL-DUAL METHODS ..."
*/
/*      MATHEMATICAL PROGRAMMING, VOL. 32, 1985, PP. 125-145. */
/*  [2] BERTSEKAS, D. P., AND TSENG, P., "RELAXATION METHODS FOR */
/*      MINIMUM COST ..." OPERATIONS RESEARCH, VOL. 26, 1988, PP. 93-114. 
*/

/* --------------------------------------------------------------- */

/*  SOURCE -  RELAXT WAS WRITTEN BY DIMITRI P. BERTSEKAS */
/*     AND PAUL TSENG, WITH A CONTRIBUTION BY JONATHAN ECKSTEIN */
/*     IN THE PHASE II INITIALIZATION. */
/*     TO OBTAIN A COPY OF THE CODE AND SUPPORTING DOCUMENTATION, */
/*     PLEASE CONTACT: */

/*     DIMITRI P. BERTSEKAS */
/*     LABORATORY FOR INFORMATION AND DECISION SYSTEMS */
/*     MASSACHUSETTS INSTITUTE OF TECHNOLOGY */
/*     CAMBRIDGE, MA 02139 */
/*     (617) 253-7267 */

/* --------------------------------------------------------------- */

/*  USER GUIDELINES - */

/*     This code is in the public domain and can be used for any */
/*     purpose. It can be distributed freely.  Users are requested to */
/*     acknowledge the authorship of the code, and the relaxation */
/*     algorithm.  They should also register with the authors to receive 
*/
/*     updates and subsequent releases. */

/*     No modifications should be made to this code other */
/*     than the minimal necessary */
/*     to make it compatible with the FORTRAN compilers of specific */
/*     machines. When reporting computational results please be sure */
/*     to describe the memory limitations of your machine. Generally */
/*     RELAXT requires more memory than primal simplex codes and may */
/*     be penalized severely by limited machine memory. */

/*     The difference between this routine and the similar code RELAXII is
 */
/*     that it maintains a data structure that gives all the balanced arcs
 */
/*     in the network.  This structure is called the "tree" for historical
 */
/*     reasons, even though it describes a subnetwork that will generally 
*/
/*     be neither acyclic nor connected.  Also, the tree may contain some 
*/
/*     arcs that are not balanced:  it turns out to be cheaper to purge */

/*    arcs that have become unbalanced only when their end nodes are being
*/
/*    scanned, as opposed to always maintaining an exact set of balanced a
rcs.*/

/* --------------------------------------------------------------- */

/*  INPUT PARAMETERS (SEE NOTES 1, 2, 4) */

/*     N         = NUMBER OF NODES */
/*     NA        = NUMBER OF ARCS */
/*     LARGE     = A VERY LARGE INTEGER TO REPRESENT INFINITY */
/*                 (SEE NOTE 3) */
/*     REPEAT    = .TRUE. IF SENSITIVITY ANALYSIS IS ACTIVATED */
/*                 (.FALSE. OTHERWISE) */
/*     STARTN(I) = STARTING NODE FOR THE I-TH ARC,    I = 1,...,NA */
/*     ENDN(I)   = ENDING NODE FOR THE I-TH ARC,      I = 1,...,NA */
/*     FOU(I)    = FIRST ARC LEAVING I-TH NODE,       I = 1,...,N */
/*     NXTOU(I)  = NEXT ARC LEAVING THE STARTING NODE OF J-TH ARC, */
/*                                                    I = 1,...,NA */
/*     FIN(I)    = FIRST ARC ENTERING I-TH NODE,      I = 1,...,N */
/*     NXTIN(I)  = NEXT ARC ENTERING THE ENDING NODE OF J-TH ARC, */
/*                                                    I = 1,...,NA */


/*  UPDATED PARAMETERS (SEE NOTES 1, 3, 4) */

/*     RC(I)     = REDUCED COST OF I-TH ARC,          I = 1,...,NA */
/*     U(I)      = CAPACITY OF I-TH ARC ON INPUT */
/*                 AND (CAPACITY OF I-TH ARC) - X(I) ON OUTPUT, */
/*                                                    I = 1,...,NA */
/*     DFCT(I)   = DEMAND AT I-TH NODE ON INPUT */
/*                 AND ZERO ON OUTPUT,                I = 1,...,N */


/*  OUTPUT PARAMETERS (SEE NOTES 1, 3, 4) */

/*     X(I)      = FLOW ON I-TH ARC,                  I = 1,...,NA */
/*     NMULTINODE = NUMBER OF MULTINODE ITERATIONS IN RELAXT */
/*     ITER       = NUMBER OF ITERATIONS IN RELAXT */
/*     NUM_AUGM   = NUMBER OF FLOW AUGMENTATION STEPS IN RELAXT */
/*     NUM_ASCNT  = NUMBER OF MULTINODE ASCENT STEPS IN RELAXT */
/*     NUM_SP     = NUMBER OF SHORTEST PATH FLOW AUGMENTATIONS */


/*  WORKING PARAMETERS (SEE NOTES 1, 4, 5) */


/*  NOTE 1 - */
/*     All data should be in INTEGER*4. To run in limited memory systems, 
*/
/*     declare the arrays STARTN, ENDN, NXTIN, NXTOU, FIN, FOU, LABEL, */
/*     PRDCSR, SAVE, TFSTOU, TNXTOU, TFSTIN, TNXTIN as INTEGER*2 instead. 
*/

/*  NOTE 2 - */
/*     This routine makes no effort to initialize with a favorable X */
/*    from amongst those flow vectors that satisfy complementary slackness
*/
/*     with the initial reduced cost vector RC. */
/*     If a favorable array X is known, then it can be passed, together */

/*     with the corresponding arrays U and DFCT, to this routine */
/*     directly.  This, however, requires that the capacity */
/*     tightening portion and the flow initialization portion */
/*     of this routine (up to line labeled 70) be skipped. */

/*  NOTE 3 - */
/*     All problem data should be less than LARGE in magnitude, */
/*     and LARGE should be less than, say, 1/4 the largest INTEGER*4 */
/*     of the machine used. This will guard primarily against */
/*     overflow in uncapacitated problems where the arc capacities */
/*     are taken finite but very large. Note, however, that as in */
/*     all codes operating with integers, overflo may occur if some */
/*     of the problem data takes very large values.) */

/*  NOTE 4 - */
/*     Each common block contains just one array, so the arrays in RELAXT 
*/
/*     can be dimensioned to 1 and take their dimension from the */
/*     main calling routine. With this trick RELAXT need not be recompiled
 */
/*     if the array dimensions in the calling routine change. */
/*     If your FORTRAN compiler */
/*     does not support this feature, then change the dimension of */
/*     all the arrays to be the same as the ones */
/*     declared in the main calling program. */

/*  NOTE 5 - */
/*    DDPOS and DDNEG are arrays that give the directional derivatives for
*/
/*    all positive and negative single-node price changes.  These are used
*/
/*     only in Phase II of the initialization procedure, before the */
/*     "tree" data structure comes  to play.  Therefore, to reduce */
/*     storage, they are EQUIVALENCEd to TFSTOU and TFSTIN, */
/*     which are of the same size (number of nodes) and are used */
/*     only after the tree comes into use. */

/* --------------------------------------------------------------- */

/*  INITIALIZATION PHASE I */

/*     IN THIS PHASE, WE REDUCE THE ARC CAPACITIES BY AS MUCH AS */
/*     POSSIBLE WITHOUT CHANGING THE PROBLEM; */
/*     THEN WE SET THE INITIAL FLOW ARRAY X, TOGETHER WITH */
/*     THE CORRESPONDING ARRAYS U AND DFCT. */
/*     WE ALSO STORE THOSE NODES WITH NEGATIVE DEFICIT */
/*     TO BE USED LATER IN PHASE III OF INITIALIZATION. */

/*     The initialization (from here up to line labeled 70) */
/*     can be skipped (by setting REPEAT to .TRUE.) if the calling program
 */
/*    places in common user-chosen values for the arc flows, the residual 
arc*/
/*     capacities, and the nodal deficits.  When this is done, */
/*     it is critical that the flow and the reduced cost for each arc */
/*     satisfy complementary slackess */
/*    and that the DFCT array properly correspond to the initial arc flows
.*/

    if (blkr_1.repeat) {
	goto L75;
    }

    ndef = 0;
    ntdef = 0;
    i__1 = input_1.n;
    for (node = 1; node <= i__1; ++node) {
	node_def__ = arrayb_2.dfct[node - 1];
	if (node_def__ < 0) {
	    ++ndef;
	    if (blk5_2.fin[node - 1] > 0) {
		++ntdef;
	    }
	    blk7_2.save[ndef - 1] = node;
	}

/*     Note that we also set up the initial DDPOS and DDNEG for each n
ode. */

	ddpos[node - 1] = node_def__;
	ddneg[node - 1] = -node_def__;
	maxcap = 0;
	scapou = 0;
	arc = blk3_2.fou[node - 1];
L41:
	if (arc > 0) {
/* Computing MIN */
	    i__2 = input_1.large, i__3 = scapou + arrayu_2.u[arc - 1];
	    scapou = min(i__2,i__3);
	    arc = blk4_2.nxtou[arc - 1];
	    goto L41;
	}
/* Computing MIN */
	i__2 = input_1.large, i__3 = scapou + node_def__;
	capout = min(i__2,i__3);
	if (capout < 0) {

/*     PROBLEM IS INFEASIBLE - EXIT */

	    s_wsle(&io___41);
	    do_lio(&c__9, &c__1, "EXIT DURING INITIALIZATION", 26L);
	    e_wsle();
	    s_wsle(&io___42);
	    do_lio(&c__9, &c__1, "EXOGENOUS FLOW INTO NODE", 24L);
	    do_lio(&c__3, &c__1, (char *)&node, (ftnlen)sizeof(integer));
	    do_lio(&c__9, &c__1, "  EXCEEDS OUT CAPACITY", 22L);
	    e_wsle();
	    printflows_(&node);
	    goto L400;
	}

	scapin = 0;
	arc = blk5_2.fin[node - 1];
L43:
	if (arc > 0) {
/* Computing MIN */
	    i__2 = arrayu_2.u[arc - 1];
	    arrayu_2.u[arc - 1] = min(i__2,capout);
	    if (maxcap < arrayu_2.u[arc - 1]) {
		maxcap = arrayu_2.u[arc - 1];
	    }
/* Computing MIN */
	    i__2 = input_1.large, i__3 = scapin + arrayu_2.u[arc - 1];
	    scapin = min(i__2,i__3);
	    arc = blk6_2.nxtin[arc - 1];
	    goto L43;
	}
/* L44: */
/* Computing MIN */
	i__2 = input_1.large, i__3 = scapin - node_def__;
	capin = min(i__2,i__3);
	if (capin < 0) {

/*     PROBLEM IS INFEASIBLE - EXIT */

	    s_wsle(&io___45);
	    do_lio(&c__9, &c__1, "EXIT DURING INITIALIZATION", 26L);
	    e_wsle();
	    s_wsle(&io___46);
	    do_lio(&c__9, &c__1, "EXOGENOUS FLOW OUT OF NODE", 26L);
	    do_lio(&c__3, &c__1, (char *)&node, (ftnlen)sizeof(integer));
	    do_lio(&c__9, &c__1, " EXCEEDS IN CAPACITY", 20L);
	    e_wsle();
	    printflows_(&node);
	    goto L400;
	}

	arc = blk3_2.fou[node - 1];
L45:
	if (arc > 0) {
/* Computing MIN */
	    i__2 = arrayu_2.u[arc - 1];
	    arrayu_2.u[arc - 1] = min(i__2,capin);
	    arc = blk4_2.nxtou[arc - 1];
	    goto L45;
	}
/* L40: */
    }

/*     Initialize the arc flows and the nodal deficits. */
/*     U(ARC) is the residual capacity of ARC, and X(ARC) is the flow. */
/*     These two always add up to the total capacity for ARC. */
/*     Also compute the directional derivatives for each coordinate */
/*     and compute the actual deficits. */

    i__1 = input_1.na;
    for (arc = 1; arc <= i__1; ++arc) {
	arrayx_2.x[arc - 1] = 0;
	if (array9_2.rc[arc - 1] <= 0) {
	    t = arrayu_2.u[arc - 1];
	    t1 = arrays_2.startn[arc - 1];
	    t2 = arraye_2.endn[arc - 1];
	    ddpos[t1 - 1] += t;
	    ddneg[t2 - 1] += t;
	    if (array9_2.rc[arc - 1] < 0) {
		arrayx_2.x[arc - 1] = t;
		arrayu_2.u[arc - 1] = 0;
		arrayb_2.dfct[t1 - 1] += t;
		arrayb_2.dfct[t2 - 1] -= t;
		ddneg[t1 - 1] -= t;
		ddpos[t2 - 1] -= t;
	    }
	}
/* L70: */
    }

/* --------------------------------------------------------------- */

/*  INITIALIZATION PHASE II */

/*     IN THIS PHASE, WE PERFORM ONLY SINGLE NODE (COORDINATE) ITERATIONS.
 */
/*     Adaptive strategy:  the number of strictly single-node iteration */

/*    passes attempted is a function of the average density of the network
.*/

    if (input_1.na > input_1.n * 10) {
	numpasses = 2;
    } else {
	numpasses = 3;
    }

/*     We now do either 2 or 3 passes through all the nodes. */
/*     In this initial phase, if a single */
/*     node iteration is not possible, we just go on to */
/*     the next node. */

    i__1 = numpasses;
    for (passes = 1; passes <= i__1; ++passes) {
	i__2 = input_1.n;
	for (node = 1; node <= i__2; ++node) {
	    if (arrayb_2.dfct[node - 1] != 0) {
/*     Increase or decrease the price of NODE? */
		if (ddpos[node - 1] <= 0) {
/*    Increase price of NODE.  Loop over breakpoints in +P
rice(NODE) direction.*/
/*     On outgoing arcs, tension will rise and reduced cos
t will fall */
/*        -- so, next break comes at smallest positive red
uced cost. */
/*     On incoming arcs, tension will fall and reduced cos
t will rise */
/*        -- so, next break comes at smallest negative red
uced cost. */
		    delprc = input_1.large;
		    arc = blk3_2.fou[node - 1];
L303:
		    if (arc > 0) {
			trc = array9_2.rc[arc - 1];
			if (trc > 0 && trc < delprc) {
			    delprc = trc;
			}
			arc = blk4_2.nxtou[arc - 1];
			goto L303;
		    }
		    arc = blk5_2.fin[node - 1];
L304:
		    if (arc > 0) {
			trc = array9_2.rc[arc - 1];
			if (trc < 0 && trc > -delprc) {
			    delprc = -trc;
			}
			arc = blk6_2.nxtin[arc - 1];
			goto L304;
		    }
/*         If no breakpoint is left and ascent is still po
ssible, the problem*/
/*          is infeasible. */
		    if (delprc >= input_1.large) {
			if (ddpos[node - 1] == 0) {
			    goto L300;
			}
			goto L400;
		    }
/*         We have an actual breakpoint.  Increase price b
y that quantity.*/
/*          First check the effect on all outgoing arcs, w
hich will have a */
/*          reduced cost drop. */
L350:
		    nxtbrk = input_1.large;
		    arc = blk3_2.fou[node - 1];
L305:
		    if (arc > 0) {
			trc = array9_2.rc[arc - 1];
			if (trc == 0) {
			    t1 = arraye_2.endn[arc - 1];
			    t = arrayu_2.u[arc - 1];
			    if (t > 0) {
				arrayb_2.dfct[node - 1] += t;
				arrayb_2.dfct[t1 - 1] -= t;
				arrayx_2.x[arc - 1] = t;
				arrayu_2.u[arc - 1] = 0;
			    } else {
				t = arrayx_2.x[arc - 1];
			    }
			    ddneg[node - 1] -= t;
			    ddpos[t1 - 1] -= t;
			}
/*            For all outgoing arcs tension rises, and
 reduced cost drops.*/
			trc -= delprc;
			if (trc > 0 && trc < nxtbrk) {
			    nxtbrk = trc;
			} else if (trc == 0) {
/*              Arc goes from inactive to balanced
.  Just change tension */
/*             increase derivatives, and check for
 status change at other end.*/
			    ddpos[node - 1] += arrayu_2.u[arc - 1];
			    ddneg[arraye_2.endn[arc - 1] - 1] += arrayu_2.u[
				    arc - 1];
			}
			array9_2.rc[arc - 1] = trc;
			arc = blk4_2.nxtou[arc - 1];
			goto L305;
		    }
/*          Time to check the incoming arcs into the node.
 */
/*         These arcs will have a tension decrease and a r
educed cost rise.*/
		    arc = blk5_2.fin[node - 1];
L306:
		    if (arc > 0) {
			trc = array9_2.rc[arc - 1];
			if (trc == 0) {
			    t1 = arrays_2.startn[arc - 1];
			    t = arrayx_2.x[arc - 1];
			    if (t > 0) {
				arrayb_2.dfct[node - 1] += t;
				arrayb_2.dfct[t1 - 1] -= t;
				arrayu_2.u[arc - 1] = t;
				arrayx_2.x[arc - 1] = 0;
			    } else {
				t = arrayu_2.u[arc - 1];
			    }
			    ddpos[t1 - 1] -= t;
			    ddneg[node - 1] -= t;
			}
/*             Note the reduced cost rise for every ar
c. */
			trc += delprc;
			if (trc < 0 && trc > -nxtbrk) {
			    nxtbrk = -trc;
			} else if (trc == 0) {
/*                Now check for movement from acti
ve to balanced. */
/*                If so, tension decreases and red
uced cost increases. */
			    ddneg[arrays_2.startn[arc - 1] - 1] += arrayx_2.x[
				    arc - 1];
			    ddpos[node - 1] += arrayx_2.x[arc - 1];
			}
			array9_2.rc[arc - 1] = trc;
			arc = blk6_2.nxtin[arc - 1];
			goto L306;
		    }
/*          We are now done with the iteration.  If the cu
rrent direction */
/*          is still a (degenerate) ascent direction, push
 onward. */
		    if (ddpos[node - 1] <= 0 && nxtbrk < input_1.large) {
			delprc = nxtbrk;
			goto L350;
		    }
/*     Now comes the code for a price decrease at NODE. */

/*     On outgoing arcs, tension will drop and reduced cos
t will increase */
/*        -- so, next break comes at smallest negative red
uced cost. */
/*     On incoming arcs, tension will increase and reduced
 cost will fall */
/*        -- so, next break comes at smallest positive red
uced cost. */
		} else if (ddneg[node - 1] <= 0) {
		    delprc = input_1.large;
		    arc = blk3_2.fou[node - 1];
L307:
		    if (arc > 0) {
			trc = array9_2.rc[arc - 1];
			if (trc < 0 && trc > -delprc) {
			    delprc = -trc;
			}
			arc = blk4_2.nxtou[arc - 1];
			goto L307;
		    }
		    arc = blk5_2.fin[node - 1];
L308:
		    if (arc > 0) {
			trc = array9_2.rc[arc - 1];
			if (trc > 0 && trc < delprc) {
			    delprc = trc;
			}
			arc = blk6_2.nxtin[arc - 1];
			goto L308;
		    }
/*        If there is no breakpoint, the problem is infeas
ible, */
/*        unless we are making a degenerate step. */
		    if (delprc == input_1.large) {
			if (ddneg[node - 1] == 0) {
			    goto L300;
			}
			goto L400;
		    }
/*        Now we make the step to the next breakpoint.  We
 start with the */
/*        outgoing arcs.  These have a tension decrease an
d reduced cost */
/*        rise.  Therefore, the possible transitions are f
rom balanced to */
/*        inactive or active to balanced. */
L360:
		    nxtbrk = input_1.large;
		    arc = blk3_2.fou[node - 1];
L309:
		    if (arc > 0) {
			trc = array9_2.rc[arc - 1];
			if (trc == 0) {
			    t1 = arraye_2.endn[arc - 1];
			    t = arrayx_2.x[arc - 1];
			    if (t > 0) {
				arrayb_2.dfct[node - 1] -= t;
				arrayb_2.dfct[t1 - 1] += t;
				arrayu_2.u[arc - 1] = t;
				arrayx_2.x[arc - 1] = 0;
			    } else {
				t = arrayu_2.u[arc - 1];
			    }
			    ddpos[node - 1] -= t;
			    ddneg[t1 - 1] -= t;
			}
/*           Log the reduced cost rise for all arcs. 
*/
			trc += delprc;
			if (trc < 0 && trc > -nxtbrk) {
			    nxtbrk = -trc;
			} else if (trc == 0) {
/*              Active to balanced.  Tension decre
ase derivs go up. */
			    ddneg[node - 1] += arrayx_2.x[arc - 1];
			    ddpos[arraye_2.endn[arc - 1] - 1] += arrayx_2.x[
				    arc - 1];
			}
			array9_2.rc[arc - 1] = trc;
			arc = blk4_2.nxtou[arc - 1];
			goto L309;
		    }
/*        Now do the incoming arcs.  These have a tension 
increase and */
/*        therefore a reduced cost drop.  The possible tra
nsitions are */
/*        from inactive to balanced and from balanced to a
ctive. */
		    arc = blk5_2.fin[node - 1];
L310:
		    if (arc > 0) {
			trc = array9_2.rc[arc - 1];
			if (trc == 0) {
			    t1 = arrays_2.startn[arc - 1];
			    t = arrayu_2.u[arc - 1];
			    if (t > 0) {
				arrayb_2.dfct[node - 1] -= t;
				arrayb_2.dfct[t1 - 1] += t;
				arrayx_2.x[arc - 1] = t;
				arrayu_2.u[arc - 1] = 0;
			    } else {
				t = arrayx_2.x[arc - 1];
			    }
			    ddneg[t1 - 1] -= t;
			    ddpos[node - 1] -= t;
			}
			trc -= delprc;
			if (trc > 0 && trc < nxtbrk) {
			    nxtbrk = trc;
			} else if (trc == 0) {
			    ddpos[arrays_2.startn[arc - 1] - 1] += arrayu_2.u[
				    arc - 1];
			    ddneg[node - 1] += arrayu_2.u[arc - 1];
			}
			array9_2.rc[arc - 1] = trc;
			arc = blk6_2.nxtin[arc - 1];
			goto L310;
		    }
/*        OK.  Movement is done.  Is this direction still 
a (degenerate) */
/*        ascent direction.  If so, keep going. */
		    if (ddneg[node - 1] <= 0 && nxtbrk < input_1.large) {
			delprc = nxtbrk;
			goto L360;
		    }
		}
	    }
L300:
	    ;
	}
/* L390: */
    }

/* --------------------------------------------------------------- */

/*  INITIALIZATION PHASE III */

/*     IN THIS PHASE, WE CHECK WHETHER THE NUMBER OF NODES WITH */
/*     NEGATIVE DEFIICT IS SMALL AND WHETHER NONE OF THE */
/*     ORIGINAL SOURCES IS A TRANSSHIPMENT NODE.  IF THE ANSWER */
/*     IS `YES' TO BOTH QUESTIONS, THEN WE DO A SHORTEST PATH */
/*     INITIALIZATION FROM EACH NODE OF NEGATIVE DEFICIT. */


/*     SET THE PARAMETERS THRESH AND CAPFACTOR WHICH CONTROL THE */
/*     SHORTEST AUGMENTING PATH INITIALIZATION */
    thresh1 = 5;
    thresh = 15;
    capfactor = (float).02;
    output_1.num_sp__ = 0;

/*     STORE ALSO THE NODES THAT NOW HAVE NEGATIVE DEFICIT */

    ndef1 = ndef;
    i__1 = input_1.n;
    for (i = 1; i <= i__1; ++i) {
	if (arrayb_2.dfct[i - 1] < 0) {
	    ++ndef;
	    blk7_2.save[ndef - 1] = i;
	}
/* L372: */
    }

/*     RETURN IF FINISHED */

    if (ndef == ndef1) {
	return 0;
    }

/*     IF NUMBER OF SOURCES IS SMALL AND NONE OF THE */
/*     ORIGINAL SOURCES IS A TRANSSHIPMENT NODE, THEN */
/*     DO A SHORTEST AUGMENTING PATH INITIALIZATION. */

    if ((ndef - ndef1 <= thresh || ndef1 <= thresh1) && ntdef == 0) {
	capthresh = (integer) (capfactor * maxcap);
	feasbl = TRUE_;
	if (ndef - ndef1 <= thresh) {
	    limit1 = ndef1 + 1;
	    limit2 = ndef;
	} else {
	    limit1 = 1;
	    limit2 = ndef1;
	}
	i__1 = limit2;
	for (i = limit1; i <= i__1; ++i) {
	    node = blk7_2.save[i - 1];
	    ++output_1.num_sp__;
	    short_path__(&node, &capthresh, &feasbl, &nolist);
	    if (! feasbl) {
		goto L400;
	    }
/* L374: */
	}
/*     RECTIFY THE FLOWS AND DEFICITS TO ACCOUNT FOR */
/*     SMALL CAPACITY ARCS IGNORED IN THE SHORTEST PATH COMPUTATIONS 
*/
	i__1 = input_1.na;
	for (arc = 1; arc <= i__1; ++arc) {
	    if (array9_2.rc[arc - 1] < 0 && arrayu_2.u[arc - 1] > 0) {
		t = arrayu_2.u[arc - 1];
		t1 = arrays_2.startn[arc - 1];
		t2 = arraye_2.endn[arc - 1];
		arrayx_2.x[arc - 1] += t;
		arrayu_2.u[arc - 1] = 0;
		arrayb_2.dfct[t1 - 1] += t;
		arrayb_2.dfct[t2 - 1] -= t;
	    }
	    if (array9_2.rc[arc - 1] > 0 && arrayx_2.x[arc - 1] > 0) {
		t = arrayx_2.x[arc - 1];
		t1 = arrays_2.startn[arc - 1];
		t2 = arraye_2.endn[arc - 1];
		arrayu_2.u[arc - 1] += t;
		arrayx_2.x[arc - 1] = 0;
		arrayb_2.dfct[t1 - 1] -= t;
		arrayb_2.dfct[t2 - 1] += t;
	    }
/* L376: */
	}
    }

/* --------------------------------------------------------------- */

/*  BEGIN RELAXATION ALGORITHM */


/*     INITIALIZE TREE DATA STRUCTURE. */

    i__1 = input_1.n;
    for (i = 1; i <= i__1; ++i) {
	blk10_2.tfstou[i - 1] = 0;
/* L50: */
	blk12_2.tfstin[i - 1] = 0;
    }
    i__1 = input_1.na;
    for (i = 1; i <= i__1; ++i) {
	blk13_2.tnxtin[i - 1] = -1;
	blk11_2.tnxtou[i - 1] = -1;
	if (array9_2.rc[i - 1] == 0) {
	    blk11_2.tnxtou[i - 1] = blk10_2.tfstou[arrays_2.startn[i - 1] - 1]
		    ;
	    blk10_2.tfstou[arrays_2.startn[i - 1] - 1] = i;
	    blk13_2.tnxtin[i - 1] = blk12_2.tfstin[arraye_2.endn[i - 1] - 1];
	    blk12_2.tfstin[arraye_2.endn[i - 1] - 1] = i;
	}
/* L51: */
    }

/*     Initialize other variables. */

L75:
    feasbl = TRUE_;
    output_1.iter = 0;
    output_1.nmultinode = 0;
    ndfct = input_1.n;
    output_1.num_augm__ = 0;
    output_1.num_ascnt__ = 0;
    numnonzero = 0;
    switch_ = FALSE_;
    i__1 = input_1.n;
    for (i = 1; i <= i__1; ++i) {
	blk9_2.mark[i - 1] = FALSE_;
	blk8_2.scan[i - 1] = FALSE_;
/* L76: */
    }
    nlabel = 0;
/*     Set threshold for SWITCH. */
/*     RELAX uses an adaptive strategy for deciding whether to */
/*     continue the scanning process after a price change. */
/*     The threshold parameters TP and TS that control */
/*     this strategy are set in the next two lines. */

    tp = 10;
    ts = input_1.n / 15;

/*     Start the relaxation algorithm. */

L80:

    i__1 = input_1.n;
    for (node = 1; node <= i__1; ++node) {
	defcit = arrayb_2.dfct[node - 1];
	if (defcit == 0) {
	    goto L100;
	} else {
	    posit = defcit > 0;
	    ++numnonzero;
	    ++output_1.iter;
	}

/*         ATTEMPT A SINGLE NODE ITERATION FROM NODE */

	if (posit) {

/*    ************* CASE OF NODE W/ POSITIVE DEFICIT ******** */

	    pchange = FALSE_;
	    indef = defcit;
	    delx = 0;
	    nb = 0;

/*     Check outgoing (probably) balanced arcs from NODE. */

	    arc = blk10_2.tfstou[node - 1];
L500:
	    if (arc > 0) {
		if (array9_2.rc[arc - 1] == 0 && arrayx_2.x[arc - 1] > 0) {
		    delx += arrayx_2.x[arc - 1];
		    ++nb;
		    blk7_2.save[nb - 1] = arc;
		}
		arc = blk11_2.tnxtou[arc - 1];
		goto L500;
	    }

/*     Check incoming arcs now. */

	    arc = blk12_2.tfstin[node - 1];
L501:
	    if (arc > 0) {
		if (array9_2.rc[arc - 1] == 0 && arrayu_2.u[arc - 1] > 0) {
		    delx += arrayu_2.u[arc - 1];
		    ++nb;
		    blk7_2.save[nb - 1] = -arc;
		}
		arc = blk13_2.tnxtin[arc - 1];
		goto L501;
	    }

/*     End of initial node scan. */

L18:

/*    ********* IF no price change is possible exit ********** */

	    if (delx > defcit) {
		quit = defcit < indef;
		goto L16;
	    }

/*     Now compute distance to next breakpoint. */

	    delprc = input_1.large;
	    arc = blk3_2.fou[node - 1];
L502:
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1];
		if (rdcost < 0 && rdcost > -delprc) {
		    delprc = -rdcost;
		}
		arc = blk4_2.nxtou[arc - 1];
		goto L502;
	    }
	    arc = blk5_2.fin[node - 1];
L503:
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1];
		if (rdcost > 0 && rdcost < delprc) {
		    delprc = rdcost;
		}
		arc = blk6_2.nxtin[arc - 1];
		goto L503;
	    }

/*     ******* check if the problem is infeasible ******* */

	    if (delx < defcit && delprc == input_1.large) {
/*       ***** The dual cost can be decreased without bound  
***** */
		goto L400;
	    }

/*    **** SKIP FLOW ADJUSTEMT IF THERE IS NO FLOW TO MODIFY *** 
*/

	    if (delx == 0) {
		goto L14;
	    }

/*     *****  Adjust the flow on balanced arcs incident of NODE to
 */
/*     maintain complementary slackness after the price change **
*** */

	    i__2 = nb;
	    for (j = 1; j <= i__2; ++j) {
		arc = blk7_2.save[j - 1];
		if (arc > 0) {
		    node2 = arraye_2.endn[arc - 1];
		    t1 = arrayx_2.x[arc - 1];
		    arrayb_2.dfct[node2 - 1] += t1;
		    arrayu_2.u[arc - 1] += t1;
		    arrayx_2.x[arc - 1] = 0;
		} else {
		    narc = -arc;
		    node2 = arrays_2.startn[narc - 1];
		    t1 = arrayu_2.u[narc - 1];
		    arrayb_2.dfct[node2 - 1] += t1;
		    arrayx_2.x[narc - 1] += t1;
		    arrayu_2.u[narc - 1] = 0;
		}
/* L13: */
	    }
	    defcit -= delx;
L14:
	    if (delprc == input_1.large) {
		quit = TRUE_;
		goto L19;
	    }

/*     ***** NODE corresponds to a dual ascent direction.  Decreas
e */
/*     the price of NODE by DELPRC and compute the stepsize to the
 */
/*     next breakpoint in the dual cost ***** */

	    nb = 0;
	    pchange = TRUE_;
	    dp = delprc;
	    delprc = input_1.large;
	    delx = 0;
	    arc = blk3_2.fou[node - 1];
L504:
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1] + dp;
		array9_2.rc[arc - 1] = rdcost;
		if (rdcost == 0) {
		    ++nb;
		    blk7_2.save[nb - 1] = arc;
		    delx += arrayx_2.x[arc - 1];
		}
		if (rdcost < 0 && rdcost > -delprc) {
		    delprc = -rdcost;
		}
		arc = blk4_2.nxtou[arc - 1];
		goto L504;
	    }
	    arc = blk5_2.fin[node - 1];
L505:
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1] - dp;
		array9_2.rc[arc - 1] = rdcost;
		if (rdcost == 0) {
		    ++nb;
		    blk7_2.save[nb - 1] = -arc;
		    delx += arrayu_2.u[arc - 1];
		}
		if (rdcost > 0 && rdcost < delprc) {
		    delprc = rdcost;
		}
		arc = blk6_2.nxtin[arc - 1];
		goto L505;
	    }

/*   ***** return to check if another price change is possible **
**** */

	    goto L18;

/*     ******* perform flow augmentation at NODE **** */

L16:
	    i__2 = nb;
	    for (j = 1; j <= i__2; ++j) {
		arc = blk7_2.save[j - 1];
		if (arc > 0) {
/*         *** ARC is an outgoing arc from NODE *********
*********** */
		    node2 = arraye_2.endn[arc - 1];
		    t1 = arrayb_2.dfct[node2 - 1];
		    if (t1 < 0) {
/*          ***** Decrease the total deficit by decrea
sing flow of ARC  ******/
			quit = TRUE_;
			t2 = arrayx_2.x[arc - 1];
/* Computing MIN */
			i__3 = defcit, i__4 = -t1, i__3 = min(i__3,i__4);
			dx = min(i__3,t2);
			defcit -= dx;
			arrayb_2.dfct[node2 - 1] = t1 + dx;
			arrayx_2.x[arc - 1] = t2 - dx;
			arrayu_2.u[arc - 1] += dx;
			if (defcit == 0) {
			    goto L19;
			}
		    }
		} else {
/*         *** -ARC is an incoming arc to NODE **********
*********** */
		    narc = -arc;
		    node2 = arrays_2.startn[narc - 1];
		    t1 = arrayb_2.dfct[node2 - 1];
		    if (t1 < 0) {
/*          ***** Decrease the total deficit by increa
sing flow of -ARC  ******/
			quit = TRUE_;
			t2 = arrayu_2.u[narc - 1];
/* Computing MIN */
			i__3 = defcit, i__4 = -t1, i__3 = min(i__3,i__4);
			dx = min(i__3,t2);
			defcit -= dx;
			arrayb_2.dfct[node2 - 1] = t1 + dx;
			arrayx_2.x[narc - 1] += dx;
			arrayu_2.u[narc - 1] = t2 - dx;
			if (defcit == 0) {
			    goto L19;
			}
		    }
		}
/* L11: */
	    }
L19:
	    arrayb_2.dfct[node - 1] = defcit;

/*      Reconstruct the list of balanced arcs incident to this nod
e. */
/*      First, the list at this node is now totally different.  Ea
t */
/*      the old lists of incoming and outgoing balanced arcs, and 
create */
/*      a whole new one.  This way we get the in and out lists of 
balanced */
/*      arcs for NODE to be exactly correct.  For the adjacent nod
es, we */
/*      add in all the newly balanced arcs, but do not bother gett
ing rid */
/*      of formerly balanced ones (they will be purged the next ti
me the */
/*      adjacent node is scanned). */

	    if (pchange) {
		arc = blk10_2.tfstou[node - 1];
		blk10_2.tfstou[node - 1] = 0;
L506:
		if (arc > 0) {
		    nxtarc = blk11_2.tnxtou[arc - 1];
		    blk11_2.tnxtou[arc - 1] = -1;
		    arc = nxtarc;
		    goto L506;
		}
		arc = blk12_2.tfstin[node - 1];
		blk12_2.tfstin[node - 1] = 0;
L507:
		if (arc > 0) {
		    nxtarc = blk13_2.tnxtin[arc - 1];
		    blk13_2.tnxtin[arc - 1] = -1;
		    arc = nxtarc;
		    goto L507;
		}

/*        *** Now add the currently balanced arcs to the list 
for this node ****/
/*        *** (which is now empty), and the appropriate adjace
nt ones.      ****/

		i__2 = nb;
		for (j = 1; j <= i__2; ++j) {
		    arc = blk7_2.save[j - 1];
		    if (arc <= 0) {
			arc = -arc;
		    }
		    if (blk11_2.tnxtou[arc - 1] < 0) {
			blk11_2.tnxtou[arc - 1] = blk10_2.tfstou[
				arrays_2.startn[arc - 1] - 1];
			blk10_2.tfstou[arrays_2.startn[arc - 1] - 1] = arc;
		    }
		    if (blk13_2.tnxtin[arc - 1] < 0) {
			blk13_2.tnxtin[arc - 1] = blk12_2.tfstin[
				arraye_2.endn[arc - 1] - 1];
			blk12_2.tfstin[arraye_2.endn[arc - 1] - 1] = arc;
		    }
/* L508: */
		}
	    }

/*   *** end of single node iteration for a positive deficit node 
*** */

	} else {

/*     ******* single node iteration for a negative deficit node 
****** */

	    pchange = FALSE_;
	    defcit = -defcit;
	    indef = defcit;
	    delx = 0;
	    nb = 0;

	    arc = blk12_2.tfstin[node - 1];
L509:
	    if (arc > 0) {
		if (array9_2.rc[arc - 1] == 0 && arrayx_2.x[arc - 1] > 0) {
		    delx += arrayx_2.x[arc - 1];
		    ++nb;
		    blk7_2.save[nb - 1] = arc;
		}
		arc = blk13_2.tnxtin[arc - 1];
		goto L509;
	    }
	    arc = blk10_2.tfstou[node - 1];
L510:
	    if (arc > 0) {
		if (array9_2.rc[arc - 1] == 0 && arrayu_2.u[arc - 1] > 0) {
		    delx += arrayu_2.u[arc - 1];
		    ++nb;
		    blk7_2.save[nb - 1] = -arc;
		}
		arc = blk11_2.tnxtou[arc - 1];
		goto L510;
	    }

L28:
	    if (delx >= defcit) {
		quit = defcit < indef;
		goto L26;
	    }

/*     Now compute distance to next breakpoint. */

	    delprc = input_1.large;
	    arc = blk5_2.fin[node - 1];
L511:
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1];
		if (rdcost < 0 && rdcost > -delprc) {
		    delprc = -rdcost;
		}
		arc = blk6_2.nxtin[arc - 1];
		goto L511;
	    }
	    arc = blk3_2.fou[node - 1];
L512:
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1];
		if (rdcost > 0 && rdcost < delprc) {
		    delprc = rdcost;
		}
		arc = blk4_2.nxtou[arc - 1];
		goto L512;
	    }
/*     ******* check if problem is infeasible *******************
***** */
	    if (delx < defcit && delprc == input_1.large) {
		goto L400;
	    }
	    if (delx == 0) {
		goto L24;
	    }

/*     ******* flow augmentation is possible ********************
***** */
	    i__2 = nb;
	    for (j = 1; j <= i__2; ++j) {
		arc = blk7_2.save[j - 1];
		if (arc > 0) {
		    node2 = arrays_2.startn[arc - 1];
		    t1 = arrayx_2.x[arc - 1];
		    arrayb_2.dfct[node2 - 1] -= t1;
		    arrayu_2.u[arc - 1] += t1;
		    arrayx_2.x[arc - 1] = 0;
		} else {
		    narc = -arc;
		    node2 = arraye_2.endn[narc - 1];
		    t1 = arrayu_2.u[narc - 1];
		    arrayb_2.dfct[node2 - 1] -= t1;
		    arrayx_2.x[narc - 1] += t1;
		    arrayu_2.u[narc - 1] = 0;
		}
/* L23: */
	    }
	    defcit -= delx;
L24:
	    if (delprc == input_1.large) {
		quit = TRUE_;
		goto L29;
	    }
/*     ******* price increase at NODE is possible ***************
***** */
	    nb = 0;
	    pchange = TRUE_;
	    dp = delprc;
	    delprc = input_1.large;
	    delx = 0;
	    arc = blk5_2.fin[node - 1];
L513:
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1] + dp;
		array9_2.rc[arc - 1] = rdcost;
		if (rdcost == 0) {
		    ++nb;
		    blk7_2.save[nb - 1] = arc;
		    delx += arrayx_2.x[arc - 1];
		}
		if (rdcost < 0 && rdcost > -delprc) {
		    delprc = -rdcost;
		}
		arc = blk6_2.nxtin[arc - 1];
		goto L513;
	    }
	    arc = blk3_2.fou[node - 1];
L514:
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1] - dp;
		array9_2.rc[arc - 1] = rdcost;
		if (rdcost == 0) {
		    ++nb;
		    blk7_2.save[nb - 1] = -arc;
		    delx += arrayu_2.u[arc - 1];
		}
		if (rdcost > 0 && rdcost < delprc) {
		    delprc = rdcost;
		}
		arc = blk4_2.nxtou[arc - 1];
		goto L514;
	    }
	    goto L28;

/*     ******* perform flow augmentation at NODE **** */

L26:
	    i__2 = nb;
	    for (j = 1; j <= i__2; ++j) {
		arc = blk7_2.save[j - 1];
		if (arc > 0) {
/*         *** ARC is an incoming arc to NODE ***********
********* */
		    node2 = arrays_2.startn[arc - 1];
		    t1 = arrayb_2.dfct[node2 - 1];
		    if (t1 > 0) {
			quit = TRUE_;
			t2 = arrayx_2.x[arc - 1];
/* Computing MIN */
			i__3 = min(defcit,t1);
			dx = min(i__3,t2);
			defcit -= dx;
			arrayb_2.dfct[node2 - 1] = t1 - dx;
			arrayx_2.x[arc - 1] = t2 - dx;
			arrayu_2.u[arc - 1] += dx;
			if (defcit == 0) {
			    goto L29;
			}
		    }
		} else {
/*         *** -ARC is an outgoing arc from NODE ********
************* */
		    narc = -arc;
		    node2 = arraye_2.endn[narc - 1];
		    t1 = arrayb_2.dfct[node2 - 1];
		    if (t1 > 0) {
			quit = TRUE_;
			t2 = arrayu_2.u[narc - 1];
/* Computing MIN */
			i__3 = min(defcit,t1);
			dx = min(i__3,t2);
			defcit -= dx;
			arrayb_2.dfct[node2 - 1] = t1 - dx;
			arrayx_2.x[narc - 1] += dx;
			arrayu_2.u[narc - 1] = t2 - dx;
			if (defcit == 0) {
			    goto L29;
			}
		    }
		}
/* L21: */
	    }
L29:
	    arrayb_2.dfct[node - 1] = -defcit;

/*      Reconstruct the list of balanced arcs incident to this nod
e. */
/*      First, the list at this node is now totally different.  Ea
t */
/*      the old lists of incoming and outgoing balanced arcs. */
	    if (pchange) {
		arc = blk10_2.tfstou[node - 1];
		blk10_2.tfstou[node - 1] = 0;
L515:
		if (arc > 0) {
		    nxtarc = blk11_2.tnxtou[arc - 1];
		    blk11_2.tnxtou[arc - 1] = -1;
		    arc = nxtarc;
		    goto L515;
		}
		arc = blk12_2.tfstin[node - 1];
		blk12_2.tfstin[node - 1] = 0;
L516:
		if (arc > 0) {
		    nxtarc = blk13_2.tnxtin[arc - 1];
		    blk13_2.tnxtin[arc - 1] = -1;
		    arc = nxtarc;
		    goto L516;
		}

/*        *** Now add the currently balanced arcs to the list 
for this node ****/
/*        *** (which is now empty), and the appropriate adjace
nt ones.      ****/

		i__2 = nb;
		for (j = 1; j <= i__2; ++j) {
		    arc = blk7_2.save[j - 1];
		    if (arc <= 0) {
			arc = -arc;
		    }
		    if (blk11_2.tnxtou[arc - 1] < 0) {
			blk11_2.tnxtou[arc - 1] = blk10_2.tfstou[
				arrays_2.startn[arc - 1] - 1];
			blk10_2.tfstou[arrays_2.startn[arc - 1] - 1] = arc;
		    }
		    if (blk13_2.tnxtin[arc - 1] < 0) {
			blk13_2.tnxtin[arc - 1] = blk12_2.tfstin[
				arraye_2.endn[arc - 1] - 1];
			blk12_2.tfstin[arraye_2.endn[arc - 1] - 1] = arc;
		    }
/* L517: */
		}
	    }

/*    ***** end of single node iteration for a negative deficit no
de *** */

	}

	if (quit) {
	    goto L100;
	}

/*      ******* do a multi-node operation from NODE ***************** 
*/

	++output_1.nmultinode;
	switch_ = ndfct < tp;

/*      ******* UNMARK NODES LABELED EARLIER ******* */

	i__2 = nlabel;
	for (j = 1; j <= i__2; ++j) {
	    node2 = blk1_3.label[j - 1];
	    blk9_2.mark[node2 - 1] = FALSE_;
	    blk8_2.scan[node2 - 1] = FALSE_;
/* L90: */
	}

/*      ******* INITIALIZE LABELING ****** */

	nlabel = 1;
	blk1_3.label[0] = node;
	blk9_2.mark[node - 1] = TRUE_;
	blk2_3.prdcsr[node - 1] = 0;

/*      ******** SCAN STARTING NODE ********* */

	blk8_2.scan[node - 1] = TRUE_;
	nscan = 1;
	dm = arrayb_2.dfct[node - 1];
	delx = 0;
	i__2 = nb;
	for (j = 1; j <= i__2; ++j) {
	    arc = blk7_2.save[j - 1];
	    if (arc > 0) {
		if (posit) {
		    node2 = arraye_2.endn[arc - 1];
		} else {
		    node2 = arrays_2.startn[arc - 1];
		}
		if (! blk9_2.mark[node2 - 1]) {
		    ++nlabel;
		    blk1_3.label[nlabel - 1] = node2;
		    blk2_3.prdcsr[node2 - 1] = arc;
		    blk9_2.mark[node2 - 1] = TRUE_;
		    delx += arrayx_2.x[arc - 1];
		}
	    } else {
		narc = -arc;
		if (posit) {
		    node2 = arrays_2.startn[narc - 1];
		} else {
		    node2 = arraye_2.endn[narc - 1];
		}
		if (! blk9_2.mark[node2 - 1]) {
		    ++nlabel;
		    blk1_3.label[nlabel - 1] = node2;
		    blk2_3.prdcsr[node2 - 1] = arc;
		    blk9_2.mark[node2 - 1] = TRUE_;
		    delx += arrayu_2.u[narc - 1];
		}
	    }
/* L95: */
	}

/*        **** start scanning labeled nodes **** */

L120:
	++nscan;

/*        ****** check to see if SWITCH needs to be set ****** */
/*        SWITCH indicates it may now be best to change over to a more
 */
/*        conventional primal-dual algorithm (one which can reuse old 
*/
/*        labels to some extent). */

	switch_ = switch_ || nscan > ts && ndfct < ts;

/*   **** scan next node on the list of labeled nodes **** */
/*  *** scanning will continue until either an OVERESTIMATE of the res
idual*/
/*  capacity across the cut corresponding to the scanned set of nodes 
(called*/
/*   DELX) exceeds the absolute value of the total deficit of the scan
ned */
/*  nodes (called DM), or else an augmenting path is found.  Arcs that
 are*/
/*   in the tree but are not balanced are purged as part of the scanni
ng */
/*   process. */
	i = blk1_3.label[nscan - 1];
	blk8_2.scan[i - 1] = TRUE_;
	if (posit) {

/*     ******* scanning node I for case of positive deficit ******
 */

	    naugnod = 0;
	    prvarc = 0;
	    arc = blk10_2.tfstou[i - 1];
L518:
	    if (arc > 0) {

/*       ***** ARC is an outgoing arc from NODE ***** */

		if (array9_2.rc[arc - 1] == 0) {
		    if (arrayx_2.x[arc - 1] > 0) {
			node2 = arraye_2.endn[arc - 1];
			if (! blk9_2.mark[node2 - 1]) {

/*                ***** NODE2 is not in the labele
d set.  Add NODE2 to the */
/*                labeled set. ***** */

			    blk2_3.prdcsr[node2 - 1] = arc;
			    if (arrayb_2.dfct[node2 - 1] < 0) {
				++naugnod;
				blk7_2.save[naugnod - 1] = node2;
			    }
			    ++nlabel;
			    blk1_3.label[nlabel - 1] = node2;
			    blk9_2.mark[node2 - 1] = TRUE_;
			    delx += arrayx_2.x[arc - 1];
			}
		    }
		    prvarc = arc;
		    arc = blk11_2.tnxtou[arc - 1];
		} else {
		    tmparc = arc;
		    arc = blk11_2.tnxtou[arc - 1];
		    blk11_2.tnxtou[tmparc - 1] = -1;
		    if (prvarc == 0) {
			blk10_2.tfstou[i - 1] = arc;
		    } else {
			blk11_2.tnxtou[prvarc - 1] = arc;
		    }
		}
		goto L518;
	    }



	    prvarc = 0;
	    arc = blk12_2.tfstin[i - 1];
L519:
	    if (arc > 0) {

/*       ***** ARC is an incoming arc into NODE ***** */

		if (array9_2.rc[arc - 1] == 0) {
		    if (arrayu_2.u[arc - 1] > 0) {
			node2 = arrays_2.startn[arc - 1];
			if (! blk9_2.mark[node2 - 1]) {

/*                ***** NODE2 is not in the labele
d set.  Add NODE2 to the */
/*                labeled set. ***** */

			    blk2_3.prdcsr[node2 - 1] = -arc;
			    if (arrayb_2.dfct[node2 - 1] < 0) {
				++naugnod;
				blk7_2.save[naugnod - 1] = node2;
			    }
			    ++nlabel;
			    blk1_3.label[nlabel - 1] = node2;
			    blk9_2.mark[node2 - 1] = TRUE_;
			    delx += arrayu_2.u[arc - 1];
			}
		    }
		    prvarc = arc;
		    arc = blk13_2.tnxtin[arc - 1];
		} else {
		    tmparc = arc;
		    arc = blk13_2.tnxtin[arc - 1];
		    blk13_2.tnxtin[tmparc - 1] = -1;
		    if (prvarc == 0) {
			blk12_2.tfstin[i - 1] = arc;
		    } else {
			blk13_2.tnxtin[prvarc - 1] = arc;
		    }
		}
		goto L519;
	    }

/*   * correct the residual capacity of the scanned nodes cut * */


	    arc = blk2_3.prdcsr[i - 1];
	    if (arc > 0) {
		delx -= arrayx_2.x[arc - 1];
	    } else {
		delx -= arrayu_2.u[-arc - 1];
	    }

/*  ********** end of scanning of I for positive deficit case ****
 */

	} else {

/*     ******* scanning node I for case of negative deficit **** 
*/

	    naugnod = 0;
	    prvarc = 0;
	    arc = blk12_2.tfstin[i - 1];
L520:
	    if (arc > 0) {
		if (array9_2.rc[arc - 1] == 0) {
		    if (arrayx_2.x[arc - 1] > 0) {
			node2 = arrays_2.startn[arc - 1];
			if (! blk9_2.mark[node2 - 1]) {
			    blk2_3.prdcsr[node2 - 1] = arc;
			    if (arrayb_2.dfct[node2 - 1] > 0) {
				++naugnod;
				blk7_2.save[naugnod - 1] = node2;
			    }
			    ++nlabel;
			    blk1_3.label[nlabel - 1] = node2;
			    blk9_2.mark[node2 - 1] = TRUE_;
			    delx += arrayx_2.x[arc - 1];
			}
		    }
		    prvarc = arc;
		    arc = blk13_2.tnxtin[arc - 1];
		} else {
		    tmparc = arc;
		    arc = blk13_2.tnxtin[arc - 1];
		    blk13_2.tnxtin[tmparc - 1] = -1;
		    if (prvarc == 0) {
			blk12_2.tfstin[i - 1] = arc;
		    } else {
			blk13_2.tnxtin[prvarc - 1] = arc;
		    }
		}
		goto L520;
	    }



	    prvarc = 0;
	    arc = blk10_2.tfstou[i - 1];
L521:
	    if (arc > 0) {
		if (array9_2.rc[arc - 1] == 0) {
		    if (arrayu_2.u[arc - 1] > 0) {
			node2 = arraye_2.endn[arc - 1];
			if (! blk9_2.mark[node2 - 1]) {
			    blk2_3.prdcsr[node2 - 1] = -arc;
			    if (arrayb_2.dfct[node2 - 1] > 0) {
				++naugnod;
				blk7_2.save[naugnod - 1] = node2;
			    }
			    ++nlabel;
			    blk1_3.label[nlabel - 1] = node2;
			    blk9_2.mark[node2 - 1] = TRUE_;
			    delx += arrayu_2.u[arc - 1];
			}
		    }
		    prvarc = arc;
		    arc = blk11_2.tnxtou[arc - 1];
		} else {
		    tmparc = arc;
		    arc = blk11_2.tnxtou[arc - 1];
		    blk11_2.tnxtou[tmparc - 1] = -1;
		    if (prvarc == 0) {
			blk10_2.tfstou[i - 1] = arc;
		    } else {
			blk11_2.tnxtou[prvarc - 1] = arc;
		    }
		}
		goto L521;
	    }

	    arc = blk2_3.prdcsr[i - 1];
	    if (arc > 0) {
		delx -= arrayx_2.x[arc - 1];
	    } else {
		delx -= arrayu_2.u[-arc - 1];
	    }
	}

/*   ****** ADD DEFICIT OF NODE SCANNED TO DM ****** */

	dm += arrayb_2.dfct[i - 1];

/*      *** check if the set of scanned nodes correspond */
/*      to a dual ascent direction; if yes, perform a */
/*      price adjustment step, otherwise continue labeling * */

	if (nscan < nlabel) {
	    if (switch_) {
		goto L210;
	    }
	    if (delx >= dm && delx >= -dm) {
		goto L210;
	    }
	}

/*   ************* TRY A PRICE CHANGE *********** */
/*   Note that since DELX-ABS(DM) is an OVERESTIMATE of ascent slope, 
we */
/*   may occasionally try a direction that is not really an ascent.  I
n */
/*   this case the ANCNTx routines return with QUIT set to .FALSE. .  
The */
/*   main code, in turn, then tries to label some more node. */

	if (posit) {
	    ascnt1_(&dm, &delx, &nlabel, &augnod, &feasbl, &switch_, &nscan);
	    ++output_1.num_ascnt__;
	} else {
	    ascnt2_(&dm, &delx, &nlabel, &augnod, &feasbl, &switch_, &nscan);
	    ++output_1.num_ascnt__;
	}
	if (! feasbl) {
	    goto L400;
	}
	if (! switch_) {
	    goto L100;
	}
	if (switch_ && augnod > 0) {
	    naugnod = 1;
	    blk7_2.save[0] = augnod;
	}

/*         *** CHECK IF AUGMENTATION IS POSSIBLE. */
/*         IF NOT RETURN TO SCAN ANOTHER NODE. *** */

L210:

	if (naugnod == 0) {
	    goto L120;
	}

/*         Do the augmentation. */

	i__2 = naugnod;
	for (j = 1; j <= i__2; ++j) {
	    ++output_1.num_augm__;
	    augnod = blk7_2.save[j - 1];
	    if (posit) {
		dx = -arrayb_2.dfct[augnod - 1];
		ib = augnod;
L1500:
		if (blk2_3.prdcsr[ib - 1] != 0) {
		    arc = blk2_3.prdcsr[ib - 1];
		    if (arc > 0) {
/* Computing MIN */
			i__3 = dx, i__4 = arrayx_2.x[arc - 1];
			dx = min(i__3,i__4);
			ib = arrays_2.startn[arc - 1];
		    } else {
/* Computing MIN */
			i__3 = dx, i__4 = arrayu_2.u[-arc - 1];
			dx = min(i__3,i__4);
			ib = arraye_2.endn[-arc - 1];
		    }
		    goto L1500;
		}
		root = ib;
/* Computing MIN */
		i__3 = dx, i__4 = arrayb_2.dfct[root - 1];
		dx = min(i__3,i__4);
		if (dx > 0) {

/*     ***** Update the flow by decreasing (increasing) th
e flow of */
/*     all arcs positively (negatively) oriented in the fl
ow */
/*     augmenting path.  Adjust the deficits accordingly. 
***** */

		    arrayb_2.dfct[augnod - 1] += dx;
		    arrayb_2.dfct[root - 1] -= dx;
		    ib = augnod;
L1501:
		    if (ib != root) {
			arc = blk2_3.prdcsr[ib - 1];
			if (arc > 0) {
			    arrayx_2.x[arc - 1] -= dx;
			    arrayu_2.u[arc - 1] += dx;
			    ib = arrays_2.startn[arc - 1];
			} else {
			    narc = -arc;
			    arrayx_2.x[narc - 1] += dx;
			    arrayu_2.u[narc - 1] -= dx;
			    ib = arraye_2.endn[narc - 1];
			}
			goto L1501;
		    }
		}
	    } else {
		dx = arrayb_2.dfct[augnod - 1];
		ib = augnod;
L1502:
		if (blk2_3.prdcsr[ib - 1] != 0) {
		    arc = blk2_3.prdcsr[ib - 1];
		    if (arc > 0) {
/* Computing MIN */
			i__3 = dx, i__4 = arrayx_2.x[arc - 1];
			dx = min(i__3,i__4);
			ib = arraye_2.endn[arc - 1];
		    } else {
/* Computing MIN */
			i__3 = dx, i__4 = arrayu_2.u[-arc - 1];
			dx = min(i__3,i__4);
			ib = arrays_2.startn[-arc - 1];
		    }
		    goto L1502;
		}
		root = ib;
/* Computing MIN */
		i__3 = dx, i__4 = -arrayb_2.dfct[root - 1];
		dx = min(i__3,i__4);
		if (dx > 0) {

/*     ******* update the flow and deficits *************
************ */

		    arrayb_2.dfct[augnod - 1] -= dx;
		    arrayb_2.dfct[root - 1] += dx;
		    ib = augnod;
L1503:
		    if (ib != root) {
			arc = blk2_3.prdcsr[ib - 1];
			if (arc > 0) {
			    arrayx_2.x[arc - 1] -= dx;
			    arrayu_2.u[arc - 1] += dx;
			    ib = arraye_2.endn[arc - 1];
			} else {
			    narc = -arc;
			    arrayx_2.x[narc - 1] += dx;
			    arrayu_2.u[narc - 1] -= dx;
			    ib = arrays_2.startn[narc - 1];
			}
			goto L1503;
		    }
		}
	    }
/* L96: */
	}

/*        ** RETURN TO TAKE UP ANOTHER NODE W/ NONZERO DEFICIT ** */

L100:
	;
    }
/*        ********** TEST FOR TERMINATION *********** */

/*        We have just done a sweep throught all the nodes.  If they all 
*/
/*        had zero defecit, we must be done. */

    ndfct = numnonzero;
    numnonzero = 0;
    if (ndfct == 0) {
	return 0;
    } else {
	goto L80;
    }

/*     ******* INFEASIBILITY MESSAGE ********************* */

L400:
    s_wsle(&io___93);
    do_lio(&c__9, &c__1, " PROBLEM IS FOUND TO BE INFEASIBLE.", 35L);
    e_wsle();
    feasbl = FALSE_;
    return 0;
} /* relaxt_ */

#undef ddpos
#undef ddneg



/* Subroutine */ int short_path__(node, capthresh, feasbl, nolist)
integer *node, *capthresh;
logical *feasbl;
integer *nolist;
{
    /* System generated locals */
    integer i__1, i__2;

    /* Local variables */
    static integer diff, narc, maxd, root, i, k, k2, start, ib, dk, dv, dx, 
	    opnode, dp1, hp1, hp2, hp3, arc, end, nhp, curnode;


/* --------------------------------------------------------------- */

/*  PURPOSE - THIS ROUTINE USES A HEAP IMPLEMENTATION OF DIJKSTRA'S */
/*     SHORTEST PATH ALGORITHM TO FIND A SHORTEST AUGMENTING */
/*     PATH FROM NODE AND AUGMENTS FLOW ALONG THIS PATH. */

/* --------------------------------------------------------------- */

/*  INPUT PARAMETERS (SEE NOTES 1, 4) */

/*     N         = NUMBER OF NODES */
/*     NA        = NUMBER OF ARCS */
/*     LARGE     = A VERY LARGE INTEGER TO REPRESENT INFINITY */
/*                 (SEE NOTE 3) */
/*     STARTN(I) = STARTING NODE FOR THE I-TH ARC,    I = 1,...,NA */
/*     ENDN(I)   = ENDING NODE FOR THE I-TH ARC,      I = 1,...,NA */
/*     FOU(I)    = FIRST ARC LEAVING I-TH NODE,       I = 1,...,N */
/*     NXTOU(I)  = NEXT ARC LEAVING THE STARTING NODE OF J-TH ARC, */
/*                                                    I = 1,...,NA */
/*     FIN(I)    = FIRST ARC ENTERING I-TH NODE,      I = 1,...,N */
/*     NXTIN(I)  = NEXT ARC ENTERING THE ENDING NODE OF J-TH ARC, */
/*     NODE      = ORIGIN FOR THE SHORTEST PATH */
/*     CAPTHRESH = CAPACITY THRESHOLD (ARCS WHOSE CAPACITY IS LESS */
/*                 THAN CAPTHRESH ARE IGNORED) */


/*  UPDATED PARAMETERS (SEE NOTES 1, 4) */

/*     RC(I)     = REDUCED COST OF I-TH ARC,          I = 1,...,NA */
/*     U(I)      = (CAPACITY OF I-TH ARC) - X(I),     I = 1,...,NA */
/*     X(I)      = FLOW ON I-TH ARC,                  I = 1,...,NA */
/*     DFCT(I)   = DEFICIT AT I-TH NODE,              I = 1,...,N */


/*  OUTPUT PARAMETERS */

/*     NOLIST    = NUMBER OF NODES PERMANENTLY LABELED BY SHORTEST */
/*                 PATH ALGORITHM */
/*     FEASBL    = .FALSE. IF PROBLEM IS FOUND TO BE INFEASIBLE */
/*                 (.TRUE. OTHERWISE) */


/*  WORKING PARAMETERS */


/* --------------------------------------------------------------- */


    i__1 = input_1.n;
    for (i = 1; i <= i__1; ++i) {
	blk1_4.d[i - 1] = input_1.large;
	blk11_3.q[i - 1] = 0;
	blk9_2.mark[i - 1] = FALSE_;
/* L10: */
    }
    blk1_4.d[*node - 1] = 0;
    blk2_3.prdcsr[*node - 1] = 0;
    *nolist = 0;
    nhp = 0;
    curnode = *node;
L18:
    arc = blk3_2.fou[curnode - 1];
L20:
    if (arc > 0) {
	if (array9_2.rc[arc - 1] >= 0 && arrayu_2.u[arc - 1] > *capthresh) {
	    opnode = arraye_2.endn[arc - 1];
	    dv = blk1_4.d[curnode - 1] + array9_2.rc[arc - 1];
	    if (blk1_4.d[opnode - 1] > dv) {
		blk1_4.d[opnode - 1] = dv;
		blk2_3.prdcsr[opnode - 1] = -arc;
		if (blk11_3.q[opnode - 1] == 0) {

/* INSERT OPNODE INTO THE HEAP */

		    ++nhp;
		    blk11_3.q[opnode - 1] = nhp;
		}

/* UPDATE THE HEAP */

		k = blk11_3.q[opnode - 1];
L25:
		k2 = k / 2;
		if (k2 > 0) {
		    hp2 = blk10_3.hp[k2 - 1];
		    if (dv < blk1_4.d[hp2 - 1]) {
			blk10_3.hp[k - 1] = hp2;
			blk11_3.q[hp2 - 1] = k;
			k = k2;
			goto L25;
		    }
		}
		blk10_3.hp[k - 1] = opnode;
		blk11_3.q[opnode - 1] = k;
	    }
	}
	arc = blk4_2.nxtou[arc - 1];
	goto L20;
    }
    arc = blk5_2.fin[curnode - 1];
L30:
    if (arc > 0) {
	if (array9_2.rc[arc - 1] <= 0 && arrayx_2.x[arc - 1] > *capthresh) {
	    opnode = arrays_2.startn[arc - 1];
	    dv = blk1_4.d[curnode - 1] - array9_2.rc[arc - 1];
	    if (blk1_4.d[opnode - 1] > dv) {
		blk1_4.d[opnode - 1] = dv;
		blk2_3.prdcsr[opnode - 1] = arc;
		if (blk11_3.q[opnode - 1] == 0) {

/* INSERT OPNODE INTO THE HEAP */

		    ++nhp;
		    blk11_3.q[opnode - 1] = nhp;
		}

/* UPDATE THE HEAP */

		k = blk11_3.q[opnode - 1];
L35:
		k2 = k / 2;
		if (k2 > 0) {
		    hp2 = blk10_3.hp[k2 - 1];
		    if (dv < blk1_4.d[hp2 - 1]) {
			blk10_3.hp[k - 1] = hp2;
			blk11_3.q[hp2 - 1] = k;
			k = k2;
			goto L35;
		    }
		}
		blk10_3.hp[k - 1] = opnode;
		blk11_3.q[opnode - 1] = k;
	    }
	}
	arc = blk6_2.nxtin[arc - 1];
	goto L30;
    }

/*   MARK PERMANENTLY LABELED NODE */

    ++(*nolist);
    blk12_3.list[*nolist - 1] = curnode;
    blk9_2.mark[curnode - 1] = TRUE_;

/* REMOVE THE NEW CURRENT NODE FROM THE HEAP */
/* CHECK IF IT HAS POSITIVE DEFICIT */

    if (nhp == 0) {
	goto L130;
    }
    curnode = blk10_3.hp[0];
    blk11_3.q[curnode - 1] = 0;
    if (arrayb_2.dfct[curnode - 1] > 0) {
	goto L130;
    }
    --nhp;

/* CHECK WHETHER THE HEAP IS EMPTY */

    if (nhp == 0) {
	goto L18;
    }

/* UPDATE  THE HEAP */

/* L80: */
    hp1 = blk10_3.hp[nhp];
    dp1 = blk1_4.d[hp1 - 1];
    k = 1;
L90:
    k2 = k << 1;
    hp2 = blk10_3.hp[k2 - 1];
    if ((i__1 = k2 - nhp) < 0) {
	goto L100;
    } else if (i__1 == 0) {
	goto L110;
    } else {
	goto L120;
    }
L100:
    hp3 = blk10_3.hp[k2];
    if (blk1_4.d[hp2 - 1] < blk1_4.d[hp3 - 1]) {
	goto L110;
    }
    hp2 = hp3;
    ++k2;
L110:
    if (dp1 <= blk1_4.d[hp2 - 1]) {
	goto L120;
    }
    blk10_3.hp[k - 1] = hp2;
    blk11_3.q[hp2 - 1] = k;
    k = k2;
    goto L90;
L120:
    blk10_3.hp[k - 1] = hp1;
    blk11_3.q[hp1 - 1] = k;
    goto L18;
L130:
/*    SHORTEST AUGMENTING PATH HAS BEEN COMPUTED */

/*    UPDATE THE REDUCED COSTS OF ALL ARCS */

    maxd = blk1_4.d[curnode - 1];
    i__1 = *nolist;
    for (i = 1; i <= i__1; ++i) {
	k = blk12_3.list[i - 1];
	dk = blk1_4.d[k - 1];

	diff = maxd - dk;
	arc = blk3_2.fou[k - 1];
L134:
	if (arc > 0) {
	    end = arraye_2.endn[arc - 1];
	    if (! blk9_2.mark[end - 1]) {
		array9_2.rc[arc - 1] -= diff;
	    } else {
		array9_2.rc[arc - 1] = array9_2.rc[arc - 1] - blk1_4.d[end - 
			1] + dk;
	    }
	    arc = blk4_2.nxtou[arc - 1];
	    goto L134;
	}
	arc = blk5_2.fin[k - 1];
L136:
	if (arc > 0) {
	    start = arrays_2.startn[arc - 1];
	    if (! blk9_2.mark[start - 1]) {
		array9_2.rc[arc - 1] += diff;
	    }
	    arc = blk6_2.nxtin[arc - 1];
	    goto L136;
	}
/* L140: */
    }

/*    DO THE AUGMENTATION AND EXIT */

/* Computing MIN */
    i__1 = arrayb_2.dfct[curnode - 1], i__2 = -arrayb_2.dfct[*node - 1];
    dx = min(i__1,i__2);
    if (dx > 0) {
	ib = curnode;
L150:
	if (blk2_3.prdcsr[ib - 1] != 0) {
	    arc = blk2_3.prdcsr[ib - 1];
	    if (arc > 0) {
/* Computing MIN */
		i__1 = dx, i__2 = arrayx_2.x[arc - 1];
		dx = min(i__1,i__2);
		ib = arraye_2.endn[arc - 1];
	    } else {
/* Computing MIN */
		i__1 = dx, i__2 = arrayu_2.u[-arc - 1];
		dx = min(i__1,i__2);
		ib = arrays_2.startn[-arc - 1];
	    }
	    goto L150;
	}
	root = ib;

/*  UPDATE THE ARC FLOWS AND THE DEFICITS */

	arrayb_2.dfct[curnode - 1] -= dx;
	arrayb_2.dfct[root - 1] += dx;
	ib = curnode;
L160:
	if (ib != root) {
	    arc = blk2_3.prdcsr[ib - 1];
	    if (arc > 0) {
		arrayx_2.x[arc - 1] -= dx;
		arrayu_2.u[arc - 1] += dx;
		ib = arraye_2.endn[arc - 1];
	    } else {
		narc = -arc;
		arrayx_2.x[narc - 1] += dx;
		arrayu_2.u[narc - 1] -= dx;
		ib = arrays_2.startn[narc - 1];
	    }
	    goto L160;
	}
    }
    return 0;
} /* short_path__ */



/* Subroutine */ int checkcompslack_()
{
    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    integer s_wsle(), do_lio(), e_wsle();
    /* Subroutine */ int s_paus();

    /* Local variables */
    static integer arc;

    /* Fortran I/O blocks */
    static cilist io___116 = { 0, 6, 0, 0, 0 };
    static cilist io___117 = { 0, 6, 0, 0, 0 };
    static cilist io___118 = { 0, 6, 0, 0, 0 };
    static cilist io___119 = { 0, 6, 0, 0, 0 };



/* --------------------------------------------------------------- */

/*  PURPOSE - THIS ROUTINE CHECKS THAT COMPLEMENTARY SLACKNESS */
/*     IS SATISFIED BY THE ARRAYS RC, X, U */

/* --------------------------------------------------------------- */

/*  INPUT PARAMETERS (SEE NOTES 1, 4) */

/*     N         = NUMBER OF NODES */
/*     NA        = NUMBER OF ARCS */
/*     LARGE     = A VERY LARGE INTEGER TO REPRESENT INFINITY */
/*                 (SEE NOTE 3) */
/*     STARTN(I) = STARTING NODE FOR THE I-TH ARC,    I = 1,...,NA */
/*     ENDN(I)   = ENDING NODE FOR THE I-TH ARC,      I = 1,...,NA */
/*     FOU(I)    = FIRST ARC LEAVING I-TH NODE,       I = 1,...,N */
/*     NXTOU(I)  = NEXT ARC LEAVING THE STARTING NODE OF I-TH ARC, */
/*                                                    I = 1,...,NA */
/*     FIN(I)    = FIRST ARC ENTERING I-TH NODE,      I = 1,...,N */
/*     NXTIN(I)  = NEXT ARC ENTERING THE ENDING NODE OF I-TH ARC, */
/*                                                    I = 1,...,NA */
/*     RC(I)     = REDUCED COST OF I-TH ARC,          I = 1,...,NA */
/*     X(I)      = FLOW ON I-TH ARC,                  I = 1,...,NA */
/*     U(I)      = (CAPACITY OF I-TH ARC) - X(I)      I = 1,...,NA */


/* --------------------------------------------------------------- */

    i__1 = input_1.na;
    for (arc = 1; arc <= i__1; ++arc) {
	if (array9_2.rc[arc - 1] > 0) {
	    if (arrayx_2.x[arc - 1] > 0) {
		s_wsle(&io___116);
		do_lio(&c__9, &c__1, "COMPLEMENTARY SLACKNESS VIOLATED", 32L);

		do_lio(&c__3, &c__1, (char *)&arc, (ftnlen)sizeof(integer));
		e_wsle();
		s_wsle(&io___117);
		do_lio(&c__3, &c__1, (char *)&array9_2.rc[arc - 1], (ftnlen)
			sizeof(integer));
		do_lio(&c__3, &c__1, (char *)&arrayx_2.x[arc - 1], (ftnlen)
			sizeof(integer));
		e_wsle();
		s_paus("", 0L);
	    }
	} else if (array9_2.rc[arc - 1] < 0) {
	    if (arrayu_2.u[arc - 1] > 0) {
		s_wsle(&io___118);
		do_lio(&c__9, &c__1, "COMPLEMENTARY SLACKNESS VIOLATED", 32L);

		do_lio(&c__3, &c__1, (char *)&arc, (ftnlen)sizeof(integer));
		e_wsle();
		s_wsle(&io___119);
		do_lio(&c__3, &c__1, (char *)&array9_2.rc[arc - 1], (ftnlen)
			sizeof(integer));
		do_lio(&c__3, &c__1, (char *)&arrayu_2.u[arc - 1], (ftnlen)
			sizeof(integer));
		e_wsle();
		s_paus("", 0L);
	    }
	}
/* L100: */
    }
    return 0;
} /* checkcompslack_ */

/* Subroutine */ int printflows_(node)
integer *node;
{
    /* Builtin functions */
    integer s_wsle(), do_lio(), e_wsle();

    /* Local variables */
    static integer arc;

    /* Fortran I/O blocks */
    static cilist io___120 = { 0, 6, 0, 0, 0 };
    static cilist io___121 = { 0, 6, 0, 0, 0 };
    static cilist io___122 = { 0, 6, 0, 0, 0 };
    static cilist io___124 = { 0, 6, 0, 0, 0 };
    static cilist io___125 = { 0, 6, 0, 0, 0 };
    static cilist io___126 = { 0, 6, 0, 0, 0 };
    static cilist io___127 = { 0, 6, 0, 0, 0 };
    static cilist io___128 = { 0, 6, 0, 0, 0 };
    static cilist io___129 = { 0, 6, 0, 0, 0 };
    static cilist io___130 = { 0, 6, 0, 0, 0 };



/* --------------------------------------------------------------- */

/*  PURPOSE - THIS ROUTINE PRINTS THE DEFICIT AND THE FLOWS */
/*     OF ARCS INCIDENT TO NODE.  IT IS USED FOR DIAGNOSTIC */
/*     PURPOSES IN CASE OF AN INFEASIBLE PROBLEM HERE. */
/*     IT CAN BE USED ALSO FOR MORE GENERAL DIAGNOSTIC */
/*     PURPOSES. */

/* --------------------------------------------------------------- */




/* --------------------------------------------------------------- */

    s_wsle(&io___120);
    do_lio(&c__9, &c__1, "DEFICIT (I.E., NET FLOW OUT) OF NODE =", 38L);
    do_lio(&c__3, &c__1, (char *)&arrayb_2.dfct[*node - 1], (ftnlen)sizeof(
	    integer));
    e_wsle();
    s_wsle(&io___121);
    do_lio(&c__9, &c__1, "FLOWS AND CAPACITIES OF INCIDENT ARCS OF NODE", 45L)
	    ;
    do_lio(&c__3, &c__1, (char *)&(*node), (ftnlen)sizeof(integer));
    e_wsle();

/*     CHECK ALL ARCS LEAVING NODE */

    if (blk3_2.fou[*node - 1] == 0) {
	s_wsle(&io___122);
	do_lio(&c__9, &c__1, "NO OUTGOING ARCS", 16L);
	e_wsle();
    } else {
	arc = blk3_2.fou[*node - 1];
L5:
	if (arc > 0) {
	    s_wsle(&io___124);
	    do_lio(&c__9, &c__1, "ARC", 3L);
	    do_lio(&c__3, &c__1, (char *)&arc, (ftnlen)sizeof(integer));
	    do_lio(&c__9, &c__1, "  BETWEEN NODES", 15L);
	    do_lio(&c__3, &c__1, (char *)&(*node), (ftnlen)sizeof(integer));
	    do_lio(&c__3, &c__1, (char *)&arraye_2.endn[arc - 1], (ftnlen)
		    sizeof(integer));
	    e_wsle();
	    s_wsle(&io___125);
	    do_lio(&c__9, &c__1, "FLOW =", 6L);
	    do_lio(&c__3, &c__1, (char *)&arrayx_2.x[arc - 1], (ftnlen)sizeof(
		    integer));
	    e_wsle();
	    s_wsle(&io___126);
	    do_lio(&c__9, &c__1, "RESIDUAL CAPACITY =", 19L);
	    do_lio(&c__3, &c__1, (char *)&arrayu_2.u[arc - 1], (ftnlen)sizeof(
		    integer));
	    e_wsle();
	    arc = blk4_2.nxtou[arc - 1];
	    goto L5;
	}
    }

/*     CHECK ALL ARCS INCOMING TO NODE */

    if (blk5_2.fin[*node - 1] == 0) {
	s_wsle(&io___127);
	do_lio(&c__9, &c__1, "NO INCOMING ARCS", 16L);
	e_wsle();
    } else {
	arc = blk5_2.fin[*node - 1];
L10:
	if (arc > 0) {
	    s_wsle(&io___128);
	    do_lio(&c__9, &c__1, "ARC", 3L);
	    do_lio(&c__3, &c__1, (char *)&arc, (ftnlen)sizeof(integer));
	    do_lio(&c__9, &c__1, "  BETWEEN NODES", 15L);
	    do_lio(&c__3, &c__1, (char *)&arrays_2.startn[arc - 1], (ftnlen)
		    sizeof(integer));
	    do_lio(&c__3, &c__1, (char *)&(*node), (ftnlen)sizeof(integer));
	    e_wsle();
	    s_wsle(&io___129);
	    do_lio(&c__9, &c__1, "FLOW =", 6L);
	    do_lio(&c__3, &c__1, (char *)&arrayx_2.x[arc - 1], (ftnlen)sizeof(
		    integer));
	    e_wsle();
	    s_wsle(&io___130);
	    do_lio(&c__9, &c__1, "RESIDUAL CAPACITY =", 19L);
	    do_lio(&c__3, &c__1, (char *)&arrayu_2.u[arc - 1], (ftnlen)sizeof(
		    integer));
	    e_wsle();
	    arc = blk6_2.nxtin[arc - 1];
	    goto L10;
	}
    }


    return 0;
} /* printflows_ */

/* Subroutine */ int ascnt1_(dm, delx, nlabel, augnod, feasbl, switch_, nscan)

integer *dm, *delx, *nlabel, *augnod;
logical *feasbl, *switch_;
integer *nscan;
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    static integer node, node2, i, j, nsave, t1, t2, t3, nb, delprc, rdcost, 
	    arc, dlx;


/*     This subroutine essentially performs the multi-node */
/*     price adjustment step.  It first checks if the set */
/*     of scanned nodes correspond to a dual ascent direction. */
/*     If yes, then decrease the price of all scanned nodes. */
/*     There are two possibilities for price adjustment: */
/*     If SWITCH=.TRUE. then the set of scanned nodes */
/*     corresponds to an elementary direction of maximal */
/*     rate of ascent, in which case the price of all scanned */
/*     nodes are decreased until the next breakpoint in the */
/*     dual cost is encountered.  At this point some arc */
/*     becomes balanced and more node(s) are added to the */
/*     labeled set. */
/*     If SWITCH=.FALSE. then the prices of all scanned nodes */
/*     are decreased until the rate of ascent becomes */
/*     negative (this corresponds to the price adjustment */
/*     step in which both the line search and the degenerate */
/*     ascent iteration are implemented). */


/*     The two "tree"-based ascent routines have a common temporary */
/*     storage area whose dimension is set below.  The maximum conceivable
 */
/*     amount needed equals the number of arcs, but this should never */
/*     actually occur. */


/*     ***** Store the arcs between the set of scanned nodes and */
/*     its complement in SAVE and compute DELPRC, the stepsize */
/*     to the next breakpoint in the dual cost in the direction */
/*     of decreasing prices of the scanned nodes. ***** */

    delprc = input_1.large;
    dlx = 0;
    nsave = 0;

/*   **** calculate the array SAVE of arcs across the cut of scanned */
/*   nodes in a different way depending on whether NSCAN>N/2 or not. */
/*   This is done for efficiency. **** */

    if (*nscan <= input_1.n / 2) {
	i__1 = *nscan;
	for (i = 1; i <= i__1; ++i) {
	    node = blk1_3.label[i - 1];
	    arc = blk3_2.fou[node - 1];
L500:
	    if (arc > 0) {

/*           ***** ARC is an arc pointing from the set of scan
ned */
/*           nodes to its complement. ***** */

		node2 = arraye_2.endn[arc - 1];
		if (! blk8_2.scan[node2 - 1]) {
		    ++nsave;
		    blk7_2.save[nsave - 1] = arc;
		    rdcost = array9_2.rc[arc - 1];
		    if (rdcost == 0 && blk2_3.prdcsr[node2 - 1] != arc) {
			dlx += arrayx_2.x[arc - 1];
		    }
		    if (rdcost < 0 && rdcost > -delprc) {
			delprc = -rdcost;
		    }
		}
		arc = blk4_2.nxtou[arc - 1];
		goto L500;
	    }
	    arc = blk5_2.fin[node - 1];
L501:
	    if (arc > 0) {

/*           ***** ARC is an arc pointing to the set of scanne
d */
/*           nodes from its complement. ***** */

		node2 = arrays_2.startn[arc - 1];
		if (! blk8_2.scan[node2 - 1]) {
		    ++nsave;
		    blk7_2.save[nsave - 1] = -arc;
		    rdcost = array9_2.rc[arc - 1];
		    if (rdcost == 0 && blk2_3.prdcsr[node2 - 1] != -arc) {
			dlx += arrayu_2.u[arc - 1];
		    }
		    if (rdcost > 0 && rdcost < delprc) {
			delprc = rdcost;
		    }
		}
		arc = blk6_2.nxtin[arc - 1];
		goto L501;
	    }
/* L1: */
	}

    } else {

	i__1 = input_1.n;
	for (node = 1; node <= i__1; ++node) {
	    if (blk8_2.scan[node - 1]) {
		goto L2;
	    }
	    arc = blk5_2.fin[node - 1];
L502:
	    if (arc > 0) {
		node2 = arrays_2.startn[arc - 1];
		if (blk8_2.scan[node2 - 1]) {
		    ++nsave;
		    blk7_2.save[nsave - 1] = arc;
		    rdcost = array9_2.rc[arc - 1];
		    if (rdcost == 0 && blk2_3.prdcsr[node - 1] != arc) {
			dlx += arrayx_2.x[arc - 1];
		    }
		    if (rdcost < 0 && rdcost > -delprc) {
			delprc = -rdcost;
		    }
		}
		arc = blk6_2.nxtin[arc - 1];
		goto L502;
	    }
	    arc = blk3_2.fou[node - 1];
L503:
	    if (arc > 0) {
		node2 = arraye_2.endn[arc - 1];
		if (blk8_2.scan[node2 - 1]) {
		    ++nsave;
		    blk7_2.save[nsave - 1] = -arc;
		    rdcost = array9_2.rc[arc - 1];
		    if (rdcost == 0 && blk2_3.prdcsr[node - 1] != -arc) {
			dlx += arrayu_2.u[arc - 1];
		    }
		    if (rdcost > 0 && rdcost < delprc) {
			delprc = rdcost;
		    }
		}
		arc = blk4_2.nxtou[arc - 1];
		goto L503;
	    }
L2:
	    ;
	}
    }

/*     ***** Check if the set of scanned nodes truly corresponds */
/*     to a dual ascent direction.  Here DELX+DLX is the exact */
/*     sum of the flow on arcs from the scanned set to the */
/*     unscanned set plus the ( capacity - flow ) on arcs from */
/*     the unscanned set to the scanned set. ***** */
/*     ***** If this is not the case, we set SWITCH to .TRUE. */
/*     and exit the subroutine. ***** */

    if (*delx + dlx >= *dm) {
	*switch_ = TRUE_;
	*augnod = 0;
	i__1 = *nlabel;
	for (i = *nscan + 1; i <= i__1; ++i) {
	    node = blk1_3.label[i - 1];
	    if (arrayb_2.dfct[node - 1] < 0) {
		*augnod = node;
	    }
/* L3: */
	}
	return 0;
    }
    *delx += dlx;

/*     ******* check that the problem is feasible ******************** */

L4:
    if (delprc == input_1.large) {

/*       ***** We can decrease the dual cost without bound. */
/*       Therefore the primal problem is infeasible. ***** */

	*feasbl = FALSE_;
	return 0;
    }

/*     ******* Decrease prices of the scanned nodes, add more */
/*     nodes to the labeled set & check if a newly labeled node */
/*     has negative deficit. ***** */

    if (*switch_) {
	*augnod = 0;
	i__1 = nsave;
	for (i = 1; i <= i__1; ++i) {
	    arc = blk7_2.save[i - 1];
	    if (arc > 0) {
		array9_2.rc[arc - 1] += delprc;
		if (array9_2.rc[arc - 1] == 0) {
		    node2 = arraye_2.endn[arc - 1];
		    if (blk11_2.tnxtou[arc - 1] < 0) {
			blk11_2.tnxtou[arc - 1] = blk10_2.tfstou[
				arrays_2.startn[arc - 1] - 1];
			blk10_2.tfstou[arrays_2.startn[arc - 1] - 1] = arc;
		    }
		    if (blk13_2.tnxtin[arc - 1] < 0) {
			blk13_2.tnxtin[arc - 1] = blk12_2.tfstin[node2 - 1];
			blk12_2.tfstin[node2 - 1] = arc;
		    }
		    blk2_3.prdcsr[node2 - 1] = arc;
		    if (arrayb_2.dfct[node2 - 1] < 0) {
			*augnod = node2;
		    } else {
			if (! blk9_2.mark[node2 - 1]) {
			    blk9_2.mark[node2 - 1] = TRUE_;
			    ++(*nlabel);
			    blk1_3.label[*nlabel - 1] = node2;
			}
		    }
		}
	    } else {
		arc = -arc;
		array9_2.rc[arc - 1] -= delprc;
		if (array9_2.rc[arc - 1] == 0) {
		    node2 = arrays_2.startn[arc - 1];
		    if (blk11_2.tnxtou[arc - 1] < 0) {
			blk11_2.tnxtou[arc - 1] = blk10_2.tfstou[node2 - 1];
			blk10_2.tfstou[node2 - 1] = arc;
		    }
		    if (blk13_2.tnxtin[arc - 1] < 0) {
			blk13_2.tnxtin[arc - 1] = blk12_2.tfstin[
				arraye_2.endn[arc - 1] - 1];
			blk12_2.tfstin[arraye_2.endn[arc - 1] - 1] = arc;
		    }
		    blk2_3.prdcsr[node2 - 1] = -arc;
		    if (arrayb_2.dfct[node2 - 1] < 0) {
			*augnod = node2;
		    } else {
			if (! blk9_2.mark[node2 - 1]) {
			    blk9_2.mark[node2 - 1] = TRUE_;
			    ++(*nlabel);
			    blk1_3.label[*nlabel - 1] = node2;
			}
		    }
		}
	    }
/* L7: */
	}
	return 0;

    } else {

/*     ***** Decrease the prices of the scanned nodes by DELPRC. */
/*     Adjust arc flow to maintain complementary slackness with */
/*     the prices. ***** */

	nb = 0;
	i__1 = nsave;
	for (i = 1; i <= i__1; ++i) {
	    arc = blk7_2.save[i - 1];
	    if (arc > 0) {
		t1 = array9_2.rc[arc - 1];
		if (t1 == 0) {
		    t2 = arrayx_2.x[arc - 1];
		    t3 = arrays_2.startn[arc - 1];
		    arrayb_2.dfct[t3 - 1] -= t2;
		    t3 = arraye_2.endn[arc - 1];
		    arrayb_2.dfct[t3 - 1] += t2;
		    arrayu_2.u[arc - 1] += t2;
		    arrayx_2.x[arc - 1] = 0;
		}
		array9_2.rc[arc - 1] = t1 + delprc;
		if (array9_2.rc[arc - 1] == 0) {
		    *delx += arrayx_2.x[arc - 1];
		    ++nb;
		    blk2_3.prdcsr[nb - 1] = arc;
		}
	    } else {
		arc = -arc;
		t1 = array9_2.rc[arc - 1];
		if (t1 == 0) {
		    t2 = arrayu_2.u[arc - 1];
		    t3 = arrays_2.startn[arc - 1];
		    arrayb_2.dfct[t3 - 1] += t2;
		    t3 = arraye_2.endn[arc - 1];
		    arrayb_2.dfct[t3 - 1] -= t2;
		    arrayx_2.x[arc - 1] += t2;
		    arrayu_2.u[arc - 1] = 0;
		}
		array9_2.rc[arc - 1] = t1 - delprc;
		if (array9_2.rc[arc - 1] == 0) {
		    *delx += arrayu_2.u[arc - 1];
		    ++nb;
		    blk2_3.prdcsr[nb - 1] = arc;
		}
	    }
/* L6: */
	}
    }

    if (*delx <= *dm) {

/*       ***** The set of scanned nodes still corresponds to a */
/*       dual (possibly degenerate) ascent direction.  Compute */
/*       the stepsize DELPRC to the next breakpoint in the */
/*       dual cost. ***** */

	delprc = input_1.large;
	i__1 = nsave;
	for (i = 1; i <= i__1; ++i) {
	    arc = blk7_2.save[i - 1];
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1];
		if (rdcost < 0 && rdcost > -delprc) {
		    delprc = -rdcost;
		}
	    } else {
		arc = -arc;
		rdcost = array9_2.rc[arc - 1];
		if (rdcost > 0 && rdcost < delprc) {
		    delprc = rdcost;
		}
	    }
/* L10: */
	}
	if (delprc != input_1.large || *delx < *dm) {
	    goto L4;
	}
    }

/*       *** Add new balanced arcs to the superset of balanced arcs.  *** 
*/

    i__1 = nb;
    for (i = 1; i <= i__1; ++i) {
	arc = blk2_3.prdcsr[i - 1];
	if (blk13_2.tnxtin[arc - 1] == -1) {
	    j = arraye_2.endn[arc - 1];
	    blk13_2.tnxtin[arc - 1] = blk12_2.tfstin[j - 1];
	    blk12_2.tfstin[j - 1] = arc;
	}
	if (blk11_2.tnxtou[arc - 1] == -1) {
	    j = arrays_2.startn[arc - 1];
	    blk11_2.tnxtou[arc - 1] = blk10_2.tfstou[j - 1];
	    blk10_2.tfstou[j - 1] = arc;
	}
/* L9: */
    }
    return 0;
} /* ascnt1_ */

/* Subroutine */ int ascnt2_(dm, delx, nlabel, augnod, feasbl, switch_, nscan)

integer *dm, *delx, *nlabel, *augnod;
logical *feasbl, *switch_;
integer *nscan;
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    static integer node, node2, i, j, nsave, t1, t2, t3, nb, delprc, rdcost, 
	    arc, dlx;


/*     The two "tree"-based ascent routines have a common temporary */
/*     storage area whose dimension is set below.  The maximum conceivable
 */
/*     amount needed equals the number of arcs, but this should never */
/*     actually occur. */


/*     ******* augment flows across the cut & compute price rise ***** */

    delprc = input_1.large;
    dlx = 0;
    nsave = 0;
    if (*nscan <= input_1.n / 2) {
	i__1 = *nscan;
	for (i = 1; i <= i__1; ++i) {
	    node = blk1_3.label[i - 1];
	    arc = blk5_2.fin[node - 1];
L500:
	    if (arc > 0) {
		node2 = arrays_2.startn[arc - 1];
		if (! blk8_2.scan[node2 - 1]) {
		    ++nsave;
		    blk7_2.save[nsave - 1] = arc;
		    rdcost = array9_2.rc[arc - 1];
		    if (rdcost == 0 && blk2_3.prdcsr[node2 - 1] != arc) {
			dlx += arrayx_2.x[arc - 1];
		    }
		    if (rdcost < 0 && rdcost > -delprc) {
			delprc = -rdcost;
		    }
		}
		arc = blk6_2.nxtin[arc - 1];
		goto L500;
	    }
	    arc = blk3_2.fou[node - 1];
L501:
	    if (arc > 0) {
		node2 = arraye_2.endn[arc - 1];
		if (! blk8_2.scan[node2 - 1]) {
		    ++nsave;
		    blk7_2.save[nsave - 1] = -arc;
		    rdcost = array9_2.rc[arc - 1];
		    if (rdcost == 0 && blk2_3.prdcsr[node2 - 1] != -arc) {
			dlx += arrayu_2.u[arc - 1];
		    }
		    if (rdcost > 0 && rdcost < delprc) {
			delprc = rdcost;
		    }
		}
		arc = blk4_2.nxtou[arc - 1];
		goto L501;
	    }
/* L1: */
	}
    } else {
	i__1 = input_1.n;
	for (node = 1; node <= i__1; ++node) {
	    if (blk8_2.scan[node - 1]) {
		goto L2;
	    }
	    arc = blk3_2.fou[node - 1];
L502:
	    if (arc > 0) {
		node2 = arraye_2.endn[arc - 1];
		if (blk8_2.scan[node2 - 1]) {
		    ++nsave;
		    blk7_2.save[nsave - 1] = arc;
		    rdcost = array9_2.rc[arc - 1];
		    if (rdcost == 0 && blk2_3.prdcsr[node - 1] != arc) {
			dlx += arrayx_2.x[arc - 1];
		    }
		    if (rdcost < 0 && rdcost > -delprc) {
			delprc = -rdcost;
		    }
		}
		arc = blk4_2.nxtou[arc - 1];
		goto L502;
	    }
	    arc = blk5_2.fin[node - 1];
L503:
	    if (arc > 0) {
		node2 = arrays_2.startn[arc - 1];
		if (blk8_2.scan[node2 - 1]) {
		    ++nsave;
		    blk7_2.save[nsave - 1] = -arc;
		    rdcost = array9_2.rc[arc - 1];
		    if (rdcost == 0 && blk2_3.prdcsr[node - 1] != -arc) {
			dlx += arrayu_2.u[arc - 1];
		    }
		    if (rdcost > 0 && rdcost < delprc) {
			delprc = rdcost;
		    }
		}
		arc = blk6_2.nxtin[arc - 1];
		goto L503;
	    }
L2:
	    ;
	}
    }
    if (*delx + dlx >= -(*dm)) {
	*switch_ = TRUE_;
	*augnod = 0;
	i__1 = *nlabel;
	for (i = *nscan + 1; i <= i__1; ++i) {
	    node = blk1_3.label[i - 1];
	    if (arrayb_2.dfct[node - 1] > 0) {
		*augnod = node;
	    }
/* L3: */
	}
	return 0;
    }
    *delx += dlx;

/*     ******* check that the problem is feasible ******************** */

L4:
    if (delprc == input_1.large) {
	*feasbl = FALSE_;
	return 0;
    }

/*      ***** INCREASE PRICES ***** */

    if (*switch_) {
	*augnod = 0;
	i__1 = nsave;
	for (i = 1; i <= i__1; ++i) {
	    arc = blk7_2.save[i - 1];
	    if (arc > 0) {
		array9_2.rc[arc - 1] += delprc;
		if (array9_2.rc[arc - 1] == 0) {
		    node2 = arrays_2.startn[arc - 1];
		    if (blk11_2.tnxtou[arc - 1] < 0) {
			blk11_2.tnxtou[arc - 1] = blk10_2.tfstou[node2 - 1];
			blk10_2.tfstou[node2 - 1] = arc;
		    }
		    if (blk13_2.tnxtin[arc - 1] < 0) {
			blk13_2.tnxtin[arc - 1] = blk12_2.tfstin[
				arraye_2.endn[arc - 1] - 1];
			blk12_2.tfstin[arraye_2.endn[arc - 1] - 1] = arc;
		    }
		    blk2_3.prdcsr[node2 - 1] = arc;
		    if (arrayb_2.dfct[node2 - 1] > 0) {
			*augnod = node2;
		    } else {
			if (! blk9_2.mark[node2 - 1]) {
			    blk9_2.mark[node2 - 1] = TRUE_;
			    ++(*nlabel);
			    blk1_3.label[*nlabel - 1] = node2;
			}
		    }
		}
	    } else {
		arc = -arc;
		array9_2.rc[arc - 1] -= delprc;
		if (array9_2.rc[arc - 1] == 0) {
		    node2 = arraye_2.endn[arc - 1];
		    if (blk11_2.tnxtou[arc - 1] < 0) {
			blk11_2.tnxtou[arc - 1] = blk10_2.tfstou[
				arrays_2.startn[arc - 1] - 1];
			blk10_2.tfstou[arrays_2.startn[arc - 1] - 1] = arc;
		    }
		    if (blk13_2.tnxtin[arc - 1] < 0) {
			blk13_2.tnxtin[arc - 1] = blk12_2.tfstin[node2 - 1];
			blk12_2.tfstin[node2 - 1] = arc;
		    }
		    blk2_3.prdcsr[node2 - 1] = -arc;
		    if (arrayb_2.dfct[node2 - 1] > 0) {
			*augnod = node2;
		    } else {
			if (! blk9_2.mark[node2 - 1]) {
			    blk9_2.mark[node2 - 1] = TRUE_;
			    ++(*nlabel);
			    blk1_3.label[*nlabel - 1] = node2;
			}
		    }
		}
	    }
/* L7: */
	}
	return 0;

    } else {

	nb = 0;
	i__1 = nsave;
	for (i = 1; i <= i__1; ++i) {
	    arc = blk7_2.save[i - 1];
	    if (arc > 0) {
		t1 = array9_2.rc[arc - 1];
		if (t1 == 0) {
		    t2 = arrayx_2.x[arc - 1];
		    t3 = arrays_2.startn[arc - 1];
		    arrayb_2.dfct[t3 - 1] -= t2;
		    t3 = arraye_2.endn[arc - 1];
		    arrayb_2.dfct[t3 - 1] += t2;
		    arrayu_2.u[arc - 1] += t2;
		    arrayx_2.x[arc - 1] = 0;
		}
		array9_2.rc[arc - 1] = t1 + delprc;
		if (array9_2.rc[arc - 1] == 0) {
		    *delx += arrayx_2.x[arc - 1];
		    ++nb;
		    blk2_3.prdcsr[nb - 1] = arc;
		}
	    } else {
		arc = -arc;
		t1 = array9_2.rc[arc - 1];
		if (t1 == 0) {
		    t2 = arrayu_2.u[arc - 1];
		    t3 = arrays_2.startn[arc - 1];
		    arrayb_2.dfct[t3 - 1] += t2;
		    t3 = arraye_2.endn[arc - 1];
		    arrayb_2.dfct[t3 - 1] -= t2;
		    arrayx_2.x[arc - 1] += t2;
		    arrayu_2.u[arc - 1] = 0;
		}
		array9_2.rc[arc - 1] = t1 - delprc;
		if (array9_2.rc[arc - 1] == 0) {
		    *delx += arrayu_2.u[arc - 1];
		    ++nb;
		    blk2_3.prdcsr[nb - 1] = arc;
		}
	    }
/* L6: */
	}

    }
    if (*delx <= -(*dm)) {
	delprc = input_1.large;
	i__1 = nsave;
	for (i = 1; i <= i__1; ++i) {
	    arc = blk7_2.save[i - 1];
	    if (arc > 0) {
		rdcost = array9_2.rc[arc - 1];
		if (rdcost < 0 && rdcost > -delprc) {
		    delprc = -rdcost;
		}
	    } else {
		arc = -arc;
		rdcost = array9_2.rc[arc - 1];
		if (rdcost > 0 && rdcost < delprc) {
		    delprc = rdcost;
		}
	    }
/* L10: */
	}
	if (delprc != input_1.large || *delx < -(*dm)) {
	    goto L4;
	}
    }

/*     *** Add new balance arcs to the superset of balanced arcs.  *** */

    i__1 = nb;
    for (i = 1; i <= i__1; ++i) {
	arc = blk2_3.prdcsr[i - 1];
	if (blk13_2.tnxtin[arc - 1] == -1) {
	    j = arraye_2.endn[arc - 1];
	    blk13_2.tnxtin[arc - 1] = blk12_2.tfstin[j - 1];
	    blk12_2.tfstin[j - 1] = arc;
	}
	if (blk11_2.tnxtou[arc - 1] == -1) {
	    j = arrays_2.startn[arc - 1];
	    blk11_2.tnxtou[arc - 1] = blk10_2.tfstou[j - 1];
	    blk10_2.tfstou[j - 1] = arc;
	}
/* L9: */
    }

    return 0;
} /* ascnt2_ */

/* Main program alias */ /*int main_ () { MAIN__ (); }*/
