/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:41 */
/*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */
#include <math.h>
#include "fcrt.h"
#include "ddaslv.h"
#include <stdlib.h>
		/* PARAMETER translations */
#define	IDB	6
#define	LCJ	1
#define	LIPVT	31
#define	LIRES	3
#define	LMAT	9
#define	LML	1
#define	LMU	2
#define	LWM	5
#define	REVLOC	21
		/* end of PARAMETER translations */
 
void /*FUNCTION*/ ddaslv(
long neq,
long *ldd,
double *x,
double y[],
double yprime[],
double delta[],
void (*ddasf)(double*,double[],double[],double[],double[],long*,double*,long*,double[],long[]),
long info[],
long iwork[],
double rwork[])
{
	long int ires, lmata, meband;
		/* OFFSET Vectors w/subscript range: 1 to dimension */
	double *const Delta = &delta[0] - 1;
	long *const Info = &info[0] - 1;
	long *const Iwork = &iwork[0] - 1;
	double *const Rwork = &rwork[0] - 1;
	double *const Y = &y[0] - 1;
	double *const Yprime = &yprime[0] - 1;
		/* end of OFFSET VECTORS */
 
	/* Copyright (c) 2006, Math a la Carte, Inc.
	 *>> 2008-08-26 ddaslv Hanson add argument of leading dimension to ddasf
	 *>> 2001-12-12 ddaslv Krogh  Changed code for reverse communication
	 *>> 2001-11-23 ddaslv Krogh  Changed many names per library conventions.
	 *>> 2001-11-04 ddaslv Krogh  Fixes for F77 and conversion to single
	 *>> 2001-11-01 ddaslv Hanson Provide code to Math a la Carte.
	 *--D replaces "?": ?daslv, ?daslx, ?gbsl, ?gesl, ?dasf, ?dasdb
	 ****BEGIN PROLOGUE  DDASLV
	 ****SUBSIDIARY
	 ****PURPOSE  Linear system solver for DDASLX.
	 ****LIBRARY   SLATEC (DDASLX)
	 ****TYPE      DOUBLE PRECISION (SDASLV-S, DDASLV-D)
	 ****AUTHOR  Petzold, Linda R., (LLNL)
	 ****DESCRIPTION
	 *-----------------------------------------------------------------------
	 *     THIS ROUTINE MANAGES THE SOLUTION OF THE LINEAR
	 *     SYSTEM ARISING IN THE NEWTON ITERATION.
	 *     MATRICES AND REAL TEMPORARY STORAGE AND
	 *     REAL INFORMATION ARE STORED IN THE ARRAY rwork(iwork(lwm)).
	 *     INTEGER MATRIX INFORMATION IS STORED IN
	 *     THE ARRAY IWORK.
	 *     FOR A DENSE MATRIX, THE LINPACK ROUTINE
	 *     DGESL IS CALLED.
	 *     FOR A BANDED MATRIX,THE LINPACK ROUTINE
	 *     DGBSL IS CALLED. */
	/*     A user routine interior to DDASF or reverse communication
	 *     may also be called.  That is why the current values of Y(*)
	 *     and YPRIME(*) are passed to this routine.  For example an
	 *     iterative solver will typically need this information.
	 *-----------------------------------------------------------------------
	 ****ROUTINES CALLED  DGBSL, DGESL, DDASF
	 ****REVISION HISTORY  (YYMMDD)
	 *   830315  DATE WRITTEN
	 *   901009  Finished conversion to SLATEC 4.0 format (F.N.Fritsch)
	 *   901019  Merged changes made by C. Ulrich with SLATEC 4.0 format.
	 *   901026  Added explicit declarations for all variables and minor
	 *           cosmetic changes to prologue.  (FNF)
	 *   981130  Put in reverse communication and forward communication
	 *           solution steps, RJH.
	 ****END PROLOGUE  DDASLV
	 * */
 
 
 
	/*     POINTERS INTO IWORK */
 
	/*     POINTERS INTO RWORK */
 
	/*     POINTERS INTO INFO */
 
	/****FIRST EXECUTABLE STATEMENT  DDASLV */
	lmata = labs( Iwork[LMAT] );
	if (lmata <= 2)
	{
		/*                          Dense matrix */
		dgesl( &Rwork[Iwork[LWM]], *ldd, neq, &Iwork[LIPVT], delta,
		 0 );
	}
	else if (lmata <= 4)
	{
		/*                          Banded matrix */
		meband = 2*Iwork[LML] + Iwork[LMU] + 1;
		dgbsl( &Rwork[Iwork[LWM]], meband, neq, Iwork[LML], Iwork[LMU],
		 &Iwork[LIPVT], delta, 0 );
	}
	else if ((lmata == 6) || (lmata >= 11))
	{
		/*                          User solves with reverse communication */
		Iwork[LIRES] = 4;
		Iwork[REVLOC] = -1;
	}
	else
	{
		/*                          User solves in ddasf */
		ires = 4;
		if (Info[IDB] != 0)
			ddasdb( 2, neq, *x, y, yprime, info, rwork, iwork, ires,
			 rwork, rwork );
		(*ddasf)( x, y, yprime, delta, &Rwork[Iwork[LWM]], ldd, &Rwork[LCJ],
		 &ires, rwork, iwork );
 
		if (Info[IDB] != 0)
			ddasdb( 3, neq, *x, y, yprime, info, rwork, iwork, ires,
			 rwork, rwork );
	}
	return;
	/*------END OF SUBROUTINE DDASLV------ */
} /* end of function */