/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:14 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "ddasdb.h" #include #include /* PARAMETER translations */ #define IDB 6 #define ITOL 2 #define LALPHA 11 #define LCNSTR 10 #define LDELTA 46 #define LK 7 #define LMAT 9 #define LPHI 25 #define LTXT1 23 #define LWM 5 #define MEDDIG 12 #define MEFDAT 25 #define MEFMAT 62 #define MEFVEC 61 #define MENTXT 23 #define MERET 51 #define METABS 32 #define METEXT 53 /* end of PARAMETER translations */ void /*FUNCTION*/ ddasdb( long kase, long neq, double t, double y[], double yprime[], long info[], double rwork[], long iwork[], long idid, double atol[], double rtol[]) { long int i, idat[3], j, k, ki, km, kx, mattyp, nvec; double fdat[3]; static char mtxtaa[1][135]={"INFO() in index order: $Tinfo1=$I$Ttol=$I$Tout=$I$T stop=$I$Tmat=$I$Tdb=$I$Tmaxh=$I$Th0=$I$Tord=$I$Tcnstr=$I$Tinityp=$I$Tmxstep=$I$T$E"}; static char mtxtab[1][214]={"$NIWORK() in index order: $Tlml=$I$Tlmu=$I$Tmxord=$I$Tk=$I$Tkold=$I$Tns=$I$Tnstl=$I$Tnst=$I$Tnre=$I$Tnje=$I$Tetf=$I$Tctf=$I$Tnpd=$I$Tjcalc=$I$Tphase=$I$Trevloc=$I$Tmxstep=$I$Te=$I$Twt=$I$Tphi=$I$Twm=$I$Tntemp=$I$E"}; static char mtxtac[1][113]={"$NRWORK() in index order: tstop=$F hmax=$F h=$F tn=$F cj=$F cjold=$F hold=$F njac=$F round=$F hmin=$F$E"}; static char text1[7][24]={"$N$N*************** $B","From user code$E ", "On entry to DDASLX$E ","On exit from DDASLX$E ","Before call to DDASLF$E", "After call to DDASLF$E ","Inside DDASTP$E "}; static long mact1[5]={METEXT,MENTXT,2,METEXT,MERET}; static long mact2[2]={METEXT,MERET}; static long mact3[4]={METEXT,MEFVEC,0,MERET}; static long mact4[4]={METABS,10,METEXT,MERET}; static long mact5[8]={METEXT,MEFMAT,0,0,0,0,0,MERET}; static long mact6[24]={METEXT,MEFVEC,6,METEXT,MEFDAT,7,MEFVEC, 6,METEXT,MEFDAT,13,MEFVEC,6,METEXT,MEFDAT,19,MEFVEC,6,METEXT, MEFDAT,25,MEFVEC,6,MERET}; /* OFFSET Vectors w/subscript range: 1 to dimension */ double *const Atol = &atol[0] - 1; double *const Fdat = &fdat[0] - 1; long *const Idat = &idat[0] - 1; long *const Info = &info[0] - 1; long *const Iwork = &iwork[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; double *const Rtol = &rtol[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. *>> 2010-08-26 ddasdb Krogh Changed declaration of info to info(*). *>> 2006-04-09 ddasdb Krogh Declared MDFDAT *>> 2002-05-29 ddasdb Krogh Fixed prob. giving diagnostic on a compiler *>> 2001-12-13 ddasdb Krogh Initial code *--D Replaces "?": ?dasdb, ?daslx, ?dasf, ?dastp, ?mess * * Gives pretty print out of variables used by the DAE solver ddaslx. * */ /* kase tells us from where we were called. * 0 Entry to ddaslx * 1 Exit from ddaslx * 2 Just prior to call to ddasf * 3 Just after call to ddasf * >3 Inside ddastp * <0 Presumably a call from user code. In this case -kase defines a * two digit number d_1d_0. d_0 is treated as if it gives kase, * and d_1 is treated as if it were the k-th digit for this kase. */ /* The printing rules are given as a 7 digit number * d_6d_5d_4d_3d_2d_1d_0 in info(idb), which is interpreted as * follows. * d_0 Print on entry to DDASLX * = 0 No print. * = 1 IDID/IRES, INFO(1), NEQ, T, TOUT * = 2 The above + y, y' * = 3 The above + Tolerances * = 4 The above + INFO (all of it) * d_1 Print on exit from DDASLX. Print is as for d_0 * d_2 Before a call to DDASF (or return for reverse communication * that would ordinarily call DDASF). * = 0 No print. * = 1 Print T, IDID (which is IRES in this case) * = 2 The above + anything vectors used in the computations, * except for y, and y'. * = 3 Print y and y' * = 4 Print matrix if used in computation. * d_3 As for the case above, except print is for what is in * locations just stored to. * d_4 Internal print inside subroutine DDASTP. * = 0 No print. * = 1 Print corrections * = 2 Print y and y' * = 3 Error weights * = 4 difference tables * = 5 integration coefficients * d_5 Determines how much of WORK and IWORK are printed, when * there is other print. * = 0 No print. * = 1 Always print IWORK(1:16) * = 2 Always print WORK(1:9) * = 3 Always print both of the above. * d_6 For turning off, or limiting the amount of print. * = 0 No effect. * = 1 No effect, but gives a way to specify a value of 0, 1 or 2 * when passing a negative value of IRES after starting. * > 1 Print data for just this many of the first variables, and * just this many of the first rows in matrices when * variables or matrices are printed. */ /* Declarations for the calling sequence */ /* Local variables */ /* POINTERS INTO IWORK */ /* POINTERS INTO RWORK */ /* POINTERS INTO INFO */ /* Parameters for calls to mess and dmess */ /* ********* Error message text *************** *[Last 2 letters of Param. name] [Text generating message.] *AA INFO() in index order: $Tinfo1=$I$Ttol=$I$Tout=$I$T stop=$I$T$C * mat=$I$Tdb=$I$Tmaxh=$I$Th0=$I$Tord=$I$Tcnstr=$I$T$C * inityp=$I$Tmxstep=$I$T$E * $ *AB $NIWORK() in index order: $Tlml=$I$Tlmu=$I$Tmxord=$I$T$C * k=$I$Tkold=$I$Tns=$I$Tnstl=$I$Tnst=$I$Tnre=$I$T$C * nje=$I$Tetf=$I$Tctf=$I$Tnpd=$I$Tjcalc=$I$Tphase=$I$T$C * revloc=$I$Tmxstep=$I$Te=$I$Twt=$I$Tphi=$I$Twm=$I$T$C * ntemp=$I$E * $ *AC $NRWORK() in index order: tstop=$F hmax=$F h=$F tn=$F $C * cj=$F cjold=$F hold=$F njac=$F round=$F hmin=$F$E */ /* End of automaticaaly generated data * */ /* 1 2 3 4 5 */ nvec = neq; ki = kase; if (ki < 0) { /* User code call */ k = -ki; j = 10; ki = 0; L_10: if (((k%j) == 0) && (ki < 3)) { j *= 10; ki += 1; goto L_10; } Mact1[3] = 2*LTXT1 + 1; mess( mact1, (char*)text1,24, idat ); km = 2; } else { k = Info[IDB]; km = 1; } if (k >= 1000000) { if (k < 2000000) { k -= 1000000; if (kase >= 0) Info[IDB] = k; if (k == 0) return; } if (k >= 2000000) nvec = k/1000000; } mattyp = labs( Iwork[LMAT] ); if (mattyp > 4) { mattyp = Iwork[LMAT] - 6; if (mattyp > 4) mattyp -= 4; } /* kx defines printing rules for iwork and rwork */ kx = (k/100000)%10; /* Get the appropriate digit for the kase we have */ k = (k/ipow(10,ki))%10; if (k == 0) return; /* Always print out a heading */ Mact1[3] = (ki + 2)*LTXT1 + 1; mess( &Mact1[km], (char*)text1,24, idat ); Mact3[3] = nvec; if (ki <= 1) { /* Entry or exit from ddaslx * First print T, IDID, INFO(1), NEQ, TOUT */ Idat[1] = idid; Idat[2] = Info[1]; Idat[3] = neq; Fdat[1] = t; dmess( mact2, "T = $F, IDID = $I, info(1) = $I, NEQ = $I$E" ,47, idat, fdat ); if (k == 1) goto L_100; /* Print y and y' */ dmess( mact3, "$NY():$B",9, idat, y ); dmess( mact3, "Y'():$B",8, idat, yprime ); if (k == 2) goto L_100; /* Print Tolerances */ if (Info[ITOL] == 0) { Fdat[1] = Atol[1]; Fdat[2] = Rtol[1]; dmess( mact2, "ATOL = $F, RTOL = $F$E",24, idat, fdat ); } else { dmess( mact3, "ATOL():$B",10, idat, atol ); dmess( mact3, "RTOL():$B",10, idat, rtol ); } if (k == 3) goto L_100; /* Print all of INFO */ mess( mact4, (char*)mtxtaa,135, info ); } else if (ki <= 3) { /* Returning from or calling ddasf * Print T, IRES */ Fdat[1] = t; Idat[1] = idid; dmess( mact2, "T = $F, IRES = $I$E",21, idat, fdat ); if (k == 1) goto L_100; /* Print vectors wanted */ if ((Idat[1] == 1) || (Idat[1] == 4)) { if ((ki != 2) || (Idat[1] == 4)) dmess( mact3, "$NDELTA: $B",12, idat, &Rwork[LDELTA] ); } else if ((Idat[1] == 5) && (ki != 2)) { if ((kase < 0) && (Info[1] != 1)) { /* Don't have access to info in this case */ Mact3[3] = 1; } else { if ((nvec == neq) || (nvec > Iwork[LCNSTR])) Mact3[3] = Iwork[LCNSTR]; } dmess( mact3, "$NDELTA: $B",12, idat, &Rwork[LDELTA + nvec] ); } if (k >= 3) { dmess( mact3, "$NY(): $B",10, idat, y ); dmess( mact3, "YPRIME(): $B",13, idat, yprime ); } if (k <= 3) goto L_100; if (Idat[1] <= 1) goto L_100; if ((kase < 0) && (Info[1] != 1)) goto L_100; if (mattyp < 0) goto L_100; /* Print the matrix if computed */ i = Idat[1]; if (i == 5) i = 2; if (i + ki > 4) { Mact5[3] = neq + Iwork[LCNSTR]; Mact5[4] = nvec; Mact5[5] = nvec; if (mattyp > 4) Mact5[5] = Iwork[1] + Iwork[2]; if (Idat[1] == 5) { if ((nvec == neq) || (nvec > Iwork[LCNSTR])) Mact5[3] = Iwork[LCNSTR]; dmess( mact5, "$NConstraint Rows$E",20, idat, &Rwork[LWM + neq] ); } else { dmess( mact5, "$NMatrix$B",11, idat, &Rwork[LWM] ); } } } else { /* From inside ddastp * Print corrections */ dmess( mact3, "$NDELTA: $B",12, idat, &Rwork[LDELTA + nvec] ); if (k == 1) goto L_100; /* Print y, y', and corrections. */ dmess( mact3, "$NY(): $B",10, idat, y ); dmess( mact3, "YPRIME(): $B",13, idat, yprime ); if (k == 2) goto L_100; /* Print error weights */ dmess( mact3, "Weights(): $B",14, idat, atol ); if (k == 3) goto L_100; /* Print difference tables */ Mact5[3] = neq; Mact5[4] = nvec; Mact5[5] = Iwork[LK] + 1; Mact5[6] = 22; dmess( mact5, "$NDifference Tables$EEq. $#",28, idat, &Rwork[Iwork[LPHI]] ); Mact5[6] = 0; if (k == 4) goto L_100; /* Print integration coefficients */ for (i = 3; i <= 23; i += 5) { Mact6[i] = Iwork[LK]; } dmess( mact6, "Integration Coefficients$Nalpha: $Bbeta: $Bgamma: $Bpsi: $Bsigma: $B" ,53+18+1, idat, &Rwork[LALPHA] ); } L_100: ; if (kx == 0) return; if ((kx%2) == 1) { /* Print IWORK */ if (mattyp < 3) { Iwork[1] = 0; Iwork[2] = 0; } mess( mact4, (char*)mtxtab,214, iwork ); } if (kx < 2) return; /* Print RWORK */ dmess( mact2, (char*)mtxtac,113, idat, rwork ); return; } /* end of function */