got the Linear programming routines to work within the Cantera
directory. I had forgot to include several files. You can now turn these on via a Makefile flag
This commit is contained in:
Harry Moffat
parent
0c4e09876d
commit
c96226700e
10 changed files with 2659 additions and 19 deletions
|
|
@ -9,7 +9,7 @@
|
|||
###############################################################
|
||||
|
||||
.SUFFIXES :
|
||||
.SUFFIXES : .cpp .d .o .h
|
||||
.SUFFIXES : .cpp .c .d .o .h
|
||||
|
||||
INCDIR = ../../../build/include/cantera/kernel
|
||||
INSTALL_TSC = ../../../bin/install_tsc
|
||||
|
|
@ -17,6 +17,10 @@ do_ranlib = @DO_RANLIB@
|
|||
|
||||
do_VCSnonideal = @COMPILE_VCSNONIDEAL@
|
||||
|
||||
#
|
||||
# Decide whether ot use the linear programmaing module lookalike
|
||||
# (from Goodwin's code). Both should produce the same results.
|
||||
do_AltLinProg = 1
|
||||
|
||||
debug_mode = @CANTERA_DEBUG_MODE@
|
||||
ifeq ($(debug_mode), 1)
|
||||
|
|
@ -35,7 +39,13 @@ endif
|
|||
#
|
||||
#LOCAL_DEFS=-DDEBUG_BASISOPTIMIZE
|
||||
#
|
||||
LOCAL_DEFS=-DDEBUG_BASISOPTIMIZE -DDEBUG_CHEMEQUIL -DCANTERA_SRC_TREE -DALTLINPROG -DDEBUG
|
||||
|
||||
ifeq ($(do_AltLinProg), 1)
|
||||
DALT_STR=-DALTLINPROG
|
||||
endif
|
||||
LOCAL_DEFS=-DDEBUG_BASISOPTIMIZE -DDEBUG_CHEMEQUIL \
|
||||
-DDEBUG $(DALT_STR)
|
||||
#
|
||||
#
|
||||
PIC_FLAG=@PIC@
|
||||
|
||||
|
|
@ -46,6 +56,15 @@ EQUIL_OBJ = BasisOptimize.o ChemEquil.o MultiPhase.o MultiPhaseEquil.o equilibra
|
|||
|
||||
EQUIL_H = ChemEquil.h MultiPhase.h MultiPhaseEquil.h equil.h PropertyCalculator.h
|
||||
|
||||
# depending on the option, different object files are used
|
||||
ifeq ($(do_AltLinProg), 1)
|
||||
DALT_OBJ=vcs_setMolesLinProg.o
|
||||
else
|
||||
DALT_OBJ=vcs_linmaxc.o vcs_dbocls.o vcs_dbols.o vcs_dbolsm.o vcs_dmout.o \
|
||||
vcs_dvout.o vcs_ivout.o vcs_xerror.o
|
||||
endif
|
||||
|
||||
|
||||
ifeq ($(do_VCSnonideal), 1)
|
||||
VCSNONIDEAL_OBJ = vcs_solve_TP.o vcs_VolPhase.o vcs_solve.o vcs_prob.o \
|
||||
vcs_TP.o vcs_TV.o vcs_report.o vcs_util.o \
|
||||
|
|
@ -54,8 +73,10 @@ VCSNONIDEAL_OBJ = vcs_solve_TP.o vcs_VolPhase.o vcs_solve.o vcs_prob.o \
|
|||
vcs_nasa_poly.o vcs_nondim.o vcs_Exception.o \
|
||||
vcs_funcVtot.o vcs_inest.o vcs_rearrange.o \
|
||||
vcs_root1d.o vcs_rxnadj.o vcs_timer_generic.o \
|
||||
vcs_SpeciesProperties.o vcs_setMolesLinProg.o \
|
||||
vcs_prep.o vcs_species_thermo.o vcs_Gibbs.o
|
||||
vcs_SpeciesProperties.o \
|
||||
vcs_prep.o vcs_species_thermo.o vcs_Gibbs.o \
|
||||
$(DALT_OBJ)
|
||||
|
||||
VCSNONIDEAL_H = vcs_internal.h vcs_VolPhase.h vcs_solve.h vcs_prob.h \
|
||||
vcs_IntStarStar.h vcs_DoubleStarStar.h vcs_defs.h \
|
||||
vcs_MultiPhaseEquil.h vcs_nasa_poly.h vcs_Exception.h \
|
||||
|
|
@ -77,12 +98,18 @@ all: $(LIB) $(VLIB) .depends
|
|||
$(INSTALL_TSC) "$${lh}" $(INCDIR) ; \
|
||||
done)
|
||||
|
||||
%.d: Makefile %.o
|
||||
@CXX_DEPENDS@ $(CXX_FLAGS) $(CXX_INCLUDES) $*.cpp > $*.d
|
||||
.cpp.d: Makefile %.o
|
||||
g++ -MM $(CXX_FLAGS) $(CXX_INCLUDES) $*.cpp > $*.d
|
||||
|
||||
.c.d: Makefile %.o
|
||||
g++ -MM $(CXX_FLAGS) $(CXX_INCLUDES) -I../../../ext/f2c_libs $*.c > $*.d
|
||||
|
||||
.cpp.o:
|
||||
@CXX@ -c $< $(CXX_FLAGS) $(CXX_INCLUDES)
|
||||
|
||||
.c.o:
|
||||
@CC@ -c $< $(CXX_FLAGS) $(CXX_INCLUDES) -I../../../ext/f2c_libs
|
||||
|
||||
$(LIB): $(EQUIL_OBJ) $(EQUIL_H) $(VCSNONIDEAL_OBJ) $(VCSNONIDEAL_H)
|
||||
@ARCHIVE@ $(LIB) $(EQUIL_OBJ) $(VCSNONIDEAL_OBJ) > /dev/null
|
||||
ifeq ($(do_ranlib),1)
|
||||
|
|
@ -96,9 +123,8 @@ ifeq ($(do_ranlib),1)
|
|||
endif
|
||||
|
||||
|
||||
|
||||
clean:
|
||||
@(for lh in dummy.h $(EQUIL_H) ; do \
|
||||
@(for lh in dummy.h $(EQUIL_H) $(VCSNONIDEAL_H); do \
|
||||
th=$(INCDIR)/"$${lh}" ; \
|
||||
if test -f "$${th}" ; then \
|
||||
$(RM) "$${th}" ; \
|
||||
|
|
|
|||
|
|
@ -13,8 +13,7 @@
|
|||
#ifndef VCS_MULTIPHASEEQUIL_H
|
||||
#define VCS_MULTIPHASEEQUIL_H
|
||||
|
||||
|
||||
#ifdef CANTERA_NOTIN_SRC_TREE
|
||||
#ifdef CANTERA_APP
|
||||
#include "cantera/kernel/ct_defs.h"
|
||||
#include "cantera/kernel/MultiPhase.h"
|
||||
#else
|
||||
|
|
|
|||
|
|
@ -719,7 +719,8 @@ static integer c__4 = 4;
|
|||
drelpr = d1mach_(&c__4);
|
||||
checkl = FALSE_;
|
||||
filter = TRUE_;
|
||||
lenx = (*ncols + *mcon << 1) + 2;
|
||||
/*lenx = (*ncols + *mcon << 1) + 2;*/
|
||||
lenx = ((*ncols + *mcon) << 1) + 2;
|
||||
iscale = 1;
|
||||
igo = 1;
|
||||
accum = FALSE_;
|
||||
|
|
@ -1302,11 +1303,13 @@ L230:
|
|||
liw = 1;
|
||||
|
||||
/* SET THE NEW TRIANGULARIZATION FACTOR. */
|
||||
x[(*ncols + *mcon << 1) + 1] = zero;
|
||||
/*x[(*ncols + *mcon << 1) + 1] = zero;*/
|
||||
x[((*ncols + *mcon) << 1) + 1] = zero;
|
||||
|
||||
/* SET THE WEIGHT TO USE IN COMPONENTS .GT. MCON, */
|
||||
/* WHEN MAKING LINEAR INDEPENDENCE TEST. */
|
||||
x[(*ncols + *mcon << 1) + 2] = one / wt;
|
||||
/*x[(*ncols + *mcon << 1) + 2] = one / wt; */
|
||||
x[((*ncols + *mcon) << 1) + 2] = one / wt;
|
||||
i__1 = mout + *mcon;
|
||||
i__2 = *ncols + *mcon;
|
||||
dbols_(&w[w_offset], mdw, &i__1, &i__2, &bl[1], &bu[1], &ind[1], &iopt[
|
||||
|
|
|
|||
1574
Cantera/src/equil/vcs_dbolsm.c
Normal file
1574
Cantera/src/equil/vcs_dbolsm.c
Normal file
File diff suppressed because it is too large
Load diff
476
Cantera/src/equil/vcs_dmout.c
Normal file
476
Cantera/src/equil/vcs_dmout.c
Normal file
|
|
@ -0,0 +1,476 @@
|
|||
/* dmout.f -- translated by f2c (version 20031025).
|
||||
You must link the resulting object file with libf2c:
|
||||
on Microsoft Windows system, link with libf2c.lib;
|
||||
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
|
||||
or, if you install libf2c.a in a standard place, with -lf2c -lm
|
||||
-- in that order, at the end of the command line, as in
|
||||
cc *.o -lf2c -lm
|
||||
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
|
||||
|
||||
http://www.netlib.org/f2c/libf2c.zip
|
||||
*/
|
||||
|
||||
#include "f2c.h"
|
||||
|
||||
/* Table of constant values */
|
||||
|
||||
static integer c__2 = 2;
|
||||
static integer c__1 = 1;
|
||||
|
||||
/* DECK DMOUT */
|
||||
/* Subroutine */ int dmout_(integer *m, integer *n, integer *lda, doublereal *
|
||||
a, char *ifmt, integer *idigit, ftnlen ifmt_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
static char icol[3] = "COL";
|
||||
|
||||
/* Format strings */
|
||||
static char fmt_1010[] = "(10x,10(4x,a,i4,1x))";
|
||||
static char fmt_1009[] = "(1x,\002ROW\002,i4,2x,1p10d12.3)";
|
||||
static char fmt_1000[] = "(10x,8(5x,a,i4,2x))";
|
||||
static char fmt_1004[] = "(1x,\002ROW\002,i4,2x,1p8d14.5)";
|
||||
static char fmt_1001[] = "(10x,5(9x,a,i4,6x))";
|
||||
static char fmt_1005[] = "(1x,\002ROW\002,i4,2x,1p5d22.13)";
|
||||
static char fmt_1002[] = "(10x,4(12x,a,i4,9x))";
|
||||
static char fmt_1006[] = "(1x,\002ROW\002,i4,2x,1p4d28.19)";
|
||||
static char fmt_1003[] = "(10x,3(16x,a,i4,13x))";
|
||||
static char fmt_1007[] = "(1x,\002ROW\002,i4,2x,1p3d36.27)";
|
||||
|
||||
/* System generated locals */
|
||||
integer a_dim1, a_offset, i__1, i__2, i__3;
|
||||
cilist ci__1;
|
||||
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
static integer i__, j, k1, k2, lout;
|
||||
extern integer i1mach_(integer *);
|
||||
static integer ndigit;
|
||||
|
||||
/* Fortran I/O blocks */
|
||||
static cilist io___6 = { 0, 0, 0, fmt_1010, 0 };
|
||||
static cilist io___8 = { 0, 0, 0, fmt_1009, 0 };
|
||||
static cilist io___10 = { 0, 0, 0, fmt_1000, 0 };
|
||||
static cilist io___11 = { 0, 0, 0, fmt_1004, 0 };
|
||||
static cilist io___12 = { 0, 0, 0, fmt_1001, 0 };
|
||||
static cilist io___13 = { 0, 0, 0, fmt_1005, 0 };
|
||||
static cilist io___14 = { 0, 0, 0, fmt_1002, 0 };
|
||||
static cilist io___15 = { 0, 0, 0, fmt_1006, 0 };
|
||||
static cilist io___16 = { 0, 0, 0, fmt_1003, 0 };
|
||||
static cilist io___17 = { 0, 0, 0, fmt_1007, 0 };
|
||||
static cilist io___18 = { 0, 0, 0, fmt_1000, 0 };
|
||||
static cilist io___19 = { 0, 0, 0, fmt_1009, 0 };
|
||||
static cilist io___20 = { 0, 0, 0, fmt_1000, 0 };
|
||||
static cilist io___21 = { 0, 0, 0, fmt_1004, 0 };
|
||||
static cilist io___22 = { 0, 0, 0, fmt_1001, 0 };
|
||||
static cilist io___23 = { 0, 0, 0, fmt_1005, 0 };
|
||||
static cilist io___24 = { 0, 0, 0, fmt_1002, 0 };
|
||||
static cilist io___25 = { 0, 0, 0, fmt_1006, 0 };
|
||||
static cilist io___26 = { 0, 0, 0, fmt_1003, 0 };
|
||||
static cilist io___27 = { 0, 0, 0, fmt_1007, 0 };
|
||||
|
||||
|
||||
/* ***BEGIN PROLOGUE DMOUT */
|
||||
/* ***REFER TO DBOCLS,DFC */
|
||||
/* ***ROUTINES CALLED I1MACH */
|
||||
/* ***DESCRIPTION */
|
||||
|
||||
/* DOUBLE PRECISION MATRIX OUTPUT ROUTINE. */
|
||||
|
||||
/* INPUT.. */
|
||||
|
||||
/* M,N,LDA,A(*,*) PRINT THE DOUBLE PRECISION ARRAY A(I,J),I = 1,...,M, */
|
||||
/* J=1,...,N, ON OUTPUT UNIT LOUT=6. LDA IS THE DECLARED */
|
||||
/* FIRST DIMENSION OF A(*,*) AS SPECIFIED IN THE CALLING */
|
||||
/* PROGRAM. THE HEADING IN THE FORTRAN FORMAT STATEMENT */
|
||||
/* IFMT(*), DESCRIBED BELOW, IS PRINTED AS A FIRST STEP. */
|
||||
/* THE COMPONENTS A(I,J) ARE INDEXED, ON OUTPUT, IN A */
|
||||
/* PLEASANT FORMAT. */
|
||||
/* IFMT(*) A FORTRAN FORMAT STATEMENT. THIS IS PRINTED ON */
|
||||
/* OUTPUT UNIT LOUT=6 WITH THE VARIABLE FORMAT FORTRAN */
|
||||
/* STATEMENT */
|
||||
/* WRITE(LOUT,IFMT). */
|
||||
/* IDIGIT PRINT AT LEAST IABS(IDIGIT) DECIMAL DIGITS PER NUMBER. */
|
||||
/* THE SUBPROGRAM WILL CHOOSE THAT INTEGER 4,6,14,20 OR */
|
||||
/* 28 WHICH WILL PRINT AT LEAST IABS(IDIGIT) NUMBER OF */
|
||||
/* PLACES. IF IDIGIT.LT.0, 72 PRINTING COLUMNS ARE */
|
||||
/* UTILIZED TO WRITE EACH LINE OF OUTPUT OF THE ARRAY */
|
||||
/* A(*,*). (THIS CAN BE USED ON MOST TIME-SHARING */
|
||||
/* TERMINALS). IF IDIGIT.GE.0, 133 PRINTING COLUMNS ARE */
|
||||
/* UTILIZED. (THIS CAN BE USED ON MOST LINE PRINTERS). */
|
||||
|
||||
/* EXAMPLE.. */
|
||||
|
||||
/* PRINT AN ARRAY CALLED (SIMPLEX TABLEAU ) OF SIZE 10 BY 20 SHOWING */
|
||||
/* 6 DECIMAL DIGITS PER NUMBER. THE USER IS RUNNING ON A TIME-SHARING */
|
||||
/* SYSTEM WITH A 72 COLUMN OUTPUT DEVICE. */
|
||||
|
||||
/* DOUBLE PRECISION TABLEU(20,20) */
|
||||
/* M = 10 */
|
||||
/* N = 20 */
|
||||
/* LDTABL = 20 */
|
||||
/* IDIGIT = -6 */
|
||||
/* CALL DMOUT(M,N,LDTABL,TABLEU,21H(16H1SIMPLEX TABLEAU),IDIGIT) */
|
||||
|
||||
|
||||
|
||||
/* AUTHORS JOHN A. WISNIEWSKI SANDIA LABS ALBUQUERQUE. */
|
||||
/* RICHARD J. HANSON SANDIA LABS ALBUQUERQUE. */
|
||||
/* DATE JULY 30,1978. */
|
||||
/* ***END PROLOGUE DMOUT */
|
||||
/* Parameter adjustments */
|
||||
a_dim1 = *lda;
|
||||
a_offset = 1 + a_dim1;
|
||||
a -= a_offset;
|
||||
|
||||
/* Function Body */
|
||||
/* ***FIRST EXECUTABLE STATEMENT DMOUT */
|
||||
lout = i1mach_(&c__2);
|
||||
ci__1.cierr = 0;
|
||||
ci__1.ciunit = lout;
|
||||
ci__1.cifmt = ifmt;
|
||||
s_wsfe(&ci__1);
|
||||
e_wsfe();
|
||||
if (*m <= 0 || *n <= 0 || *lda <= 0) {
|
||||
return 0;
|
||||
}
|
||||
ndigit = *idigit;
|
||||
if (*idigit == 0) {
|
||||
ndigit = 4;
|
||||
}
|
||||
if (*idigit >= 0) {
|
||||
goto L80;
|
||||
}
|
||||
|
||||
ndigit = -(*idigit);
|
||||
if (ndigit > 4) {
|
||||
goto L9;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 5) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 4;
|
||||
k2 = min(i__2,i__3);
|
||||
io___6.ciunit = lout;
|
||||
s_wsfe(&io___6);
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
io___8.ciunit = lout;
|
||||
s_wsfe(&io___8);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L5: */
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
L9:
|
||||
if (ndigit > 6) {
|
||||
goto L20;
|
||||
}
|
||||
|
||||
i__2 = *n;
|
||||
for (k1 = 1; k1 <= i__2; k1 += 4) {
|
||||
/* Computing MIN */
|
||||
i__1 = *n, i__3 = k1 + 3;
|
||||
k2 = min(i__1,i__3);
|
||||
io___10.ciunit = lout;
|
||||
s_wsfe(&io___10);
|
||||
i__1 = k2;
|
||||
for (i__ = k1; i__ <= i__1; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
io___11.ciunit = lout;
|
||||
s_wsfe(&io___11);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L10: */
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
L20:
|
||||
if (ndigit > 14) {
|
||||
goto L40;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 2) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 1;
|
||||
k2 = min(i__2,i__3);
|
||||
io___12.ciunit = lout;
|
||||
s_wsfe(&io___12);
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
io___13.ciunit = lout;
|
||||
s_wsfe(&io___13);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L30: */
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
L40:
|
||||
if (ndigit > 20) {
|
||||
goto L60;
|
||||
}
|
||||
|
||||
i__2 = *n;
|
||||
for (k1 = 1; k1 <= i__2; k1 += 2) {
|
||||
/* Computing MIN */
|
||||
i__1 = *n, i__3 = k1 + 1;
|
||||
k2 = min(i__1,i__3);
|
||||
io___14.ciunit = lout;
|
||||
s_wsfe(&io___14);
|
||||
i__1 = k2;
|
||||
for (i__ = k1; i__ <= i__1; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
io___15.ciunit = lout;
|
||||
s_wsfe(&io___15);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L50: */
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
L60:
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; ++k1) {
|
||||
k2 = k1;
|
||||
io___16.ciunit = lout;
|
||||
s_wsfe(&io___16);
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
io___17.ciunit = lout;
|
||||
s_wsfe(&io___17);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L70: */
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
L80:
|
||||
if (ndigit > 4) {
|
||||
goto L86;
|
||||
}
|
||||
|
||||
i__2 = *n;
|
||||
for (k1 = 1; k1 <= i__2; k1 += 10) {
|
||||
/* Computing MIN */
|
||||
i__1 = *n, i__3 = k1 + 9;
|
||||
k2 = min(i__1,i__3);
|
||||
io___18.ciunit = lout;
|
||||
s_wsfe(&io___18);
|
||||
i__1 = k2;
|
||||
for (i__ = k1; i__ <= i__1; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
io___19.ciunit = lout;
|
||||
s_wsfe(&io___19);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L85: */
|
||||
}
|
||||
}
|
||||
|
||||
L86:
|
||||
if (ndigit > 6) {
|
||||
goto L100;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 8) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 7;
|
||||
k2 = min(i__2,i__3);
|
||||
io___20.ciunit = lout;
|
||||
s_wsfe(&io___20);
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
io___21.ciunit = lout;
|
||||
s_wsfe(&io___21);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L90: */
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
L100:
|
||||
if (ndigit > 14) {
|
||||
goto L120;
|
||||
}
|
||||
|
||||
i__2 = *n;
|
||||
for (k1 = 1; k1 <= i__2; k1 += 5) {
|
||||
/* Computing MIN */
|
||||
i__1 = *n, i__3 = k1 + 4;
|
||||
k2 = min(i__1,i__3);
|
||||
io___22.ciunit = lout;
|
||||
s_wsfe(&io___22);
|
||||
i__1 = k2;
|
||||
for (i__ = k1; i__ <= i__1; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
io___23.ciunit = lout;
|
||||
s_wsfe(&io___23);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L110: */
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
L120:
|
||||
if (ndigit > 20) {
|
||||
goto L140;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 4) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 3;
|
||||
k2 = min(i__2,i__3);
|
||||
io___24.ciunit = lout;
|
||||
s_wsfe(&io___24);
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
io___25.ciunit = lout;
|
||||
s_wsfe(&io___25);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L130: */
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
L140:
|
||||
i__2 = *n;
|
||||
for (k1 = 1; k1 <= i__2; k1 += 3) {
|
||||
/* Computing MIN */
|
||||
i__1 = *n, i__3 = k1 + 2;
|
||||
k2 = min(i__1,i__3);
|
||||
io___26.ciunit = lout;
|
||||
s_wsfe(&io___26);
|
||||
i__1 = k2;
|
||||
for (i__ = k1; i__ <= i__1; ++i__) {
|
||||
do_fio(&c__1, icol, (ftnlen)3);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
io___27.ciunit = lout;
|
||||
s_wsfe(&io___27);
|
||||
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
|
||||
i__3 = k2;
|
||||
for (j = k1; j <= i__3; ++j) {
|
||||
do_fio(&c__1, (char *)&a[i__ + j * a_dim1], (ftnlen)sizeof(
|
||||
doublereal));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L150: */
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
} /* dmout_ */
|
||||
|
||||
|
|
@ -24,11 +24,6 @@
|
|||
namespace VCSnonideal {
|
||||
|
||||
static char pprefix[20] = " --- vcs_inest: ";
|
||||
|
||||
#ifdef ALTLINPROG
|
||||
#else
|
||||
extern int linprogmax(double *, double *, double *, double *, int, int, int);
|
||||
#endif
|
||||
/*****************************************************************************/
|
||||
/*****************************************************************************/
|
||||
/*****************************************************************************/
|
||||
|
|
|
|||
298
Cantera/src/equil/vcs_ivout.c
Normal file
298
Cantera/src/equil/vcs_ivout.c
Normal file
|
|
@ -0,0 +1,298 @@
|
|||
/* ivout.f -- translated by f2c (version 20031025).
|
||||
You must link the resulting object file with libf2c:
|
||||
on Microsoft Windows system, link with libf2c.lib;
|
||||
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
|
||||
or, if you install libf2c.a in a standard place, with -lf2c -lm
|
||||
-- in that order, at the end of the command line, as in
|
||||
cc *.o -lf2c -lm
|
||||
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
|
||||
|
||||
http://www.netlib.org/f2c/libf2c.zip
|
||||
*/
|
||||
|
||||
#include "f2c.h"
|
||||
|
||||
/* Table of constant values */
|
||||
|
||||
static integer c__1 = 1;
|
||||
|
||||
/* DECK IVOUT */
|
||||
/* Subroutine */ int ivout_(integer *n, integer *ix, char *ifmt, integer *
|
||||
idigit, ftnlen ifmt_len)
|
||||
{
|
||||
/* Format strings */
|
||||
static char fmt_1000[] = "(1x,i4,\002 - \002,i4,20(1x,i5))";
|
||||
static char fmt_1001[] = "(1x,i4,\002 - \002,i4,15(1x,i7))";
|
||||
static char fmt_1002[] = "(1x,i4,\002 - \002,i4,10(1x,i11))";
|
||||
static char fmt_1003[] = "(1x,i4,\002 - \002,i4,7(1x,i15))";
|
||||
|
||||
/* System generated locals */
|
||||
integer i__1, i__2, i__3;
|
||||
cilist ci__1;
|
||||
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
static integer i__, j, k1, k2, lout;
|
||||
extern integer i1mach_(integer *);
|
||||
static integer ndigit;
|
||||
|
||||
/* Fortran I/O blocks */
|
||||
static cilist io___6 = { 0, 0, 0, fmt_1000, 0 };
|
||||
static cilist io___8 = { 0, 0, 0, fmt_1001, 0 };
|
||||
static cilist io___9 = { 0, 0, 0, fmt_1002, 0 };
|
||||
static cilist io___10 = { 0, 0, 0, fmt_1003, 0 };
|
||||
static cilist io___11 = { 0, 0, 0, fmt_1000, 0 };
|
||||
static cilist io___12 = { 0, 0, 0, fmt_1001, 0 };
|
||||
static cilist io___13 = { 0, 0, 0, fmt_1002, 0 };
|
||||
static cilist io___14 = { 0, 0, 0, fmt_1003, 0 };
|
||||
|
||||
|
||||
/* ***BEGIN PROLOGUE IVOUT */
|
||||
/* ***REFER TO SPLP */
|
||||
/* ***ROUTINES CALLED I1MACH */
|
||||
/* ***DESCRIPTION */
|
||||
|
||||
/* REVISED FEB. 27, 1981. */
|
||||
|
||||
/* INTEGER VECTOR OUTPUT ROUTINE. */
|
||||
|
||||
/* INPUT.. */
|
||||
|
||||
/* N,IX(*) PRINT THE INTEGER ARRAY IX(I),I=1,...,N, ON OUTPUT */
|
||||
/* UNIT LOUT. THE HEADING IN THE FORTRAN FORMAT */
|
||||
/* STATEMENT IFMT(*), DESCRIBED BELOW, IS PRINTED AS A FIRST */
|
||||
/* STEP. THE COMPONENTS IX(I) ARE INDEXED, ON OUTPUT, */
|
||||
/* IN A PLEASANT FORMAT. */
|
||||
/* IFMT(*) A FORTRAN FORMAT STATEMENT. THIS IS PRINTED ON OUTPUT */
|
||||
/* UNIT LOUT WITH THE VARIABLE FORMAT FORTRAN STATEMENT */
|
||||
/* WRITE(LOUT,IFMT) */
|
||||
/* IDIGIT PRINT UP TO IABS(IDIGIT) DECIMAL DIGITS PER NUMBER. */
|
||||
/* THE SUBPROGRAM WILL CHOOSE THAT INTEGER 4,6,10 OR 14 */
|
||||
/* WHICH WILL PRINT AT LEAST IABS(IDIGIT) NUMBER OF */
|
||||
/* PLACES. IF IDIGIT.LT.0, 72 PRINTING COLUMNS ARE UTILIZED */
|
||||
/* TO WRITE EACH LINE OF OUTPUT OF THE ARRAY IX(*). (THIS */
|
||||
/* CAN BE USED ON MOST TIME-SHARING TERMINALS). IF */
|
||||
/* IDIGIT.GE.0, 133 PRINTING COLUMNS ARE UTILIZED. (THIS CAN */
|
||||
/* BE USED ON MOST LINE PRINTERS). */
|
||||
|
||||
/* EXAMPLE.. */
|
||||
|
||||
/* PRINT AN ARRAY CALLED (COSTS OF PURCHASES) OF LENGTH 100 SHOWING */
|
||||
/* 6 DECIMAL DIGITS PER NUMBER. THE USER IS RUNNING ON A TIME-SHARING */
|
||||
/* SYSTEM WITH A 72 COLUMN OUTPUT DEVICE. */
|
||||
|
||||
/* DIMENSION ICOSTS(100) */
|
||||
/* N = 100 */
|
||||
/* IDIGIT = -6 */
|
||||
/* CALL IVOUT(N,ICOSTS,'(''1COSTS OF PURCHASES'')',IDIGIT) */
|
||||
|
||||
|
||||
|
||||
/* AUTHORS JOHN A. WISNIEWSKI SANDIA LABS ALBUQUERQUE. */
|
||||
/* RICHARD J. HANSON SANDIA LABS ALBUQUERQUE. */
|
||||
/* DATE JULY 27,1978. */
|
||||
/* ***END PROLOGUE IVOUT */
|
||||
|
||||
/* GET THE UNIT NUMBER WHERE OUTPUTWILL BE WRITTEN. */
|
||||
/* ***FIRST EXECUTABLE STATEMENT IVOUT */
|
||||
/* Parameter adjustments */
|
||||
--ix;
|
||||
|
||||
/* Function Body */
|
||||
j = 2;
|
||||
lout = i1mach_(&j);
|
||||
ci__1.cierr = 0;
|
||||
ci__1.ciunit = lout;
|
||||
ci__1.cifmt = ifmt;
|
||||
s_wsfe(&ci__1);
|
||||
e_wsfe();
|
||||
if (*n <= 0) {
|
||||
return 0;
|
||||
}
|
||||
ndigit = *idigit;
|
||||
if (*idigit == 0) {
|
||||
ndigit = 4;
|
||||
}
|
||||
if (*idigit >= 0) {
|
||||
goto L80;
|
||||
}
|
||||
|
||||
ndigit = -(*idigit);
|
||||
if (ndigit > 4) {
|
||||
goto L20;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 10) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 9;
|
||||
k2 = min(i__2,i__3);
|
||||
io___6.ciunit = lout;
|
||||
s_wsfe(&io___6);
|
||||
do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer));
|
||||
do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer));
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L10: */
|
||||
}
|
||||
return 0;
|
||||
|
||||
L20:
|
||||
if (ndigit > 6) {
|
||||
goto L40;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 7) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 6;
|
||||
k2 = min(i__2,i__3);
|
||||
io___8.ciunit = lout;
|
||||
s_wsfe(&io___8);
|
||||
do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer));
|
||||
do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer));
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L30: */
|
||||
}
|
||||
return 0;
|
||||
|
||||
L40:
|
||||
if (ndigit > 10) {
|
||||
goto L60;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 5) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 4;
|
||||
k2 = min(i__2,i__3);
|
||||
io___9.ciunit = lout;
|
||||
s_wsfe(&io___9);
|
||||
do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer));
|
||||
do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer));
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L50: */
|
||||
}
|
||||
return 0;
|
||||
|
||||
L60:
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 3) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 2;
|
||||
k2 = min(i__2,i__3);
|
||||
io___10.ciunit = lout;
|
||||
s_wsfe(&io___10);
|
||||
do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer));
|
||||
do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer));
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L70: */
|
||||
}
|
||||
return 0;
|
||||
|
||||
L80:
|
||||
if (ndigit > 4) {
|
||||
goto L100;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 20) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 19;
|
||||
k2 = min(i__2,i__3);
|
||||
io___11.ciunit = lout;
|
||||
s_wsfe(&io___11);
|
||||
do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer));
|
||||
do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer));
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L90: */
|
||||
}
|
||||
return 0;
|
||||
|
||||
L100:
|
||||
if (ndigit > 6) {
|
||||
goto L120;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 15) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 14;
|
||||
k2 = min(i__2,i__3);
|
||||
io___12.ciunit = lout;
|
||||
s_wsfe(&io___12);
|
||||
do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer));
|
||||
do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer));
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L110: */
|
||||
}
|
||||
return 0;
|
||||
|
||||
L120:
|
||||
if (ndigit > 10) {
|
||||
goto L140;
|
||||
}
|
||||
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 10) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 9;
|
||||
k2 = min(i__2,i__3);
|
||||
io___13.ciunit = lout;
|
||||
s_wsfe(&io___13);
|
||||
do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer));
|
||||
do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer));
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L130: */
|
||||
}
|
||||
return 0;
|
||||
|
||||
L140:
|
||||
i__1 = *n;
|
||||
for (k1 = 1; k1 <= i__1; k1 += 7) {
|
||||
/* Computing MIN */
|
||||
i__2 = *n, i__3 = k1 + 6;
|
||||
k2 = min(i__2,i__3);
|
||||
io___14.ciunit = lout;
|
||||
s_wsfe(&io___14);
|
||||
do_fio(&c__1, (char *)&k1, (ftnlen)sizeof(integer));
|
||||
do_fio(&c__1, (char *)&k2, (ftnlen)sizeof(integer));
|
||||
i__2 = k2;
|
||||
for (i__ = k1; i__ <= i__2; ++i__) {
|
||||
do_fio(&c__1, (char *)&ix[i__], (ftnlen)sizeof(integer));
|
||||
}
|
||||
e_wsfe();
|
||||
/* L150: */
|
||||
}
|
||||
return 0;
|
||||
} /* ivout_ */
|
||||
|
||||
|
|
@ -21,6 +21,7 @@
|
|||
#endif
|
||||
|
||||
#include "vcs_internal.h"
|
||||
#include "vcs_solve.h"
|
||||
|
||||
extern "C" void dbocls_(double *W, int *MDW, int *MCON, int *MROWS,
|
||||
int *NCOLS,
|
||||
|
|
@ -34,6 +35,8 @@ extern "C" void dbocls_(double *W, int *MDW, int *MCON, int *MROWS,
|
|||
******************************************************************************/
|
||||
namespace VCSnonideal {
|
||||
|
||||
#ifdef ALTLINPROG
|
||||
#else
|
||||
int linprogmax(double *XMOLES, double *CC, double *AX, double *BB,
|
||||
int NE, int M, int NE0)
|
||||
|
||||
|
|
@ -146,5 +149,5 @@ int linprogmax(double *XMOLES, double *CC, double *AX, double *BB,
|
|||
|
||||
return 0;
|
||||
}
|
||||
|
||||
#endif
|
||||
}
|
||||
|
|
|
|||
|
|
@ -802,6 +802,11 @@ public:
|
|||
|
||||
};
|
||||
|
||||
#ifdef ALTLINPROG
|
||||
#else
|
||||
int linprogmax(double *, double *, double *, double *, int, int, int);
|
||||
#endif
|
||||
|
||||
}
|
||||
#endif
|
||||
|
||||
|
|
|
|||
261
Cantera/src/equil/vcs_xerror.c
Normal file
261
Cantera/src/equil/vcs_xerror.c
Normal file
|
|
@ -0,0 +1,261 @@
|
|||
/* xerror.f -- translated by f2c (version 20031025).
|
||||
You must link the resulting object file with libf2c:
|
||||
on Microsoft Windows system, link with libf2c.lib;
|
||||
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
|
||||
or, if you install libf2c.a in a standard place, with -lf2c -lm
|
||||
-- in that order, at the end of the command line, as in
|
||||
cc *.o -lf2c -lm
|
||||
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
|
||||
|
||||
http://www.netlib.org/f2c/libf2c.zip
|
||||
*/
|
||||
|
||||
#include "f2c.h"
|
||||
|
||||
/* Table of constant values */
|
||||
|
||||
static integer c__2 = 2;
|
||||
static integer c__1 = 1;
|
||||
|
||||
/* ======================================================================= */
|
||||
/* -------------------------------------------------- */
|
||||
/* | CVS Head Information | */
|
||||
/* -------------------------------------------------- */
|
||||
/* $Author$ */
|
||||
/* $Date$ */
|
||||
/* $Revision$ */
|
||||
/* ======================================================================= */
|
||||
|
||||
/* Subroutine */ int s88fmt_(integer *n, integer *ivalue, integer *ifmt)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
static struct {
|
||||
char e_1[40];
|
||||
integer e_2;
|
||||
} equiv_5 = { "0 1 2 3 4 5 6 7 8 9 ", 0 };
|
||||
|
||||
#define idigit ((integer *)&equiv_5)
|
||||
|
||||
|
||||
static integer it, nt, index;
|
||||
|
||||
/* ----------------------------------------------------------------------- */
|
||||
/* S88FMT replaces ifmt(1), ... ,ifmt(n) with the */
|
||||
/* characters corresponding to the n least significant */
|
||||
/* digits of ivalue. */
|
||||
/* Taken from the Bell laboratories port library error handler */
|
||||
/* latest revision --- 7 June 1978. */
|
||||
|
||||
/* Jones R.E., *SLATEC common mathematical library error handling */
|
||||
/* package*, SAND78-1189, Sandia Laboratories, 1978. */
|
||||
/* ----------------------------------------------------------------------- */
|
||||
/* Parameter adjustments */
|
||||
--ifmt;
|
||||
|
||||
/* Function Body */
|
||||
nt = *n;
|
||||
it = *ivalue;
|
||||
L10:
|
||||
if (nt == 0) {
|
||||
return 0;
|
||||
}
|
||||
index = it % 10;
|
||||
ifmt[nt] = idigit[index];
|
||||
it /= 10;
|
||||
--nt;
|
||||
goto L10;
|
||||
} /* s88fmt_ */
|
||||
|
||||
#undef idigit
|
||||
|
||||
|
||||
|
||||
/* ----------------------------------------------------------------------- */
|
||||
|
||||
/* Subroutine */ int xerrwv_(char *msg, integer *nmes, integer *nerr, integer
|
||||
*iert, integer *ni, integer *i1, integer *i2, integer *nr, real *r1,
|
||||
real *r2, ftnlen msg_len)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
static struct {
|
||||
char e_1[16];
|
||||
integer fill_2[2];
|
||||
char e_3[4];
|
||||
integer fill_4[2];
|
||||
char e_5[8];
|
||||
integer fill_6[1];
|
||||
char e_7[4];
|
||||
} equiv_20 = { "( 1 X , ", {0}, "A ", {0}, ", A ", {0},
|
||||
") " };
|
||||
|
||||
#define nform ((integer *)&equiv_20)
|
||||
|
||||
static integer ncpw = 4;
|
||||
static integer mesflg = 1;
|
||||
static integer lunit = 6;
|
||||
|
||||
/* Format strings */
|
||||
static char fmt_20[] = "(6x,\002IN ABOVE MESSAGE, I1 =\002,i10)";
|
||||
static char fmt_30[] = "(6x,\002IN ABOVE MESSAGE, I1 =\002,i10,3x,\002I"
|
||||
"2 =\002,i10)";
|
||||
static char fmt_40[] = "(6x,\002IN ABOVE MESSAGE, R1 =\002,d21.13)";
|
||||
static char fmt_50[] = "(6x,\002IN ABOVE, R1 =\002,d21.13,3x,\002R2 "
|
||||
"=\002,d21.13)";
|
||||
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
|
||||
/* Builtin functions */
|
||||
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
|
||||
/* Subroutine */ int s_stop(char *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
static integer i__, nch, lun, nrem, nwds;
|
||||
extern /* Subroutine */ int s88fmt_(integer *, integer *, integer *);
|
||||
|
||||
/* Fortran I/O blocks */
|
||||
static cilist io___14 = { 0, 0, 0, (char *)nform, 0 };
|
||||
static cilist io___16 = { 0, 0, 0, fmt_20, 0 };
|
||||
static cilist io___17 = { 0, 0, 0, fmt_30, 0 };
|
||||
static cilist io___18 = { 0, 0, 0, fmt_40, 0 };
|
||||
static cilist io___19 = { 0, 0, 0, fmt_50, 0 };
|
||||
|
||||
|
||||
/* ----------------------------------------------------------------------- */
|
||||
/* Subroutine xerrwv, as given here, constitutes */
|
||||
/* a simplified version of the slatec error handling package */
|
||||
/* written by A. C. Hindmarsh at LLL. version of January 23, 1980, */
|
||||
/* modified by L. R. Petzold, April 1982. */
|
||||
|
||||
/* All arguments are input arguments. */
|
||||
|
||||
/* msg = the message (Hollerith literal or integer array). */
|
||||
/* nmes = the length of msg (number of characters). */
|
||||
/* nerr = the error number (not used). */
|
||||
/* iert = the error type.. */
|
||||
/* 1 means recoverable (control returns to caller). */
|
||||
/* 2 means fatal (run is aborted--see note below). */
|
||||
/* ni = number of integers (0, 1, or 2) to be printed with message. */
|
||||
/* i1,i2 = integers to be printed, depending on ni. */
|
||||
/* nr = number of reals (0, 1, or 2) to be printed with message. */
|
||||
/* r1,r2 = reals to be printed, depending on ni. */
|
||||
|
||||
/* note.. this routine is machine-dependent and specialized for use */
|
||||
/* in limited context, in the following ways.. */
|
||||
/* 1. the number of hollerith characters stored per word, denoted */
|
||||
/* by ncpw below, is set in a data statement below. */
|
||||
/* 2. the value of nmes is assumed to be at most 60. */
|
||||
/* (multi-line messages are generated by repeated calls.) */
|
||||
/* 3. if iert = 2, control passes to the statement stop */
|
||||
/* to abort the run. this statement may be machine-dependent. */
|
||||
/* 4. r1 and r2 are assumed to be in real and are printed */
|
||||
/* in d21.13 format. */
|
||||
/* 5. the data statement below contains default values of */
|
||||
/* mesflg = print control flag.. */
|
||||
/* 1 means print all messages (the default). */
|
||||
/* 0 means no printing. */
|
||||
/* lunit = logical unit number for messages. */
|
||||
/* the default is 6 (machine-dependent). */
|
||||
/* to change lunit, change the data statement */
|
||||
/* below. */
|
||||
/* ----------------------------------------------------------------------- */
|
||||
/* The following are instructions for installing this routine */
|
||||
/* in different machine environments. */
|
||||
|
||||
/* To change the default output unit, change the data statement */
|
||||
/* below. */
|
||||
|
||||
/* For a different number of characters per word, change the */
|
||||
/* data statement setting ncpw below. */
|
||||
/* Alternatives for various computers are shown in comment */
|
||||
/* cards. */
|
||||
|
||||
/* For a different run-abort command, change the statement following */
|
||||
/* statement 100 at the end. */
|
||||
/* ----------------------------------------------------------------------- */
|
||||
/* The following value of ncpw is valid for the cdc-6600 and */
|
||||
/* cdc-7600 computers. */
|
||||
/* data ncpw/10/ */
|
||||
/* The following is valid for the cray-1 computer. */
|
||||
/* data ncpw/8/ */
|
||||
/* The following is valid for the burroughs 6700 and 7800 computers. */
|
||||
/* data ncpw/6/ */
|
||||
/* The following is valid for the pdp-10 computer. */
|
||||
/* data ncpw/5/ */
|
||||
/* The following is valid for the vax computer with 4 bytes per integer, */
|
||||
/* and for the ibm-360, ibm-303x, and ibm-43xx computers. */
|
||||
/* data ncpw/4/ */
|
||||
/* The following is valid for the pdp-11, or vax with 2-byte integers. */
|
||||
/* data ncpw/2/ */
|
||||
/* ---------------------------------------------------------------------- */
|
||||
/* Parameter adjustments */
|
||||
msg -= msg_len;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* This may have to be modified according to the information */
|
||||
/* provided above */
|
||||
|
||||
|
||||
if (mesflg == 0) {
|
||||
goto L100;
|
||||
}
|
||||
lun = lunit;
|
||||
nch = min(*nmes,60);
|
||||
nwds = nch / ncpw;
|
||||
s88fmt_(&c__2, &nwds, &nform[4]);
|
||||
s88fmt_(&c__2, &ncpw, &nform[7]);
|
||||
nrem = nch - nwds * ncpw;
|
||||
if (nrem > 0) {
|
||||
++nwds;
|
||||
}
|
||||
if (nrem < 1) {
|
||||
nrem = 1;
|
||||
}
|
||||
s88fmt_(&c__1, &nrem, &nform[11]);
|
||||
io___14.ciunit = lun;
|
||||
s_wsfe(&io___14);
|
||||
i__1 = nwds;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
do_fio(&c__1, msg + i__ * msg_len, msg_len);
|
||||
}
|
||||
e_wsfe();
|
||||
if (*ni == 1) {
|
||||
io___16.ciunit = lun;
|
||||
s_wsfe(&io___16);
|
||||
do_fio(&c__1, (char *)&(*i1), (ftnlen)sizeof(integer));
|
||||
e_wsfe();
|
||||
}
|
||||
if (*ni == 2) {
|
||||
io___17.ciunit = lun;
|
||||
s_wsfe(&io___17);
|
||||
do_fio(&c__1, (char *)&(*i1), (ftnlen)sizeof(integer));
|
||||
do_fio(&c__1, (char *)&(*i2), (ftnlen)sizeof(integer));
|
||||
e_wsfe();
|
||||
}
|
||||
if (*nr == 1) {
|
||||
io___18.ciunit = lun;
|
||||
s_wsfe(&io___18);
|
||||
do_fio(&c__1, (char *)&(*r1), (ftnlen)sizeof(real));
|
||||
e_wsfe();
|
||||
}
|
||||
if (*nr == 2) {
|
||||
io___19.ciunit = lun;
|
||||
s_wsfe(&io___19);
|
||||
do_fio(&c__1, (char *)&(*r1), (ftnlen)sizeof(real));
|
||||
do_fio(&c__1, (char *)&(*r2), (ftnlen)sizeof(real));
|
||||
e_wsfe();
|
||||
}
|
||||
L100:
|
||||
if (*iert != 2) {
|
||||
return 0;
|
||||
}
|
||||
s_stop("", (ftnlen)0);
|
||||
return 0;
|
||||
} /* xerrwv_ */
|
||||
|
||||
#undef nform
|
||||
|
||||
|
||||
Loading…
Add table
Reference in a new issue