/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:20 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "sivadb.h" #include #include /* PARAMETER translations */ #define KDIM 16 #define KPE 1305501 #define KPI 400301 #define LTXTAH 16 #define LTXTAI 22 #define MAXORD 2 #define MAXSTF 1 #define MEDDIG 12 #define MEFMAT 62 #define MEFVEC 61 #define MEIVEC 57 #define MERET 51 #define METABL 55 #define METABS 32 #define METDIG 22 #define METEXT 53 #define NEDDIG (-MEDDIG) /* end of PARAMETER translations */ /* COMMON translations */ struct t_sivaev { float eeps2, eept75, eovep2, ovtm75, ovd10, eeps10, eeps16, erov10; } sivaev; struct t_sivasc { float tn, xi[KDIM]; long int iopst, kordi, kqmaxd, kqmaxi, ldt, maxdif, maxint, nkdko, nte, nyny, ndtf, numdt; } sivasc; struct t_sivamc { float tg[2], tgstop[2], tmark, tmarkx, tout, tolg, hc, hdec, hinc, hincc, hmax, hmaxp9, hmin, alpha[KDIM], beta[KDIM + 1], d[MAXORD][MAXSTF + MAXORD], g[MAXORD][KDIM], v[KDIM + MAXORD], ds[MAXORD][MAXSTF + MAXORD], gs[KDIM], sigma[KDIM], rbq[KDIM], dnoise, eave, eimax, eimin, emax, erep, robnd, snoise, fdat[11]; long int icf, ics, igflg, igtype[2], igstop[2], ilgrep, ings, iop3, iop4, iop5, iop6, iop7, iop8, iop9, iop10, iop11, iop12, iop13, iop14, iop15, iop16, iop17, iop18, iop19, iop20, iop21, iop22, iop21s, itolep, iy, kemax, kis, kmark, kord1i, kord2i, kpred, kqdcon, kqicon, kqmaxs, kqmxds, kqmxil, kqmxip, kqmxis, ksc, ksout, ksstrt, kstep, lex, linc, lincd, lincq, lsc, maxkqd, maxkqi, method, ne, neptol, ng, ngtot, noiseq, noutko, ntolf, ny, idat[6]; } sivamc; /* end of COMMON translations */ void /*FUNCTION*/ sivadb( long lprint, float tspecs[], float y[], float f[], long kord[], char *text) { long int j, k, l, n1, n2; static char mtxtaa[1][27]={"$NKORD: $BInt. Ord.: $B"}; static char mtxtab[1][14]={"D.E. Ord.: $B"}; static char mtxtac[1][14]={"Meth.Type: $B"}; static char mtxtad[1][35]={"Tolerance Groups: $BTolerances: $B"}; static char mtxtae[1][29]={"$NDifferences$BEq. $#Ord. $#"}; static char mtxtaf[1][10]={"$NTN=$F$E"}; static char mtxtag[1][121]={"$NIOPST=$I$TKORDI=$I$TKQMAXD=$I$TKQMAXI=$I$TLDT=$I$TMAXDIF=$I$TMAXINT=$I$TNKDKO=$I$TNTE=$I$TNYNY=$I$TNDTF=$I$TNUMDT=$I$E"}; static char mtxtah[3][243]={"$NICF=$I$TICS=$I$TIGFLG=$I$TIGTYPE(1)=$I$TIGTYPE(2)=$I$TIGSTOP(1)=$I$TIGSTOP(2)=$I$TILGREP=$I$TINGS=$I$TIOP3=$I$TIOP4=$I$TIOP5=$I$TIOP6=$I$TIOP7=$I$TIOP8=$I$TIOP9=$I$TIOP10=$I$TIOP11=$I$TIOP12=$I$TIOP13=$I$TIOP14=$I$TIOP15=$I$TIOP16=$I$TIOP17", "=$I$TIOP18=$I$TIOP19=$I$TIOP20=$I$TIOP21=$I$TIOP22=$I$TIOP21S=$I$TITOLEP=$I$TIY=$I$TKEMAX=$I$TKIS=$I$TKMARK=$I$TKORD1I=$I$TKORD2I=$I$TKPRED=$I$TKQDCON=$I$TKQICON=$I$TKQMAXS=$I$TKQMXDS=$I$TKQMXIL=$I$TKQMXIP=$I$TKQMXIS=$I$TKSC=$I$TKSOUT=$I$TKSS", "TRT=$I$TKSTEP=$I$TLEX=$I$TLINC=$I$TLINCD=$I$TLINCQ=$I$TLSC=$I$TMAXKQD=$I$TMAXKQI=$I$TMETHOD=$I$TNE=$I$TNEPTOL=$I$TNG=$I$TNGTOT=$I$TNOISEQ=$I$TNOUTKO=$I$TNTOLF=$I$TNY=$I$E$NDNOISE=$F$TEAVE=$F$TEIMAX=$F$TEIMIN=$F$TEMAX=$F$TEREP=$F$TROBND=$F$E "}; static char mtxtai[1][81]={"$NTG(1)=$F$TTG(2)=$F$TTGSTOP(1)=$F$TTGSTOP(2)=$F$TTMARK=$F$TTMARKX=$F$TTOUT=$F$E"}; static char mtxtaj[1][69]={"HC=$F$THDEC=$F$THINC=$F$THINCC=$F$THMAX=$F$THMAXP9=$F$THMIN=$F$T$N$E"}; static char mtxtak[1][85]={"K$HXI(K)$HBETA(K)$HALPHA(K)$HG(K,1)$HRBQ(K)$HSIGMA(K)$HGS(K)$HV(K)$HG(K,2..MAXINT)$E"}; static char mtxtal[1][89]={"$NEEPS2=$F$TEEPT75=$F$TEOVEP2=$F$TOVTM75=$F$TOVD10=$F$TEEPS10=$F$TEEPS16=$F$TEROV10=$F$E"}; static long mact0[3]={METABS,10,MERET}; static long mact1[2]={METEXT,MERET}; static long mact2[7]={METEXT,MEIVEC,3,METEXT,MEIVEC,0,MERET}; static long mact3[7]={METEXT,MEIVEC,0,METEXT,MEFVEC,0,MERET}; static long mact4[8]={METEXT,MEFMAT,0,0,0,LTXTAI,LTXTAH,MERET}; static long mact5[11]={METABS,12,METEXT,METABS,18,METDIG,5,METEXT, METABS,0,MERET}; static long mact6[3]={NEDDIG,0,MERET}; static long mact7[14]={METABL,0,0,0,KPI,0,0,0,0,KPE,KPE,KPE,0, 0}; static long mactfv[4]={METEXT,MEFVEC,3,MERET}; static char text1[1][12]={"$NTSPECS:$B"}; static char text2[1][5]={"Y:$B"}; static char text3[1][6]={"YN:$B"}; static char text4[1][5]={"F:$B"}; float *const dvc1 = (float*)sivamc.tg; float *const dvc2 = (float*)&sivamc.hc; float *const evc = (float*)&sivaev.eeps2; long int *const ivc1 = (long*)&sivasc.iopst; long int *const ivc2 = (long*)&sivamc.icf; float *const rvc2 = (float*)&sivamc.dnoise; float *const tneq = (float*)&sivasc.tn; /* OFFSET Vectors w/subscript range: 1 to dimension */ float *const Alpha = &sivamc.alpha[0] - 1; float *const Beta = &sivamc.beta[0] - 1; float *const Dvc1 = &dvc1[0] - 1; float *const Dvc2 = &dvc2[0] - 1; float *const Evc = &evc[0] - 1; float *const F = &f[0] - 1; float *const Fdat = &sivamc.fdat[0] - 1; float *const Gs = &sivamc.gs[0] - 1; long *const Idat = &sivamc.idat[0] - 1; long *const Igstop = &sivamc.igstop[0] - 1; long *const Igtype = &sivamc.igtype[0] - 1; long *const Ivc1 = &ivc1[0] - 1; long *const Ivc2 = &ivc2[0] - 1; long *const Kord = &kord[0] - 1; long *const Mact0 = &mact0[0] - 1; long *const Mact1 = &mact1[0] - 1; long *const Mact2 = &mact2[0] - 1; long *const Mact3 = &mact3[0] - 1; long *const Mact4 = &mact4[0] - 1; long *const Mact5 = &mact5[0] - 1; long *const Mact6 = &mact6[0] - 1; long *const Mact7 = &mact7[0] - 1; long *const Mactfv = &mactfv[0] - 1; float *const Rbq = &sivamc.rbq[0] - 1; float *const Rvc2 = &rvc2[0] - 1; float *const Sigma = &sivamc.sigma[0] - 1; float *const Tg = &sivamc.tg[0] - 1; float *const Tgstop = &sivamc.tgstop[0] - 1; float *const Tneq = &tneq[0] - 1; float *const Tspecs = &tspecs[0] - 1; float *const V = &sivamc.v[0] - 1; float *const Xi = &sivasc.xi[0] - 1; float *const Y = &y[0] - 1; /* end of OFFSET VECTORS */ /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 2009-11-04 SIVADB Krogh Included TOLG, initilized the unitialized. *>> 2000-12-01 SIVADB Krogh Removed unused parameter METXTF. *>> 1996-07-02 SIVADB Krogh Transpose flag for matrix output in C. *>> 1996-03-25 SIVADB Krogh Introduced TEXT1-TEXT4 to comply with F77. *>> 1996-01-19 SIVADB Krogh Changed NTEXT to TEXT to agree with doc. *>> 1995-04-26 SIVADB Krogh Fixed print of V & G's for high order eqs. *>> 1994-11-11 SIVADB Krogh Declared all vars. *>> 1994-10-20 SIVADB Krogh Changes to use M77CON *>> 1994-09-12 SIVADB Krogh Added CHGTYP code. *>> 1994-03-07 SIVADB Krogh Allow larger order in single precision. *>> 1993-05-03 SIVADB Krogh Additions for Conversion to C. *>> 1993-04-14 SIVADB Krogh Changes for new MESS usage. *>> 1992-04-08 SIVADB Krogh Unused labels 10 and 60 removed. *>> 1992-03-10 SIVADB Krogh Fixed value for KDIM in single p. version. *>> 1992-02-17 SIVADB Krogh Made tabs depend on # digits output. *>> 1991-11-04 SIVADB Krogh Switched to use MESS, SMESS *>> 1990-03-08 SIVADB Krogh Unused stiff vars. set to 0. *>> 1989-07-21 SIVADB Krogh Code for integrating discontinuities *>> 1988-06-07 SIVADB Krogh Dim. of IVC2 and DVC2 upped by 1 (old bug) *>> 1987-12-07 SIVADB Krogh Initial code. * *--S replaces "?": ?IVADB, ?IVAEV, ?IVAMC, ?IVASC, ?MESS * * SUBROUTINE TO GIVE DEBUG PRINT FOR VARIABLE ORDER INTEGRATOR * * LET ABS(LPRINT)= 10*N1 + N2 (N1,N2 DIGITS) * N1=1 DO NOT PRINT ANY VARIABLES EXTERNAL TO THE INTEGRATOR * N1=2 PRINT TSPECS, CURRENT Y, PAST Y, CURRENT F, * ALL PERTINENT CONTENTS OF KORD, AND TOL. * N1=3 ABOVE + DIFFERENCE TABLES UP TO HIGHEST DIFFERENCE USED * N1=4 SAME AS N1=1 + ALL IN STORAGE ALLOCATED FOR DIFFERENCES * * N2=1 DO NOT PRINT ANY VARIABLES INTERNAL TO THE INTEGRATOR * N2=2 PRINT ALL SCALAR VARIABLES IN INTERPOLATION COMMON BLOCK * N2=3 ABOVE + ALL SCALAR VARIABLES IN MAIN INTEG. COMMON BLOCK * N2=4 SAME AS N1=3 + ALL USED IN ARRAYS XI,BETA,ALPHA, FIRST * COLUMN OF G, GS,RBQ,SIGMA * N2=5 SAME AS N1=4 + ALL USED IN ARRAYS G,D,DS,V * */ /*--S Next line special: P=>D, X=>Q */ /*++S Default KDIM = 16 *++ Default KDIM = 20 *++ Default MAXORD = 2, MAXSTF = 1 *++ Default STIFF=.F. */ /*++ Substitute for KDIM, MAXORD, MAXSTF below */ /*--S Next line special: P=>D, X=>Q */ /*--S Next line special: P=>D, X=>Q */ /*. SPECIFICATION OF ENVIRONMENTAL CONSTANTS. */ /* Declarations for error message processing. */ /* wddtrr wwddtrr */ /* ********* Error message text *************** *[Last 2 letters of Param. name] [Text generating message.] *AA $NKORD: $B *AB Int. Ord.: $B * $ *AC D.E. Ord.: $B * $ *AD Meth.Type: $B * $ *AE Tolerance Groups: $B *AF Tolerances: $B * $ *AG $NDifferences$B *AH Eq. $# *AI Ord. $# * $ *AJ $NTN=$F$E * $ *AK $NIOPST=$I$TKORDI=$I$TKQMAXD=$I$TKQMAXI=$I$TLDT=$I$T$C * MAXDIF=$I$TMAXINT=$I$TNKDKO=$I$TNTE=$I$TNYNY=$I$TNDTF=$I$C * $TNUMDT=$I$E * $ *AL $NICF=$I$TICS=$I$TIGFLG=$I$TIGTYPE(1)=$I$TIGTYPE(2)=$I$T$C * IGSTOP(1)=$I$TIGSTOP(2)=$I$TILGREP=$I$TINGS=$I$TIOP3=$I$T$C * IOP4=$I$TIOP5=$I$TIOP6=$I$TIOP7=$I$TIOP8=$I$TIOP9=$I$T$C * IOP10=$I$TIOP11=$I$TIOP12=$I$TIOP13=$I$TIOP14=$I$TIOP15=$I$T$C * IOP16=$I$TIOP17=$I$TIOP18=$I$TIOP19=$I$TIOP20=$I$TIOP21=$I$T$C * IOP22=$I$TIOP21S=$I$TITOLEP=$I$TIY=$I$TKEMAX=$I$TKIS=$I$T$C * KMARK=$I$TKORD1I=$I$TKORD2I=$I$TKPRED=$I$TKQDCON=$I$T$C * KQICON=$I$TKQMAXS=$I$TKQMXDS=$I$TKQMXIL=$I$TKQMXIP=$I$T$C * KQMXIS=$I$TKSC=$I$TKSOUT=$I$TKSSTRT=$I$TKSTEP=$I$TLEX=$I$T$C * LINC=$I$TLINCD=$I$TLINCQ=$I$TLSC=$I$TMAXKQD=$I$TMAXKQI=$I$T$C * METHOD=$I$TNE=$I$TNEPTOL=$I$TNG=$I$TNGTOT=$I$TNOISEQ=$I$T$C * NOUTKO=$I$TNTOLF=$I$TNY=$I$E *AM $NDNOISE=$F$TEAVE=$F$TEIMAX=$F$TEIMIN=$F$TEMAX=$F$T$C * EREP=$F$TROBND=$F$E * $ *AN $NTG(1)=$F$TTG(2)=$F$TTGSTOP(1)=$F$TTGSTOP(2)=$F$C * $TTMARK=$F$TTMARKX=$F$TTOUT=$F$E * $ *AO HC=$F$THDEC=$F$THINC=$F$THINCC=$F$THMAX=$F$T$C * HMAXP9=$F$THMIN=$F$T$N$E * $ *AP K$HXI(K)$HBETA(K)$HALPHA(K)$HG(K,1)$HRBQ(K)$HSIGMA(K)$H * GS(K)$HV(K)$HG(K,2..MAXINT)$E * $ *AQ $NEEPS2=$F$TEEPT75=$F$TEOVEP2=$F$TOVTM75=$F$TOVD10=$F$T$C * EEPS10=$F$TEEPS16=$F$TEROV10=$F$E */ /* 1 2 3 4 5 6 7 */ /* 1 2 3 4 5 6 7 */ /* 1 2 3 4 5 6 7 */ /* 1 2 3 4 5 6 7 8 */ /* 9 10 11 */ /* 2 3 4 5 6 7 8 9 10 11 12 13 14 */ /* 1 2 3 4 */ /* ******** * START OF CODE -- PRINT TEXT AND SET INDEX FOR F * ******** * Getting variables that are not yet assigned some values. *++ Code for ~STIFF is active */ sivamc.kqdcon = 0; sivamc.kqmxds = 0; sivamc.maxkqd = 0; /*++ End */ Gs[1] = 1.e0; if (sivamc.iop6 == 0) { Igtype[1] = 0; Igstop[1] = 0; Tg[1] = 0.e0; Tgstop[1] = 0.e0; } if (sivamc.iop7 == 0) { Igtype[2] = 0; Igstop[2] = 0; Tg[2] = 0.e0; Tgstop[2] = 0.e0; } if (sivamc.iop6 + sivamc.iop7 == 0) { sivamc.ings = 0; sivamc.ng = 0; } if (sivamc.iop10 == 0) sivamc.noutko = 0; j = 0; messft( mact0, text ); n1 = lprint/10; n2 = lprint - 10*n1; if (n1 <= 1) goto L_80; /* ******** * PRINT ALL EXTERNAL VARIABLES EXCEPT FOR THE DIFFERENCES * ******** */ Mactfv[3] = max( sivamc.iop5, 4 ); /*--S Next line special: P=>D, X=>Q */ smess( mactfv, (char*)text1,12, kord, tspecs ); Mactfv[3] = sivamc.ny; /*--S Next line special: P=>D, X=>Q */ smess( mactfv, (char*)text2,5, kord, y ); /*--S Next line special: P=>D, X=>Q */ smess( mactfv, (char*)text3,6, kord, &Y[sivasc.nyny] ); Mactfv[3] = sivasc.nte; /*--S Next line special: P=>S, X=>D */ smess( mactfv, (char*)text4,5, kord, f ); Mact2[6] = sivasc.nte; mess( mact2, (char*)mtxtaa,27, kord ); if (sivasc.nkdko > 0) mess( &Mact2[4], (char*)mtxtab,14, &Kord[sivasc.nkdko] ); if (sivasc.iopst > 0) mess( &Mact2[4], (char*)mtxtac,14, &Kord[sivasc.iopst] ); /* WRITE TOL */ k = sivamc.iop16; L_70: if (Kord[k] < 0) k += 1; k += 1; if (Kord[k - 1] < sivasc.nte) goto L_70; Mact3[3] = k - sivamc.iop16; Mact3[6] = Mact3[3]; /*--S Next line special: P=>S, X=>D */ smess( mact3, (char*)mtxtad,35, &Kord[sivamc.iop16], &F[sivamc.ntolf] ); if (n1 == 2) goto L_80; /* ******** * WRITE THE DIFFERENCE TABLES * ******** */ k = sivasc.numdt; if (n1 == 3) k = sivamc.kqmaxs; Mact4[3] = sivasc.numdt; Mact4[4] = -k; Mact4[5] = sivasc.nte; /*--S Next line special: P=>S, X=>D */ smess( mact4, (char*)mtxtae,29, kord, &F[sivasc.ndtf] ); L_80: if (n2 <= 1) return; /* ******** * WRITE SCALARS IN COMMON * ******** *--S Next line special: P=>D, X=>Q */ smess( mact1, (char*)mtxtaf,10, kord, tneq ); /* ===== COMMON 1 -- INTEGER * */ mess( mact1, (char*)mtxtag,121, ivc1 ); if (n2 == 2) return; mess( mact6, (char*)mtxtaa,27, sivamc.idat ); Mact5[10] = Mact6[2] + 14; /* ===== COMMON 2 -- INTEGER AND FLOATING POINT * *--S Next line special: P=>S, X=>D */ smess( mact5, (char*)mtxtah,243, ivc2, rvc2 ); /*--S Next line special: P=>D, X=>Q */ smess( mact1, (char*)mtxtai,81, ivc2, dvc1 ); /*--S Next line special: P=>S, X=>D */ smess( mact1, (char*)mtxtaj,69, ivc2, dvc2 ); if (n2 == 3) return; /* wddtrr wddtrr */ j = 101000*Mact6[2] + 800501; Mact7[2] = 1; Mact7[3] = sivamc.kqmaxs; Mact7[4] = 8; for (k = 6; k <= 9; k++) { Mact7[k] = j; } if (n2 > 0) { Mact7[4] = 8 + sivasc.maxint; Mact7[13] = j; l = min( sivasc.maxint, 4 ); Mact7[14] = j + l - 2; } for (k = 1; k <= Mact7[3]; k++) { Fdat[1] = Xi[k]; Fdat[2] = Beta[k]; Fdat[3] = Alpha[k]; Fdat[4] = sivamc.g[0][k - 1]; Fdat[5] = Rbq[k]; Fdat[6] = Sigma[k]; Fdat[7] = Gs[k]; if (n2 >= 4) { Fdat[8] = V[k]; for (j = 2; j <= l; j++) { Fdat[7 + j] = sivamc.g[j - 1][k - 1]; } } /*--S Next line special: P=>S, X=>D */ smess( mact7, (char*)mtxtak,85, sivamc.idat, sivamc.fdat ); } /*++ Code for STIFF is inactive * if (MAXDIF .le. 0) return * Need to define MACT8 and set values *c--S Next line special: P=>S, X=>D * call SMESS(MACT8, 'D$B', IDAT, D) *c--S Next line special: P=>S, X=>D * call SMESS(MACT8, 'DS$B', IDAT, DS) *++ End * *--S Next line special: P=>S, X=>D */ smess( mact1, (char*)mtxtal,89, sivamc.idat, evc ); return; } /* end of function */