[BACK]Return to imachprax.c CVS log [TXT] [DIR] Up to [Local Repository] / imach / src

Diff for /imach/src/imachprax.c between versions 1.1 and 1.6

version 1.1, 2023/01/31 09:24:19 version 1.6, 2024/04/24 21:10:29
Line 1 Line 1
 /* $Id$  /* $Id$
   $State$    $State$
   $Log$    $Log$
   Revision 1.1  2023/01/31 09:24:19  brouard    Revision 1.6  2024/04/24 21:10:29  brouard
   Summary: version s1 with praxis instead of Powell for large models with age and difficulties to converge    Summary: First IMaCh version using Brent Praxis software based on Buckhardt and Gegenfürtner C codes
   
     Revision 1.5  2023/10/09 09:10:01  brouard
     Summary: trying to reconsider
   
     Revision 1.4  2023/06/22 12:50:51  brouard
     Summary: stil on going
   
     Revision 1.3  2023/06/22 11:28:07  brouard
     *** empty log message ***
   
     Revision 1.2  2023/06/22 11:22:40  brouard
     Summary: with svd but not working yet
   
     Revision 1.353  2023/05/08 18:48:22  brouard
     *** empty log message ***
   
     Revision 1.352  2023/04/29 10:46:21  brouard
     *** empty log message ***
   
     Revision 1.351  2023/04/29 10:43:47  brouard
     Summary: 099r45
   
     Revision 1.350  2023/04/24 11:38:06  brouard
     *** empty log message ***
   
     Revision 1.349  2023/01/31 09:19:37  brouard
     Summary: Improvements in models with age*Vn*Vm
   
   Revision 1.347  2022/09/18 14:36:44  brouard    Revision 1.347  2022/09/18 14:36:44  brouard
   Summary: version 0.99r42    Summary: version 0.99r42
Line 1266  Important routines Line 1293  Important routines
 /* #define POWELLORIGINAL /\* Don't use Directest to decide new direction but original Powell test *\/ */  /* #define POWELLORIGINAL /\* Don't use Directest to decide new direction but original Powell test *\/ */
 /* #define MNBRAKORIGINAL /\* Don't use mnbrak fix *\/ */  /* #define MNBRAKORIGINAL /\* Don't use mnbrak fix *\/ */
 /* #define FLATSUP  *//* Suppresses directions where likelihood is flat */  /* #define FLATSUP  *//* Suppresses directions where likelihood is flat */
   /* #define POWELLORIGINCONJUGATE  /\* Don't use conjugate but biggest decrease if valuable *\/ */
   /* #define NOTMINFIT */
   
 #include <math.h>  #include <math.h>
 #include <stdio.h>  #include <stdio.h>
Line 1362  double gnuplotversion=GNUPLOTVERSION; Line 1391  double gnuplotversion=GNUPLOTVERSION;
 /* $State$ */  /* $State$ */
 #include "version.h"  #include "version.h"
 char version[]=__IMACH_VERSION__;  char version[]=__IMACH_VERSION__;
 char copyright[]="January 2023,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015-2020, Nihon University 2021-202, INED 2000-2022";  char copyright[]="April 2023,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015-2020, Nihon University 2021-202, INED 2000-2022";
 char fullversion[]="$Revision$ $Date$";   char fullversion[]="$Revision$ $Date$"; 
 char strstart[80];  char strstart[80];
 char optionfilext[10], optionfilefiname[FILENAMELENGTH];  char optionfilext[10], optionfilefiname[FILENAMELENGTH];
Line 1410  int *wav; /* Number of waves for this in Line 1439  int *wav; /* Number of waves for this in
 int maxwav=0; /* Maxim number of waves */  int maxwav=0; /* Maxim number of waves */
 int jmin=0, jmax=0; /* min, max spacing between 2 waves */  int jmin=0, jmax=0; /* min, max spacing between 2 waves */
 int ijmin=0, ijmax=0; /* Individuals having jmin and jmax */   int ijmin=0, ijmax=0; /* Individuals having jmin and jmax */ 
 int gipmx=0, gsw=0; /* Global variables on the number of contributions   int gipmx = 0;
   double gsw = 0; /* Global variables on the number of contributions
                    to the likelihood and the sum of weights (done by funcone)*/                     to the likelihood and the sum of weights (done by funcone)*/
 int mle=1, weightopt=0;  int mle=1, weightopt=0;
 int **mw; /* mw[mi][i] is number of the mi wave for this individual */  int **mw; /* mw[mi][i] is number of the mi wave for this individual */
Line 1474  extern time_t time(); Line 1504  extern time_t time();
   
 struct tm start_time, end_time, curr_time, last_time, forecast_time;  struct tm start_time, end_time, curr_time, last_time, forecast_time;
 time_t  rstart_time, rend_time, rcurr_time, rlast_time, rforecast_time; /* raw time */  time_t  rstart_time, rend_time, rcurr_time, rlast_time, rforecast_time; /* raw time */
   time_t   rlast_btime; /* raw time */
 struct tm tm;  struct tm tm;
   
 char strcurr[80], strfor[80];  char strcurr[80], strfor[80];
Line 1597  int **nbcode, *Tvar; /**< model=V2 => Tv Line 1628  int **nbcode, *Tvar; /**< model=V2 => Tv
 /* Tprod[i]=k             1               2             */ /* Position in model of the ith prod without age */  /* Tprod[i]=k             1               2             */ /* Position in model of the ith prod without age */
 /* cptcovage                    1               2         3 */ /* Counting cov*age in the model equation */  /* cptcovage                    1               2         3 */ /* Counting cov*age in the model equation */
 /* Tage[cptcovage]=k            5               8         10 */ /* Position in the model of ith cov*age */  /* Tage[cptcovage]=k            5               8         10 */ /* Position in the model of ith cov*age */
   /* model="V2+V3+V4+V6+V7+V6*V2+V7*V2+V6*V3+V7*V3+V6*V4+V7*V4+age*V2+age*V3+age*V4+age*V6+age*V7+age*V6*V2+age*V6*V3+age*V7*V3+age*V6*V4+age*V7*V4\r"*/
   /*  p Tvard[1][1]@21 = {6, 2, 7, 2, 6, 3, 7, 3, 6, 4, 7, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0}*/
   /*  p Tvard[2][1]@21 = {7, 2, 6, 3, 7, 3, 6, 4, 7, 4, 0 <repeats 11 times>} */
   /* p Tvardk[1][1]@24 = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 2, 7, 2, 6, 3, 7, 3, 6, 4, 7, 4, 0, 0}*/
   /* p Tvardk[1][1]@22 = {0, 0, 0, 0, 0, 0, 0, 0, 6, 2, 7, 2, 6, 3, 7, 3, 6, 4, 7, 4, 0, 0} */
 /* Tvard[1][1]@4={4,3,1,2}    V4*V3 V1*V2               */ /* Position in model of the ith prod without age */  /* Tvard[1][1]@4={4,3,1,2}    V4*V3 V1*V2               */ /* Position in model of the ith prod without age */
 /* Tvardk[4][1]=4;Tvardk[4][2]=3;Tvardk[7][1]=1;Tvardk[7][2]=2 */ /* Variables of a prod at position in the model equation*/  /* Tvardk[4][1]=4;Tvardk[4][2]=3;Tvardk[7][1]=1;Tvardk[7][2]=2 */ /* Variables of a prod at position in the model equation*/
 /* TvarF TvarF[1]=Tvar[6]=2,  TvarF[2]=Tvar[7]=7, TvarF[3]=Tvar[9]=1  ID of fixed covariates or product V2, V1*V2, V1 */  /* TvarF TvarF[1]=Tvar[6]=2,  TvarF[2]=Tvar[7]=7, TvarF[3]=Tvar[9]=1  ID of fixed covariates or product V2, V1*V2, V1 */
Line 1795  char *trimbb(char *out, char *in) Line 1831  char *trimbb(char *out, char *in)
   return s;    return s;
 }  }
   
   char *trimbtab(char *out, char *in)
   { /* Trim  blanks or tabs in line but keeps first blanks if line starts with blanks */
     char *s;
     s=out;
     while (*in != '\0'){
       while( (*in == ' ' || *in == '\t')){ /* && *(in+1) != '\0'){*/
         in++;
       }
       *out++ = *in++;
     }
     *out='\0';
     return s;
   }
   
 /* char *substrchaine(char *out, char *in, char *chain) */  /* char *substrchaine(char *out, char *in, char *chain) */
 /* { */  /* { */
 /*   /\* Substract chain 'chain' from 'in', return and output 'out' *\/ */  /*   /\* Substract chain 'chain' from 'in', return and output 'out' *\/ */
Line 2577  void linmin(double p[], double xi[], int Line 2627  void linmin(double p[], double xi[], int
   free_vector(pcom,1,n);     free_vector(pcom,1,n); 
 }   } 
   
 /**** praxis ****/  /**** praxis gegen ****/
 # include <float.h>  
 /* # include <math.h> */  
 /* # include <stdio.h> */  
 /* # include <stdlib.h> */  
 /* # include <string.h> */  
 /* # include <time.h> */  
   
 # include "praxis.h"  
   
 /******************************************************************************/  
   
 double flin ( int n, int jsearch, double l, double (*func) ( double [] ),   
   double x[], int *nf, double v[], double q0[], double q1[], double *qd0,   
   double *qd1, double *qa, double *qb, double *qc )  
 /* double flin ( int n, int jsearch, double l, double f ( double x[], int n ),  */  
 /*   double x[], int *nf, double v[], double q0[], double q1[], double *qd0,  */  
 /*   double *qd1, double *qa, double *qb, double *qc ) */  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     FLIN is the function of one variable to be minimized by MINNY.  
   
   Discussion:  
   
     F(X) is a scalar function of a vector argument X.  
   
     A minimizer of F(X) is sought along a line or parabola.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  /* This has been tested by Visual C from Microsoft and works */
   /* meaning tha valgrind could be wrong */
   /*********************************************************************/
   /*      f u n c t i o n     p r a x i s                              */
   /*                                                                   */
   /* praxis is a general purpose routine for the minimization of a     */
   /* function in several variables. the algorithm used is a modifi-    */
   /* cation of conjugate gradient search method by powell. the changes */
   /* are due to r.p. brent, who gives an algol-w program, which served */
   /* as a basis for this function.                                     */
   /*                                                                   */
   /* references:                                                       */
   /*     - powell, m.j.d., 1964. an efficient method for finding       */
   /*       the minimum of a function in several variables without      */
   /*       calculating derivatives, computer journal, 7, 155-162       */
   /*     - brent, r.p., 1973. algorithms for minimization without      */
   /*       derivatives, prentice hall, englewood cliffs.               */
   /*                                                                   */
   /*     problems, suggestions or improvements are always wellcome     */
   /*                       karl gegenfurtner   07/08/87                */
   /*                                           c - version             */
   /*********************************************************************/
   /*                                                                   */
   /* usage: min = praxis(tol, macheps, h, n, prin, x, func)      */
   /* macheps has been suppressed because it is replaced by DBL_EPSILON */
   /* and if it was an argument of praxis (as it is in original brent)  */
   /* it should be declared external */
   /* usage: min = praxis(tol, h, n, prin, x, func)      */
   /* was    min = praxis(fun, x, n);                                   */
   /*                                                                   */
   /*  fun        the function to be minimized. fun is called from      */
   /*             praxis with x and n as arguments                      */
   /*  x          a double array containing the initial guesses for     */
   /*             the minimum, which will contain the solution on       */
   /*             return                                                */
   /*  n          an integer specifying the number of unknown           */
   /*             parameters                                            */
   /*  min        praxis returns the least calculated value of fun      */
   /*                                                                   */
   /* some additional global variables control some more aspects of     */
   /* the inner workings of praxis. setting them is optional, they      */
   /* are all set to some reasonable default values given below.        */
   /*                                                                   */
   /*   prin      controls the printed output from the routine.         */
   /*             0 -> no output                                        */
   /*             1 -> print only starting and final values             */
   /*             2 -> detailed map of the minimization process         */
   /*             3 -> print also eigenvalues and vectors of the        */
   /*                  search directions                                */
   /*             the default value is 1                                */
   /*  tol        is the tolerance allowed for the precision of the     */
   /*             solution. praxis returns if the criterion             */
   /*             2 * ||x[k]-x[k-1]|| <= sqrt(macheps) * ||x[k]|| + tol */
   /*             is fulfilled more than ktm times.                     */
   /*             the default value depends on the machine precision    */
   /*  ktm        see just above. default is 1, and a value of 4 leads  */
   /*             to a very(!) cautious stopping criterion.             */
   /*  h0 or step       is a steplength parameter and should be set equal     */
   /*             to the expected distance from the solution.           */
   /*             exceptionally small or large values of step lead to   */
   /*             slower convergence on the first few iterations        */
   /*             the default value for step is 1.0                     */
   /*  scbd       is a scaling parameter. 1.0 is the default and        */
   /*             indicates no scaling. if the scales for the different */
   /*             parameters are very different, scbd should be set to  */
   /*             a value of about 10.0.                                */
   /*  illc       should be set to true (1) if the problem is known to  */
   /*             be ill-conditioned. the default is false (0). this    */
   /*             variable is automatically set, when praxis finds      */
   /*             the problem to be ill-conditioned during iterations.  */
   /*  maxfun     is the maximum number of calls to fun allowed. praxis */
   /*             will return after maxfun calls to fun even when the   */
   /*             minimum is not yet found. the default value of 0      */
   /*             indicates no limit on the number of calls.            */
   /*             this return condition is only checked every n         */
   /*             iterations.                                           */
   /*                                                                   */
   /*********************************************************************/
   
     28 July 2016  #include <math.h>
   #include <stdio.h>
   Author:  #include <stdlib.h>
   #include <float.h> /* for DBL_EPSILON */
     Original FORTRAN77 version by Richard Brent.  /* #include "machine.h" */
     C version by John Burkardt.  
   
   Reference:  
   
     Richard Brent,  
     Algorithms for Minimization with Derivatives,  
     Prentice Hall, 1973,  
     Reprinted by Dover, 2002.  
   
   Parameters:  
   
     Input, int N, the number of variables.  
   
     Input, int JSEARCH, indicates the kind of search.  
     If JSEARCH is a legal column index, linear search along V(*,JSEARCH).  
     If JSEARCH is -1, then the search is parabolic, based on X, Q0 and Q1.  
   
     Input, double L, is the parameter determining the particular  
     point at which F is to be evaluated.    
     For a linear search, L is the step size.  
     For a quadratic search, L is a parameter which specifies  
     a point in the plane of X, Q0 and Q1.  
   
     Input, double F ( double X[], int N ), the function to be minimized.  
   
     Input, double X[N], the base point of the search.  
   
     Input/output, int *NF, the function evaluation counter.  
   
     Input, double V[N,N], a matrix whose columns constitute   /* extern void minfit(int n, double eps, double tol, double **ab, double q[]); */
     search directions.  /* extern void minfit(int n, double eps, double tol, double ab[N][N], double q[]); */
   /* control parameters */
   /* control parameters */
   #define SQREPSILON 1.0e-19
   /* #define EPSILON 1.0e-8 */ /* in main */
   
   double tol = SQREPSILON,
          scbd = 1.0,
          step = 1.0;
   int    ktm = 1,
          /* prin = 2, */
          maxfun = 0,
          illc = 0;
          
   /* some global variables */
   static int i, j, k, k2, nl, nf, kl, kt;
   /* static double s; */
   double sl, dn, dmin,
          fx, f1, lds, ldt, sf, df,
          qf1, qd0, qd1, qa, qb, qc,
          m2, m4, small_windows, vsmall, large, 
          vlarge, ldfac, t2;
   /* static double d[N], y[N], z[N], */
   /*        q0[N], q1[N], v[N][N]; */
   
   static double *d, *y, *z;
   static double  *q0, *q1, **v;
   double *tflin; /* used in flin: return (*fun)(tflin, n); */
   double *e; /* used in minfit, don't konw how to free memory and thus made global */
   /* static double s, sl, dn, dmin, */
   /*        fx, f1, lds, ldt, sf, df, */
   /*        qf1, qd0, qd1, qa, qb, qc, */
   /*        m2, m4, small, vsmall, large,  */
   /*        vlarge, ldfac, t2; */
   /* static double d[N], y[N], z[N], */
   /*        q0[N], q1[N], v[N][N]; */
   
   /* these will be set by praxis to point to it's arguments */
   static int prin; /* added */
   static int n;
   static double *x;
   static double (*fun)();
   /* static double (*fun)(double *x, int n); */
   
   /* these will be set by praxis to the global control parameters */
   /* static double h, macheps, t; */
   extern double macheps;
   static double h;
   static double t;
   
     Input, double Q0[N], Q1[N], two auxiliary points used to  static double 
     determine the plane when a quadratic search is performed.  drandom()       /* return random no between 0 and 1 */
   {
      return (double)(rand()%(8192*2))/(double)(8192*2);
   }
   
     Input, double *QD0, *QD1, values needed to compute the   static void sort()              /* d and v in descending order */
     coefficients QA, QB, QC.  {
      int k, i, j;
      double s;
   
     Output, double *QA, *QB, *QC, coefficients used to combine     for (i=1; i<=n-1; i++) {
     Q0, X, and A1 if a quadratic search is used.         k = i; s = d[i];
          for (j=i+1; j<=n; j++) {
              if (d[j] > s) {
                 k = j;
                 s = d[j];
              }
          }
          if (k > i) {
             d[k] = d[i];
             d[i] = s;
             for (j=1; j<=n; j++) {
                 s = v[j][i];
                 v[j][i] = v[j][k];
                 v[j][k] = s;
             }
          }
      }
   }
   
     Output, double FLIN, the value of the function at the   double randbrent ( int *naught )
     minimizing point.  {
 */    double ran1, ran3[127], half;
     int ran2, q, r, i, j;
     int init=0; /* false */
     double rr;
     /* REAL*8 RAN1,RAN3(127),HALF */
   
     /*     INTEGER RAN2,Q,R */
     /*     LOGICAL INIT */
     /*     DATA INIT/.FALSE./ */
     /*     IF (INIT) GO TO 3 */
     if(!init){ 
   /*       R = MOD(NAUGHT,8190) + 1 *//* 1804289383 rand () */
       r = *naught % 8190 + 1;/* printf(" naught r %d %d",*naught,r); */
       ran2=127;
       for(i=ran2; i>0; i--){
   /*       RAN2 = 128 */
   /*       DO 2 I=1,127 */
         ran2 = ran2-1;
   /*          RAN2 = RAN2 - 1 */
         ran1 = -pow(2.0,55);
   /*          RAN1 = -2.D0**55 */
   /*          DO 1 J=1,7 */
         for(j=1; j<=7;j++){
   /*             R = MOD(1756*R,8191) */
           r = (1756*r) % 8191;/* printf(" i=%d (1756*r)%8191=%d",j,r); */
           q=r/32;
   /*             Q = R/32 */
   /* 1           RAN1 = (RAN1 + Q)*(1.0D0/256) */
           ran1 =(ran1+q)*(1.0/256);
         }
   /* 2        RAN3(RAN2) = RAN1 */
         ran3[ran2] = ran1; /* printf(" ran2=%d ran1=%.7g \n",ran2,ran1); */ 
       }
   /*       INIT = .TRUE. */
       init=1;
   /* 3     IF (RAN2.EQ.1) RAN2 = 128 */
     }
     if(ran2 == 0) ran2 = 126;
     else ran2 = ran2 -1;
     /* RAN2 = RAN2 - 1 */
     /* RAN1 = RAN1 + RAN3(RAN2) */
     ran1 = ran1 + ran3[ran2];/* printf("BIS ran2=%d ran1=%.7g \n",ran2,ran1);  */
     half= 0.5;
     /* HALF = .5D0 */
     /* IF (RAN1.GE.0.D0) HALF = -HALF */
     if(ran1 >= 0.) half =-half;
     ran1 = ran1 +half;
     ran3[ran2] = ran1;
     rr= ran1+0.5;
     /* RAN1 = RAN1 + HALF */
     /*   RAN3(RAN2) = RAN1 */
     /*   RANDOM = RAN1 + .5D0 */
   /*   r = ( ( double ) ( *seed ) ) * 4.656612875E-10; */
     return rr;
   }
   static void matprint(char *s, double **v, int m, int n)
   /* char *s; */
   /* double v[N][N]; */
 {  {
   #define INCX 8
   int i;    int i;
   double *t;   
   double value;    int i2hi;
     int ihi;
   t = ( double * ) malloc ( n * sizeof ( double ) );    int ilo;
 /*    int i2lo;
   The search is linear.    int jlo=1;
 */    int j;
   if ( 0 <= jsearch )    int j2hi;
     int jhi;
     int j2lo;
     ilo=1;
     ihi=n;
     jlo=1;
     jhi=n;
     
     printf ("\n" );
     printf ("%s\n", s );
     for ( j2lo = jlo; j2lo <= jhi; j2lo = j2lo + INCX )
   {    {
     for ( i = 0; i < n; i++ )      j2hi = j2lo + INCX - 1;
       if ( n < j2hi )
     {      {
       t[i] = x[i] + l * v[i+jsearch*n];        j2hi = n;
     }      }
   }      if ( jhi < j2hi )
 /*  
   The search is along a parabolic space curve.  
 */  
   else  
   {  
     *qa =                  l * ( l - *qd1 ) /        ( *qd0 + *qd1 ) / *qd0;  
     *qb = - ( l + *qd0 ) *     ( l - *qd1 ) / *qd1                   / *qd0;  
     *qc =   ( l + *qd0 ) * l                / *qd1 / ( *qd0 + *qd1 );  
   
     for ( i = 0; i < n; i++ )  
     {      {
       t[i] = *qa * q0[i] + *qb * x[i] + *qc * q1[i];        j2hi = jhi;
     }      }
   }  
 /*  
   The function evaluation counter NF is incremented.  
 */  
   *nf = *nf + 1;  
 /*  
   Evaluate the function.  
 */  
   value = (*func) ( (t-1) );/* This for func which is computed from x[1] and not from x[0] xm1=(x-1)*/  
   /* value = f ( t, n ); */  
   
   free ( t );  
   
   return value;  
 }  
 /******************************************************************************/  
   
 void minfit ( int n, double tol, double a[], double q[] )      /* fprintf ( ficlog, "\n" ); */
       printf ("\n" );
 /******************************************************************************/  
 /*  /*
   Purpose:    For each column J in the current range...
   
     MINFIT computes the singular value decomposition of an N by N array.  
   
   Discussion:  
   
     This is an improved version of the EISPACK routine MINFIT  
     restricted to the case M = N and P = 0.  
   
     The singular values of the array A are returned in Q.  A is  
     overwritten with the orthogonal matrix V such that U * diag(Q) = A * V,  
     where U is another orthogonal matrix.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     30 July 2016  
   
   Author:  
   
     Original FORTRAN77 version by Richard Brent.  
     C version by John Burkardt.  
   
   Reference:  
   
     Richard Brent,  
     Algorithms for Minimization with Derivatives,  
     Prentice Hall, 1973,  
     Reprinted by Dover, 2002.  
   
     James Wilkinson, Christian Reinsch,  
     Handbook for Automatic Computation,  
     Volume II, Linear Algebra, Part 2,  
     Springer Verlag, 1971.  
   
     Brian Smith, James Boyle, Jack Dongarra, Burton Garbow, Yasuhiko Ikebe,   
     Virginia Klema, Cleve Moler,  
     Matrix Eigensystem Routines, EISPACK Guide,  
     Lecture Notes in Computer Science, Volume 6,  
     Springer Verlag, 1976,  
     ISBN13: 978-3540075462,  
     LC: QA193.M37.  
   
   Parameters:  
   
     Input, int N, the order of the matrix A.  
   
     Input, double TOL, a tolerance which determines when a vector  
     (a column or part of a column of the matrix) may be considered  
     "essentially" equal to zero.  
   
     Input/output, double A[N,N].  On input, an N by N array whose  
     singular value decomposition is desired.  On output, the  
     SVD orthogonal matrix factor V.  
   
     Input/output, double Q[N], the singular values.    Write the header.
 */  */
 {      /* fprintf ( ficlog, "  Col:  "); */
   double c;      printf ("Col:");
   double *e;      for ( j = j2lo; j <= j2hi; j++ )
   double eps;      {
   double f;        /* fprintf ( ficlog, "  %7d     ", j - 1 ); */
   double g;        /* printf (" %9d      ", j - 1 ); */
   double h;        printf (" %9d      ", j );
   int i;      }
   int ii;      /* fprintf ( ficlog, "\n" ); */
   int j;      /* fprintf ( ficlog, "  Row\n" ); */
   int jj;      /* fprintf ( ficlog, "\n" ); */
   int k;      printf ("\n" );
   int kt;      printf ("  Row\n" );
   const int kt_max = 30;      printf ("\n" );
   int l;  
   int l2;  
   double s;  
   int skip;  
   double temp;  
   double x;  
   double y;  
   double z;  
 /*  /*
   Householder's reduction to bidiagonal form.    Determine the range of the rows in this strip.
 */  */
   if ( n == 1 )      if ( 1 < ilo ){
   {        i2lo = ilo;
     q[0] = a[0+0*n];      }else{
     a[0+0*n] = 1.0;        i2lo = 1;
     return;  
   }  
   
   e = ( double * ) malloc ( n * sizeof ( double ) );  
   
   eps = DBL_EPSILON;  
   g = 0.0;  
   x = 0.0;  
   
   for ( i = 1; i <= n; i++ )  
   {  
     e[i-1] = g;  
     l = i + 1;  
   
     s = 0.0;  
     for ( ii = i; ii <= n; ii++ )  
     {  
       s = s + a[ii-1+(i-1)*n] * a[ii-1+(i-1)*n];  
     }  
   
     g = 0.0;  
   
     if ( tol <= s )  
     {  
       f = a[i-1+(i-1)*n];  
   
       g = sqrt ( s );  
   
       if ( 0.0 <= f )  
       {  
         g = - g;  
       }  
   
       h = f * g - s;  
       a[i-1+(i-1)*n] = f - g;  
   
       for ( j = l; j <= n; j++ )  
       {  
         f = 0.0;  
         for ( ii = i; ii <= n; ii++ )  
         {  
           f = f + a[ii-1+(i-1)*n] * a[ii-1+(j-1)*n];  
         }  
         f = f / h;  
   
         for ( ii = i; ii <= n; ii++ )  
         {  
           a[ii-1+(j-1)*n] = a[ii-1+(j-1)*n] + f * a[ii-1+(i-1)*n];  
         }  
       }   
     }      }
       if ( m < ihi ){
     q[i-1] = g;        i2hi = m;
       }else{
     s = 0.0;        i2hi = ihi;
     for ( j = l; j <= n; j++ )  
     {  
       s = s + a[i-1+(j-1)*n] * a[i-1+(j-1)*n];  
     }      }
   
     g = 0.0;      for ( i = i2lo; i <= i2hi; i++ ){
   /*
     if ( tol <= s )    Print out (up to) 5 entries in row I, that lie in the current strip.
     {  */
       if ( i < n )        /* fprintf ( ficlog, "%5d:", i - 1 ); */
       {        /* printf ("%5d:", i - 1 ); */
         f = a[i-1+i*n];        printf ("%5d:", i );
       }        for ( j = j2lo; j <= j2hi; j++ )
   
       g = sqrt ( s );  
   
       if ( 0.0 <= f )  
       {  
         g = - g;  
       }  
   
       h = f * g - s;  
   
       if ( i < n )  
       {        {
         a[i-1+i*n] = f - g;          /* fprintf ( ficlog, "  %14g", a[i-1+(j-1)*m] ); */
         for ( jj = l; jj <= n; jj++ )          /* printf ("%14.7g  ", a[i-1+(j-1)*m] ); */
         {             /* printf("%14.7f  ", v[i-1][j-1]); */
           e[jj-1] = a[i-1+(jj-1)*n] / h;             printf("%14.7f  ", v[i][j]);
         }          /* fprintf ( stdout, "  %14g", a[i-1+(j-1)*m] ); */
   
         for ( j = l; j <= n; j++ )  
         {  
           s = 0.0;  
           for ( jj = l; jj <= n; jj++ )  
           {  
             s = s + a[j-1+(jj-1)*n] * a[i-1+(jj-1)*n];  
           }  
           for ( jj = l; jj <= n; jj++ )  
           {  
             a[j-1+(jj-1)*n] = a[j-1+(jj-1)*n] + s * e[jj-1];  
           }  
         }  
       }        }
         /* fprintf ( ficlog, "\n" ); */
         printf ("\n" );
     }      }
   
     y = fabs ( q[i-1] ) + fabs ( e[i-1] );  
   
     x = fmax ( x, y );  
   }    }
 /*   
   Accumulation of right-hand transformations.     /* printf("%s\n", s); */
 */     /* for (k=0; k<n; k++) { */
   a[n-1+(n-1)*n] = 1.0;     /*     for (i=0; i<n; i++) { */
   g = e[n-1];     /*         /\* printf("%20.10e ", v[k][i]); *\/ */
   l = n;     /*     } */
      /*     printf("\n"); */
      /* } */
   #undef INCX  
   }
   
   for ( i = n - 1; 1 <= i; i-- )  void vecprint(char *s, double *x, int n)
   {  /* char *s; */
     if ( g != 0.0 )  /* double x[N]; */
     {  {
       h = a[i-1+i*n] * g;     int i=0;
      
      printf(" %s", s);
      /* for (i=0; i<n; i++) */
      for (i=1; i<=n; i++)
        printf ("  %14.7g",  x[i] );
        /* printf("  %8d: %14g\n", i, x[i]); */
      printf ("\n" ); 
   }
   
       for ( ii = l; ii <= n; ii++ )  static void print()             /* print a line of traces */
       {  {
         a[ii-1+(i-1)*n] = a[i-1+(ii-1)*n] / h;   
       }  
   
       for ( j = l; j <= n; j++ )     printf("\n");
       {     /* printf("... chi square reduced to ... %20.10e\n", fx); */
         s = 0.0;     /* printf("... after %u function calls ...\n", nf); */
         for ( jj = l; jj <= n; jj++ )     /* printf("... including %u linear searches ...\n", nl); */
         {     printf("%10d    %10d%14.7g",nl, nf, fx);
           s = s + a[i-1+(jj-1)*n] * a[jj-1+(j-1)*n];     vecprint("... current values of x ...", x, n);
         }  }
   /* static void print2(int n, double *x, int prin, double fx, int nf, int nl) */ /* print a line of traces */
   static void print2() /* print a line of traces */
   {
     int i; double fmin=0.;
   
         for ( ii = l; ii <= n; ii++ )     /* printf("\n"); */
         {     /* printf("... chi square reduced to ... %20.10e\n", fx); */
           a[ii-1+(j-1)*n] = a[ii-1+(j-1)*n] + s * a[ii-1+(i-1)*n];     /* printf("... after %u function calls ...\n", nf); */
         }     /* printf("... including %u linear searches ...\n", nl); */
       }     /* printf("%10d    %10d%14.7g",nl, nf, fx); */
     }    printf ( "\n" );
     printf ( "  Linear searches      %d", nl );
     /* printf ( "  Linear searches      %d\n", nl ); */
     /* printf ( "  Function evaluations %d\n", nf ); */
     /* printf ( "  Function value FX = %g\n", fx ); */
     printf ( "  Function evaluations %d", nf );
     printf ( "  Function value FX = %.12lf\n", fx );
   #ifdef DEBUGPRAX
      printf("n=%d prin=%d\n",n,prin);
   #endif
      if(fx <= fmin) printf(" UNDEFINED "); else  printf("%14.7g",log(fx-fmin));
      if ( n <= 4 || 2 < prin )
      {
        /* for(i=1;i<=n;i++)printf("%14.7g",x[i-1]); */
        for(i=1;i<=n;i++)printf("%14.7g",x[i]);
        /* r8vec_print ( n, x, "  X:" ); */
      }
      printf("\n");
    }
   
     for ( jj = l; jj <= n; jj++ )  
     {  
       a[i-1+(jj-1)*n] = 0.0;  
     }  
   
     for ( ii = l; ii <= n; ii++ )  /* #ifdef MSDOS */
     {  /* static double tflin[N]; */
       a[ii-1+(i-1)*n] = 0.0;  /* #endif */
     }  
   
     a[i-1+(i-1)*n] = 1.0;  static double flin(double l, int j)
   /* double l; */
   {
      int i;
      /* #ifndef MSDOS */
      /*    double tflin[N]; */
      /* #endif    */
      /* double *tflin; */ /* Be careful to put tflin on a vector n */
   
      /* j is used from 0 to n-1 and can be -1 for parabolic search */
   
      /* if (j != -1) {            /\* linear search *\/ */
      if (j > 0) {         /* linear search */
        /* for (i=0; i<n; i++){ */
        for (i=1; i<=n; i++){
             tflin[i] = x[i] + l *v[i][j];
   #ifdef DEBUGPRAX
             /* printf("     flin i=%14d t=%14.7f x=%14.7f l=%14.7f v[%d,%d]=%14.7f nf=%14d\n",i+1, tflin[i],x[i],l,i,j,v[i][j],nf); */
             printf("     flin i=%14d t=%14.7f x=%14.7f l=%14.7f v[%d,%d]=%14.7f nf=%14d\n",i, tflin[i],x[i],l,i,j,v[i][j],nf);
   #endif
        }
      }
      else {                       /* search along parabolic space curve */
         qa = l*(l-qd1)/(qd0*(qd0+qd1));
         qb = (l+qd0)*(qd1-l)/(qd0*qd1);
         qc = l*(l+qd0)/(qd1*(qd0+qd1));
   #ifdef DEBUGPRAX      
         printf("     search along a parabolic space curve. j=%14d nf=%14d l=%14.7f qd0=%14.7f qd1=%14.7f\n",j,nf,l,qd0,qd1);
   #endif
         /* for (i=0; i<n; i++){ */
         for (i=1; i<=n; i++){
             tflin[i] = qa*q0[i]+qb*x[i]+qc*q1[i];
   #ifdef DEBUGPRAX
             /* printf("      parabole i=%14d t(i)=%14.7f q0=%14.7f x=%14.7f q1=%14.7f\n",i+1,tflin[i],q0[i],x[i],q1[i]); */
             printf("      parabole i=%14d t(i)=%14.7e q0=%14.7e x=%14.7e q1=%14.7e\n",i,tflin[i],q0[i],x[i],q1[i]);
   #endif
         }
      }
      nf++;
   
     g = e[i-1];  #ifdef NR_SHIFT
         return (*fun)((tflin-1), n);
   #else
        /* return (*fun)(tflin, n);*/
         return (*fun)(tflin);
   #endif
   }
   
     l = i;  void minny(int j, int nits, double *d2, double *x1, double f1, int fk)
   }  /* double *d2, *x1, f1; */
   {
   /* here j is from 0 to n-1 and can be -1 for parabolic search  */
     /*      MINIMIZES F FROM X IN THE DIRECTION V(*,J) */
             /*      UNLESS J<1, WHEN A QUADRATIC SEARCH IS DONE */
             /*      IN THE PLANE DEFINED BY Q0, Q1 AND X. */
             /*      D2 AN APPROXIMATION TO HALF F'' (OR ZERO), */
             /*      X1 AN ESTIMATE OF DISTANCE TO MINIMUM, */
             /*      RETURNED AS THE DISTANCE FOUND. */
             /*       IF FK = TRUE THEN F1 IS FLIN(X1), OTHERWISE */
             /*       X1 AND F1 ARE IGNORED ON ENTRY UNLESS FINAL */
             /*       FX > F1. NITS CONTROLS THE NUMBER OF TIMES */
             /*       AN ATTEMPT IS MADE TO HALVE THE INTERVAL. */
             /* SIDE EFFECTS: USES AND ALTERS X, FX, NF, NL. */
             /*       IF J < 1 USES VARIABLES Q... . */
             /*       USES H, N, T, M2, M4, LDT, DMIN, MACHEPS; */
      int k, i, dz;
      double x2, xm, f0, f2, fm, d1, t2, sf1, sx1;
      double s;
      double macheps;
      macheps=pow(16.0,-13.0);
      sf1 = f1; sx1 = *x1;
      k = 0; xm = 0.0; fm = f0 = fx; dz = *d2 < macheps;
      /* h=1.0;*/ /* To be revised */
   #ifdef DEBUGPRAX
      /* printf("min macheps=%14g h=%14g step=%14g t=%14g fx=%14g\n",macheps,h, step,t, fx);  */
      /* Where is fx coming from */
      printf("   min macheps=%14g h=%14g  t=%14g fx=%.9lf dirj=%d\n",macheps, h, t, fx, j);
      matprint("  min vectors:",v,n,n);
   #endif
      /* find step size */
      s = 0.;
      /* for (i=0; i<n; i++) s += x[i]*x[i]; */
      for (i=1; i<=n; i++) s += x[i]*x[i];
      s = sqrt(s);
      if (dz)
         t2 = m4*sqrt(fabs(fx)/dmin + s*ldt) + m2*ldt;
      else
         t2 = m4*sqrt(fabs(fx)/(*d2) + s*ldt) + m2*ldt;
      s = s*m4 + t;
      if (dz && t2 > s) t2 = s;
      if (t2 < small_windows) t2 = small_windows;
      if (t2 > 0.01*h) t2 = 0.01 * h;
      if (fk && f1 <= fm) {
         xm = *x1;
         fm = f1;
      }
   #ifdef DEBUGPRAX
      printf("   additional flin X1=%14.7f t2=%14.7f *f1=%14.7f fm=%14.7f fk=%d\n",*x1,t2,f1,fm,fk);
   #endif   
      if (!fk || fabs(*x1) < t2) {
        *x1 = (*x1 >= 0 ? t2 : -t2); 
         /* *x1 = (*x1 > 0 ? t2 : -t2); */ /* kind of error */
   #ifdef DEBUGPRAX
        printf("    additional flin X1=%16.10e dirj=%d fk=%d\n",*x1, j, fk);
   #endif
         f1 = flin(*x1, j);
   #ifdef DEBUGPRAX
       printf("    after flin f1=%18.12e dirj=%d fk=%d\n",f1, j,fk);
   #endif
      }
      if (f1 <= fm) {
         xm = *x1;
         fm = f1;
      }
   L0: /*L0 loop or next */
 /*  /*
   Diagonalization of the bidiagonal form.    Evaluate FLIN at another point and estimate the second derivative.
 */  */
   eps = eps * x;     if (dz) {
         x2 = (f0 < f1 ? -(*x1) : 2*(*x1));
   #ifdef DEBUGPRAX
         printf("     additional second flin x2=%14.8e x1=%14.8e f0=%14.8e f1=%18.12e dirj=%d\n",x2,*x1,f0,f1,j);
   #endif
         f2 = flin(x2, j);
   #ifdef DEBUGPRAX
         printf("     additional second flin x2=%16.10e x1=%16.10e f1=%18.12e f0=%18.10e f2=%18.10e fm=%18.10e\n",x2, *x1, f1,f0,f2,fm);
   #endif
         if (f2 <= fm) {
            xm = x2;
            fm = f2;
         }
         /* d2 is the curvature or double difference f1 doesn't seem to be accurately computed */
         *d2 = (x2*(f1-f0) - (*x1)*(f2-f0))/((*x1)*x2*((*x1)-x2));
   #ifdef DEBUGPRAX
         double d11,d12;
         d11=(f1-f0)/(*x1);d12=(f2-f0)/x2;
         printf(" d11=%18.12e d12=%18.12e d11-d12=%18.12e x1-x2=%18.12e (d11-d12)/(x2-(*x1))=%18.12e\n", d11 ,d12, d11-d12, x2-(*x1), (d11-d12)/(x2-(*x1)));
         printf(" original computing f1=%18.12e *d2=%16.10e f0=%18.12e f1-f0=%16.10e f2-f0=%16.10e\n",f1,*d2,f0,f1-f0, f2-f0);
         double ff1=7.783920622852e+04;
         double f1mf0=9.0344736236e-05;
         *d2 = (f1mf0)/ (*x1)/((*x1)-x2) - (f2-f0)/x2/((*x1)-x2);
         /* *d2 = (ff1-f0)/ (*x1)/((*x1)-x2) - (f2-f0)/x2/((*x1)-x2); */
         printf(" simpliff computing *d2=%16.10e f1mf0=%18.12e,f1=f0+f1mf0=%18.12e\n",*d2,f1mf0,f0+f1mf0);
         *d2 = ((f1-f0)/ (*x1) - (f2-f0)/x2)/((*x1)-x2);
         printf(" overlifi computing *d2=%16.10e\n",*d2);
   #endif
         *d2 = ((f1-f0)/ (*x1) - (f2-f0)/x2)/((*x1)-x2);      
      }
   #ifdef DEBUGPRAX
         printf("    additional second flin xm=%14.8e fm=%14.8e *d2=%14.8e\n",xm, fm,*d2);
   #endif
      /*
        Estimate the first derivative at 0.
      */
      d1 = (f1-f0)/(*x1) - *x1**d2; dz = 1;
      /*
         Predict the minimum.
       */
      if (*d2 <= small_windows) {
        x2 = (d1 < 0 ? h : -h);
      }
      else {
         x2 = - 0.5*d1/(*d2);
      }
   #ifdef DEBUGPRAX
       printf("   AT d1=%14.8e d2=%14.8e small=%14.8e dz=%d x1=%14.8e x2=%14.8e\n",d1,*d2,small_windows,dz,*x1,x2);
   #endif
       if (fabs(x2) > h)
         x2 = (x2 > 0 ? h : -h);
   L1:  /* L1 or try loop */
   #ifdef DEBUGPRAX
       printf("   AT predicted minimum flin x2=%14.8e x1=%14.8e K=%14d NITS=%14d dirj=%d\n",x2,*x1,k,nits,j);
   #endif
      f2 = flin(x2, j); /* x[i]+x2*v[i][j] */
   #ifdef DEBUGPRAX
      printf("   after flin f0=%14.8e f1=%14.8e f2=%14.8e fm=%14.8e\n",f0,f1,f2, fm);
   #endif
      if ((k < nits) && (f2 > f0)) {
   #ifdef DEBUGPRAX
        printf("  NO SUCCESS SO TRY AGAIN;\n");
   #endif
        k++;
        if ((f0 < f1) && (*x1*x2 > 0.0))
          goto L0; /* or next */
        x2 *= 0.5;
        goto L1;
      }
      nl++;
   #ifdef DEBUGPRAX
      printf(" bebeBE end of min x1=%14.8e x2=%14.8e f1=%14.8e f2=%14.8e f0=%14.8e fm=%14.8e d2=%14.8e\n",*x1, x2, f1, f2, f0, fm, *d2);
   #endif
      if (f2 > fm) x2 = xm; else fm = f2;
      if (fabs(x2*(x2-*x1)) > small_windows) {
         *d2 = (x2*(f1-f0) - *x1*(fm-f0))/(*x1*x2*(*x1-x2));
      }
      else {
         if (k > 0) *d2 = 0;
      }
   #ifdef DEBUGPRAX
      printf(" bebe end of min x1=%14.8e fx=%14.8e d2=%14.8e\n",*x1, fx, *d2);
   #endif
      if (*d2 <= small_windows) *d2 = small_windows;
      *x1 = x2; fx = fm;
      if (sf1 < fx) {
         fx = sf1;
         *x1 = sx1;
      }
     /*
       Update X for linear search.
     */
   #ifdef DEBUGPRAX
      printf("  end of min x1=%14.8e fx=%14.8e d2=%14.8e\n",*x1, fx, *d2);
   #endif
      
      /* if (j != -1) */
      /*    for (i=0; i<n; i++) */
      /*        x[i] += (*x1)*v[i][j]; */
      if (j > 0)
         for (i=1; i<=n; i++)
             x[i] += (*x1)*v[i][j];
   }
   
   for ( k = n; 1 <= k; k-- )  void quad()     /* look for a minimum along the curve q0, q1, q2        */
   {  {
     kt = 0;     int i;
      double l, s;
   
     for ( ; ; )     s = fx; fx = qf1; qf1 = s; qd1 = 0.0;
     {     /* for (i=0; i<n; i++) { */
       kt = kt + 1;     for (i=1; i<=n; i++) {
          s = x[i]; l = q1[i]; x[i] = l; q1[i] = s;
          qd1 = qd1 + (s-l)*(s-l);
      }
      s = 0.0; qd1 = sqrt(qd1); l = qd1;
   #ifdef DEBUGPRAX
     printf("  QUAD after sqrt qd1=%14.8e \n",qd1);
   #endif
    
      if (qd0>0.0 && qd1>0.0 &&nl>=3*n*n) {
   #ifdef DEBUGPRAX
        printf(" QUAD before min value=%14.8e \n",qf1);
   #endif
         /* min(-1, 2, &s, &l, qf1, 1); */
         minny(0, 2, &s, &l, qf1, 1);
         qa = l*(l-qd1)/(qd0*(qd0+qd1));
         qb = (l+qd0)*(qd1-l)/(qd0*qd1);
         qc = l*(l+qd0)/(qd1*(qd0+qd1));
      }
      else {
         fx = qf1; qa = qb = 0.0; qc = 1.0;
      }
   #ifdef DEBUGPRAX
     printf("after eventual min qd0=%14.8e qd1=%14.8e nl=%d\n",qd0, qd1,nl);
   #endif
      qd0 = qd1;
      /* for (i=0; i<n; i++) { */
      for (i=1; i<=n; i++) {
          s = q0[i]; q0[i] = x[i];
          x[i] = qa*s + qb*x[i] + qc*q1[i];
      }
   #ifdef DEBUGQUAD
      vecprint ( " X after QUAD:" , x, n );
   #endif
   }
   
       if ( kt_max < kt )  /* void minfit(int n, double eps, double tol, double ab[N][N], double q[]) */
       {  void minfit(int n, double eps, double tol, double **ab, double q[])
         e[k-1] = 0.0;  /* int n; */
         fprintf ( stderr, "\n" );  /* double eps, tol, ab[N][N], q[N]; */
         fprintf ( stderr, "MINFIT - Fatal error!\n" );  {
         fprintf ( stderr, "  The QR algorithm failed to converge.\n" );     int l, kt, l2, i, j, k;
         exit ( 1 );     double c, f, g, h, s, x, y, z;
       }     /* double eps; */
   /* #ifndef MSDOS */
   /*    double e[N];              /\* plenty of stack on a vax *\/ */
   /* #endif */
      /* double *e; */
      /* e=vector(0,n-1); /\* should be freed somewhere but gotos *\/ */
      
      /* householder's reduction to bidiagonal form */
   
       skip = 0;     if(n==1){
        /* q[1-1]=ab[1-1][1-1]; */
       for ( l2 = k; 1 <= l2; l2-- )       /* ab[1-1][1-1]=1.0; */
       {       q[1]=ab[1][1];
         l = l2;       ab[1][1]=1.0;
        return; /* added from hardt */
         if ( fabs ( e[l-1] ) <= eps )     }
         {     /* eps=macheps; */ /* added */
           skip = 1;     x = g = 0.0;
           break;  #ifdef DEBUGPRAX
         }     matprint (" HOUSE holder:", ab, n, n);
   #endif
         if ( 1 < l )  
         {     /* for (i=0; i<n; i++) {  /\* FOR I := 1 UNTIL N DO *\/ */
           if ( fabs ( q[l-2] ) <= eps )     for (i=1; i<=n; i++) {  /* FOR I := 1 UNTIL N DO */
           {       e[i] = g; s = 0.0; l = i+1;
             break;       /* for (j=i; j<n; j++)  /\* FOR J := I UNTIL N DO S := S*AB(J,I)**2; *\/ /\* not correct *\/ */
           }       for (j=i; j<=n; j++)  /* FOR J := I UNTIL N DO S := S*AB(J,I)**2; */ /* not correct */
         }         s += ab[j][i] * ab[j][i];
       }  #ifdef DEBUGPRAXFIN
 /*       printf("i=%d s=%d %.7g tol=%.7g",i,s,tol);
   Cancellation of E(L) if 1 < L.  #endif
 */       if (s < tol) {
       if ( ! skip )         g = 0.0;
       {       }
         c = 0.0;       else {
         s = 1.0;         /* f = ab[i][i]; */
          f = ab[i][i];
         for ( i = l; i <= k; i++ )         if (f < 0.0) 
         {           g = sqrt(s);
           f = s * e[i-1];         else
           e[i-1] = c * e[i-1];           g = -sqrt(s);
           if ( fabs ( f ) <= eps )         /* h = f*g - s; ab[i][i] = f - g; */
           {         h = f*g - s; ab[i][i] = f - g;
             break;         /* for (j=l; j<n; j++) { */ /* FOR J := L UNTIL N DO */ /* wrong */
           }         for (j=l; j<=n; j++) {
           g = q[i-1];           f = 0.0;
 /*           /* for (k=i; k<n; k++) /\* FOR K := I UNTIL N DO *\/ /\* wrong *\/ */
   q(i) = h = sqrt(g*g + f*f).           for (k=i; k<=n; k++) /* FOR K := I UNTIL N DO */
 */             /* f += ab[k][i] * ab[k][j]; */
           h = r8_hypot ( f, g );             f += ab[k][i] * ab[k][j];
              f /= h;
           q[i-1] = h;           for (k=i; k<=n; k++) /* FOR K := I UNTIL N DO */
              /* for (k=i; k<n; k++)/\* FOR K := I UNTIL N DO *\/ /\* wrong *\/ */
           if ( h == 0.0 )             ab[k][j] += f * ab[k][i];
           {           /* ab[k][j] += f * ab[k][i]; */
             g = 1.0;  #ifdef DEBUGPRAX
             h = 1.0;           printf("Holder J=%d F=%.7g",j,f);
           }  #endif
          }
           c =   g / h;       } /* end s */
           s = - f / h;       /* q[i] = g; s = 0.0; */
         }       q[i] = g; s = 0.0;
       }  #ifdef DEBUGPRAX
 /*       printf(" I Q=%d %.7g",i,q[i]);
   Test for convergence for this index K.  #endif   
 */         
       z = q[k-1];       /* if (i < n) */
        /* if (i <= n)  /\* I is always lower or equal to n wasn't in golub reinsch*\/ */
       if ( l == k )       /* for (j=l; j<n; j++) */
       {       for (j=l; j<=n; j++)
         if ( z < 0.0 )         s += ab[i][j] * ab[i][j];
         {       /* s += ab[i][j] * ab[i][j]; */
           q[k-1] = - z;       if (s < tol) {
           for ( i = 1; i <= n; i++ )         g = 0.0;
           {       }
             a[i-1+(k-1)*n] = - a[i-1+(k-1)*n];       else {
           }         if(i<n)
         }           /* f = ab[i][i+1]; */ /* Brent golub overflow */
         break;           f = ab[i][i+1];
       }         if (f < 0.0)
 /*           g = sqrt(s);
   Shift from bottom 2*2 minor.         else 
 */           g = - sqrt(s);
       x = q[l-1];         h = f*g - s;
       y = q[k-2];         /* h = f*g - s; ab[i][i+1] = f - g; */ /* Overflow for i=n Error in Golub too but not Burkardt*/
       g = e[k-2];         /* for (j=l; j<n; j++) */
       h = e[k-1];         /*     e[j] = ab[i][j]/h; */
       f = ( ( y - z ) * ( y + z ) + ( g - h ) * ( g + h ) ) / ( 2.0 * h * y );         if(i<n){
            ab[i][i+1] = f - g;
       g = r8_hypot ( f, 1.0 );           for (j=l; j<=n; j++)
              e[j] = ab[i][j]/h;
       if ( f < 0.0 )           /* for (j=l; j<n; j++) { */
       {           for (j=l; j<=n; j++) {
         temp = f - g;             s = 0.0;
       }             /* for (k=l; k<n; k++) s += ab[j][k]*ab[i][k]; */
       else             for (k=l; k<=n; k++) s += ab[j][k]*ab[i][k];
       {             /* for (k=l; k<n; k++) ab[j][k] += s * e[k]; */
         temp = f + g;             for (k=l; k<=n; k++) ab[j][k] += s * e[k];
       }           } /* END J */
          } /* END i <n */
       f = ( ( x - z ) * ( x + z ) + h * ( y / temp - h ) ) / x;       } /* end s */
 /*         /* y = fabs(q[i]) + fabs(e[i]); */
   Next QR transformation.       y = fabs(q[i]) + fabs(e[i]);
 */       if (y > x) x = y;
       c = 1.0;  #ifdef DEBUGPRAX
       s = 1.0;       printf(" I Y=%d %.7g",i,y);
   #endif
       for ( i = l + 1; i <= k; i++ )  #ifdef DEBUGPRAX
       {       printf(" i=%d e(i) %.7g",i,e[i]);
         g = e[i-1];  #endif
         y = q[i-1];     } /* end i */
         h = s * g;     /*
         g = g * c;       Accumulation of right hand transformations */
      /* for (i=n-1; i >= 0; i--) { */ /* FOR I := N STEP -1 UNTIL 1 DO */
         z = r8_hypot ( f, h );     /* We should avoid the overflow in Golub */
      /* ab[n-1][n-1] = 1.0; */
         e[i-2] = z;     /* g = e[n-1]; */
      ab[n][n] = 1.0;
         if ( z == 0.0 )     g = e[n];
         {     l = n;
           f = 1.0;  
           z = 1.0;     /* for (i=n; i >= 1; i--) { */
         }     for (i=n-1; i >= 1; i--) { /* n-1 loops, different from brent and golub*/
        if (g != 0.0) {
         c = f / z;         /* h = ab[i-1][i]*g; */
         s = h / z;         h = ab[i][i+1]*g;
         f =   x * c + g * s;         for (j=l; j<=n; j++) ab[j][i] = ab[i][j] / h;
         g = - x * s + g * c;         for (j=l; j<=n; j++) {
         h = y * s;           /* h = ab[i][i+1]*g; */
         y = y * c;           /* for (j=l; j<n; j++) ab[j][i] = ab[i][j] / h; */
            /* for (j=l; j<n; j++) { */
         for ( j = 1; j <= n; j++ )           s = 0.0;
         {           /* for (k=l; k<n; k++) s += ab[i][k] * ab[k][j]; */
           x = a[j-1+(i-2)*n];           /* for (k=l; k<n; k++) ab[k][j] += s * ab[k][i]; */
           z = a[j-1+(i-1)*n];           for (k=l; k<=n; k++) s += ab[i][k] * ab[k][j];
           a[j-1+(i-2)*n] =   x * c + z * s;           for (k=l; k<=n; k++) ab[k][j] += s * ab[k][i];
           a[j-1+(i-1)*n] = - x * s + z * c;         }/* END J */
         }       }/* END G */
        /* for (j=l; j<n; j++) */
         z = r8_hypot ( f, h );       /*     ab[i][j] = ab[j][i] = 0.0; */
        /* ab[i][i] = 1.0; g = e[i]; l = i; */
         q[i-2] = z;       for (j=l; j<=n; j++)
          ab[i][j] = ab[j][i] = 0.0;
         if ( z == 0.0 )       ab[i][i] = 1.0; g = e[i]; l = i;
         {     }/* END I */
           f = 1.0;  #ifdef DEBUGPRAX
           z = 1.0;     matprint (" HOUSE accumulation:",ab,n, n );
         }  #endif
   
         c = f / z;     /* diagonalization to bidiagonal form */
         s = h / z;     eps *= x;
         f =   c * g + s * y;     /* for (k=n-1; k>= 0; k--) { */
         x = - s * g + c * y;     for (k=n; k>= 1; k--) {
       }       kt = 0;
   TestFsplitting:
       e[l-1] = 0.0;  #ifdef DEBUGPRAX
       e[k-1] = f;       printf(" TestFsplitting: k=%d kt=%d\n",k,kt);
       q[k-1] = x;       /* for(i=1;i<=n;i++)printf(" e(%d)=%.14f",i,e[i]);printf("\n"); */
     }  #endif     
   }       kt = kt+1; 
   /* TestFsplitting: */
   free ( e );       /* if (++kt > 30) { */
        if (kt > 30) { 
   return;         e[k] = 0.0;
 }         fprintf(stderr, "\n+++ MINFIT - Fatal error\n");
 /******************************************************************************/         fprintf ( stderr, "  The QR algorithm failed to converge.\n" );
        }
 void minny ( int n, int jsearch, int nits, double *d2, double *x1, double *f1,        /* for (l2=k; l2>=0; l2--) { */
              int fk, double (*func) ( double []), double x[], double t, double h,        for (l2=k; l2>=1; l2--) {
   double v[], double q0[], double q1[], int *nl, int *nf, double dmin,          l = l2;
   double ldt, double *fx, double *qa, double *qb, double *qc, double *qd0,   #ifdef DEBUGPRAX
   double *qd1 )         printf(" l e(l)< eps %d %.7g %.7g ",l,e[l], eps);
 /* void minny ( int n, int jsearch, int nits, double *d2, double *x1, double *f1,  */  #endif
 /*   int fk, double f ( double x[], int n ), double x[], double t, double h,  */         /* if (fabs(e[l]) <= eps) */
 /*   double v[], double q0[], double q1[], int *nl, int *nf, double dmin,  */         if (fabs(e[l]) <= eps)
 /*   double ldt, double *fx, double *qa, double *qb, double *qc, double *qd0,  */           goto TestFconvergence;
 /*   double *qd1 ) */         /* if (fabs(q[l-1]) <= eps)*/ /* missing if ( 1 < l ){ *//* printf(" q(l-1)< eps %d %.7g %.7g ",l-1,q[l-2], eps); */
          if (fabs(q[l-1]) <= eps)
 /******************************************************************************/           break; /* goto Cancellation; */
 /*       }
   Purpose:     Cancellation:
   #ifdef DEBUGPRAX
     MINNY minimizes a scalar function of N variables along a line.       printf(" Cancellation:\n");
   #endif     
   Discussion:       c = 0.0; s = 1.0;
        for (i=l; i<=k; i++) {
     MINNY minimizes F along the line from X in the direction V(*,JSEARCH)          f = s * e[i]; e[i] *= c;
     or else using a quadratic search in the plane defined by Q0, Q1 and X.         /* f = s * e[i]; e[i] *= c; */
          if (fabs(f) <= eps)
     If FK = true, then F1 is FLIN(X1).  Otherwise X1 and F1 are ignored           goto TestFconvergence;
     on entry unless final FX is greater than F1.         /* g = q[i]; */
          g = q[i];
   Licensing:         if (fabs(f) < fabs(g)) {
            double fg = f/g;
     This code is distributed under the GNU LGPL license.           h = fabs(g)*sqrt(1.0+fg*fg);
          }
   Modified:         else {
            double gf = g/f;
     03 August 2016           h = (f!=0.0 ? fabs(f)*sqrt(1.0+gf*gf) : 0.0);
          }
   Author:         /*    COMMENT: THE ABOVE REPLACES Q(I):=H:=LONGSQRT(G*G+F*F) */
          /* WHICH MAY GIVE INCORRECT RESULTS IF THE */
     Original FORTRAN77 version by Richard Brent.         /* SQUARES UNDERFLOW OR IF F = G = 0; */
     C version by John Burkardt.         
          /* q[i] = h; */
   Reference:         q[i] = h;
          if (h == 0.0) { h = 1.0; g = 1.0; }
     Richard Brent,         c = g/h; s = -f/h;
     Algorithms for Minimization with Derivatives,       }
     Prentice Hall, 1973,  TestFconvergence:
     Reprinted by Dover, 2002.   #ifdef DEBUGPRAX
        printf(" TestFconvergence: l=%d k=%d\n",l,k);
   Parameters:  #endif     
        /* z = q[k]; */
     Input, int N, the number of variables.       z = q[k];
        if (l == k)
     Input, int JSEARCH, indicates the kind of search.         goto Convergence;
     If J is a legal columnindex, linear search in the direction of V(*,JSEARCH).       /* shift from bottom 2x2 minor */
     Otherwise, the search is parabolic, based on X, Q0 and Q1.       /* x = q[l]; y = q[k-l]; g = e[k-1]; h = e[k]; */ /* Error */
        x = q[l]; y = q[k-1]; g = e[k-1]; h = e[k];
     Input, int NITS, the maximum number of times the interval        f = ((y-z)*(y+z) + (g-h)*(g+h)) / (2.0*h*y);
     may be halved to retry the calculation.       g = sqrt(f*f+1.0);
        if (f <= 0.0)
     Input/output, double *D2, is either zero, or an approximation to          f = ((x-z)*(x+z) + h*(y/(f-g)-h))/x;
     the value of (1/2) times the second derivative of F.       else
          f = ((x-z)*(x+z) + h*(y/(f+g)-h))/x;
     Input/output, double *X1, on entry, an estimate of the        /* next qr transformation */
     distance from X to the minimum along V(*,JSEARCH), or a curve.         s = c = 1.0;
     On output, the distance between X and the minimizer that was found.       for (i=l+1; i<=k; i++) {
   #ifdef DEBUGPRAXQR
     Input/output, double *F1, ?         printf(" Before Mid TestFconvergence: l+1=%d i=%d k=%d h=%.6e e(i)=%14.8f e(i-1)=%14.8f\n",l+1,i,k, h, e[i],e[i-1]);
   #endif     
     Input, int FK; if FK is TRUE, then on input F1 contains          /* g = e[i]; y = q[i]; h = s*g; g *= c; */
     the value FLIN(X1).         g = e[i]; y = q[i]; h = s*g; g *= c;
          if (fabs(f) < fabs(h)) {
     Input, double F ( double X[], int N ), is the name of the function to            double fh = f/h;
     be minimized.           z = fabs(h) * sqrt(1.0 + fh*fh);
          }
     Input/output, double X[N], ?         else {
            double hf = h/f;
     Input, double T, ?           z = (f!=0.0 ? fabs(f)*sqrt(1.0+hf*hf) : 0.0);
          }
     Input, double H, ?         /* e[i-1] = z; */
          e[i-1] = z;
     Input, double V[N,N], a matrix whose columns are direction  #ifdef DEBUGPRAXQR
     vectors along which the function may be minimized.         printf(" Mid TestFconvergence: l+1=%d i=%d k=%d h=%.6e e(i)=%14.8f e(i-1)=%14.8f\n",l+1,i,k, h, e[i],e[i-1]);
   #endif     
     ?, double Q0[N], ?         if (z == 0.0) 
            f = z = 1.0;
     ?, double Q1[N], ?         c = f/z; s = h/z;
          f = x*c + g*s; g = - x*s + g*c; h = y*s;
     Input/output, int *NL, the number of linear searches.         y *= c;
          /* for (j=0; j<n; j++) { */
     Input/output, int *NF, the number of function evaluations.         /*     x = ab[j][i-1]; z = ab[j][i]; */
          /*     ab[j][i-1] = x*c + z*s; */
     Input, double DMIN, an estimate for the smallest eigenvalue.         /*     ab[j][i] = - x*s + z*c; */
          /* } */
     Input, double LDT, the length of the step.         for (j=1; j<=n; j++) {
            x = ab[j][i-1]; z = ab[j][i];
     Input/output, double *FX, the value of F(X,N).           ab[j][i-1] = x*c + z*s;
            ab[j][i] = - x*s + z*c;
     Input/output, double *QA, *QB, *QC;         }
          if (fabs(f) < fabs(h)) {
     Input/output, double *QD0, *QD1, ?.           double fh = f/h;
 */           z = fabs(h) * sqrt(1.0 + fh*fh);
 {         }
   double d1;         else {
   int dz;           double hf = h/f;
   double f0;           z = (f!=0.0 ? fabs(f)*sqrt(1.0+hf*hf) : 0.0);
   double f2;         }
   double fm;  #ifdef DEBUGPRAXQR
   int i;         printf(" qr transformation z f h=%.7g %.7g %.7g i=%d k=%d\n",z,f,h, i, k);
   int k;  #endif
   double m2;         q[i-1] = z;
   double m4;         if (z == 0.0)
   double machep;           z = f = 1.0;
   int ok;         c = f/z; s = h/z;
   double s;         f = c*g + s*y;  /* f can be very small */
   double sf1;         x = - s*g + c*y;
   double small;       }
   double sx1;       /* e[l] = 0.0; e[k] = f; q[k] = x; */
   double t2;       e[l] = 0.0; e[k] = f; q[k] = x;
   double temp;  #ifdef DEBUGPRAXQR
   double x2;       printf(" aftermid loop l=%d k=%d e(l)=%7g e(k)=%.7g q(k)=%.7g x=%.7g\n",l,k,e[l],e[k],q[k],x);
   double xm;  #endif
        goto TestFsplitting;
   machep = DBL_EPSILON;     Convergence:
   small = machep * machep;  #ifdef DEBUGPRAX
   m2 = sqrt ( machep );       printf(" Convergence:\n");
   m4 = sqrt ( m2 );  #endif     
   sf1 = *f1;       if (z < 0.0) {
   sx1 = *x1;         /* q[k] = - z; */
   k = 0;         /* for (j=0; j<n; j++) ab[j][k] = - ab[j][k]; */
   xm = 0.0;         q[k] = - z;
   fm = *fx;         for (j=1; j<=n; j++) ab[j][k] = - ab[j][k];
   f0 = *fx;       }/* END Z */
   dz = ( *d2 < machep );     }/* END K */
 /*  } /* END MINFIT */
   Find the step size.  
 */  
   s = r8vec_norm ( n, x );  double praxis(double tol, double macheps, double h0, int _n, int _prin, double *_x, double (*_fun)(double *_x))
   /* double praxis(double tol, double macheps, double h0, int _n, int _prin, double *_x, double (*_fun)(double *_x, int _n)) */
   if ( dz )  /* double praxis(double (*_fun)(), double _x[], int _n) */
   {  /* double (*_fun)(); */
     temp = dmin;  /* double _x[N]; */
   }  /* double (*_fun)(); */
   else  /* double _x[N]; */
   {  
     temp = *d2;  
   }  
   
   t2 = m4 * sqrt ( fabs ( *fx ) / temp + s * ldt ) + m2 * ldt;  
   s = m4 * s + t;  
   if ( dz && s < t2 )  
   {  
     t2 = s;  
   }  
   
   t2 = fmax ( t2, small );  
   t2 = fmin ( t2, 0.01 * h );  
   
   if ( fk && *f1 <= fm )  
   {  
     xm = *x1;  
     fm = *f1;  
   }  
   
   if ( ( ! fk ) || fabs ( *x1 ) < t2 )  
   {  
     if ( 0.0 <= *x1 )  
     {  
       temp = 1.0;  
     }  
     else  
     {  
       temp = - 1.0;  
     }  
   
     *x1 = temp * t2;  
     *f1 = flin ( n, jsearch, *x1, func, x, nf, v, q0, q1, qd0, qd1, qa, qb, qc );  
     /* *f1 = flin ( n, jsearch, *x1, f, x, nf, v, q0, q1, qd0, qd1, qa, qb, qc ); */  
   }  
   
   if ( *f1 <= fm )  
   {  
     xm = *x1;  
     fm = *f1;  
   }  
 /*  
   Evaluate FLIN at another point and estimate the second derivative.  
 */  
   for ( ; ; )  
   {  
     if ( dz )  
     {  
       if ( *f1 <= f0 )  
       {  
         x2 = 2.0 * *x1;  
       }  
       else  
       {  
         x2 = - *x1;  
       }  
   
       f2 = flin ( n, jsearch, x2, func, x, nf, v, q0, q1, qd0, qd1, qa, qb, qc );  
       /* f2 = flin ( n, jsearch, x2, f, x, nf, v, q0, q1, qd0, qd1, qa, qb, qc ); */  
   
       if ( f2 <= fm )  
       {  
         xm = x2;  
         fm = f2;  
       }  
   
       *d2 = ( x2 * ( *f1 - f0 ) - *x1 * ( f2 - f0 ) )  
         / ( ( *x1 * x2 ) * ( *x1 - x2 ) );  
     }  
 /*  
   Estimate the first derivative at 0.  
 */  
     d1 = ( *f1 - f0 ) / *x1 - *x1 * *d2;  
     dz = 1;  
 /*  
   Predict the minimum.  
 */  
     if ( *d2 <= small )  
     {  
       if ( 0.0 <= d1 )  
       {  
         x2 = - h;  
       }  
       else  
       {  
         x2 = h;  
       }  
     }  
     else  
     {  
       x2 = ( - 0.5 * d1 ) / *d2;  
     }  
   
     if ( h < fabs ( x2 ) )  
     {  
       if ( x2 <= 0.0 )  
       {  
         x2 = - h;  
       }  
       else  
       {  
         x2 = h;  
       }  
     }  
 /*  
   Evaluate F at the predicted minimum.  
 */  
     ok = 1;  
   
     for ( ; ; )  
     {  
       f2 = flin ( n, jsearch, x2, func, x, nf, v, q0, q1, qd0, qd1, qa, qb, qc );  
       /* f2 = flin ( n, jsearch, x2, f, x, nf, v, q0, q1, qd0, qd1, qa, qb, qc ); */  
   
       if ( nits <= k || f2 <= f0 )  
       {  
         break;  
       }  
   
       k = k + 1;  
   
       if ( f0 < *f1 && 0.0 < *x1 * x2 )  
       {  
         ok = 0;  
         break;  
       }  
       x2 = 0.5 * x2;  
     }  
   
     if ( ok )  
     {  
       break;  
     }  
   }  
 /*  
   Increment the one-dimensional search counter.  
 */  
   *nl = *nl + 1;  
   
   if ( fm < f2 )  
   {  
     x2 = xm;  
   }  
   else  
   {  
     fm = f2;  
   }  
 /*  
   Get a new estimate of the second derivative.  
 */  
   if ( small < fabs ( x2 * ( x2 - *x1 ) ) )  
   {  
     *d2 = ( x2 * ( *f1 - f0 ) - *x1 * ( fm - f0 ) )   
       / ( ( *x1 * x2 ) * ( *x1 - x2 ) );  
   }  
   else  
   {  
     if ( 0 < k )  
     {  
       *d2 = 0.0;  
     }  
   }  
   
   *d2 = fmax ( *d2, small );  
   
   *x1 = x2;  
   *fx = fm;  
   
   if ( sf1 < *fx )  
   {  
     *fx = sf1;  
     *x1 = sx1;  
   }  
 /*  
   Update X for linear search.  
 */  
   if ( 0 <= jsearch )  
   {  
     for ( i = 0; i < n; i++ )  
     {  
       x[i] = x[i] + *x1 * v[i+jsearch*n];  
     }  
   }  
   
   return;  
 }  
 /******************************************************************************/  
   
 /* double praxis ( double t0, double h0, int n, int prin, double x[],  */  
 /*   double f ( double x[], int n ) ) */  
 double praxis ( double t0, double h0, int n, int prin, double x[],   
                 double (*func) ( double [] ))  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     PRAXIS seeks an N-dimensional minimizer X of a scalar function F(X).  
   
   Discussion:  
   
     PRAXIS returns the minimum of the function F(X,N) of N variables  
     using the principal axis method.  The gradient of the function is  
     not required.  
   
     The approximating quadratic form is  
   
       Q(x") = F(x,n) + (1/2) * (x"-x)" * A * (x"-x)  
   
     where X is the best estimate of the minimum and   
   
       A = inverse(V") * D * inverse(V)  
   
     V(*,*) is the matrix of search directions;   
     D(*) is the array of second differences.    
   
     If F(X) has continuous second derivatives near X0, then A will tend   
     to the hessian of F at X0 as X approaches X0.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     03 August 2016  
   
   Author:  
   
     Original FORTRAN77 version by Richard Brent.  
     C version by John Burkardt.  
   
   Reference:  
   
     Richard Brent,  
     Algorithms for Minimization with Derivatives,  
     Prentice Hall, 1973,  
     Reprinted by Dover, 2002.  
   
   Parameters:  
   
     Input, double T0, is a tolerance.  PRAXIS attempts to return   
     praxis = f(x) such that if X0 is the true local minimum near X, then  
     norm ( x - x0 ) < T0 + sqrt ( EPSILON ) * norm ( X ),  
     where EPSILON  is the machine precision.  
   
     Input, double H0, is the maximum step size.  H0 should be   
     set to about the maximum distance from the initial guess to the minimum.  
     If H0 is set too large or too small, the initial rate of  
     convergence may be slow.  
   
     Input, int N, the number of variables.  
   
     Input, int PRIN, controls printing intermediate results.  
     0, nothing is printed.  
     1, F is printed after every n+1 or n+2 linear minimizations.    
        final X is printed, but intermediate X is printed only   
        if N is at most 4.  
     2, the scale factors and the principal values of the approximating   
        quadratic form are also printed.  
     3, X is also printed after every few linear minimizations.  
     4, the principal vectors of the approximating quadratic form are   
        also printed.  
   
     Input/output, double X[N], is an array containing on entry a  
     guess of the point of minimum, on return the estimated point of minimum.  
   
     Input, double F ( double X[], int N ), is the name of the function to be  
     minimized.  
   
     Output, double PRAXIS, the function value at the minimizer.  
   
   Local parameters:  
   
     Local, double DMIN, an estimate for the smallest eigenvalue.  
   
     Local, double FX, the value of F(X,N).  
   
     Local, int ILLC, is TRUE if the system is ill-conditioned.  
   
     Local, double LDT, the length of the step.  
   
     Local, int NF, the number of function evaluations.  
   
     Local, int NL, the number of linear searches.  
 */  
 {  
   int biter=0; /* Added to count the loops */  
   double *d;  
   double d2;  
   double df;  
   double dmin;  
   double dn;  
   double dni;  
   double f1;  
   int fk;  
   double fx;  
   double h;  
   int i;  
   int illc;  
   int j;  
   int jsearch;  
   int k;  
   int k2;  
   int kl;  
   int kt;  
   int ktm;  
   double large;  
   double ldfac;  
   double lds;  
   double ldt;  
   double m2;  
   double m4;  
   double machep;  
   int nits;  
   int nl;  
   int nf;  
   double *q0;  
   double *q1;  
   double qa;  
   double qb;  
   double qc;  
   double qd0;  
   double qd1;  
   double qf1;  
   double r;  
   double s;  
   double scbd;  
   int seed;  
   double sf;  
   double sl;  
   double small;  
   double t;  
   double temp;  
   double t2;  
   double *v;  
   double value;  
   double vlarge;  
   double vsmall;  
   double *y;  
   double *z;  
 /*  
   Allocation.  
 */  
   d = ( double * ) malloc ( n * sizeof ( double ) );  
   q0 = ( double * ) malloc ( n * sizeof ( double ) );  
   q1 = ( double * ) malloc ( n * sizeof ( double ) );  
   v = ( double * ) malloc ( n * n * sizeof ( double ) );  
   y = ( double * ) malloc ( n * sizeof ( double ) );  
   z = ( double * ) malloc ( n * sizeof ( double ) );  
 /*  
   Initialization.  
 */  
   machep = DBL_EPSILON;  
   small = machep * machep;  
   vsmall = small * small;  
   large = 1.0 / small;  
   vlarge = 1.0 / vsmall;  
   m2 = sqrt ( machep );  
   m4 = sqrt ( m2 );  
   seed = 123456789;  
 /*  
   Heuristic numbers:  
   
   If the axes may be badly scaled (which is to be avoided if  
   possible), then set SCBD = 10.  Otherwise set SCBD = 1.  
   
   If the problem is known to be ill-conditioned, initialize ILLC = true.  
   
   KTM is the number of iterations without improvement before the  
   algorithm terminates.  KTM = 4 is very cautious; usually KTM = 1  
   is satisfactory.  
 */  
   scbd = 1.0;  
   illc = 0;  
   ktm = 1;  
   
   if ( illc )  
   {  
     ldfac = 0.1;  
   }  
   else  
   {  
     ldfac = 0.01;  
   }  
   
   kt = 0;  
   nl = 0;  
   nf = 1;  
   /* fx = f ( x, n ); */  
   fx = (*func) ( (x-1) );/* This for func which is computed from x[1] and not from x[0] xm1=(x-1)*/  
   qf1 = fx;  
   t = small + fabs ( t0 );  
   t2 = t;  
   dmin = small;  
   h = h0;  
   h = fmax ( h, 100.0 * t );  
   ldt = h;  
 /*  
   The initial set of search directions V is the identity matrix.  
 */  
   for ( j = 0; j < n; j++ )  
   {  
     for ( i = 0; i < n; i++ )  
     {  
       v[i+j*n] = 0.0;  
     }  
     v[j+j*n] = 1.0;  
   }  
   
   for ( i = 0; i < n; i++ )  
   {  
     d[i] = 0.0;  
   }  
   qa = 0.0;  
   qb = 0.0;  
   qc = 0.0;  
   qd0 = 0.0;  
   qd1 = 0.0;  
   r8vec_copy ( n, x, q0 );  
   r8vec_copy ( n, x, q1 );  
   
   if ( 0 < prin )  
   {  
     print2 ( n, x, prin, fx, nf, nl );  
   }  
 /*  
   The main loop starts here.  
 */  
   for ( ; ; )  
   {  
     biter++;  /* Added to count the loops */  
     printf("\n Big iteration %d \n",biter);  
     sf = d[0];  
     d[0] = 0.0;  
 /*  
   Minimize along the first direction V(*,1).  
 */  
     jsearch = 0;  
     nits = 2;  
     d2 = d[0];  
     s = 0.0;  
     value = fx;  
     fk = 0;  
   
     minny ( n, jsearch, nits, &d2, &s, &value, fk, func, x, t,   
       h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qa, &qb, &qc, &qd0, &qd1 );  
     /* minny ( n, jsearch, nits, &d2, &s, &value, fk, func, x, t,  */  
     /*   h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qa, &qb, &qc, &qd0, &qd1 ); */  
   
     d[0] = d2;  
   
     if ( s <= 0.0 )  
     {  
       for ( i = 0; i < n; i++ )  
       {  
         v[i+0*n] = - v[i+0*n];  
       }  
     }  
   
     if ( sf <= 0.9 * d[0] || d[0] <= 0.9 * sf )  
     {  
       for ( i = 1; i < n; i++ )  
       {  
         d[i] = 0.0;  
       }  
     }  
 /*  
   The inner loop starts here.  
 */  
     for ( k = 2; k <= n; k++ )  
     {  
       r8vec_copy ( n, x, y );  
   
       sf = fx;  
   
       if ( 0 < kt )  
       {  
         illc = 1;  
       }  
   
       for ( ; ; )  
       {  
         kl = k;  
         df = 0.0;  
 /*  
   A random step follows, to avoid resolution valleys.  
 */  
         if ( illc )  
         {  
           for ( j = 0; j < n; j++ )  
           {  
             r = r8_uniform_01 ( &seed );  
             s = ( 0.1 * ldt + t2 * pow ( 10.0, kt ) ) * ( r - 0.5 );  
             z[j] = s;  
             for ( i = 0; i < n; i++ )  
             {  
               x[i] = x[i] + s * v[i+j*n];  
             }  
           }  
   
           fx = (*func) ( (x-1) );/* This for func which is computed from x[1] and not from x[0] xm1=(x-1)*/  
           /* fx = f ( x, n ); */  
           nf = nf + 1;  
         }  
 /*  
   Minimize along the "non-conjugate" directions V(*,K),...,V(*,N).  
 */  
         for ( k2 = k; k2 <= n; k2++ )  
         {  
           sl = fx;  
   
           jsearch = k2 - 1;  
           nits = 2;  
           d2 = d[k2-1];  
           s = 0.0;  
           value = fx;  
           fk = 0;  
   
           minny ( n, jsearch, nits, &d2, &s, &value, fk, func, x, t,   
             h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qa, &qb, &qc, &qd0, &qd1 );  
           /* minny ( n, jsearch, nits, &d2, &s, &value, fk, f, x, t,  */  
           /*   h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qa, &qb, &qc, &qd0, &qd1 ); */  
   
           d[k2-1] = d2;  
   
           if ( illc )  
           {  
             s = d[k2-1] * pow ( s + z[k2-1], 2 );  
           }  
           else  
           {  
             s = sl - fx;  
           }  
   
           if ( df <= s )  
           {  
             df = s;  
             kl = k2;  
           }  
         }  
 /*  
   If there was not much improvement on the first try, set  
   ILLC = true and start the inner loop again.  
 */  
         if ( illc )  
         {  
           break;  
         }  
         printf("\n fabs(  100.0 * machep(=%.12lf) * fx(=%.12lf) ) <=? df(=%.12lf)\n", machep, fx, df);  
         if ( fabs ( 100.0 * machep * fx ) <= df )  
         {  
           break;  
         }  
         illc = 1;  
       }  
   
       if ( k == 2 && 1 < prin )  
       {  
         r8vec_print ( n, d, "  The second difference array:" );  
       }  
 /*  
   Minimize along the "conjugate" directions V(*,1),...,V(*,K-1).  
 */  
       for ( k2 = 1; k2 < k; k2++ )  
       {  
         jsearch = k2 - 1;  
         nits = 2;  
         d2 = d[k2-1];  
         s = 0.0;  
         value = fx;  
         fk = 0;  
   
         minny ( n, jsearch, nits, &d2, &s, &value, fk, func, x, t,   
           h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qa, &qb, &qc, &qd0, &qd1 );  
         /* minny ( n, jsearch, nits, &d2, &s, &value, fk, f, x, t,  */  
         /*   h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qa, &qb, &qc, &qd0, &qd1 ); */  
   
         d[k2-1] = d2;  
       }  
    
       f1 = fx;  
       fx = sf;  
   
       for ( i = 0; i < n; i++ )  
       {  
         temp = x[i];  
         x[i] = y[i];  
         y[i] = temp - y[i];  
       }  
         
       lds = r8vec_norm ( n, y );  
 /*  
   Discard direction V(*,kl).  
   
   If no random step was taken, V(*,KL) is the "non-conjugate"  
   direction along which the greatest improvement was made.  
 */  
       if ( small < lds )  
       {  
         for ( j = kl - 1; k <= j; j-- )  
         {  
           for ( i = 1; i <= n; i++ )  
           {  
             v[i-1+j*n] = v[i-1+(j-1)*n];  
           }  
           d[j] = d[j-1];  
         }  
   
         d[k-1] = 0.0;  
   
         for ( i = 1; i <= n; i++ )  
         {  
           v[i-1+(k-1)*n] = y[i-1] / lds;  
         }  
 /*  
   Minimize along the new "conjugate" direction V(*,k), which is  
   the normalized vector:  (new x) - (old x).  
 */  
         jsearch = k - 1;  
         nits = 4;  
         d2 = d[k-1];  
         value = f1;  
         fk = 1;  
   
         minny ( n, jsearch, nits, &d2, &lds, &value, fk, func, x, t,   
           h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qa, &qb, &qc, &qd0, &qd1 );  
         /* minny ( n, jsearch, nits, &d2, &lds, &value, fk, f, x, t,  */  
         /*   h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qa, &qb, &qc, &qd0, &qd1 ); */  
   
         d[k-1] = d2;  
   
         if ( lds <= 0.0 )  
         {  
           lds = - lds;  
           for ( i = 1; i <= n; i++ )  
           {  
             v[i-1+(k-1)*n] = - v[i-1+(k-1)*n];  
           }  
         }  
       }  
   
       ldt = ldfac * ldt;  
       ldt = fmax ( ldt, lds );  
   
       if ( 0 < prin )  
       {  
         printf(" k=%d",k);   
         print2 ( n, x, prin, fx, nf, nl );  
       }  
   
       t2 = r8vec_norm ( n, x );  
   
       t2 = m2 * t2 + t;  
 /*  
   See whether the length of the step taken since starting the  
   inner loop exceeds half the tolerance.  
 */  
       if ( 0.5 * t2 < ldt )  
       {  
         kt = - 1;  
       }  
   
       kt = kt + 1;  
   
       if ( ktm < kt )  
       {  
         if ( 0 < prin )  
         {  
           r8vec_print ( n, x, "  X:" );  
         }  
   
         free ( d );  
         free ( q0 );  
         free ( q1 );  
         free ( v );  
         free ( y );  
         free ( z );  
   
         return fx;  
       }  
     }  
 /*  
   The inner loop ends here.  
   
   Try quadratic extrapolation in case we are in a curved valley.  
 */  
     quad ( n, func, x, t, h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qf1,   
       &qa, &qb, &qc, &qd0, &qd1 );  
     /* quad ( n, f, x, t, h, v, q0, q1, &nl, &nf, dmin, ldt, &fx, &qf1,  */  
     /*   &qa, &qb, &qc, &qd0, &qd1 ); */  
   
     for ( j = 0; j < n; j++ )  
     {  
       d[j] = 1.0 / sqrt ( d[j] );  
     }  
    
     dn = r8vec_max ( n, d );  
   
     if ( 3 < prin )  
     {  
       r8mat_print ( n, n, v, "  The new direction vectors:" );  
     }  
   
     for ( j = 0; j < n; j++ )  
     {  
       for ( i = 0; i < n; i++ )  
       {  
         v[i+j*n] = ( d[j] / dn ) * v[i+j*n];  
       }  
     }  
 /*  
   Scale the axes to try to reduce the condition number.  
 */  
     if ( 1.0 < scbd )  
     {  
       for ( i = 0; i < n; i++ )  
       {  
         s = 0.0;  
         for ( j = 0; j < n; j++ )  
         {  
           s = s + v[i+j*n] * v[i+j*n];  
         }  
         s = sqrt ( s );  
         z[i] = fmax ( m4, s );  
       }  
   
       s = r8vec_min ( n, z );  
   
       for ( i = 0; i < n; i++ )  
       {  
         sl = s / z[i];  
         z[i] = 1.0 / sl;  
   
         if ( scbd < z[i] )  
         {  
           sl = 1.0 / scbd;  
           z[i] = scbd;  
         }  
         for ( j = 0; j < n; j++ )  
         {  
           v[i+j*n] = sl * v[i+j*n];  
         }  
       }  
     }  
 /*  
   Calculate a new set of orthogonal directions before repeating  
   the main loop.  
   
   Transpose V for MINFIT:  
 */  
     printf(" Calculate a new set of orthogonal directions before repeating  the main loop.\n  Transpose V for MINFIT:...\n");  
     r8mat_transpose_in_place ( n, v );  
 /*  
   MINFIT finds the singular value decomposition of V.  
   
   This gives the principal values and principal directions of the  
   approximating quadratic form without squaring the condition number.  
 */  
     printf(" MINFIT finds the singular value decomposition of V. \n This gives the principal values and principal directions of the\n  approximating quadratic form without squaring the condition number...\n");  
     minfit ( n, vsmall, v, d );  
 /*  
   Unscale the axes.  
 */  
     printf(" Unscale the axes.\n");  
     if ( 1.0 < scbd )  
     {  
       for ( i = 0; i < n; i++ )  
       {  
         for ( j = 0; j < n; j++ )  
         {  
           v[i+j*n] = z[i] * v[i+j*n];  
         }  
       }  
   
       for ( j = 0; j < n; j++ )  
       {  
         s = 0.0;  
         for ( i = 0; i < n; i++ )  
         {  
           s = s + v[i+j*n] * v[i+j*n];  
         }  
         s = sqrt ( s );  
   
         d[j] = s * d[j];  
         for ( i = 0; i < n; i++ )  
         {  
           v[i+j*n] = v[i+j*n] / s;  
         }  
       }  
     }  
   
     for ( i = 0; i < n; i++ )  
     {  
       dni = dn * d[i];  
   
       if ( large < dni )  
       {  
         d[i] = vsmall;  
       }  
       else if ( dni < small )  
       {  
         d[i] = vlarge;  
       }  
       else  
       {  
         d[i] = 1.0 / dni / dni;  
       }  
     }  
 /*  
   Sort the eigenvalues and eigenvectors.  
 */  
     printf(" Sort the eigenvalues and eigenvectors....\n");  
     svsort ( n, d, v );  
 /*  
   Determine the smallest eigenvalue.  
 */  
     printf("  Determine the smallest eigenvalue.\n");  
     dmin = fmax ( d[n-1], small );  
 /*  
   The ratio of the smallest to largest eigenvalue determines whether  
   the system is ill conditioned.  
 */  
       
     if ( dmin < m2 * d[0] )  
     {  
       illc = 1;  
     }  
     else  
     {  
       illc = 0;  
     }  
     printf("  The ratio of the smallest to largest eigenvalue determines whether\n  the system is ill conditioned=%d . dmin=%.12lf < m2=%.12lf * d[0]=%.12lf \n",illc, dmin,m2, d[0]);  
   
     if ( 1 < prin )  
     {  
       if ( 1.0 < scbd )  
       {  
         r8vec_print ( n, z, "  The scale factors:" );  
       }   
       r8vec_print ( n, d, "  Principal values of the quadratic form:" );  
     }  
   
     if ( 3 < prin )  
     {  
       r8mat_print ( n, n, v, "  The principal axes:" );  
     }  
 /*  
   The main loop ends here.  
 */  
   }  
   
   if ( 0 < prin )  
   {  
     r8vec_print ( n, x, "  X:" );  
   }  
 /*  
   Free memory.  
 */  
   free ( d );  
   free ( q0 );  
   free ( q1 );  
   free ( v );  
   free ( y );  
   free ( z );  
   
   return fx;  
 }  
 /******************************************************************************/  
   
 void print2 ( int n, double x[], int prin, double fx, int nf, int nl )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     PRINT2 prints certain data about the progress of the iteration.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     28 July 2016  
   
   Author:  
   
     Original FORTRAN77 version by Richard Brent.  
     C version by John Burkardt.  
   
   Reference:  
   
     Richard Brent,  
     Algorithms for Minimization with Derivatives,  
     Prentice Hall, 1973,  
     Reprinted by Dover, 2002.  
   
   Parameters:  
   
     Input, int N, the number of variables.  
   
     Input, double X[N], the current estimate of the minimizer.  
   
     Input, int PRIN, the user-specifed print level.  
     0, nothing is printed.  
     1, F is printed after every n+1 or n+2 linear minimizations.    
        final X is printed, but intermediate X is printed only   
        if N is at most 4.  
     2, the scale factors and the principal values of the approximating   
        quadratic form are also printed.  
     3, X is also printed after every few linear minimizations.  
     4, the principal vectors of the approximating quadratic form are   
        also printed.  
   
     Input, double FX, the smallest value of F(X) found so far.  
   
     Input, int NF, the number of function evaluations.  
   
     Input, int NL, the number of linear searches.  
 */  
 {  
   printf ( "\n" );  
   printf ( "  Linear searches      %d", nl );  
   /* printf ( "  Linear searches      %d\n", nl ); */  
   /* printf ( "  Function evaluations %d\n", nf ); */  
   /* printf ( "  Function value FX = %g\n", fx ); */  
   printf ( "  Function evaluations %d", nf );  
   printf ( "  Function value FX = %.12lf\n", fx );  
   
   if ( n <= 4 || 2 < prin )  
   {  
     r8vec_print ( n, x, "  X:" );  
   }  
   
   return;  
 }  
 /******************************************************************************/  
   
 void quad ( int n, double (*func) ( double [] ), double x[], double t,   
   double h, double v[], double q0[], double q1[], int *nl, int *nf, double dmin,   
   double ldt, double *fx, double *qf1, double *qa, double *qb, double *qc,   
   double *qd0, double *qd1 )  
 /* void quad ( int n, double f ( double x[], int n ), double x[], double t,  */  
 /*   double h, double v[], double q0[], double q1[], int *nl, int *nf, double dmin,  */  
 /*   double ldt, double *fx, double *qf1, double *qa, double *qb, double *qc,  */  
 /*   double *qd0, double *qd1 ) */  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     QUAD seeks to minimize the scalar function F along a particular curve.  
   
   Discussion:  
   
     The minimizer to be sought is required to lie on a curve defined  
     by Q0, Q1 and X.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     30 July 2016  
   
   Author:  
   
     Original FORTRAN77 version by Richard Brent.  
     C version by John Burkardt.  
   
   Reference:  
   
     Richard Brent,  
     Algorithms for Minimization with Derivatives,  
     Prentice Hall, 1973,  
     Reprinted by Dover, 2002.  
   
   Parameters:  
   
     Input, int N, the number of variables.  
   
     Input, double F ( double X[], int N ), the name of the function to   
     be minimized.  
   
     Input/output, double X[N], ?  
   
     Input, double T, ?  
   
     Input, double H, ?  
   
     Input, double V[N,N], the matrix of search directions.  
   
     Input/output, double Q0[N], Q1[N], two auxiliary points used to define  
     a curve through X.  
   
     Input/output, int *NL, the number of linear searches.  
   
     Input/output, int *NF, the number of function evaluations.  
   
     Input, double DMIN, an estimate for the smallest eigenvalue.  
   
     Input, double LDT, the length of the step.  
   
     Input/output, double *FX, the value of F(X,N).  
   
     Input/output, double *QF1, *QA, *QB, *QC, *QD0, *QD1 ?  
 */  
 {  
   int fk;  
   int i;  
   int jsearch;  
   double l;  
   int nits;  
   double s;  
   double temp;  
   double value;  
   
   temp = *fx;  
   *fx   = *qf1;  
   *qf1  = temp;  
   
   for ( i = 0; i < n; i++ )  
   {  
     temp  = x[i];  
     x[i]  = q1[i];  
     q1[i] = temp;  
   }  
   
   *qd1 = 0.0;  
   for ( i = 0; i < n; i++ )  
   {  
     *qd1 = *qd1 + ( x[i] - q1[i] ) * ( x[i] - q1[i] );  
   }  
   *qd1 = sqrt ( *qd1 );  
   
   if ( *qd0 <= 0.0 || *qd1 <= 0.0 || *nl < 3 * n * n )  
   {  
     *fx = *qf1;  
     *qa = 0.0;  
     *qb = 0.0;  
     *qc = 1.0;  
     s = 0.0;  
   }  
   else  
   {  
     jsearch = - 1;  
     nits = 2;  
     s = 0.0;  
     l = *qd1;  
     value = *qf1;  
     fk = 1;  
   
     minny ( n, jsearch, nits, &s, &l, &value, fk, func, x, t,   
       h, v, q0, q1, nl, nf, dmin, ldt, fx, qa, qb, qc, qd0, qd1 );  
     /* minny ( n, jsearch, nits, &s, &l, &value, fk, f, x, t,  */  
     /*   h, v, q0, q1, nl, nf, dmin, ldt, fx, qa, qb, qc, qd0, qd1 ); */  
   
     *qa =                  l * ( l - *qd1 )        / ( *qd0 + *qd1 ) / *qd0;  
     *qb = - ( l + *qd0 )     * ( l - *qd1 ) / *qd1                   / *qd0;  
     *qc =   ( l + *qd0 ) * l                / *qd1 / ( *qd0 + *qd1 );  
   }  
   
   *qd0 = *qd1;  
   
   for ( i = 0; i < n; i++ )  
   {  
     s = q0[i];  
     q0[i] = x[i];  
     x[i] = *qa * s + *qb * x[i] + *qc * q1[i];  
   }  
   
   return;  
 }  
 /******************************************************************************/  
   
 double r8_hypot ( double x, double y )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8_HYPOT returns the value of sqrt ( X^2 + Y^2 ).  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     26 March 2012  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     Input, double X, Y, the arguments.  
   
     Output, double R8_HYPOT, the value of sqrt ( X^2 + Y^2 ).  
 */  
 {  
   double a;  
   double b;  
   double value;  
   
   if ( fabs ( x ) < fabs ( y ) )  
   {  
     a = fabs ( y );  
     b = fabs ( x );  
   }  
   else  
   {  
     a = fabs ( x );  
     b = fabs ( y );  
   }  
 /*  
   A contains the larger value.  
 */  
   if ( a == 0.0 )  
   {  
     value = 0.0;  
   }  
   else  
   {  
     value = a * sqrt ( 1.0 + ( b / a ) * ( b / a ) );  
   }  
   
   return value;  
 }  
 /******************************************************************************/  
   
 double r8_uniform_01 ( int *seed )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8_UNIFORM_01 returns a pseudorandom R8 scaled to [0,1].  
   
   Discussion:  
   
     This routine implements the recursion  
   
       seed = 16807 * seed mod ( 2^31 - 1 )  
       r8_uniform_01 = seed / ( 2^31 - 1 )  
   
     The integer arithmetic never requires more than 32 bits,  
     including a sign bit.  
   
     If the initial seed is 12345, then the first three computations are  
   
       Input     Output      R8_UNIFORM_01  
       SEED      SEED  
   
          12345   207482415  0.096616  
      207482415  1790989824  0.833995  
     1790989824  2035175616  0.947702  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     11 August 2004  
   
   Author:  
   
     John Burkardt  
   
   Reference:  
   
     Paul Bratley, Bennett Fox, Linus Schrage,  
     A Guide to Simulation,  
     Springer Verlag, pages 201-202, 1983.  
   
     Pierre L'Ecuyer,  
     Random Number Generation,  
     in Handbook of Simulation  
     edited by Jerry Banks,  
     Wiley Interscience, page 95, 1998.  
   
     Bennett Fox,  
     Algorithm 647:  
     Implementation and Relative Efficiency of Quasirandom  
     Sequence Generators,  
     ACM Transactions on Mathematical Software,  
     Volume 12, Number 4, pages 362-376, 1986.  
   
     P A Lewis, A S Goodman, J M Miller,  
     A Pseudo-Random Number Generator for the System/360,  
     IBM Systems Journal,  
     Volume 8, pages 136-143, 1969.  
   
   Parameters:  
   
     Input/output, int *SEED, the "seed" value.  Normally, this  
     value should not be 0.  On output, SEED has been updated.  
   
     Output, double R8_UNIFORM_01, a new pseudorandom variate, strictly between  
     0 and 1.  
 */  
 {  
   const int i4_huge = 2147483647;  
   int k;  
   double r;  
   
   if ( *seed == 0 )  
   {  
     fprintf ( stderr, "\n" );  
     fprintf ( stderr, "R8_UNIFORM_01 - Fatal error!\n" );  
     fprintf ( stderr, "  Input value of SEED = 0\n" );  
     exit ( 1 );  
   }  
   
   k = *seed / 127773;  
   
   *seed = 16807 * ( *seed - k * 127773 ) - k * 2836;  
   
   if ( *seed < 0 )  
   {  
     *seed = *seed + i4_huge;  
   }  
   
   r = ( ( double ) ( *seed ) ) * 4.656612875E-10;  
   
   return r;  
 }  
 /******************************************************************************/  
   
 void r8mat_print ( int m, int n, double a[], char *title )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8MAT_PRINT prints an R8MAT.  
   
   Discussion:  
   
     An R8MAT is a doubly dimensioned array of R8 values, stored as a vector  
     in column-major order.  
   
     Entry A(I,J) is stored as A[I+J*M]  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     28 May 2008  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     Input, int M, the number of rows in A.  
   
     Input, int N, the number of columns in A.  
   
     Input, double A[M*N], the M by N matrix.  
   
     Input, char *TITLE, a title.  
 */  
 {  
   r8mat_print_some ( m, n, a, 1, 1, m, n, title );  
   
   return;  
 }  
 /******************************************************************************/  
   
 void r8mat_print_some ( int m, int n, double a[], int ilo, int jlo, int ihi,  
   int jhi, char *title )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8MAT_PRINT_SOME prints some of an R8MAT.  
   
   Discussion:  
   
     An R8MAT is a doubly dimensioned array of R8 values, stored as a vector  
     in column-major order.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     26 June 2013  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     Input, int M, the number of rows of the matrix.  
     M must be positive.  
   
     Input, int N, the number of columns of the matrix.  
     N must be positive.  
   
     Input, double A[M*N], the matrix.  
   
     Input, int ILO, JLO, IHI, JHI, designate the first row and  
     column, and the last row and column to be printed.  
   
     Input, char *TITLE, a title.  
 */  
 {  
 # define INCX 5  
   
   int i;  
   int i2hi;  
   int i2lo;  
   int j;  
   int j2hi;  
   int j2lo;  
   
   fprintf ( stdout, "\n" );  
   fprintf ( stdout, "%s\n", title );  
   
   if ( m <= 0 || n <= 0 )  
   {  
     fprintf ( stdout, "\n" );  
     fprintf ( stdout, "  (None)\n" );  
     return;  
   }  
 /*  
   Print the columns of the matrix, in strips of 5.  
 */  
   for ( j2lo = jlo; j2lo <= jhi; j2lo = j2lo + INCX )  
   {  
     j2hi = j2lo + INCX - 1;  
     if ( n < j2hi )  
     {  
       j2hi = n;  
     }  
     if ( jhi < j2hi )  
     {  
       j2hi = jhi;  
     }  
   
     fprintf ( stdout, "\n" );  
 /*  
   For each column J in the current range...  
   
   Write the header.  
 */  
     fprintf ( stdout, "  Col:  ");  
     for ( j = j2lo; j <= j2hi; j++ )  
     {  
       fprintf ( stdout, "  %7d     ", j - 1 );  
     }  
     fprintf ( stdout, "\n" );  
     fprintf ( stdout, "  Row\n" );  
     fprintf ( stdout, "\n" );  
 /*  
   Determine the range of the rows in this strip.  
 */  
     if ( 1 < ilo )  
     {  
       i2lo = ilo;  
     }  
     else  
     {  
       i2lo = 1;  
     }  
     if ( m < ihi )  
     {  
       i2hi = m;  
     }  
     else  
     {  
       i2hi = ihi;  
     }  
   
     for ( i = i2lo; i <= i2hi; i++ )  
     {  
 /*  
   Print out (up to) 5 entries in row I, that lie in the current strip.  
 */  
       fprintf ( stdout, "%5d:", i - 1 );  
       for ( j = j2lo; j <= j2hi; j++ )  
       {  
         fprintf ( stdout, "  %14g", a[i-1+(j-1)*m] );  
       }  
       fprintf ( stdout, "\n" );  
     }  
   }  
   
   return;  
 # undef INCX  
 }  
 /******************************************************************************/  
   
 void r8mat_transpose_in_place ( int n, double a[] )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8MAT_TRANSPOSE_IN_PLACE transposes a square matrix in place.  
   
   Discussion:  
   
     An R8MAT is a doubly dimensioned array of R8 values, stored as a vector  
     in column-major order.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     26 June 2008  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     Input, int N, the number of rows and columns of the matrix A.  
   
     Input/output, double A[N*N], the matrix to be transposed.  
 */  
 {  
   int i;  
   int j;  
   double t;  
   
   for ( j = 0; j < n; j++ )  
   {  
     for ( i = 0; i < j; i++ )  
     {  
       t        = a[i+j*n];  
       a[i+j*n] = a[j+i*n];  
       a[j+i*n] = t;  
     }  
   }  
   return;  
 }  
 /******************************************************************************/  
   
 void r8vec_copy ( int n, double a1[], double a2[] )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8VEC_COPY copies an R8VEC.  
   
   Discussion:  
   
     An R8VEC is a vector of R8's.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     03 July 2005  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     Input, int N, the number of entries in the vectors.  
   
     Input, double A1[N], the vector to be copied.  
   
     Input, double A2[N], the copy of A1.  
 */  
 {  
   int i;  
   
   for ( i = 0; i < n; i++ )  
   {  
     a2[i] = a1[i];  
   }  
   return;  
 }  
 /******************************************************************************/  
   
 double r8vec_max ( int n, double r8vec[] )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8VEC_MAX returns the value of the maximum element in a R8VEC.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     05 May 2006  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     Input, int N, the number of entries in the array.  
   
     Input, double R8VEC[N], a pointer to the first entry of the array.  
   
     Output, double R8VEC_MAX, the value of the maximum element.  This  
     is set to 0.0 if N <= 0.  
 */  
 {  
   int i;  
   double value;  
   
   if ( n <= 0 )  
   {  
     value = 0.0;  
     return value;  
   }  
   
   value = r8vec[0];  
   
   for ( i = 1; i < n; i++ )  
   {  
     if ( value < r8vec[i] )  
     {  
       value = r8vec[i];  
     }  
   }  
   return value;  
 }  
 /******************************************************************************/  
   
 double r8vec_min ( int n, double r8vec[] )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8VEC_MIN returns the value of the minimum element in a R8VEC.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     05 May 2006  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     Input, int N, the number of entries in the array.  
   
     Input, double R8VEC[N], the array to be checked.  
   
     Output, double R8VEC_MIN, the value of the minimum element.  
 */  
 {  
   int i;  
   double value;  
   
   value = r8vec[0];  
   
   for ( i = 1; i < n; i++ )  
   {  
     if ( r8vec[i] < value )  
     {  
       value = r8vec[i];  
     }  
   }  
   return value;  
 }  
 /******************************************************************************/  
   
 double r8vec_norm ( int n, double a[] )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8VEC_NORM returns the L2 norm of an R8VEC.  
   
   Discussion:  
   
     The vector L2 norm is defined as:  
   
       R8VEC_NORM = sqrt ( sum ( 1 <= I <= N ) A(I)^2 ).  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     01 March 2003  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     Input, int N, the number of entries in A.  
   
     Input, double A[N], the vector whose L2 norm is desired.  
   
     Output, double R8VEC_NORM, the L2 norm of A.  
 */  
 {  
   int i;  
   double v;  
   
   v = 0.0;  
   
   for ( i = 0; i < n; i++ )  
   {  
     v = v + a[i] * a[i];  
   }  
   v = sqrt ( v );  
   
   return v;  
 }  
 /******************************************************************************/  
   
 void r8vec_print ( int n, double a[], char *title )  
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     R8VEC_PRINT prints an R8VEC.  
   
   Discussion:  
   
     An R8VEC is a vector of R8's.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     08 April 2009  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     Input, int N, the number of components of the vector.  
   
     Input, double A[N], the vector to be printed.  
   
     Input, char *TITLE, a title.  
 */  
 {  {
   int i,j, jk, k;     /* init global extern variables and parameters */
      /* double *d, *y, *z, */
      /*   *q0, *q1, **v; */
      /* double *tflin; /\* used in flin: return (*fun)(tflin, n); *\/ */
      /* double *e; /\* used in minfit, don't konw how to free memory and thus made global *\/ */
   
   double *p;    
     int seed; /* added */
     int biter=0;
     double r;
     double randbrent( int (*));
     double s, sf;
     
      h = h0; /* step; */
      t = tol;
      scbd = 1.0;
      illc = 0;
      ktm = 1;
   
      macheps = DBL_EPSILON;
      /* prin=4; */
   #ifdef DEBUGPRAX
      printf("Praxis macheps=%14g h=%14g step=%14g tol=%14g\n",macheps,h, h0,tol); 
   #endif
      n = _n;
      x = _x;
      prin = _prin;
      fun = _fun;
      d=vector(1, n);
      y=vector(1, n);
      z=vector(1, n);
      q0=vector(1, n);
      q1=vector(1, n);
      e=vector(1, n);
      tflin=vector(1, n);
      v=matrix(1, n, 1, n);
      for(i=1;i<=n;i++){d[i]=y[i]=z[i]=q0[0]=e[i]=tflin[i]=0.;}
      small_windows = (macheps) * (macheps); vsmall = small_windows*small_windows;
      large = 1.0/small_windows; vlarge = 1.0/vsmall;
      m2 = sqrt(macheps); m4 = sqrt(m2);
      seed = 123456789; /* added */
      ldfac = (illc ? 0.1 : 0.01);
      for(i=1;i<=n;i++) z[i]=0.; /* Was missing in Gegenfurtner as well as Brent's algol or fortran  */
      nl = kt = 0; nf = 1;
   #ifdef NR_SHIFT
      fx = (*fun)((x-1), n);
   #else
      fx = (*fun)(x);
   #endif
      qf1 = fx;
      t2 = small_windows + fabs(t); t = t2; dmin = small_windows;
   #ifdef DEBUGPRAX
      printf("praxis2 macheps=%14g h=%14g step=%14g small=%14g t=%14g\n",macheps,h, h0,small_windows, t); 
   #endif
      if (h < 100.0*t) h = 100.0*t;
   #ifdef DEBUGPRAX
      printf("praxis3 macheps=%14g h=%14g step=%14g small=%14g t=%14g\n",macheps,h, h0,small_windows, t); 
   #endif
      ldt = h;
      /* for (i=0; i<n; i++) for (j=0; j<n; j++) */
      for (i=1; i<=n; i++) for (j=1; j<=n; j++)
          v[i][j] = (i == j ? 1.0 : 0.0);
      d[1] = 0.0; qd0 = 0.0;
      /* for (i=0; i<n; i++) q1[i] = x[i]; */
      for (i=1; i<=n; i++) q1[i] = x[i];
      if (prin > 1) {
         printf("\n------------- enter function praxis -----------\n");
         printf("... current parameter settings ...\n");
         printf("... scaling ... %20.10e\n", scbd);
         printf("...   tol   ... %20.10e\n", t);
         printf("... maxstep ... %20.10e\n", h);
         printf("...   illc  ... %20u\n", illc);
         printf("...   ktm   ... %20u\n", ktm);
         printf("... maxfun  ... %20u\n", maxfun);
      }
      if (prin) print2();
   
   p=(a-1); /* So that a[0]=p[1]  */  mloop:
   /* for (i=1;i<=n;i++) { */      biter++;  /* Added to count the loops */
   /*   fprintf(ficrespow," %.12lf", p[i]); */     /* sf = d[0]; */
   /* } */     /* s = d[0] = 0.0; */
   /* fprintf(ficrespow,"\n");fflush(ficrespow); */      printf("\n Big iteration %d \n",biter);
   printf("\n#model=  1      +     age ");      fprintf(ficlog,"\n Big iteration %d \n",biter);
   fprintf(ficlog,"\n#model=  1      +     age ");      sf = d[1];
   if(nagesqr==1){     s = d[1] = 0.0;
     printf("  + age*age  ");  
     fprintf(ficlog,"  + age*age  ");     /* minimize along first direction V(*,1) */
   }  #ifdef DEBUGPRAX
   for(j=1;j <=ncovmodel-2;j++){     printf("  Minimize along the first direction V(*,1). illc=%d\n",illc);
     if(Typevar[j]==0) {     /* fprintf(ficlog,"  Minimize along the first direction V(*,1).\n"); */
       printf("  +      V%d  ",Tvar[j]);  #endif
       fprintf(ficlog,"  +      V%d  ",Tvar[j]);  #ifdef DEBUGPRAX2
     }else if(Typevar[j]==1) {     printf("praxis4 macheps=%14g h=%14g step=%14g small=%14g t=%14g\n",macheps,h, h0,small_windows, t); 
       printf("  +    V%d*age ",Tvar[j]);  #endif
       fprintf(ficlog,"  +    V%d*age ",Tvar[j]);     /* min(0, 2, &d[0], &s, fx, 0); /\* mac heps not global *\/ */
     }else if(Typevar[j]==2) {     minny(1, 2, &d[1], &s, fx, 0); /* mac heps not global */
       printf("  +    V%d*V%d ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]);  #ifdef DEBUGPRAX
       fprintf(ficlog,"  +    V%d*V%d ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]);     printf("praxis5 macheps=%14g h=%14g looks at sign of s=%14g fx=%14g\n",macheps,h, s,fx); 
     }else if(Typevar[j]==3) {  #endif
       printf("  +    V%d*V%d*age ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]);     if (s <= 0.0)
       fprintf(ficlog,"  +    V%d*V%d*age ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]);        /* for (i=0; i < n; i++) */
     }        for (i=1; i <= n; i++)
   }            v[i][1] = -v[i][1];
   printf("\n");     /* if ((sf <= (0.9 * d[0])) || ((0.9 * sf) >= d[0])) */
 /*     printf("12   47.0114589    0.0154322   33.2424412    0.3279905    2.3731903  */     if ((sf <= (0.9 * d[1])) || ((0.9 * sf) >= d[1]))
 /* 13  -21.5392400    0.1118147    1.2680506    1.2973408   -1.0663662  */        /* for (i=1; i<n; i++) */
     fprintf(ficlog,"\n");        for (i=2; i<=n; i++)
     for(i=1,jk=1; i <=nlstate; i++){            d[i] = 0.0;
       for(k=1; k <=(nlstate+ndeath); k++){     /* for (k=1; k<n; k++) { */
         if (k != i) {     for (k=2; k<=n; k++) {
           printf("%d%d ",i,k);      /*
           fprintf(ficlog,"%d%d ",i,k);        The inner loop starts here.
           for(j=1; j <=ncovmodel; j++){      */
             printf("%12.7f ",p[jk]);  #ifdef DEBUGPRAX
             fprintf(ficlog,"%12.7f ",p[jk]);        printf("      The inner loop  here from k=%d to n=%d.\n",k,n);
             jk++;         /* fprintf(ficlog,"      The inner loop  here from k=%d to n=%d.\n",k,n); */
           }  #endif
           printf("\n");         /* for (i=0; i<n; i++) */
           fprintf(ficlog,"\n");         for (i=1; i<=n; i++)
              y[i] = x[i];
          sf = fx;
   #ifdef DEBUGPRAX
          printf(" illc=%d and kt=%d and ktm=%d\n", illc, kt, ktm);
   #endif
          illc = illc || (kt > 0);
   next:
          kl = k;
          df = 0.0;
          if (illc) {        /* random step to get off resolution valley */
   #ifdef DEBUGPRAX
             printf("  A random step follows, to avoid resolution valleys.\n");
             matprint("  before rand, vectors:",v,n,n);
   #endif
             for (i=1; i<=n; i++) {
   #ifdef NOBRENTRAND
               r = drandom();
   #else
               seed=i;
               /* seed=i+1; */
   #ifdef DEBUGRAND
               printf(" Random seed=%d, brent i=%d",seed,i); /* YYYY i=5 j=1 vji= -0.0001170073 */
   #endif
               r = randbrent ( &seed );
   #endif
   #ifdef DEBUGRAND
               printf(" Random r=%.7g \n",r);
   #endif      
               z[i] = (0.1 * ldt + t2 * pow(10.0,(double)kt)) * (r - 0.5);
               /* z[i] = (0.1 * ldt + t2 * pow(10.0,(double)kt)) * (drandom() - 0.5); */
   
               s = z[i];
                 for (j=1; j <= n; j++)
                     x[j] += s * v[j][i];
             }
   #ifdef DEBUGRAND
             matprint("  after rand, vectors:",v,n,n);
   #endif
   #ifdef NR_SHIFT
             fx = (*fun)((x-1), n);
   #else
             fx = (*fun)(x, n);
   #endif
             /* fx = (*func) ( (x-1) ); *//* This for func which is computed from x[1] and not from x[0] xm1=(x-1)*/
             nf++;
          }
          /* minimize along non-conjugate directions */
   #ifdef DEBUGPRAX
           printf(" Minimize along the 'non-conjugate' directions (dots printed) V(*,%d),...,V(*,%d).\n",k,n);
           /* fprintf(ficlog," Minimize along the 'non-conjugate' directions  (dots printed) V(*,%d),...,V(*,%d).\n",k,n); */
   #endif
           /* for (k2=k; k2<n; k2++) {  /\* Be careful here k2 <=n ? *\/ */
           for (k2=k; k2<=n; k2++) {  /* Be careful here k2 <=n ? */
              sl = fx;
              s = 0.0;
   #ifdef DEBUGPRAX
              printf(" Minimize along the 'NON-CONJUGATE' true direction k2=%14d fx=%14.7f\n",k2, fx);
      matprint("  before min vectors:",v,n,n);
   #endif
              /* min(k2, 2, &d[k2], &s, fx, 0); */
      /*     jsearch=k2-1; */
      /* min(jsearch, 2, &d[jsearch], &s, fx, 0); */
      minny(k2, 2, &d[k2], &s, fx, 0);
   #ifdef DEBUGPRAX
              printf(" . D(%d)=%14.7f d[k2]=%14.7f z[k2]=%14.7f illc=%14d fx=%14.7f\n",k2,d[k2],d[k2],z[k2],illc,fx);
   #endif
             if (illc) {
                 /* double szk = s + z[k2]; */
                 /* s = d[k2] * szk*szk; */
                 double szk = s + z[k2];
                 s = d[k2] * szk*szk;
              }
              else 
                 s = sl - fx;
              /* if (df < s) { */
              if (df <= s) {
                 df = s;
                 kl = k2;
   #ifdef DEBUGPRAX
               printf(" df=%.7g and choose kl=%d \n",df,kl); /* UUUU */
   #endif
              }
           } /* end loop k2 */
           /*
             If there was not much improvement on the first try, set
             ILLC = true and start the inner loop again.
           */
   #ifdef DEBUGPRAX
           printf(" If there was not much improvement on the first try, set ILLC = true and start the inner loop again. illc=%d\n",illc);
           /* fprintf(ficlog,"  If there was not much improvement on the first try, set ILLC = true and start the inner loop again.\n"); */
   #endif
           if (!illc && (df < fabs(100.0 * (macheps) * fx))) {
   #ifdef DEBUGPRAX
             printf("\n NO SUCCESS because DF is small, starts inner loop with same K(=%d), fabs(  100.0 * machep(=%.10e) * fx(=%.9e) )=%.9e > df(=%.9e) break illc=%d\n", k, macheps, fx, fabs ( 100.0 * macheps * fx ), df, illc);         
   #endif
             illc = 1;
             goto next;
         }          }
   #ifdef DEBUGPRAX
           printf("\n SUCCESS, BREAKS inner loop K(=%d) because DF is big, fabs(  100.0 * machep(=%.10e) * fx(=%.9e) )=%.9e <= df(=%.9e) break illc=%d\n", k, macheps, fx, fabs ( 100.0 * macheps * fx ), df, illc);
   #endif
           
          /* if ((k == 1) && (prin > 1)){ /\* be careful k=2 *\/ */
          if ((k == 2) && (prin > 1)){ /* be careful k=2 */
   #ifdef DEBUGPRAX
           printf("  NEW D The second difference array d:\n" );
           /* fprintf(ficlog, " NEW D The second difference array d:\n" ); */
   #endif
            vecprint(" NEW D The second difference array d:",d,n);
          }
          /* minimize along conjugate directions */ 
          /*
            Minimize along the "conjugate" directions V(*,1),...,V(*,K-1).
          */
   #ifdef DEBUGPRAX
         printf("Minimize along the 'conjugate' directions V(*,1),...,V(*,K-1=%d).\n",k-1);
         /* fprintf(ficlog,"Minimize along the 'conjugate' directions V(*,1),...,V(*,K-1=%d).\n",k-1); */
   #endif
         /* for (k2=0; k2<=k-1; k2++) { */
         for (k2=1; k2<=k-1; k2++) {
              s = 0.0;
              /* min(k2-1, 2, &d[k2-1], &s, fx, 0); */
              minny(k2, 2, &d[k2], &s, fx, 0);
          }
          f1 = fx;
          fx = sf;
          lds = 0.0;
          /* for (i=0; i<n; i++) { */
          for (i=1; i<=n; i++) {
              sl = x[i];
              x[i] = y[i];
              y[i] = sl - y[i];
              sl = y[i];
              lds = lds + sl*sl;
          }
          lds = sqrt(lds);
   #ifdef DEBUGPRAX
          printf("Minimization done 'conjugate', shifted all points, computed lds=%.8f\n",lds);
   #endif      
         /*
           Discard direction V(*,kl).
           
           If no random step was taken, V(*,KL) is the "non-conjugate"
           direction along which the greatest improvement was made.
         */
          if (lds > small_windows) {
   #ifdef DEBUGPRAX
          printf("lds big enough to throw direction  V(*,kl=%d). If no random step was taken, V(*,KL) is the 'non-conjugate' direction along which the greatest improvement was made.\n",kl);
            matprint("  before shift new conjugate vectors:",v,n,n);
   #endif
            for (i=kl-1; i>=k; i--) {
              /* for (j=0; j < n; j++) */
              for (j=1; j <= n; j++)
                /* v[j][i+1] = v[j][i]; */ /* This is v[j][i+1]=v[j][i] i=kl-1 to k */
                v[j][i+1] = v[j][i]; /* This is v[j][i+1]=v[j][i] i=kl-1 to k */
              /* v[j][i+1] = v[j][i]; */
              /* d[i+1] = d[i];*/  /* last  is d[k+1]= d[k] */
              d[i+1] = d[i];  /* last  is d[k]= d[k-1] */
            }
   #ifdef DEBUGPRAX
            matprint("  after shift new conjugate vectors:",v,n,n);         
   #endif   /* d[k] = 0.0; */
            d[k] = 0.0;
            for (i=1; i <= n; i++)
              v[i][k] = y[i] / lds;
            /* v[i][k] = y[i] / lds; */
   #ifdef DEBUGPRAX
            printf("Minimize along the new 'conjugate' direction V(*,k=%d), which is the normalized vector:  (new x) - (old x). d2=%14.7g lds=%.10f\n",k,d[k],lds);
            /* fprintf(ficlog,"Minimize along the new 'conjugate' direction V(*,k=%d), which is the normalized vector:  (new x) - (old x).\n",k); */
       matprint("  before min new conjugate vectors:",v,n,n);       
   #endif
            /* min(k-1, 4, &d[k-1], &lds, f1, 1); */
            minny(k, 4, &d[k], &lds, f1, 1);
   #ifdef DEBUGPRAX
            printf(" after min d(k)=%d %.7g lds=%14f\n",k,d[k],lds);
      matprint("  after min vectors:",v,n,n);
   #endif
            if (lds <= 0.0) {
              lds = -lds;
   #ifdef DEBUGPRAX
             printf(" lds changed sign lds=%.14f k=%d\n",lds,k);
   #endif     
              /* for (i=0; i<n; i++) */
              /*   v[i][k] = -v[i][k]; */
              for (i=1; i<=n; i++)
                v[i][k] = -v[i][k];
            }
          }
          ldt = ldfac * ldt;
          if (ldt < lds)
             ldt = lds;
          if (prin > 0){
   #ifdef DEBUGPRAX
           printf(" k=%d",k);
           /* fprintf(ficlog," k=%d",k); */
   #endif
           print2();/* n, x, prin, fx, nf, nl ); */
          }
          t2 = 0.0;
          /* for (i=0; i<n; i++) */
          for (i=1; i<=n; i++)
              t2 += x[i]*x[i];
          t2 = m2 * sqrt(t2) + t;
          /*
           See whether the length of the step taken since starting the
           inner loop exceeds half the tolerance.
         */
   #ifdef DEBUGPRAX
          printf("See if step length exceeds half the tolerance.\n"); /* ZZZZZ */
         /* fprintf(ficlog,"See if step length exceeds half the tolerance.\n"); */
   #endif
          if (ldt > (0.5 * t2))
             kt = 0;
          else 
             kt++;
   #ifdef DEBUGPRAX
          printf("if kt=%d >? ktm=%d gotoL2 loop\n",kt,ktm);
   #endif
          if (kt > ktm){
            if ( 0 < prin ){
              /* printf("\nr8vec_print\n X:\n"); */
              /* fprintf(ficlog,"\nr8vec_print\n X:\n"); */
              vecprint ("END  X:", x, n );
            }
              goto fret;
          }
   #ifdef DEBUGPRAX
      matprint("  end of L2 loop vectors:",v,n,n);
   #endif
          
      }
      /* printf("The inner loop ends here.\n"); */
      /* fprintf(ficlog,"The inner loop ends here.\n"); */
      /*
        The inner loop ends here.
        
        Try quadratic extrapolation in case we are in a curved valley.
      */
   #ifdef DEBUGPRAX
      printf("Try QUAD ratic extrapolation in case we are in a curved valley.\n");
   #endif
      /*  try quadratic extrapolation in case    */
      /*  we are stuck in a curved valley        */
      quad();
      dn = 0.0;
      /* for (i=0; i<n; i++) { */
      for (i=1; i<=n; i++) {
          d[i] = 1.0 / sqrt(d[i]);
          if (dn < d[i])
             dn = d[i];
      }
      if (prin > 2)
        matprint("  NEW DIRECTIONS vectors:",v,n,n);
      /* for (j=0; j<n; j++) { */
      for (j=1; j<=n; j++) {
          s = d[j] / dn;
          /* for (i=0; i < n; i++) */
          for (i=1; i <= n; i++)
              v[i][j] *= s;
      }
      
      if (scbd > 1.0) {       /* scale axis to reduce condition number */
   #ifdef DEBUGPRAX
        printf("Scale the axes to try to reduce the condition number.\n");
   #endif
        /* fprintf(ficlog,"Scale the axes to try to reduce the condition number.\n"); */
         s = vlarge;
         /* for (i=0; i<n; i++) { */
         for (i=1; i<=n; i++) {
             sl = 0.0;
             /* for (j=0; j < n; j++) */
             for (j=1; j <= n; j++)
                 sl += v[i][j]*v[i][j];
             z[i] = sqrt(sl);
             if (z[i] < m4)
                z[i] = m4;
             if (s > z[i])
                s = z[i];
         }
         /* for (i=0; i<n; i++) { */
         for (i=1; i<=n; i++) {
             sl = s / z[i];
             z[i] = 1.0 / sl;
             if (z[i] > scbd) {
                sl = 1.0 / scbd;
                z[i] = scbd;
             }
       }        }
     }     }
  /* fprintf ( stdout, "\n" ); */     for (i=1; i<=n; i++)
   /* fprintf ( stdout, " %s\n", title ); */         /* for (j=0; j<=i-1; j++) { */
   fprintf ( stdout, " %s", title );         /* for (j=1; j<=i; j++) { */
   /* fprintf ( stdout, "\n" ); */         for (j=1; j<=i-1; j++) {
   for ( i = 0; i < n; i++ )             s = v[i][j];
   {             v[i][j] = v[j][i];
     /* fprintf ( stdout, "  %8d: %14g", i+1, a[i] ); */             v[j][i] = s;
     fprintf ( stdout, "  %.12lf",  a[i] );         }
   }  #ifdef DEBUGPRAX
   fprintf ( stdout, "\n" );      printf(" Calculate a new set of orthogonal directions before repeating  the main loop.\n  Transpose V for MINFIT:...\n");
   /* for ( i = 0; i < n; i++ ) */  #endif
   /* { */        /*
   /*   fprintf ( stdout, "  %8d: %14g\n", i, a[i] ); */        MINFIT finds the singular value decomposition of V.
   /* } */  
   
   return;  
 }  
 /******************************************************************************/  
   
 void svsort ( int n, double d[], double v[] )   
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     SVSORT descending sorts D and adjusts the corresponding columns of V.  
   
   Discussion:  
   
     A simple bubble sort is used on D.  
   
     In our application, D contains singular values, and the columns of V are  
     the corresponding right singular vectors.  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     28 July 2016  
   
   Author:  
   
     Original FORTRAN77 version by Richard Brent.  
     C version by John Burkardt.  
   
   Reference:  
   
     Richard Brent,  
     Algorithms for Minimization with Derivatives,  
     Prentice Hall, 1973,  
     Reprinted by Dover, 2002.  
   
   Parameters:  
   
     Input, int N, the length of D, and the order of V.  
   
     Input/output, double D[N], the vector to be sorted.    
     On output, the entries of D are in descending order.  
   
     Input/output, double V[N,N], an N by N array to be adjusted         This gives the principal values and principal directions of the
     as D is sorted.  In particular, if the value that was in D(I) on input is        approximating quadratic form without squaring the condition number.
     moved to D(J) on output, then the input column V(*,I) is moved to      */
     the output column V(*,J).   #ifdef DEBUGPRAX
 */      printf(" MINFIT finds the singular value decomposition of V. \n This gives the principal values and principal directions of the\n  approximating quadratic form without squaring the condition number...\n");
 {  #endif
   int i;  
   int j1;  
   int j2;  
   int j3;  
   double t;  
   
   for ( j1 = 0; j1 < n - 1; j1++ )     minfit(n, macheps, vsmall, v, d);
   {      /* for(i=0; i<n;i++)printf(" %14.7g",d[i]); */
 /*      /* v is overwritten with R. */
   Find J3, the index of the largest entry in D[J1:N-1].      /*
   MAXLOC apparently requires its output to be an array.        Unscale the axes.
 */      */
     j3 = j1;     if (scbd > 1.0) {
     for ( j2 = j1 + 1; j2 < n; j2++ )  #ifdef DEBUGPRAX
     {        printf(" Unscale the axes.\n");
       if ( d[j3] < d[j2] )  #endif
       {        /* for (i=0; i<n; i++) { */
         j3 = j2;        for (i=1; i<=n; i++) {
             s = z[i];
             /* for (j=0; j<n; j++) */
             for (j=1; j<=n; j++)
                 v[i][j] *= s;
       }        }
     }        /* for (i=0; i<n; i++) { */
 /*        for (i=1; i<=n; i++) {
   If J1 != J3, swap D[J1] and D[J3], and columns J1 and J3 of V.            s = 0.0;
 */            /* for (j=0; j<n; j++) */
     if ( j1 != j3 )            for (j=1; j<=n; j++)
     {                s += v[j][i]*v[j][i];
       t     = d[j1];            s = sqrt(s);
       d[j1] = d[j3];            d[i] *= s;
       d[j3] = t;            s = 1.0 / s;
       for ( i = 0; i < n; i++ )            /* for (j=0; j<n; j++) */
       {            for (j=1; j<=n; j++)
         t         = v[i+j1*n];                v[j][i] *= s;
         v[i+j1*n] = v[i+j3*n];  
         v[i+j3*n] = t;  
       }        }
     }     }
   }     /* for (i=0; i<n; i++) { */
      double dni; /* added for compatibility with buckhardt but not brent */
      for (i=1; i<=n; i++) {
        dni=dn*d[i]; /* added for compatibility with buckhardt but not brent */
          if ((dn * d[i]) > large)
             d[i] = vsmall;
          else if ((dn * d[i]) < small_windows)
             d[i] = vlarge;
          else 
           d[i] = 1.0 / dni / dni; /* added for compatibility with buckhardt but not brent */
             /* d[i] = pow(dn * d[i],-2.0); */
      }
   #ifdef DEBUGPRAX
      vecprint ("\n Before sort Eigenvalues of a:",d,n );
   #endif
      
      sort();               /* the new eigenvalues and eigenvectors */
   #ifdef DEBUGPRAX
      vecprint( " After sort the eigenvalues ....\n", d, n);
      matprint( " After sort the eigenvectors....\n", v, n,n);
   #endif
   #ifdef DEBUGPRAX
       printf("  Determine the smallest eigenvalue.\n");
   #endif
      /* dmin = d[n-1]; */
      dmin = d[n];
      if (dmin < small_windows)
         dmin = small_windows;
       /*
        The ratio of the smallest to largest eigenvalue determines whether
        the system is ill conditioned.
      */
     
      /* illc = (m2 * d[0]) > dmin; */
      illc = (m2 * d[1]) > dmin;
   #ifdef DEBUGPRAX
       printf("  The ratio of the smallest to largest eigenvalue determines whether\n  the system is ill conditioned=%d . dmin=%.10lf < m2=%.10lf * d[1]=%.10lf \n",illc, dmin,m2, d[1]);
   #endif
      
      if ((prin > 2) && (scbd > 1.0))
         vecprint("\n The scale factors:",z,n);
      if (prin > 2)
         vecprint("  Principal values (EIGEN VALUES OF A) of the quadratic form:",d,n);
      if (prin > 2)
        matprint("  The principal axes (EIGEN VECTORS OF A:",v,n, n);
   
      if ((maxfun > 0) && (nf > maxfun)) {
         if (prin)
            printf("\n... maximum number of function calls reached ...\n");
         goto fret;
      }
   #ifdef DEBUGPRAX
      printf("Goto main loop\n");
   #endif
      goto mloop;   /* back to main loop */
   
   return;  fret:
      if (prin > 0) {
            vecprint("\n  X:", x, n);
            /* printf("\n... ChiSq reduced to %20.10e ...\n", fx); */
            /* printf("... after %20u function calls.\n", nf); */
      }
      free_vector(d, 1, n);
      free_vector(y, 1, n);
      free_vector(z, 1, n);
      free_vector(q0, 1, n);
      free_vector(q1, 1, n);
      free_matrix(v, 1, n, 1, n);
      /*   double *d, *y, *z, */
      /* *q0, *q1, **v; */
      free_vector(tflin, 1, n);
      /* double *tflin; /\* used in flin: return (*fun)(tflin, n); *\/ */
      free_vector(e, 1, n);
      /* double *e; /\* used in minfit, don't konw how to free memory and thus made global *\/ */
      
      return(fx);
 }  }
 /******************************************************************************/  
   
 void timestamp ( )  /* end praxis gegen */
   
 /******************************************************************************/  
 /*  
   Purpose:  
   
     TIMESTAMP prints the current YMDHMS date as a time stamp.  
   
   Example:  
   
     31 May 2001 09:45:54 AM  
   
   Licensing:  
   
     This code is distributed under the GNU LGPL license.  
   
   Modified:  
   
     24 September 2003  
   
   Author:  
   
     John Burkardt  
   
   Parameters:  
   
     None  
 */  
 {  
 # define TIME_SIZE 40  
   
   static char time_buffer[TIME_SIZE];  
   const struct tm *tm;  
   time_t now;  
   
   now = time ( NULL );  
   tm = localtime ( &now );  
   
   strftime ( time_buffer, TIME_SIZE, "%d %B %Y %I:%M:%S %p", tm );  
   
   fprintf ( stdout, "%s\n", time_buffer );  
   
   return;  
 # undef TIME_SIZE  
 }  
 /* end praxis */  
   
 /*************** powell ************************/  /*************** powell ************************/
 /*  /*
Line 5187  void powell(double p[], double **xi, int Line 4164  void powell(double p[], double **xi, int
   double fp,fptt;    double fp,fptt;
   double *xits;    double *xits;
   int niterf, itmp;    int niterf, itmp;
     int Bigter=0, nBigterf=1;
     
   pt=vector(1,n);     pt=vector(1,n); 
   ptt=vector(1,n);     ptt=vector(1,n); 
   xit=vector(1,n);     xit=vector(1,n); 
Line 5200  void powell(double p[], double **xi, int Line 4178  void powell(double p[], double **xi, int
     ibig=0;       ibig=0; 
     del=0.0;       del=0.0; 
     rlast_time=rcurr_time;      rlast_time=rcurr_time;
       rlast_btime=rcurr_time;
     /* (void) gettimeofday(&curr_time,&tzp); */      /* (void) gettimeofday(&curr_time,&tzp); */
     rcurr_time = time(NULL);        rcurr_time = time(NULL);  
     curr_time = *localtime(&rcurr_time);      curr_time = *localtime(&rcurr_time);
     /* printf("\nPowell iter=%d -2*LL=%.12f gain=%.12f=%.3g %ld sec. %ld sec.",*iter,*fret, fp-*fret,fp-*fret, rcurr_time-rlast_time, rcurr_time-rstart_time);fflush(stdout); */      /* printf("\nPowell iter=%d -2*LL=%.12f gain=%.12f=%.3g %ld sec. %ld sec.",*iter,*fret, fp-*fret,fp-*fret, rcurr_time-rlast_time, rcurr_time-rstart_time);fflush(stdout); */
     /* fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f gain=%.12f=%.3g %ld sec. %ld sec.",*iter,*fret, fp-*fret,fp-*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog); */      /* fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f gain=%.12f=%.3g %ld sec. %ld sec.",*iter,*fret, fp-*fret,fp-*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog); */
     printf("\nPowell iter=%d -2*LL=%.12f gain=%.3lg %ld sec. %ld sec.",*iter,*fret,fp-*fret, rcurr_time-rlast_time, rcurr_time-rstart_time);fflush(stdout);      /* Bigter=(*iter - *iter % ncovmodel)/ncovmodel +1; /\* Big iteration, i.e on ncovmodel cycle *\/ */
     fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f gain=%.3lg %ld sec. %ld sec.",*iter,*fret,fp-*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog);      Bigter=(*iter - (*iter-1) % n)/n +1; /* Big iteration, i.e on ncovmodel cycle */
 /*     fprintf(ficrespow,"%d %.12f %ld",*iter,*fret,curr_time.tm_sec-start_time.tm_sec); */      printf("\nPowell iter=%d Big Iter=%d -2*LL=%.12f gain=%.3lg %ld sec. %ld sec.",*iter,Bigter,*fret,fp-*fret, rcurr_time-rlast_time, rcurr_time-rstart_time);fflush(stdout);
       fprintf(ficlog,"\nPowell iter=%d Big Iter=%d -2*LL=%.12f gain=%.3lg %ld sec. %ld sec.",*iter,Bigter,*fret,fp-*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog);
       fprintf(ficrespow,"%d %d %.12f %d",*iter,Bigter, *fret,curr_time.tm_sec-start_time.tm_sec);
     fp=(*fret); /* From former iteration or initial value */      fp=(*fret); /* From former iteration or initial value */
     for (i=1;i<=n;i++) {      for (i=1;i<=n;i++) {
       fprintf(ficrespow," %.12lf", p[i]);        fprintf(ficrespow," %.12lf", p[i]);
Line 5262  void powell(double p[], double **xi, int Line 4243  void powell(double p[], double **xi, int
         strcurr[itmp-1]='\0';          strcurr[itmp-1]='\0';
       printf("\nConsidering the time needed for the last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time);        printf("\nConsidering the time needed for the last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time);
       fprintf(ficlog,"\nConsidering the time needed for this last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time);        fprintf(ficlog,"\nConsidering the time needed for this last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time);
       for(niterf=10;niterf<=30;niterf+=10){        for(nBigterf=1;nBigterf<=31;nBigterf+=10){
           niterf=nBigterf*ncovmodel;
           /* rforecast_time=rcurr_time+(niterf-*iter)*(rcurr_time-rlast_time); */
         rforecast_time=rcurr_time+(niterf-*iter)*(rcurr_time-rlast_time);          rforecast_time=rcurr_time+(niterf-*iter)*(rcurr_time-rlast_time);
         forecast_time = *localtime(&rforecast_time);          forecast_time = *localtime(&rforecast_time);
         strcpy(strfor,asctime(&forecast_time));          strcpy(strfor,asctime(&forecast_time));
         itmp = strlen(strfor);          itmp = strlen(strfor);
         if(strfor[itmp-1]=='\n')          if(strfor[itmp-1]=='\n')
           strfor[itmp-1]='\0';            strfor[itmp-1]='\0';
         printf("   - if your program needs %d iterations to converge, convergence will be \n   reached in %s i.e.\n   on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr);          printf("   - if your program needs %d BIG iterations (%d iterations) to converge, convergence will be \n   reached in %s i.e.\n   on %s (current time is %s);\n",nBigterf, niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr);
         fprintf(ficlog,"   - if your program needs %d iterations to converge, convergence will be \n   reached in %s i.e.\n   on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr);          fprintf(ficlog,"   - if your program needs %d BIG iterations  (%d iterations) to converge, convergence will be \n   reached in %s i.e.\n   on %s (current time is %s);\n",nBigterf, niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr);
       }        }
     }      }
     for (i=1;i<=n;i++) { /* For each direction i */      for (i=1;i<=n;i++) { /* For each direction i, maximisation after loading directions */
       for (j=1;j<=n;j++) xit[j]=xi[j][i]; /* Directions stored from previous iteration with previous scales */        for (j=1;j<=n;j++) xit[j]=xi[j][i]; /* Directions stored from previous iteration with previous scales. xi is not changed but one dim xit  */
       fptt=(*fret);   
         fptt=(*fret); /* Computes likelihood for parameters xit */
 #ifdef DEBUG  #ifdef DEBUG
       printf("fret=%lf, %lf, %lf \n", *fret, *fret, *fret);        printf("fret=%lf, %lf, %lf \n", *fret, *fret, *fret);
       fprintf(ficlog, "fret=%lf, %lf, %lf \n", *fret, *fret, *fret);        fprintf(ficlog, "fret=%lf, %lf, %lf \n", *fret, *fret, *fret);
Line 5283  void powell(double p[], double **xi, int Line 4267  void powell(double p[], double **xi, int
       printf("%d",i);fflush(stdout); /* print direction (parameter) i */        printf("%d",i);fflush(stdout); /* print direction (parameter) i */
       fprintf(ficlog,"%d",i);fflush(ficlog);        fprintf(ficlog,"%d",i);fflush(ficlog);
 #ifdef LINMINORIGINAL  #ifdef LINMINORIGINAL
       linmin(p,xit,n,fret,func); /* Point p[n]. xit[n] has been loaded for direction i as input.*/        linmin(p,xit,n,fret,func); /* New point i minimizing in direction xit, i has coordinates p[j].*/
         /* xit[j] gives the n coordinates of direction i as input.*/
         /* *fret gives the maximum value on direction xit */
 #else  #else
       linmin(p,xit,n,fret,func,&flat); /* Point p[n]. xit[n] has been loaded for direction i as input.*/        linmin(p,xit,n,fret,func,&flat); /* Point p[n]. xit[n] has been loaded for direction i as input.*/
                         flatdir[i]=flat; /* Function is vanishing in that direction i */        flatdir[i]=flat; /* Function is vanishing in that direction i */
 #endif  #endif
                         /* Outputs are fret(new point p) p is updated and xit rescaled */        /* Outputs are fret(new point p) p is updated and xit rescaled */
       if (fabs(fptt-(*fret)) > del) { /* We are keeping the max gain on each of the n directions */        if (fabs(fptt-(*fret)) > del) { /* We are keeping the max gain on each of the n directions */
                                 /* because that direction will be replaced unless the gain del is small */          /* because that direction will be replaced unless the gain del is small */
                                 /* in comparison with the 'probable' gain, mu^2, with the last average direction. */          /* in comparison with the 'probable' gain, mu^2, with the last average direction. */
                                 /* Unless the n directions are conjugate some gain in the determinant may be obtained */          /* Unless the n directions are conjugate some gain in the determinant may be obtained */
                                 /* with the new direction. */          /* with the new direction. */
                                 del=fabs(fptt-(*fret));           del=fabs(fptt-(*fret)); 
                                 ibig=i;           ibig=i; 
       }         } 
 #ifdef DEBUG  #ifdef DEBUG
       printf("%d %.12e",i,(*fret));        printf("%d %.12e",i,(*fret));
       fprintf(ficlog,"%d %.12e",i,(*fret));        fprintf(ficlog,"%d %.12e",i,(*fret));
       for (j=1;j<=n;j++) {        for (j=1;j<=n;j++) {
                                 xits[j]=FMAX(fabs(p[j]-pt[j]),1.e-5);          xits[j]=FMAX(fabs(p[j]-pt[j]),1.e-5);
                                 printf(" x(%d)=%.12e",j,xit[j]);          printf(" x(%d)=%.12e",j,xit[j]);
                                 fprintf(ficlog," x(%d)=%.12e",j,xit[j]);          fprintf(ficlog," x(%d)=%.12e",j,xit[j]);
       }        }
       for(j=1;j<=n;j++) {        for(j=1;j<=n;j++) {
                                 printf(" p(%d)=%.12e",j,p[j]);          printf(" p(%d)=%.12e",j,p[j]);
                                 fprintf(ficlog," p(%d)=%.12e",j,p[j]);          fprintf(ficlog," p(%d)=%.12e",j,p[j]);
       }        }
       printf("\n");        printf("\n");
       fprintf(ficlog,"\n");        fprintf(ficlog,"\n");
 #endif  #endif
     } /* end loop on each direction i */      } /* end loop on each direction i */
     /* Convergence test will use last linmin estimation (fret) and compare former iteration (fp) */       /* Convergence test will use last linmin estimation (fret) and compare to former iteration (fp) */ 
     /* But p and xit have been updated at the end of linmin, *fret corresponds to new p, xit  */      /* But p and xit have been updated at the end of linmin, *fret corresponds to new p, xit  */
     /* New value of last point Pn is not computed, P(n-1) */      /* New value of last point Pn is not computed, P(n-1) */
     for(j=1;j<=n;j++) {      for(j=1;j<=n;j++) {
Line 5368  void powell(double p[], double **xi, int Line 4354  void powell(double p[], double **xi, int
       return;         return; 
     } /* enough precision */       } /* enough precision */ 
     if (*iter == ITMAX*n) nrerror("powell exceeding maximum iterations.");       if (*iter == ITMAX*n) nrerror("powell exceeding maximum iterations."); 
     for (j=1;j<=n;j++) { /* Computes the extrapolated point P_0 + 2 (P_n-P_0) */      for (j=1;j<=n;j++) { /* Computes the extrapolated point and value f3, P_0 + 2 (P_n-P_0)=2Pn-P0 and xit is direction Pn-P0 */
       ptt[j]=2.0*p[j]-pt[j];         ptt[j]=2.0*p[j]-pt[j]; 
       xit[j]=p[j]-pt[j];         xit[j]=p[j]-pt[j]; /* Coordinate j of last direction xi_n=P_n-P_0 */
       pt[j]=p[j];   #ifdef DEBUG
     }         printf("\n %d xit=%12.7g p=%12.7g pt=%12.7g ",j,xit[j],p[j],pt[j]);
   #endif
         pt[j]=p[j]; /* New P0 is Pn */
       }
   #ifdef DEBUG
       printf("\n");
   #endif
     fptt=(*func)(ptt); /* f_3 */      fptt=(*func)(ptt); /* f_3 */
 #ifdef NODIRECTIONCHANGEDUNTILNITER  /* No change in drections until some iterations are done */  #ifdef NODIRECTIONCHANGEDUNTILNITER  /* No change in directions until some iterations are done */
                 if (*iter <=4) {                  if (*iter <=4) {
 #else  #else
 #endif  #endif
Line 5393  void powell(double p[], double **xi, int Line 4385  void powell(double p[], double **xi, int
       /* t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)-del*SQR(fp-fptt); */        /* t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)-del*SQR(fp-fptt); */
       /*  Even if f3 <f1, directest can be negative and t >0 */        /*  Even if f3 <f1, directest can be negative and t >0 */
       /* mu² and del² are equal when f3=f1 */        /* mu² and del² are equal when f3=f1 */
                         /* f3 < f1 : mu² < del <= lambda^2 both test are equivalent */        /* f3 < f1 : mu² < del <= lambda^2 both test are equivalent */
                         /* f3 < f1 : mu² < lambda^2 < del then directtest is negative and powell t is positive */        /* f3 < f1 : mu² < lambda^2 < del then directtest is negative and powell t is positive */
                         /* f3 > f1 : lambda² < mu^2 < del then t is negative and directest >0  */        /* f3 > f1 : lambda² < mu^2 < del then t is negative and directest >0  */
                         /* f3 > f1 : lambda² < del < mu^2 then t is positive and directest >0  */        /* f3 > f1 : lambda² < del < mu^2 then t is positive and directest >0  */
 #ifdef NRCORIGINAL  #ifdef NRCORIGINAL
       t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)- del*SQR(fp-fptt); /* Original Numerical Recipes in C*/        t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)- del*SQR(fp-fptt); /* Original Numerical Recipes in C*/
 #else  #else
Line 5418  void powell(double p[], double **xi, int Line 4410  void powell(double p[], double **xi, int
       if (t < 0.0) { /* Then we use it for new direction */        if (t < 0.0) { /* Then we use it for new direction */
 #else  #else
       if (directest*t < 0.0) { /* Contradiction between both tests */        if (directest*t < 0.0) { /* Contradiction between both tests */
                                 printf("directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt,del);          printf("directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt,del);
         printf("f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt);          printf("f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt);
         fprintf(ficlog,"directest= %.12lf (if directest<0 or t<0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt, del);          fprintf(ficlog,"directest= %.12lf (if directest<0 or t<0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt, del);
         fprintf(ficlog,"f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt);          fprintf(ficlog,"f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt);
Line 5497  void powell(double p[], double **xi, int Line 4489  void powell(double p[], double **xi, int
         fprintf(ficlog,"\n");          fprintf(ficlog,"\n");
 #endif  #endif
       } /* end of t or directest negative */        } /* end of t or directest negative */
         printf(" Directest is positive, P_n-P_0 does not increase the conjugacy. n=%d\n",n);
         fprintf(ficlog," Directest is positive, P_n-P_0 does not increase the conjugacy. n=%d\n",n);
 #ifdef POWELLNOF3INFF1TEST  #ifdef POWELLNOF3INFF1TEST
 #else  #else
       } /* end if (fptt < fp)  */        } /* end if (fptt < fp)  */
Line 5705  void powell(double p[], double **xi, int Line 4699  void powell(double p[], double **xi, int
     first++;      first++;
   }    }
   
   /* Try to lower 'ftol', for example from 1.e-8 to 6.e-9.\n", ftolpl, (int)age, (int)delaymax, (int)agefin, ncvloop, (int)age-(int)agefin); */    /* Try to lower 'ftol', for example from 1.e-8 to 6.e-9.\n", ftolpl,
      * (int)age, (int)delaymax, (int)agefin, ncvloop,
      * (int)age-(int)agefin); */
   free_vector(min,1,nlstate);    free_vector(min,1,nlstate);
   free_vector(max,1,nlstate);    free_vector(max,1,nlstate);
   free_vector(meandiff,1,nlstate);    free_vector(meandiff,1,nlstate);
Line 5740  void powell(double p[], double **xi, int Line 4736  void powell(double p[], double **xi, int
   /*  0.51326036147820708, 0.48673963852179264} */    /*  0.51326036147820708, 0.48673963852179264} */
   /* If we start from prlim again, prlim tends to a constant matrix */    /* If we start from prlim again, prlim tends to a constant matrix */
   
   int i, ii,j,k, k1;    int i, ii,j, k1;
   int first=0;    int first=0;
   double *min, *max, *meandiff, maxmax,sumnew=0.;    double *min, *max, *meandiff, maxmax,sumnew=0.;
   /* double **matprod2(); */ /* test */    /* double **matprod2(); */ /* test */
Line 6007  double **pmij(double **ps, double *cov, Line 5003  double **pmij(double **ps, double *cov,
   /* Computes the backward probability at age agefin, cov[2], and covariate combination 'ij'. In fact cov is already filled and x too.    /* Computes the backward probability at age agefin, cov[2], and covariate combination 'ij'. In fact cov is already filled and x too.
    * Call to pmij(cov and x), call to cross prevalence, sums and inverses, left multiply, and returns in **ps as well as **bmij.     * Call to pmij(cov and x), call to cross prevalence, sums and inverses, left multiply, and returns in **ps as well as **bmij.
    */     */
   int i, ii, j,k;    int ii, j;
       
   double **out, **pmij();    double  **pmij();
   double sumnew=0.;    double sumnew=0.;
   double agefin;    double agefin;
   double k3=0.; /* constant of the w_x diagonal matrix (in order for B to sum to 1 even for death state) */    double k3=0.; /* constant of the w_x diagonal matrix (in order for B to sum to 1 even for death state) */
Line 6222  double ***hpxij(double ***po, int nhstep Line 5218  double ***hpxij(double ***po, int nhstep
   
      */       */
   
   int i, j, d, h, k, k1;    int i, j, d, h, k1;
   double **out, cov[NCOVMAX+1];    double **out, cov[NCOVMAX+1];
   double **newm;    double **newm;
   double agexact;    double agexact;
   double agebegin, ageend;    /*double agebegin, ageend;*/
   
   /* Hstepm could be zero and should return the unit matrix */    /* Hstepm could be zero and should return the unit matrix */
   for (i=1;i<=nlstate+ndeath;i++)    for (i=1;i<=nlstate+ndeath;i++)
Line 6403  double ***hbxij(double ***po, int nhstep Line 5399  double ***hbxij(double ***po, int nhstep
      The addresss of po (p3mat allocated to the dimension of nhstepm) should be stored for output       The addresss of po (p3mat allocated to the dimension of nhstepm) should be stored for output
   */    */
   
   int i, j, d, h, k, k1;    int i, j, d, h, k1;
   double **out, cov[NCOVMAX+1], **bmij();    double **out, cov[NCOVMAX+1], **bmij();
   double **newm, ***newmm;    double **newm, ***newmm;
   double agexact;    double agexact;
   double agebegin, ageend;    /*double agebegin, ageend;*/
   double **oldm, **savm;    double **oldm, **savm;
   
   newmm=po; /* To be saved */    newmm=po; /* To be saved */
Line 6568  double func( double *x) Line 5564  double func( double *x)
   
   for(k=1; k<=nlstate; k++) ll[k]=0.;    for(k=1; k<=nlstate; k++) ll[k]=0.;
   ioffset=0;    ioffset=0;
   for (i=1,ipmx=0, sw=0.; i<=imx; i++){    if(mle==1){
     /* Computes the values of the ncovmodel covariates of the model      for (i=1,ipmx=0, sw=0.; i<=imx; i++){
        depending if the covariates are fixed or varying (age dependent) and stores them in cov[]        /* Computes the values of the ncovmodel covariates of the model
        Then computes with function pmij which return a matrix p[i][j] giving the elementary probability           depending if the covariates are fixed or varying (age dependent) and stores them in cov[]
        to be observed in j being in i according to the model.           Then computes with function pmij which return a matrix p[i][j] giving the elementary probability
     */           to be observed in j being in i according to the model.
     ioffset=2+nagesqr ;        */
     /* Fixed */        ioffset=2+nagesqr ;
     for (kf=1; kf<=ncovf;kf++){ /* For each fixed covariate dummy or quant or prod */     /* Fixed */
       /* # V1=sex, V2=raedyrs Quant Fixed, State=livarnb4..livarnb11, V3=iadl4..iald11, V4=adlw4..adlw11, V5=r4bmi..r11bmi */        for (kf=1; kf<=ncovf;kf++){ /* For each fixed covariate dummy or quant or prod */
       /*             V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */          /* # V1=sex, V2=raedyrs Quant Fixed, State=livarnb4..livarnb11, V3=iadl4..iald11, V4=adlw4..adlw11, V5=r4bmi..r11bmi */
       /*  TvarF[1]=Tvar[6]=2,  TvarF[2]=Tvar[7]=7, TvarF[3]=Tvar[9]=1  ID of fixed covariates or product V2, V1*V2, V1 */          /*             V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */
       /* TvarFind;  TvarFind[1]=6,  TvarFind[2]=7, TvarFind[3]=9 *//* Inverse V2(6) is first fixed (single or prod)  */          /*  TvarF[1]=Tvar[6]=2,  TvarF[2]=Tvar[7]=7, TvarF[3]=Tvar[9]=1  ID of fixed covariates or product V2, V1*V2, V1 */
       cov[ioffset+TvarFind[kf]]=covar[Tvar[TvarFind[kf]]][i];/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, only V1 is fixed (TvarFind[1]=6)*/          /* TvarFind;  TvarFind[1]=6,  TvarFind[2]=7, TvarFind[3]=9 *//* Inverse V2(6) is first fixed (single or prod)  */
       /* V1*V2 (7)  TvarFind[2]=7, TvarFind[3]=9 */          cov[ioffset+TvarFind[kf]]=covar[Tvar[TvarFind[kf]]][i];/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, only V1 is fixed (TvarFind[1]=6)*/
     }          /* V1*V2 (7)  TvarFind[2]=7, TvarFind[3]=9 */
     /* In model V2+V1*V4+age*V3+V3*V2 Tvar[1] is V2, Tvar[2=V1*V4]         }
        is 5, Tvar[3=age*V3] should not be computed because of age Tvar[4=V3*V2]=6         /* In model V2+V1*V4+age*V3+V3*V2 Tvar[1] is V2, Tvar[2=V1*V4] 
        has been calculated etc */           is 5, Tvar[3=age*V3] should not be computed because of age Tvar[4=V3*V2]=6 
     /* For an individual i, wav[i] gives the number of effective waves */           has been calculated etc */
     /* We compute the contribution to Likelihood of each effective transition        /* For an individual i, wav[i] gives the number of effective waves */
        mw[mi][i] is real wave of the mi th effectve wave */        /* We compute the contribution to Likelihood of each effective transition
     /* Then statuses are computed at each begin and end of an effective wave s1=s[ mw[mi][i] ][i];           mw[mi][i] is real wave of the mi th effectve wave */
        s2=s[mw[mi+1][i]][i];        /* Then statuses are computed at each begin and end of an effective wave s1=s[ mw[mi][i] ][i];
        And the iv th varying covariate is the cotvar[mw[mi+1][i]][iv][i] because now is moved after nvocol+nqv            s2=s[mw[mi+1][i]][i];
        But if the variable is not in the model TTvar[iv] is the real variable effective in the model:           And the iv th varying covariate is the cotvar[mw[mi+1][i]][iv][i] because now is moved after nvocol+nqv 
        meaning that decodemodel should be used cotvar[mw[mi+1][i]][TTvar[iv]][i]           But if the variable is not in the model TTvar[iv] is the real variable effective in the model:
     */           meaning that decodemodel should be used cotvar[mw[mi+1][i]][TTvar[iv]][i]
     for(mi=1; mi<= wav[i]-1; mi++){  /* Varying with waves */        */
         for(mi=1; mi<= wav[i]-1; mi++){  /* Varying with waves */
       /* Wave varying (but not age varying) */        /* Wave varying (but not age varying) */
       /* for(k=1; k <= ncovv ; k++){ /\* Varying  covariates in the model (single and product but no age )"V5+V4+V3+V4*V3+V5*age+V1*age+V1" +TvarVind 1,2,3,4(V4*V3)  Tvar[1]@7{5, 4, 3, 6, 5, 1, 1 ; 6 because the created covar is after V5 and is 6, minus 1+1, 3,2,1,4 positions in cotvar*\/ */          /* for(k=1; k <= ncovv ; k++){ /\* Varying  covariates in the model (single and product but no age )"V5+V4+V3+V4*V3+V5*age+V1*age+V1" +TvarVind 1,2,3,4(V4*V3)  Tvar[1]@7{5, 4, 3, 6, 5, 1, 1 ; 6 because the created covar is after V5 and is 6, minus 1+1, 3,2,1,4 positions in cotvar*\/ */
       /*   /\* cov[ioffset+TvarVind[k]]=cotvar[mw[mi][i]][Tvar[TvarVind[k]]][i]; but where is the crossproduct? *\/ */          /*   /\* cov[ioffset+TvarVind[k]]=cotvar[mw[mi][i]][Tvar[TvarVind[k]]][i]; but where is the crossproduct? *\/ */
       /*   cov[ioffset+TvarVind[k]]=cotvar[mw[mi][i]][Tvar[TvarVind[k]]-ncovcol-nqv][i]; */          /*   cov[ioffset+TvarVind[k]]=cotvar[mw[mi][i]][Tvar[TvarVind[k]]-ncovcol-nqv][i]; */
       /* } */          /* } */
       for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Varying  covariates (single and product but no age )*/          for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Varying  covariates (single and product but no age )*/
         itv=TvarVV[ncovv]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate */            itv=TvarVV[ncovv]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate */
         ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/            ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/
         if(FixedV[itv]!=0){ /* Not a fixed covariate */            if(FixedV[itv]!=0){ /* Not a fixed covariate */
           cotvarv=cotvar[mw[mi][i]][TvarVV[ncovv]][i];  /* cotvar[wav][ncovcol+nqv+iv][i] */              cotvarv=cotvar[mw[mi][i]][TvarVV[ncovv]][i];  /* cotvar[wav][ncovcol+nqv+iv][i] */
         }else{ /* fixed covariate */  
           cotvarv=covar[itv][i];  /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */  
         }  
         if(ipos!=iposold){ /* Not a product or first of a product */  
           cotvarvold=cotvarv;  
         }else{ /* A second product */  
           cotvarv=cotvarv*cotvarvold;  
         }  
         iposold=ipos;  
         cov[ioffset+ipos]=cotvarv;  
       }  
       /* for(itv=1; itv <= ntveff; itv++){ /\* Varying dummy covariates (single??)*\/ */  
       /*   iv= Tvar[Tmodelind[ioffset-2-nagesqr-cptcovage+itv]]-ncovcol-nqv; /\* Counting the # varying covariate from 1 to ntveff *\/ */  
       /*   cov[ioffset+iv]=cotvar[mw[mi][i]][iv][i]; */  
       /*   k=ioffset-2-nagesqr-cptcovage+itv; /\* position in simple model *\/ */  
       /*   cov[ioffset+itv]=cotvar[mw[mi][i]][TmodelInvind[itv]][i]; */  
       /*   printf(" i=%d,mi=%d,itv=%d,TmodelInvind[itv]=%d,cotvar[mw[mi][i]][TmodelInvind[itv]][i]=%f\n", i, mi, itv, TmodelInvind[itv],cotvar[mw[mi][i]][TmodelInvind[itv]][i]); */  
       /* } */  
       /* for(iqtv=1; iqtv <= nqtveff; iqtv++){ /\* Varying quantitatives covariates *\/ */  
       /*   iv=TmodelInvQind[iqtv]; /\* Counting the # varying covariate from 1 to ntveff *\/ */  
       /*   /\* printf(" i=%d,mi=%d,iqtv=%d,TmodelInvQind[iqtv]=%d,cotqvar[mw[mi][i]][TmodelInvQind[iqtv]][i]=%f\n", i, mi, iqtv, TmodelInvQind[iqtv],cotqvar[mw[mi][i]][TmodelInvQind[iqtv]][i]); *\/ */  
       /*   cov[ioffset+ntveff+iqtv]=cotqvar[mw[mi][i]][TmodelInvQind[iqtv]][i]; */  
       /* } */  
       /* for products of time varying to be done */  
       for (ii=1;ii<=nlstate+ndeath;ii++)  
         for (j=1;j<=nlstate+ndeath;j++){  
           oldm[ii][j]=(ii==j ? 1.0 : 0.0);  
           savm[ii][j]=(ii==j ? 1.0 : 0.0);  
         }  
         
       agebegin=agev[mw[mi][i]][i]; /* Age at beginning of effective wave */  
       ageend=agev[mw[mi][i]][i] + (dh[mi][i])*stepm/YEARM; /* Age at end of effective wave and at the end of transition */  
       for(d=0; d<dh[mi][i]; d++){  
         newm=savm;  
         agexact=agev[mw[mi][i]][i]+d*stepm/YEARM;  
         cov[2]=agexact;  
         if(nagesqr==1)  
           cov[3]= agexact*agexact;  /* Should be changed here */  
         for (kk=1; kk<=cptcovprodage;kk++) {/*  + age*V3*V2 +age*V2 +age*V3 +age*V4 For age product with simple covariates or product of  fixed covariates  */  
           /* if(!FixedV[Tvar[Tage[kk]]]) */  
           cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; /* Tage[kk] gives the data-covariate associated with age */  
           /* else*/  
           /*cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]*agexact; *//* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */  
         }  
         for(ncovva=1, iposold=0; ncovva <= ncovvta ; ncovva++){ /* Time varying  covariates with age including individual from products, product is computed dynamically */  
           itv=TvarVVA[ncovva]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm  */  
           ipos=TvarVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/  
           if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */  
             cotvarv=cotvar[mw[mi][i]][TvarVVA[ncovva]][i];  /* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) */   
           }else{ /* fixed covariate */            }else{ /* fixed covariate */
             cotvarv=covar[itv][i];  /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */              cotvarv=covar[itv][i];  /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */
           }            }
Line 6665  double func( double *x) Line 5613  double func( double *x)
             cotvarv=cotvarv*cotvarvold;              cotvarv=cotvarv*cotvarvold;
           }            }
           iposold=ipos;            iposold=ipos;
           cov[ioffset+ipos]=cotvarv*agexact;            cov[ioffset+ipos]=cotvarv;
           /* For products */  
         }          }
           /* for products of time varying to be done */
           for (ii=1;ii<=nlstate+ndeath;ii++)
             for (j=1;j<=nlstate+ndeath;j++){
               oldm[ii][j]=(ii==j ? 1.0 : 0.0);
               savm[ii][j]=(ii==j ? 1.0 : 0.0);
             }
   
           agebegin=agev[mw[mi][i]][i]; /* Age at beginning of effective wave */
           ageend=agev[mw[mi][i]][i] + (dh[mi][i])*stepm/YEARM; /* Age at end of effective wave and at the end of transition */
           for(d=0; d<dh[mi][i]; d++){
             newm=savm;
             agexact=agev[mw[mi][i]][i]+d*stepm/YEARM;
             cov[2]=agexact;
             if(nagesqr==1)
               cov[3]= agexact*agexact;  /* Should be changed here */
             /* for (kk=1; kk<=cptcovage;kk++) { */
             /*   if(!FixedV[Tvar[Tage[kk]]]) */
             /*     cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; /\* Tage[kk] gives the data-covariate associated with age *\/ */
             /*   else */
             /*     cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]*agexact; /\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\/  */
             /* } */
             for(ncovva=1, iposold=0; ncovva <= ncovta ; ncovva++){ /* Time varying  covariates with age including individual from products, product is computed dynamically */
               itv=TvarAVVA[ncovva]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm  */
               ipos=TvarAVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/
               if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */
                 cotvarv=cotvar[mw[mi][i]][TvarAVVA[ncovva]][i];  /* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) */ 
               }else{ /* fixed covariate */
                 cotvarv=covar[itv][i];  /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */
               }
               if(ipos!=iposold){ /* Not a product or first of a product */
                 cotvarvold=cotvarv;
               }else{ /* A second product */
                 cotvarv=cotvarv*cotvarvold;
               }
               iposold=ipos;
               cov[ioffset+ipos]=cotvarv*agexact;
               /* For products */
             }
             
             out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,
                          1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate));
             savm=oldm;
             oldm=newm;
           } /* end mult */
                   
         out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,  
                      1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate));  
         savm=oldm;  
         oldm=newm;  
       } /* end mult */  
         
         /*lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]);*/ /* Original formula */          /*lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]);*/ /* Original formula */
       /* But now since version 0.9 we anticipate for bias at large stepm.          /* But now since version 0.9 we anticipate for bias at large stepm.
        * If stepm is larger than one month (smallest stepm) and if the exact delay            * If stepm is larger than one month (smallest stepm) and if the exact delay 
        * (in months) between two waves is not a multiple of stepm, we rounded to            * (in months) between two waves is not a multiple of stepm, we rounded to 
        * the nearest (and in case of equal distance, to the lowest) interval but now           * the nearest (and in case of equal distance, to the lowest) interval but now
        * we keep into memory the bias bh[mi][i] and also the previous matrix product           * we keep into memory the bias bh[mi][i] and also the previous matrix product
        * (i.e to dh[mi][i]-1) saved in 'savm'. Then we inter(extra)polate the           * (i.e to dh[mi][i]-1) saved in 'savm'. Then we inter(extra)polate the
        * probability in order to take into account the bias as a fraction of the way           * probability in order to take into account the bias as a fraction of the way
        * from savm to out if bh is negative or even beyond if bh is positive. bh varies                                   * from savm to out if bh is negative or even beyond if bh is positive. bh varies
        * -stepm/2 to stepm/2 .                                   * -stepm/2 to stepm/2 .
        * For stepm=1 the results are the same as for previous versions of Imach.                                   * For stepm=1 the results are the same as for previous versions of Imach.
        * For stepm > 1 the results are less biased than in previous versions.                                    * For stepm > 1 the results are less biased than in previous versions. 
        */                                   */
       s1=s[mw[mi][i]][i];          s1=s[mw[mi][i]][i];
       s2=s[mw[mi+1][i]][i];          s2=s[mw[mi+1][i]][i];
       bbh=(double)bh[mi][i]/(double)stepm;           bbh=(double)bh[mi][i]/(double)stepm; 
       /* bias bh is positive if real duration          /* bias bh is positive if real duration
        * is higher than the multiple of stepm and negative otherwise.           * is higher than the multiple of stepm and negative otherwise.
        */           */
       /* lli= (savm[s1][s2]>1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.+bbh)*out[s1][s2]));*/          /* lli= (savm[s1][s2]>1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.+bbh)*out[s1][s2]));*/
       if( s2 > nlstate){           if( s2 > nlstate){ 
         /* i.e. if s2 is a death state and if the date of death is known             /* i.e. if s2 is a death state and if the date of death is known 
            then the contribution to the likelihood is the probability to                then the contribution to the likelihood is the probability to 
            die between last step unit time and current  step unit time,                die between last step unit time and current  step unit time, 
            which is also equal to probability to die before dh                which is also equal to probability to die before dh 
            minus probability to die before dh-stepm .                minus probability to die before dh-stepm . 
            In version up to 0.92 likelihood was computed               In version up to 0.92 likelihood was computed
            as if date of death was unknown. Death was treated as any other               as if date of death was unknown. Death was treated as any other
            health state: the date of the interview describes the actual state               health state: the date of the interview describes the actual state
            and not the date of a change in health state. The former idea was               and not the date of a change in health state. The former idea was
            to consider that at each interview the state was recorded               to consider that at each interview the state was recorded
            (healthy, disable or death) and IMaCh was corrected; but when we               (healthy, disable or death) and IMaCh was corrected; but when we
            introduced the exact date of death then we should have modified               introduced the exact date of death then we should have modified
            the contribution of an exact death to the likelihood. This new               the contribution of an exact death to the likelihood. This new
            contribution is smaller and very dependent of the step unit               contribution is smaller and very dependent of the step unit
            stepm. It is no more the probability to die between last interview               stepm. It is no more the probability to die between last interview
            and month of death but the probability to survive from last               and month of death but the probability to survive from last
            interview up to one month before death multiplied by the               interview up to one month before death multiplied by the
            probability to die within a month. Thanks to Chris               probability to die within a month. Thanks to Chris
            Jackson for correcting this bug.  Former versions increased               Jackson for correcting this bug.  Former versions increased
            mortality artificially. The bad side is that we add another loop               mortality artificially. The bad side is that we add another loop
            which slows down the processing. The difference can be up to 10%               which slows down the processing. The difference can be up to 10%
            lower mortality.               lower mortality.
         */            */
         /* If, at the beginning of the maximization mostly, the            /* If, at the beginning of the maximization mostly, the
            cumulative probability or probability to be dead is               cumulative probability or probability to be dead is
            constant (ie = 1) over time d, the difference is equal to               constant (ie = 1) over time d, the difference is equal to
            0.  out[s1][3] = savm[s1][3]: probability, being at state               0.  out[s1][3] = savm[s1][3]: probability, being at state
            s1 at precedent wave, to be dead a month before current               s1 at precedent wave, to be dead a month before current
            wave is equal to probability, being at state s1 at               wave is equal to probability, being at state s1 at
            precedent wave, to be dead at mont of the current               precedent wave, to be dead at mont of the current
            wave. Then the observed probability (that this person died)               wave. Then the observed probability (that this person died)
            is null according to current estimated parameter. In fact,               is null according to current estimated parameter. In fact,
            it should be very low but not zero otherwise the log go to               it should be very low but not zero otherwise the log go to
            infinity.               infinity.
         */            */
 /* #ifdef INFINITYORIGINAL */  /* #ifdef INFINITYORIGINAL */
 /*          lli=log(out[s1][s2] - savm[s1][s2]); */  /*          lli=log(out[s1][s2] - savm[s1][s2]); */
 /* #else */  /* #else */
Line 6739  double func( double *x) Line 5724  double func( double *x)
 /*        else */  /*        else */
 /*          lli=log(out[s1][s2] - savm[s1][s2]); */  /*          lli=log(out[s1][s2] - savm[s1][s2]); */
 /* #endif */  /* #endif */
         lli=log(out[s1][s2] - savm[s1][s2]);            lli=log(out[s1][s2] - savm[s1][s2]);
             
           } else if  ( s2==-1 ) { /* alive */
             for (j=1,survp=0. ; j<=nlstate; j++) 
               survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j];
             /*survp += out[s1][j]; */
             lli= log(survp);
           }
           /* else if  (s2==-4) {  */
           /*   for (j=3,survp=0. ; j<=nlstate; j++)   */
           /*     survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; */
           /*   lli= log(survp);  */
           /* }  */
           /* else if  (s2==-5) {  */
           /*   for (j=1,survp=0. ; j<=2; j++)   */
           /*     survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; */
           /*   lli= log(survp);  */
           /* }  */
           else{
             lli= log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]); /* linear interpolation */
             /*  lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2]));*/ /* linear interpolation */
           } 
           /*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/
           /*if(lli ==000.0)*/
           /* printf("num[i], i=%d, bbh= %f lli=%f savm=%f out=%f %d\n",bbh,lli,savm[s1][s2], out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]],i); */
           ipmx +=1;
           sw += weight[i];
           ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
           /* if (lli < log(mytinydouble)){ */
           /*   printf("Close to inf lli = %.10lf <  %.10lf i= %d mi= %d, s[%d][i]=%d s1=%d s2=%d\n", lli,log(mytinydouble), i, mi,mw[mi][i], s[mw[mi][i]][i], s1,s2); */
           /*   fprintf(ficlog,"Close to inf lli = %.10lf i= %d mi= %d, s[mw[mi][i]][i]=%d\n", lli, i, mi,s[mw[mi][i]][i]); */
           /* } */
         } /* end of wave */
       } /* end of individual */
     }  else if(mle==2){
       for (i=1,ipmx=0, sw=0.; i<=imx; i++){
         ioffset=2+nagesqr ;
         for (k=1; k<=ncovf;k++)
           cov[ioffset+TvarFind[k]]=covar[Tvar[TvarFind[k]]][i];
         for(mi=1; mi<= wav[i]-1; mi++){
           for(k=1; k <= ncovv ; k++){
             cov[ioffset+TvarVind[k]]=cotvar[mw[mi][i]][Tvar[TvarVind[k]]][i]; /* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */ 
           }
           for (ii=1;ii<=nlstate+ndeath;ii++)
             for (j=1;j<=nlstate+ndeath;j++){
               oldm[ii][j]=(ii==j ? 1.0 : 0.0);
               savm[ii][j]=(ii==j ? 1.0 : 0.0);
             }
           for(d=0; d<=dh[mi][i]; d++){
             newm=savm;
             agexact=agev[mw[mi][i]][i]+d*stepm/YEARM;
             cov[2]=agexact;
             if(nagesqr==1)
               cov[3]= agexact*agexact;
             for (kk=1; kk<=cptcovage;kk++) {
               cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact;
             }
             out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,
                          1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate));
             savm=oldm;
             oldm=newm;
           } /* end mult */
         
           s1=s[mw[mi][i]][i];
           s2=s[mw[mi+1][i]][i];
           bbh=(double)bh[mi][i]/(double)stepm; 
           lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2])); /* linear interpolation */
           ipmx +=1;
           sw += weight[i];
           ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
         } /* end of wave */
       } /* end of individual */
     }  else if(mle==3){  /* exponential inter-extrapolation */
       for (i=1,ipmx=0, sw=0.; i<=imx; i++){
         for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i];
         for(mi=1; mi<= wav[i]-1; mi++){
           for (ii=1;ii<=nlstate+ndeath;ii++)
             for (j=1;j<=nlstate+ndeath;j++){
               oldm[ii][j]=(ii==j ? 1.0 : 0.0);
               savm[ii][j]=(ii==j ? 1.0 : 0.0);
             }
           for(d=0; d<dh[mi][i]; d++){
             newm=savm;
             agexact=agev[mw[mi][i]][i]+d*stepm/YEARM;
             cov[2]=agexact;
             if(nagesqr==1)
               cov[3]= agexact*agexact;
             for (kk=1; kk<=cptcovage;kk++) {
               if(!FixedV[Tvar[Tage[kk]]])
                 cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; /* Tage[kk] gives the data-covariate associated with age */
               else
                 cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]*agexact; /* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */ 
             }
             out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,
                          1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate));
             savm=oldm;
             oldm=newm;
           } /* end mult */
         
           s1=s[mw[mi][i]][i];
           s2=s[mw[mi+1][i]][i];
           bbh=(double)bh[mi][i]/(double)stepm; 
           lli= (savm[s1][s2]>1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.+bbh)*out[s1][s2])); /* exponential inter-extrapolation */
           ipmx +=1;
           sw += weight[i];
           ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
         } /* end of wave */
       } /* end of individual */
     }else if (mle==4){  /* ml=4 no inter-extrapolation */
       for (i=1,ipmx=0, sw=0.; i<=imx; i++){
         for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i];
         for(mi=1; mi<= wav[i]-1; mi++){
           for (ii=1;ii<=nlstate+ndeath;ii++)
             for (j=1;j<=nlstate+ndeath;j++){
               oldm[ii][j]=(ii==j ? 1.0 : 0.0);
               savm[ii][j]=(ii==j ? 1.0 : 0.0);
             }
           for(d=0; d<dh[mi][i]; d++){
             newm=savm;
             agexact=agev[mw[mi][i]][i]+d*stepm/YEARM;
             cov[2]=agexact;
             if(nagesqr==1)
               cov[3]= agexact*agexact;
             for (kk=1; kk<=cptcovage;kk++) {
               cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact;
             }
                   
       } else if  ( s2==-1 ) { /* alive */            out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,
         for (j=1,survp=0. ; j<=nlstate; j++)                          1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate));
           survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j];            savm=oldm;
         /*survp += out[s1][j]; */            oldm=newm;
         lli= log(survp);          } /* end mult */
       }        
       /* else if  (s2==-4) {  */          s1=s[mw[mi][i]][i];
       /*   for (j=3,survp=0. ; j<=nlstate; j++)   */          s2=s[mw[mi+1][i]][i];
       /*     survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; */          if( s2 > nlstate){ 
       /*   lli= log(survp);  */            lli=log(out[s1][s2] - savm[s1][s2]);
       /* }  */          } else if  ( s2==-1 ) { /* alive */
       /* else if  (s2==-5) {  */            for (j=1,survp=0. ; j<=nlstate; j++) 
       /*   for (j=1,survp=0. ; j<=2; j++)   */              survp += out[s1][j];
       /*     survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; */            lli= log(survp);
       /*   lli= log(survp);  */          }else{
       /* }  */            lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]); /* Original formula */
       else if (mle==1){          }
         lli= log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]); /* linear interpolation */          ipmx +=1;
         /*  lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2]));*/ /* linear interpolation */          sw += weight[i];
       } else if(mle==2){          ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
         lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]):log((1.+bbh)*out[s1][s2])); /* linear interpolation */          /* printf("num[i]=%09ld, i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",num[i],i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); */
       } else if(mle==3){  /* exponential inter-extrapolation */        } /* end of wave */
         lli= (savm[s1][s2]>(double)1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.+bbh)*out[s1][s2])); /* exponential inter-extrapolation */      } /* end of individual */
       } else if (mle==4){  /* mle=4 no inter-extrapolation */    }else{  /* ml=5 no inter-extrapolation no jackson =0.8a */
         lli=log(out[s1][s2]); /* Original formula */      for (i=1,ipmx=0, sw=0.; i<=imx; i++){
       } else{  /* mle=0 back to 1 */        for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i];
         lli= log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]); /* linear interpolation */        for(mi=1; mi<= wav[i]-1; mi++){
         /*lli=log(out[s1][s2]); */ /* Original formula */          for (ii=1;ii<=nlstate+ndeath;ii++)
       }            for (j=1;j<=nlstate+ndeath;j++){
       /*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/              oldm[ii][j]=(ii==j ? 1.0 : 0.0);
       /*if(lli ==000.0)*/              savm[ii][j]=(ii==j ? 1.0 : 0.0);
       /* printf("num[i], i=%d, bbh= %f lli=%f savm=%f out=%f %d\n",bbh,lli,savm[s1][s2], out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]],i); */            }
       ipmx +=1;          for(d=0; d<dh[mi][i]; d++){
       sw += weight[i];            newm=savm;
       ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;            agexact=agev[mw[mi][i]][i]+d*stepm/YEARM;
       /* if (lli < log(mytinydouble)){ */            cov[2]=agexact;
       /*   printf("Close to inf lli = %.10lf <  %.10lf i= %d mi= %d, s[%d][i]=%d s1=%d s2=%d\n", lli,log(mytinydouble), i, mi,mw[mi][i], s[mw[mi][i]][i], s1,s2); */            if(nagesqr==1)
       /*   fprintf(ficlog,"Close to inf lli = %.10lf i= %d mi= %d, s[mw[mi][i]][i]=%d\n", lli, i, mi,s[mw[mi][i]][i]); */              cov[3]= agexact*agexact;
       /* } */            for (kk=1; kk<=cptcovage;kk++) {
     } /* end of wave */              if(!FixedV[Tvar[Tage[kk]]])
   } /* end of individual */                cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; /* Tage[kk] gives the data-covariate associated with age */
               else
                 cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]*agexact; /* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */ 
             }
           
             out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,
                          1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate));
             savm=oldm;
             oldm=newm;
           } /* end mult */
         
           s1=s[mw[mi][i]][i];
           s2=s[mw[mi+1][i]][i];
           lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]); /* Original formula */
           ipmx +=1;
           sw += weight[i];
           ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
           /*printf("i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],out[s1][s2],savm[s1][s2]);*/
         } /* end of wave */
       } /* end of individual */
     } /* End of if */
   for(k=1,l=0.; k<=nlstate; k++) l += ll[k];    for(k=1,l=0.; k<=nlstate; k++) l += ll[k];
   /* printf("l1=%f l2=%f ",ll[1],ll[2]); */    /* printf("l1=%f l2=%f ",ll[1],ll[2]); */
   l= l*ipmx/sw; /* To get the same order of magnitude as if weight=1 for every body */    l= l*ipmx/sw; /* To get the same order of magnitude as if weight=1 for every body */
Line 6792  double func( double *x) Line 5922  double func( double *x)
 double funcone( double *x)  double funcone( double *x)
 {  {
   /* Same as func but slower because of a lot of printf and if */    /* Same as func but slower because of a lot of printf and if */
   int i, ii, j, k, mi, d, kk, kv=0, kf=0;    int i, ii, j, k, mi, d, kv=0, kf=0;
   int ioffset=0;    int ioffset=0;
   int ipos=0,iposold=0,ncovv=0;    int ipos=0,iposold=0,ncovv=0;
   
   char labficresilk[NCOVMAX+1];  
   double cotvarv, cotvarvold;    double cotvarv, cotvarvold;
   double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1];    double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1];
   double **out;    double **out;
Line 6829  double funcone( double *x) Line 5958  double funcone( double *x)
     /* Fixed */      /* Fixed */
     /* for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i]; */      /* for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i]; */
     /* for (k=1; k<=ncoveff;k++){ /\* Simple and product fixed Dummy covariates without age* products *\/ */      /* for (k=1; k<=ncoveff;k++){ /\* Simple and product fixed Dummy covariates without age* products *\/ */
     /*strcpy(labficresilk," "); */ /* A string fed with values of covariates and print in ficresilk at the end of the line to produce graphics with covariate values and also in order to verify the process of calculating the likelihood */  
     for (kf=1; kf<=ncovf;kf++){ /*  V2  +  V3  +  V4  Simple and product fixed covariates without age* products *//* Missing values are set to -1 but should be dropped */      for (kf=1; kf<=ncovf;kf++){ /*  V2  +  V3  +  V4  Simple and product fixed covariates without age* products *//* Missing values are set to -1 but should be dropped */
       /* printf("Debug3 TvarFind[%d]=%d",kf, TvarFind[kf]); */        /* printf("Debug3 TvarFind[%d]=%d",kf, TvarFind[kf]); */
       /* printf(" Tvar[TvarFind[kf]]=%d", Tvar[TvarFind[kf]]); */        /* printf(" Tvar[TvarFind[kf]]=%d", Tvar[TvarFind[kf]]); */
       /* printf(" i=%d covar[Tvar[TvarFind[kf]]][i]=%f\n",i,covar[Tvar[TvarFind[kf]]][i]); */        /* printf(" i=%d covar[Tvar[TvarFind[kf]]][i]=%f\n",i,covar[Tvar[TvarFind[kf]]][i]); */
       ipos=TvarFind[kf];  
       cov[ioffset+TvarFind[kf]]=covar[Tvar[TvarFind[kf]]][i];/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, only V1 is fixed (k=6)*/        cov[ioffset+TvarFind[kf]]=covar[Tvar[TvarFind[kf]]][i];/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, only V1 is fixed (k=6)*/
       /* if(globpr) */  
       /*        sprintf(labficresilk+strlen(labficresilk)," %g",cov[ioffset+ipos]); */  
 /*    cov[ioffset+TvarFind[1]]=covar[Tvar[TvarFind[1]]][i];  */  /*    cov[ioffset+TvarFind[1]]=covar[Tvar[TvarFind[1]]][i];  */
 /*    cov[2+6]=covar[Tvar[6]][i];  */  /*    cov[2+6]=covar[Tvar[6]][i];  */
 /*    cov[2+6]=covar[2][i]; V2  */  /*    cov[2+6]=covar[2][i]; V2  */
Line 6848  double funcone( double *x) Line 5973  double funcone( double *x)
 /*    cov[2+9]=covar[Tvar[9]][i];  */  /*    cov[2+9]=covar[Tvar[9]][i];  */
 /*    cov[2+9]=covar[1][i]; V1  */  /*    cov[2+9]=covar[1][i]; V1  */
     }      }
     /* In model V2+V1*V4+age*V3+V3*V2 Tvar[1] is V2, Tvar[2=V1*V4]         /* In model V2+V1*V4+age*V3+V3*V2 Tvar[1] is V2, Tvar[2=V1*V4] 
        is 5, Tvar[3=age*V3] should not be computed because of age Tvar[4=V3*V2]=6            is 5, Tvar[3=age*V3] should not be computed because of age Tvar[4=V3*V2]=6 
        has been calculated etc */           has been calculated etc */
     /* For an individual i, wav[i] gives the number of effective waves */        /* For an individual i, wav[i] gives the number of effective waves */
     /* We compute the contribution to Likelihood of each effective transition        /* We compute the contribution to Likelihood of each effective transition
        mw[mi][i] is real wave of the mi th effectve wave */           mw[mi][i] is real wave of the mi th effectve wave */
     /* Then statuses are computed at each begin and end of an effective wave s1=s[ mw[mi][i] ][i];        /* Then statuses are computed at each begin and end of an effective wave s1=s[ mw[mi][i] ][i];
        s2=s[mw[mi+1][i]][i];           s2=s[mw[mi+1][i]][i];
        And the iv th varying covariate in the DATA is the cotvar[mw[mi+1][i]][ncovcol+nqv+iv][i]           And the iv th varying covariate in the DATA is the cotvar[mw[mi+1][i]][ncovcol+nqv+iv][i]
     */        */
     /* This part may be useless now because everythin should be in covar */      /* This part may be useless now because everythin should be in covar */
     /* for (k=1; k<=nqfveff;k++){ /\* Simple and product fixed Quantitative covariates without age* products *\/ */      /* for (k=1; k<=nqfveff;k++){ /\* Simple and product fixed Quantitative covariates without age* products *\/ */
     /*   cov[++ioffset]=coqvar[TvarFQ[k]][i];/\* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, only V2 and V1*V2 is fixed (k=6 and 7?)*\/ */      /*   cov[++ioffset]=coqvar[TvarFQ[k]][i];/\* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, only V2 and V1*V2 is fixed (k=6 and 7?)*\/ */
Line 6966  double funcone( double *x) Line 6091  double funcone( double *x)
         * 3 ncovta=15    +age*V3*V2+age*V2+agev3+ageV4 +age*V6 + age*V7 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4          * 3 ncovta=15    +age*V3*V2+age*V2+agev3+ageV4 +age*V6 + age*V7 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4
         * 3 TvarAVVA[1]@15= itva 3 2    2      3    4        6       7        6 3         7 3         6 4         7 4           * 3 TvarAVVA[1]@15= itva 3 2    2      3    4        6       7        6 3         7 3         6 4         7 4 
         * 3 ncovta             1 2      3      4    5        6       7        8 9       10 11       12 13        14 15          * 3 ncovta             1 2      3      4    5        6       7        8 9       10 11       12 13        14 15
         *           *?TvarAVVAind[1]@15= V3 is in k=2 1 1  2    3        4       5        4,2         5,2,      4,3           5 3}TvarVVAind[]
         * TvarAVVAind[1]@15= V3 is in k=6 6 12  13   14      15      16       18 18       19,19,     20,20        21,21}TvarVVAind[]          * TvarAVVAind[1]@15= V3 is in k=6 6 12  13   14      15      16       18 18       19,19,     20,20        21,21}TvarVVAind[]
         * 3 ncovvta=10     +age*V6 + age*V7 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4          * 3 ncovvta=10     +age*V6 + age*V7 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4
         * 3 we want to compute =cotvar[mw[mi][i]][TvarVVA[ncovva]][i] at position TvarVVAind[ncovva]          * 3 we want to compute =cotvar[mw[mi][i]][TvarVVA[ncovva]][i] at position TvarVVAind[ncovva]
Line 6980  double funcone( double *x) Line 6105  double funcone( double *x)
         *                   2, 3, 4, 6, 7,          *                   2, 3, 4, 6, 7,
         *                     6, 8, 9, 10, 11}          *                     6, 8, 9, 10, 11}
         * TvarFind[itv]                        0      0       0          * TvarFind[itv]                        0      0       0
         * FixedV[itv]                          1      1       1  0      1 0       1 0       1 0      1 0     1 0          * FixedV[itv]                          1      1       1  0      1 0       1 0       1 0       0
           *? FixedV[itv]                          1      1       1  0      1 0       1 0       1 0      1 0     1 0
         * Tvar[TvarFind[ncovf]]=[1]=2 [2]=3 [4]=4          * Tvar[TvarFind[ncovf]]=[1]=2 [2]=3 [4]=4
         * Tvar[TvarFind[itv]]                [0]=?      ?ncovv 1 à ncovvt]          * Tvar[TvarFind[itv]]                [0]=?      ?ncovv 1 à ncovvt]
         *   Not a fixed cotvar[mw][itv][i]     6       7      6  2      7, 2,     6, 3,     7, 3,     6, 4,     7, 4}          *   Not a fixed cotvar[mw][itv][i]     6       7      6  2      7, 2,     6, 3,     7, 3,     6, 4,     7, 4}
         *   fixed covar[itv]                  [6]     [7]    [6][2]           *   fixed covar[itv]                  [6]     [7]    [6][2] 
         */          */
         
       for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /*  V6       V7      V7*V2     V6*V3     V7*V3     V6*V4     V7*V4 Time varying  covariates (single and extended product but no age) including individual from products, product is computed dynamically */        for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /*  V6       V7      V7*V2     V6*V3     V7*V3     V6*V4     V7*V4 Time varying  covariates (single and extended product but no age) including individual from products, product is computed dynamically */
         itv=TvarVV[ncovv]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, or fixed covariate of a varying product after exploding product Vn*Vm into Vn and then Vm  */          itv=TvarVV[ncovv]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, or fixed covariate of a varying product after exploding product Vn*Vm into Vn and then Vm  */
         ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/          ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/
Line 7001  double funcone( double *x) Line 6127  double funcone( double *x)
           cotvarv=covar[itv][i];  /* Good: In V6*V3, 3 is fixed at position of the data */            cotvarv=covar[itv][i];  /* Good: In V6*V3, 3 is fixed at position of the data */
           /* printf("DEBUG Fixed cov[ioffset+ipos=%d]=%g \n",ioffset+ipos,cotvarv); */            /* printf("DEBUG Fixed cov[ioffset+ipos=%d]=%g \n",ioffset+ipos,cotvarv); */
         }          }
         /* if(globpr) */  
         /*   sprintf(labficresilk+strlen(labficresilk)," %g",cotvarv); */  
         if(ipos!=iposold){ /* Not a product or first of a product */          if(ipos!=iposold){ /* Not a product or first of a product */
           cotvarvold=cotvarv;            cotvarvold=cotvarv;
         }else{ /* A second product */          }else{ /* A second product */
           cotvarv=cotvarv*cotvarvold;            cotvarv=cotvarv*cotvarvold;
         /* if(globpr) */  
         /*   sprintf(labficresilk+strlen(labficresilk)," *"); */  
           /* printf("DEBUG * \n"); */  
         }          }
         iposold=ipos;          iposold=ipos;
         cov[ioffset+ipos]=cotvarv;          cov[ioffset+ipos]=cotvarv;
Line 7052  double funcone( double *x) Line 6173  double funcone( double *x)
         cov[2]=agexact;          cov[2]=agexact;
         if(nagesqr==1)          if(nagesqr==1)
           cov[3]= agexact*agexact;            cov[3]= agexact*agexact;
         /* for (kk=1; kk<=cptcovage;kk++) {  /\*  + age*V3*V2 +age*V2 +age*V3 +age*V4 For age product with simple covariates or product of  fixed covariates  *\/ */          for(ncovva=1, iposold=0; ncovva <= ncovta ; ncovva++){ /* Time varying  covariates with age including individual from products, product is computed dynamically */
         for (kk=1; kk<=cptcovprodage;kk++) {  /*  + age*V3*V2 +age*V2 +age*V3 +age*V4 For age product with simple covariates or product of  fixed covariates  */            itv=TvarAVVA[ncovva]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm  */
           ipos=Tage[kk];            ipos=TvarAVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/
           if(!FixedV[Tvar[Tage[kk]]]){ /* age*V3*V2 +age*V2 +age*V3 +age*V4 Fixed covariate with age age*V3 or age*V2*V3 Tvar[Tage[kk]] has its own already calculated column  */  
             /* printf("DEBUG kk=%d, Fixed Tvar[Tage[kk]]=%d agexact=%g\n",kk, Tvar[Tage[kk]], agexact); */  
             cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact;    
             /* printf("DEBUG Fixed cov[Tage[kk]+2+nagesqr=%d]=%g agexact=%g \n",Tage[kk]+2+nagesqr,cov[Tage[kk]+2+nagesqr], agexact); */  
           }else{ /*  +age*V6 + age*V7 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 time varying covariates with age age*V7 or age*V7*V3 is Tvar[Tage[kk]] defined, yes*/  
             /* printf("DEBUG kk=%d, Varyingd Tvar[Tage[kk]]=%d\n",kk, Tvar[Tage[kk]]); */  
             cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]*agexact; /* Are you sure? because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */   
             /* printf("DEBUG Varying cov[Tage[kk]+2+nagesqr=%d]=%g agexact=%g \n",Tage[kk]+2+nagesqr,cov[Tage[kk]+2+nagesqr], agexact); */  
           }  
           /* if(globpr) */  
           /*   sprintf(labficresilk+strlen(labficresilk)," %g*ageF",cov[Tage[kk]+2+nagesqr]); */  
         }  
         /* For product with age age*Vn*Vm where Vn*Vm is time varying */  
         /* for(kv=1; kv<=cptcovprodvage;kv++){ /\*HERY? +age*V6 + age*V7 +age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 Number of time varying covariates with age *\/ */  
         for(ncovva=1, iposold=0; ncovva <= ncovvta ; ncovva++){ /* +age*V6 + age*V7 +age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4  Time varying  covariates with age including individual from products, product is computed dynamically */  
           itv=TvarVVA[ncovva]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm  */  
           ipos=TvarVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/  
           /* if(TvarFind[itv]==0){ /\* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv *\/ */            /* if(TvarFind[itv]==0){ /\* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv *\/ */
           if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */            if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */
             /* printf("DEBUG  ncovva=%d, Varying TvarVVA[ncovva]=%d agexact=%g\n", ncovva, TvarVVA[ncovva], agexact); */              /* printf("DEBUG  ncovva=%d, Varying TvarAVVA[ncovva]=%d\n", ncovva, TvarAVVA[ncovva]); */
             cotvarv=cotvar[mw[mi][i]][TvarVVA[ncovva]][i];  /* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) */               cotvarv=cotvar[mw[mi][i]][TvarAVVA[ncovva]][i];  /* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) */ 
           }else{ /* fixed covariate */            }else{ /* fixed covariate */
             /* cotvarv=covar[Tvar[TvarFind[itv]]][i];  /\* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model *\/ */              /* cotvarv=covar[Tvar[TvarFind[itv]]][i];  /\* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model *\/ */
             /* printf("DEBUG  ncovva=%d, Fixed TvarVVA[ncovva]=%d agexact=%g\n", ncovva, TvarVVA[ncovva], agexact); */              /* printf("DEBUG ncovva=%d, Fixed TvarAVVA[ncovva]=%d\n", ncovva, TvarAVVA[ncovva]); */
             cotvarv=covar[itv][i];  /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */              cotvarv=covar[itv][i];  /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */
           }            }
           if(ipos!=iposold){ /* Not a product or first of a product */            if(ipos!=iposold){ /* Not a product or first of a product */
Line 7088  double funcone( double *x) Line 6192  double funcone( double *x)
             cotvarv=cotvarv*cotvarvold;              cotvarv=cotvarv*cotvarvold;
           }            }
           iposold=ipos;            iposold=ipos;
             /* printf("DEBUG Product cov[ioffset+ipos=%d] \n",ioffset+ipos); */
           cov[ioffset+ipos]=cotvarv*agexact;            cov[ioffset+ipos]=cotvarv*agexact;
           /* printf("DEBUG Product cov[ioffset+ipos=%d]=%g, agexact=%g.3 \n",ioffset+ipos,cov[ioffset+ipos], agexact); */  
           /* if(globpr) */  
           /*   sprintf(labficresilk+strlen(labficresilk)," %g*age",cov[ioffset+ipos]); */  
   
           /* For products */            /* For products */
         }          }
   
         /* printf("i=%d,mi=%d,d=%d,mw[mi][i]=%d\n",i, mi,d,mw[mi][i]); */          /* printf("i=%d,mi=%d,d=%d,mw[mi][i]=%d\n",i, mi,d,mw[mi][i]); */
         /* for(kk=1;kk<=ncovmodel;kk++){ */  
         /*   printf(" %d=%11.6f",kk,cov[kk]); */  
         /* } */  
         /* printf("\n"); */  
         /* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */          /* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */
         out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,          out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,
                      1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate));                       1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate));
Line 7160  double funcone( double *x) Line 6257  double funcone( double *x)
  %11.6f %11.6f %11.6f ", \   %11.6f %11.6f %11.6f ", \
                 num[i], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw,                  num[i], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw,
                 2*weight[i]*lli,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2]));                  2*weight[i]*lli,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2]));
           /*      printf("%09ld %6.1f %6.1f %6d %2d %2d %2d %2d %3d %15.6f %8.4f %8.3f\ */
         /* printf("%09ld %6.1f %6.1f %6d %2d %2d %2d %2d %3d %15.6f %8.4f %8.3f\ */  
         /* %11.6f %11.6f %11.6f ", \ */          /* %11.6f %11.6f %11.6f ", \ */
         /*              num[i], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw, */          /*              num[i], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw, */
         /*              2*weight[i]*lli,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); */          /*              2*weight[i]*lli,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); */
Line 7171  double funcone( double *x) Line 6267  double funcone( double *x)
           /* printf(" %10.6f",-ll[k]*gipmx/gsw); */            /* printf(" %10.6f",-ll[k]*gipmx/gsw); */
         }          }
         fprintf(ficresilk," %10.6f ", -llt);          fprintf(ficresilk," %10.6f ", -llt);
         /* fprintf(ficresilk,"%s", labficresilk); */  
         /* printf(" %10.6f\n", -llt); */          /* printf(" %10.6f\n", -llt); */
         /* if(debugILK){ /\* debugILK is set by a #d in a comment line *\/ */          /* if(debugILK){ /\* debugILK is set by a #d in a comment line *\/ */
         /* fprintf(ficresilk,"%09ld ", num[i]); */ /* not necessary */          /* fprintf(ficresilk,"%09ld ", num[i]); */ /* not necessary */
Line 7189  double funcone( double *x) Line 6284  double funcone( double *x)
           }            }
           iposold=ipos;            iposold=ipos;
         }          }
         for(ncovva=1, iposold=0; ncovva <= ncovvta ; ncovva++){ /* Time varying  covariates with age including individual from products, product is computed dynamically */  
           itv=TvarVVA[ncovva]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm  */  
           ipos=TvarVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/  
           fprintf(ficresilk," %g*age",cov[ioffset+ipos]);  
         }  
  /*   if(FixedV[itv]!=0){ /\* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv *\/ */  
         /*     cotvarv=cotvar[mw[mi][i]][TvarVVA[ncovva]][i];  /\* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) *\/  */  
         /*   }else{ /\* fixed covariate *\/ */  
         /*     cotvarv=covar[itv][i];  /\* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model *\/ */  
         /*   } */  
         /*   if(ipos!=iposold){ /\* Not a product or first of a product *\/ */  
         /*     cotvarvold=cotvarv; */  
         /*   }else{ /\* A second product *\/ */  
         /*     cotvarv=cotvarv*cotvarvold; */  
         /*   } */  
         /*   iposold=ipos; */  
         /*   cov[ioffset+ipos]=cotvarv; */  
         /*   /\* For products *\/ */  
         /*   fprintf(ficresilk," %g*age",cotvarv);/\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\/  */  
         /* } */  
         /* for (kk=1; kk<=cptcovage;kk++) { */          /* for (kk=1; kk<=cptcovage;kk++) { */
         /*   if(!FixedV[Tvar[Tage[kk]]]){ */          /*   if(!FixedV[Tvar[Tage[kk]]]){ */
         /*     fprintf(ficresilk," %g*age",covar[Tvar[Tage[kk]]][i]); */          /*     fprintf(ficresilk," %g*age",covar[Tvar[Tage[kk]]][i]); */
Line 7218  double funcone( double *x) Line 6293  double funcone( double *x)
         /*     /\* printf(" %g*age",cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]);/\\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\\/  *\/ */          /*     /\* printf(" %g*age",cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]);/\\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\\/  *\/ */
         /*   } */          /*   } */
         /* } */          /* } */
           for(ncovva=1, iposold=0; ncovva <= ncovta ; ncovva++){ /* Time varying  covariates with age including individual from products, product is computed dynamically */
             itv=TvarAVVA[ncovva]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm  */
             ipos=TvarAVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/
             /* if(TvarFind[itv]==0){ /\* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv *\/ */
             if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */
               /* printf("DEBUG  ncovva=%d, Varying TvarAVVA[ncovva]=%d\n", ncovva, TvarAVVA[ncovva]); */
               cotvarv=cotvar[mw[mi][i]][TvarAVVA[ncovva]][i];  /* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) */ 
             }else{ /* fixed covariate */
               /* cotvarv=covar[Tvar[TvarFind[itv]]][i];  /\* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model *\/ */
               /* printf("DEBUG ncovva=%d, Fixed TvarAVVA[ncovva]=%d\n", ncovva, TvarAVVA[ncovva]); */
               cotvarv=covar[itv][i];  /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */
             }
             if(ipos!=iposold){ /* Not a product or first of a product */
               cotvarvold=cotvarv;
             }else{ /* A second product */
               /* printf("DEBUG * \n"); */
               cotvarv=cotvarv*cotvarvold;
             }
             cotvarv=cotvarv*agexact;
             fprintf(ficresilk," %g*age",cotvarv);
             iposold=ipos;
             /* printf("DEBUG Product cov[ioffset+ipos=%d] \n",ioffset+ipos); */
             cov[ioffset+ipos]=cotvarv;
             /* For products */
           }
         /* printf("\n"); */          /* printf("\n"); */
         /* } /\*  End debugILK *\/ */          /* } /\*  End debugILK *\/ */
         fprintf(ficresilk,"\n");          fprintf(ficresilk,"\n");
         /* printf("\n"); */  
       } /* End if globpr */        } /* End if globpr */
     } /* end of wave */      } /* end of wave */
   } /* end of individual */    } /* end of individual */
Line 7245  void likelione(FILE *ficres,double p[], Line 6344  void likelione(FILE *ficres,double p[],
      Plotting could be done.       Plotting could be done.
   */    */
   void pstamp(FILE *ficres);    void pstamp(FILE *ficres);
   int k, kf, kk, kvar, kvarold, ncovv, iposold, ipos, itv;    int k, kf, kk, kvar, ncovv, iposold, ipos;
   
   if(*globpri !=0){ /* Just counts and sums, no printings */    if(*globpri !=0){ /* Just counts and sums, no printings */
     strcpy(fileresilk,"ILK_");       strcpy(fileresilk,"ILK_"); 
Line 7263  void likelione(FILE *ficres,double p[], Line 6362  void likelione(FILE *ficres,double p[],
     fprintf(ficresilk," -2*gipw/gsw*weight*ll(total) ");      fprintf(ficresilk," -2*gipw/gsw*weight*ll(total) ");
   
     /* if(debugILK){ /\* debugILK is set by a #d in a comment line *\/ */      /* if(debugILK){ /\* debugILK is set by a #d in a comment line *\/ */
     for(kf=1;kf <= ncovf; kf++){  /* Fixed covariates */        for(kf=1;kf <= ncovf; kf++){
       fprintf(ficresilk,"V%d",Tvar[TvarFind[kf]]);          fprintf(ficresilk,"V%d",Tvar[TvarFind[kf]]);
       /* printf("V%d",Tvar[TvarFind[kf]]); */          /* printf("V%d",Tvar[TvarFind[kf]]); */
     }  
     for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){  /* Time varying covariates  V6       V7      V7*V2     V6*V3     V7*V3     V6*V4     V7*V4 Time varying  covariates (single and extended product but no age) including individual from products, product is computed dynamically */  
       itv=TvarVV[ncovv]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, or fixed covariate of a varying product after exploding product Vn*Vm into Vn and then Vm  */  
       ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate */  
       if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */  
         kvar=TvarVV[ncovv];  
       }else{  
         kvar=itv;  
       }        }
       if(ipos!=iposold){ /* Not a product or first of a product */        for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){
         kvarold=kvar;          ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate */
         /* printf(" %d",ipos); */          if(ipos!=iposold){ /* Not a product or first of a product */
         fprintf(ficresilk," V%d",kvarold);            /* printf(" %d",ipos); */
       }else{ /* a second product */            fprintf(ficresilk," V%d",TvarVV[ncovv]);
         /* printf("*"); */          }else{
         fprintf(ficresilk,"*");            /* printf("*"); */
         fprintf(ficresilk," V%d",kvar);            fprintf(ficresilk,"*");
       }          }
       iposold=ipos;          iposold=ipos;
     }        }
     for (kk=1; kk<=cptcovprodage;kk++) {  /* Fixed Covariates with age  + age*V3*V2 +age*V2 +age*V3 +age*V4 For age product with simple covariates or product of  fixed covariates  */        for (kk=1; kk<=cptcovage;kk++) {
       ipos=Tage[kk];          if(!FixedV[Tvar[Tage[kk]]]){
       if(!FixedV[Tvar[Tage[kk]]]){/* age*V3*V2 +age*V2 +age*V3 +age*V4 Fixed covariate with age age*V3 or age*V2*V3 Tvar[Tage[kk]] has its own already calculated column  */            /* printf(" %d*age(Fixed)",Tvar[Tage[kk]]); */
         /* printf(" %d*age(Fixed)",Tvar[Tage[kk]]); */            fprintf(ficresilk," %d*age(Fixed)",Tvar[Tage[kk]]);
         fprintf(ficresilk," %d*age(Fixed)",Tvar[Tage[kk]]);          }else{
       }else{            fprintf(ficresilk," %d*age(Varying)",Tvar[Tage[kk]]);/* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */ 
         fprintf(ficresilk," %d*age(Varying)",Tvar[Tage[kk]]);/* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */             /* printf(" %d*age(Varying)",Tvar[Tage[kk]]);/\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\/  */
         /* printf(" %d*age(Varying)",Tvar[Tage[kk]]);/\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\/  */          }
       }        }
     }  
     for(ncovva=1, iposold=0; ncovva <= ncovvta ; ncovva++){ /* +age*V6 + age*V7 +age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4  Time varying  covariates with age including individual from products, product is computed dynamically */  
       itv=TvarVVA[ncovva]; /*  TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm  */  
       ipos=TvarVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/  
       /* if(TvarFind[itv]==0){ /\* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv *\/ */  
       if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */  
         /* printf("DEBUG  ncovva=%d, Varying TvarVVA[ncovva]=%d agexact=%g\n", ncovva, TvarVVA[ncovva], agexact); */  
         kvar=TvarVVA[ncovva];  
         /* cotvarv=cotvar[mw[mi][i]][TvarVVA[ncovva]][i];  /\* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) *\/  */  
       }else{ /* fixed covariate */  
         /* cotvarv=covar[Tvar[TvarFind[itv]]][i];  /\* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model *\/ */  
         /* printf("DEBUG  ncovva=%d, Fixed TvarVVA[ncovva]=%d agexact=%g\n", ncovva, TvarVVA[ncovva], agexact); */  
         kvar=itv;  
         /* cotvarv=covar[itv][i];  /\* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model *\/ */  
       }  
       if(ipos!=iposold){ /* Not a product or first of a product */  
         kvarold=kvar;  
         fprintf(ficresilk," age*V%d",kvarold);  
       }else{ /* a second product */  
         /* printf("*"); */  
         fprintf(ficresilk," *V%d",kvar);  
         /* printf("DEBUG * \n"); */  
       }  
       iposold=ipos;  
       /* printf("DEBUG Product cov[ioffset+ipos=%d]=%g, agexact=%g.3 \n",ioffset+ipos,cov[ioffset+ipos], agexact); */  
       /* if(globpr) */  
       /*   sprintf(labficresilk+strlen(labficresilk)," %g*age",cov[ioffset+ipos]); */  
         
       /* For products */  
     }  
     /* } /\* End if debugILK *\/ */      /* } /\* End if debugILK *\/ */
     /* printf("\n"); */      /* printf("\n"); */
     fprintf(ficresilk,"\n");      fprintf(ficresilk,"\n");
Line 7349  void likelione(FILE *ficres,double p[], Line 6410  void likelione(FILE *ficres,double p[],
       fprintf(fichtm,"<br>- Probability p<sub>%dj</sub> by origin %d and destination j. Dot's sizes are related to corresponding weight: <a href=\"%s-p%dj.png\">%s-p%dj.png</a><br>\n \        fprintf(fichtm,"<br>- Probability p<sub>%dj</sub> by origin %d and destination j. Dot's sizes are related to corresponding weight: <a href=\"%s-p%dj.png\">%s-p%dj.png</a><br>\n \
 <img src=\"%s-p%dj.png\">\n",k,k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k);  <img src=\"%s-p%dj.png\">\n",k,k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k);
       for(kf=1; kf <= ncovf; kf++){ /* For each simple dummy covariate of the model */        for(kf=1; kf <= ncovf; kf++){ /* For each simple dummy covariate of the model */
         /* kvar=Tvar[TvarFind[kf]]; */ /* variable */           kvar=Tvar[TvarFind[kf]];  /* variable */
         fprintf(fichtm,"<br>- Probability p<sub>%dj</sub> by origin %d and destination j with colored covariate V%d. Same dot size of all points but with a different color for transitions with dummy variable V%d=1 at beginning of transition (keeping former color for V%d=0): <a href=\"%s-p%dj.png\">%s-p%dj.png</a><br> \           fprintf(fichtm,"<br>- Probability p<sub>%dj</sub> by origin %d and destination j with colored covariate V%d. Same dot size of all points but with a different color for transitions with dummy variable V%d=1 at beginning of transition (keeping former color for V%d=0): ",k,k,Tvar[TvarFind[kf]],Tvar[TvarFind[kf]],Tvar[TvarFind[kf]]);
 <img src=\"%s-p%dj-%d.png\">",k,k,Tvar[TvarFind[kf]],Tvar[TvarFind[kf]],Tvar[TvarFind[kf]],subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,Tvar[TvarFind[kf]]);           fprintf(fichtm,"<a href=\"%s-p%dj-%d.png\">%s-p%dj-%d.png</a><br>",subdirf2(optionfilefiname,"ILK_"),k,kvar,subdirf2(optionfilefiname,"ILK_"),k,kvar);
            fprintf(fichtm,"<img src=\"%s-p%dj-%d.png\">",subdirf2(optionfilefiname,"ILK_"),k,Tvar[TvarFind[kf]]);
       }        }
       for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Loop on the time varying extended covariates (with extension of Vn*Vm */        for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Loop on the time varying extended covariates (with extension of Vn*Vm */
         ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate */          ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate */
Line 7410  void likelione(FILE *ficres,double p[], Line 6472  void likelione(FILE *ficres,double p[],
   
 void mlikeli(FILE *ficres,double p[], int npar, int ncovmodel, int nlstate, double ftol, double (*func)(double []))  void mlikeli(FILE *ficres,double p[], int npar, int ncovmodel, int nlstate, double ftol, double (*func)(double []))
 {  {
   int i,j,k, jk, jkk=0, iter=0;    int i,j,  jkk=0, iter=0;
   double **xi;    double **xi;
   double fret;    /*double fret;*/
   double fretone; /* Only one call to likelihood */    /*double fretone;*/ /* Only one call to likelihood */
   /*  char filerespow[FILENAMELENGTH];*/    /*  char filerespow[FILENAMELENGTH];*/
       
   double * p1; /* Shifted parameters from 0 instead of 1 */    /*double * p1;*/ /* Shifted parameters from 0 instead of 1 */
 #ifdef NLOPT  #ifdef NLOPT
   int creturn;    int creturn;
   nlopt_opt opt;    nlopt_opt opt;
Line 7429  void mlikeli(FILE *ficres,double p[], in Line 6491  void mlikeli(FILE *ficres,double p[], in
   
   
   xi=matrix(1,npar,1,npar);    xi=matrix(1,npar,1,npar);
   for (i=1;i<=npar;i++)    for (i=1;i<=npar;i++)  /* Starting with canonical directions j=1,n xi[i=1,n][j] */
     for (j=1;j<=npar;j++)      for (j=1;j<=npar;j++)
       xi[i][j]=(i==j ? 1.0 : 0.0);        xi[i][j]=(i==j ? 1.0 : 0.0);
   printf("Powell\n");  fprintf(ficlog,"Powell\n");    printf("Powell-prax\n");  fprintf(ficlog,"Powell-prax\n");
   strcpy(filerespow,"POW_");     strcpy(filerespow,"POW_"); 
   strcat(filerespow,fileres);    strcat(filerespow,fileres);
   if((ficrespow=fopen(filerespow,"w"))==NULL) {    if((ficrespow=fopen(filerespow,"w"))==NULL) {
Line 7498  void mlikeli(FILE *ficres,double p[], in Line 6560  void mlikeli(FILE *ficres,double p[], in
 #else  /* FLATSUP */  #else  /* FLATSUP */
 /*  powell(p,xi,npar,ftol,&iter,&fret,func);*/  /*  powell(p,xi,npar,ftol,&iter,&fret,func);*/
 /*   praxis ( t0, h0, n, prin, x, beale_f ); */  /*   praxis ( t0, h0, n, prin, x, beale_f ); */
   int prin=4;    int prin=1;
   double h0=0.25;    double h0=0.25;
 #include "praxis.h"    double macheps;
     double fmin;
     macheps=pow(16.0,-13.0);
   /* #include "praxis.h" */
   /* Be careful that praxis start at x[0] and powell start at p[1] */    /* Be careful that praxis start at x[0] and powell start at p[1] */
    /* praxis ( ftol, h0, npar, prin, p, func ); */     /* praxis ( ftol, h0, npar, prin, p, func ); */
 p1= (p+1); /*  p *(p+1)@8 and p *(p1)@8 are equal p1[0]=p[1] */  /* p1= (p+1); */ /*  p *(p+1)@8 and p *(p1)@8 are equal p1[0]=p[1] */
 printf("Praxis \n");  printf("Praxis Gegenfurtner \n");
 fprintf(ficlog, "Praxis \n");fflush(ficlog);  fprintf(ficlog, "Praxis  Gegenfurtner\n");fflush(ficlog);
 praxis ( ftol, h0, npar, prin, p1, func );  /* praxis ( ftol, h0, npar, prin, p1, func ); */
     /* fmin = praxis(1.e-5,macheps, h, n, prin, x, func); */
     fmin = praxis(ftol,macheps, h0, npar, prin, p, func);
 printf("End Praxis\n");  printf("End Praxis\n");
 #endif  /* FLATSUP */  #endif  /* FLATSUP */
   
Line 8638  void prevalence(double ***probs, double Line 7705  void prevalence(double ***probs, double
   int i, m, jk, j1, bool, z1,j, iv;    int i, m, jk, j1, bool, z1,j, iv;
   int mi; /* Effective wave */    int mi; /* Effective wave */
   int iage;    int iage;
   double agebegin, ageend;    double agebegin; /*, ageend;*/
   
   double **prop;    double **prop;
   double posprop;     double posprop; 
Line 8877  void  concatwav(int wav[], int **dh, int Line 7944  void  concatwav(int wav[], int **dh, int
             if(j==0) j=1;  /* Survives at least one month after exam */              if(j==0) j=1;  /* Survives at least one month after exam */
             else if(j<0){              else if(j<0){
               nberr++;                nberr++;
               printf("Error! Negative delay (%d to death) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);                printf("Error! Negative delay (%d to death) between waves %d and %d of individual %ld (around line %d) who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
               j=1; /* Temporary Dangerous patch */                j=1; /* Temporary Dangerous patch */
               printf("   We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview. You MUST fix the contradiction between dates.\n",stepm);                printf("   We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview. You MUST fix the contradiction between dates.\n",stepm);
               fprintf(ficlog,"Error! Negative delay (%d to death) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);                fprintf(ficlog,"Error! Negative delay (%d to death) between waves %d and %d of individual %ld (around line %d) who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
               fprintf(ficlog,"   We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview. You MUST fix the contradiction between dates.\n",stepm);                fprintf(ficlog,"   We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview. You MUST fix the contradiction between dates.\n",stepm);
             }              }
             k=k+1;              k=k+1;
Line 8914  void  concatwav(int wav[], int **dh, int Line 7981  void  concatwav(int wav[], int **dh, int
           /*printf("%d %lf %d %d %d\n", i,agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);*/            /*printf("%d %lf %d %d %d\n", i,agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);*/
           if(j<0){            if(j<0){
             nberr++;              nberr++;
             printf("Error! Negative delay (%d) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);              printf("Error! Negative delay (%d) between waves %d and %d of individual %ld (around line %d) who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
             fprintf(ficlog,"Error! Negative delay (%d) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);              fprintf(ficlog,"Error! Negative delay (%d) between waves %d and %d of individual %ld (around line %d) who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
           }            }
           sum=sum+j;            sum=sum+j;
         }          }
Line 10107  void varprob(char optionfilefiname[], do Line 9174  void varprob(char optionfilefiname[], do
    double ***varpij;     double ***varpij;
   
    strcpy(fileresprob,"PROB_");      strcpy(fileresprob,"PROB_"); 
    strcat(fileresprob,fileres);     strcat(fileresprob,fileresu);
    if((ficresprob=fopen(fileresprob,"w"))==NULL) {     if((ficresprob=fopen(fileresprob,"w"))==NULL) {
      printf("Problem with resultfile: %s\n", fileresprob);       printf("Problem with resultfile: %s\n", fileresprob);
      fprintf(ficlog,"Problem with resultfile: %s\n", fileresprob);       fprintf(ficlog,"Problem with resultfile: %s\n", fileresprob);
Line 10525  void printinghtml(char fileresu[], char Line 9592  void printinghtml(char fileresu[], char
                   int popforecast, int mobilav, int prevfcast, int mobilavproj, int prevbcast, int estepm , \                    int popforecast, int mobilav, int prevfcast, int mobilavproj, int prevbcast, int estepm , \
                   double jprev1, double mprev1,double anprev1, double dateprev1, double dateprojd, double dateback1, \                    double jprev1, double mprev1,double anprev1, double dateprev1, double dateprojd, double dateback1, \
                   double jprev2, double mprev2,double anprev2, double dateprev2, double dateprojf, double dateback2){                    double jprev2, double mprev2,double anprev2, double dateprev2, double dateprojf, double dateback2){
   int jj1, k1, i1, cpt, k4, nres;    int jj1, k1, cpt, nres;
   /* In fact some results are already printed in fichtm which is open */    /* In fact some results are already printed in fichtm which is open */
    fprintf(fichtm,"<ul><li><a href='#firstorder'>Result files (first order: no variance)</a>\n \     fprintf(fichtm,"<ul><li><a href='#firstorder'>Result files (first order: no variance)</a>\n \
    <li><a href='#secondorder'>Result files (second order (variance)</a>\n \     <li><a href='#secondorder'>Result files (second order (variance)</a>\n \
Line 10662  divided by h: <sub>h</sub>P<sub>ij</sub> Line 9729  divided by h: <sub>h</sub>P<sub>ij</sub>
 <img src=\"%s_%d-3-%d.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres);   <img src=\"%s_%d-3-%d.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres); 
      /* Survival functions (period) in state j */       /* Survival functions (period) in state j */
      for(cpt=1; cpt<=nlstate;cpt++){       for(cpt=1; cpt<=nlstate;cpt++){
        fprintf(fichtm,"<br>\n- Survival functions in state %d. And probability to be observed in state %d being in state (1 to %d) at different ages. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br>", cpt, cpt, nlstate, subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres);         fprintf(fichtm,"<br>\n- Survival functions in state %d. And probability to be observed in state %d being in state (1 to %d) at different ages. Mean times spent in state (or Life Expectancy or Health Expectancy etc.) are the areas under each curve. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br>", cpt, cpt, nlstate, subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres);
        fprintf(fichtm," (data from text file  <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_"));         fprintf(fichtm," (data from text file  <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_"));
        fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres);         fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres);
      }       }
      /* State specific survival functions (period) */       /* State specific survival functions (period) */
      for(cpt=1; cpt<=nlstate;cpt++){       for(cpt=1; cpt<=nlstate;cpt++){
        fprintf(fichtm,"<br>\n- Survival functions in state %d and in any other live state (total).\         fprintf(fichtm,"<br>\n- Survival functions in state %d and in any other live state (total).\
  And probability to be observed in various states (up to %d) being in state %d at different ages.       \   And probability to be observed in various states (up to %d) being in state %d at different ages.  Mean times spent in state (or Life Expectancy or Health Expectancy etc.) are the areas under each curve. \
  <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br> ", cpt, nlstate, cpt, subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres);   <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br> ", cpt, nlstate, cpt, subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres);
        fprintf(fichtm," (data from text file  <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_"));         fprintf(fichtm," (data from text file  <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_"));
        fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres);         fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres);
      }       }
      /* Period (forward stable) prevalence in each health state */       /* Period (forward stable) prevalence in each health state */
      for(cpt=1; cpt<=nlstate;cpt++){       for(cpt=1; cpt<=nlstate;cpt++){
        fprintf(fichtm,"<br>\n- Convergence to period (stable) prevalence in state %d. Or probability for a person being in state (1 to %d) at different ages, to be in state %d some years after. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br>", cpt, nlstate, cpt, subdirf2(optionfilefiname,"P_"),cpt,k1,nres,subdirf2(optionfilefiname,"P_"),cpt,k1,nres);         fprintf(fichtm,"<br>\n- Convergence to period (stable) prevalence in state %d. Or probability for a person being in state (1 to %d) at different ages, to be alive in state %d some years after. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br>", cpt, nlstate, cpt, subdirf2(optionfilefiname,"P_"),cpt,k1,nres,subdirf2(optionfilefiname,"P_"),cpt,k1,nres);
        fprintf(fichtm," (data from text file  <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_"));         fprintf(fichtm," (data from text file  <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_"));
       fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">" ,subdirf2(optionfilefiname,"P_"),cpt,k1,nres);        fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">" ,subdirf2(optionfilefiname,"P_"),cpt,k1,nres);
      }       }
Line 10701  divided by h: <sub>h</sub>P<sub>ij</sub> Line 9768  divided by h: <sub>h</sub>P<sub>ij</sub>
       /* Back projection of prevalence up to stable (mixed) back-prevalence in each health state */        /* Back projection of prevalence up to stable (mixed) back-prevalence in each health state */
        for(cpt=1; cpt<=nlstate;cpt++){         for(cpt=1; cpt<=nlstate;cpt++){
          fprintf(fichtm,"<br>\n- Back projection of cross-sectional prevalence (estimated with cases observed from %.1f to %.1f and mobil_average=%d), \           fprintf(fichtm,"<br>\n- Back projection of cross-sectional prevalence (estimated with cases observed from %.1f to %.1f and mobil_average=%d), \
  from year %.1f up to year %.1f (probably close to stable [mixed] back prevalence in state %d (randomness in cross-sectional prevalence is not taken into \   from year %.1f up to year %.1f (probably close to stable [mixed] back prevalence in state %d). Randomness in cross-sectional prevalence is not taken into \
  account but can visually be appreciated). Or probability to have been in an state %d, knowing that the person was in either state (1 or %d) \   account but can visually be appreciated. Or probability to have been in an state %d, knowing that the person was in either state (1 or %d) \
 with weights corresponding to observed prevalence at different ages. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a>", dateprev1, dateprev2, mobilavproj, dateback1, dateback2, cpt, cpt, nlstate, subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres,subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres);  with weights corresponding to observed prevalence at different ages. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a>", dateprev1, dateprev2, mobilavproj, dateback1, dateback2, cpt, cpt, nlstate, subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres,subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres);
          fprintf(fichtm," (data from text file  <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"FB_"),subdirf2(optionfilefiname,"FB_"));           fprintf(fichtm," (data from text file  <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"FB_"),subdirf2(optionfilefiname,"FB_"));
          fprintf(fichtm," <img src=\"%s_%d-%d-%d.svg\">", subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres);           fprintf(fichtm," <img src=\"%s_%d-%d-%d.svg\">", subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres);
Line 10926  void printinggnuplot(char fileresu[], ch Line 9993  void printinggnuplot(char fileresu[], ch
   for(kf=1; kf <= ncovf; kf++){ /* For each simple dummy covariate of the model */    for(kf=1; kf <= ncovf; kf++){ /* For each simple dummy covariate of the model */
     kvar=Tvar[TvarFind[kf]]; /* variable name */      kvar=Tvar[TvarFind[kf]]; /* variable name */
     /* k=18+Tvar[TvarFind[kf]];/\*offset because there are 18 columns in the ILK_ file but could be placed else where *\/ */      /* k=18+Tvar[TvarFind[kf]];/\*offset because there are 18 columns in the ILK_ file but could be placed else where *\/ */
     k=18+kf;/*offset because there are 18 columns in the ILK_ file */      /* k=18+kf;/\*offset because there are 18 columns in the ILK_ file *\/ */
       /* k=19+kf;/\*offset because there are 19 columns in the ILK_ file *\/ */
       k=16+nlstate+kf;/*offset because there are 19 columns in the ILK_ file, first cov Vn on col 21 with 4 living states */
     for (i=1; i<= nlstate ; i ++) {      for (i=1; i<= nlstate ; i ++) {
       fprintf(ficgp,"\nset out \"%s-p%dj-%d.png\";set ylabel \"Probability for each individual/wave\";",subdirf2(optionfilefiname,"ILK_"),i,kvar);        fprintf(ficgp,"\nset out \"%s-p%dj-%d.png\";set ylabel \"Probability for each individual/wave\";",subdirf2(optionfilefiname,"ILK_"),i,kvar);
       fprintf(ficgp,"unset log;\n# For each simple dummy covariate of the model \n plot  \"%s\"",subdirf(fileresilk));        fprintf(ficgp,"unset log;\n# For each simple dummy covariate of the model \n plot  \"%s\"",subdirf(fileresilk));
Line 11612  set ter svg size 640, 480\nunset log y\n Line 10681  set ter svg size 640, 480\nunset log y\n
             fprintf(ficgp," u %d:(",ioffset);               fprintf(ficgp," u %d:(",ioffset); 
             kl=0;              kl=0;
             strcpy(gplotcondition,"(");              strcpy(gplotcondition,"(");
             for (k=1; k<=cptcoveff; k++){    /* For each covariate writing the chain of conditions */              /* for (k=1; k<=cptcoveff; k++){    /\* For each covariate writing the chain of conditions *\/ */
               /* lv= decodtabm(k1,k,cptcoveff); /\* Should be the covariate value corresponding to combination k1 and covariate k *\/ */                /* lv= decodtabm(k1,k,cptcoveff); /\* Should be the covariate value corresponding to combination k1 and covariate k *\/ */
               lv=codtabm(k1,TnsdVar[Tvaraff[k]]);              for (k=1; k<=cptcovs; k++){    /* For each covariate k get corresponding value lv for combination k1 */
                 /* lv=codtabm(k1,TnsdVar[Tvaraff[k]]); */
                 lv=Tvresult[nres][k];
                 vlv=TinvDoQresult[nres][Tvresult[nres][k]];
               /* decodtabm(1,1,4) = 1 because h=1  k= (1) 1  1  1 */                /* decodtabm(1,1,4) = 1 because h=1  k= (1) 1  1  1 */
               /* decodtabm(1,2,4) = 1 because h=1  k=  1 (1) 1  1 */                /* decodtabm(1,2,4) = 1 because h=1  k=  1 (1) 1  1 */
               /* decodtabm(13,3,4)= 2 because h=13 k=  1  1 (2) 2 */                /* decodtabm(13,3,4)= 2 because h=13 k=  1  1 (2) 2 */
               /* vlv= nbcode[Tvaraff[k]][lv]; /\* Value of the modality of Tvaraff[k] *\/ */                /* vlv= nbcode[Tvaraff[k]][lv]; /\* Value of the modality of Tvaraff[k] *\/ */
               vlv= nbcode[Tvaraff[k]][codtabm(k1,TnsdVar[Tvaraff[k]])];                /* vlv= nbcode[Tvaraff[k]][codtabm(k1,TnsdVar[Tvaraff[k]])]; */
               kl++;                kl++;
               sprintf(gplotcondition+strlen(gplotcondition),"$%d==%d && $%d==%d " ,kl,Tvaraff[k], kl+1, nbcode[Tvaraff[k]][lv]);                /* sprintf(gplotcondition+strlen(gplotcondition),"$%d==%d && $%d==%d " ,kl,Tvaraff[k], kl+1, nbcode[Tvaraff[k]][lv]); */
                 sprintf(gplotcondition+strlen(gplotcondition),"$%d==%d && $%d==%d " ,kl,lv, kl+1, vlv );
               kl++;                kl++;
               if(k <cptcoveff && cptcoveff>1)                if(k <cptcovs && cptcovs>1)
                 sprintf(gplotcondition+strlen(gplotcondition)," && ");                  sprintf(gplotcondition+strlen(gplotcondition)," && ");
             }              }
             strcpy(gplotcondition+strlen(gplotcondition),")");              strcpy(gplotcondition+strlen(gplotcondition),")");
Line 11707  set ter svg size 640, 480\nunset log y\n Line 10780  set ter svg size 640, 480\nunset log y\n
           }else{            }else{
             fprintf(ficgp,",\\\n '' ");              fprintf(ficgp,",\\\n '' ");
           }            }
           if(cptcoveff ==0){ /* No covariate */            /* if(cptcoveff ==0){ /\* No covariate *\/ */
             if(cptcovs ==0){ /* No covariate */
             ioffset=2; /* Age is in 2 */              ioffset=2; /* Age is in 2 */
             /*# yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/              /*# yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/
             /*#   1       2   3   4   5  6    7  8   9   10  11  12  13  14  15  16  17  18 */              /*#   1       2   3   4   5  6    7  8   9   10  11  12  13  14  15  16  17  18 */
Line 11731  set ter svg size 640, 480\nunset log y\n Line 10805  set ter svg size 640, 480\nunset log y\n
             /*#   1    2   3    4    5      6  7   8   9   10   11 12  13   14  15 */              /*#   1    2   3    4    5      6  7   8   9   10   11 12  13   14  15 */
             iyearc=ioffset-1;              iyearc=ioffset-1;
             iagec=ioffset;              iagec=ioffset;
             fprintf(ficgp," u %d:(",ioffset); /* PROBLEM HERE VERIFY */              fprintf(ficgp," u %d:(",ioffset); 
             kl=0;              kl=0;
             strcpy(gplotcondition,"(");              strcpy(gplotcondition,"(");
             for (k=1; k<=cptcovs; k++){    /* For each covariate k of the resultline, get corresponding value lv for combination k1 */              for (k=1; k<=cptcovs; k++){    /* For each covariate k of the resultline, get corresponding value lv for combination k1 */
Line 11819  set ter svg size 640, 480\nunset log y\n Line 10893  set ter svg size 640, 480\nunset log y\n
     fprintf(ficgp,"#Number of graphics: first is logit, 2nd is probabilities, third is incidences per year\n");      fprintf(ficgp,"#Number of graphics: first is logit, 2nd is probabilities, third is incidences per year\n");
     fprintf(ficgp,"#model=1+age+%s \n",model);      fprintf(ficgp,"#model=1+age+%s \n",model);
     fprintf(ficgp,"# Type of graphic ng=%d\n",ng);      fprintf(ficgp,"# Type of graphic ng=%d\n",ng);
     fprintf(ficgp,"#   k1=1 to 2^%d=%d\n",cptcoveff,m);/* to be checked */      /* fprintf(ficgp,"#   k1=1 to 2^%d=%d\n",cptcoveff,m);/\* to be checked *\/ */
       fprintf(ficgp,"#   k1=1 to 2^%d=%d\n",cptcovs,m);/* to be checked */
     /* for(k1=1; k1 <=m; k1++)  /\* For each combination of covariate *\/ */      /* for(k1=1; k1 <=m; k1++)  /\* For each combination of covariate *\/ */
     for(nres=1; nres <= nresult; nres++){ /* For each resultline */      for(nres=1; nres <= nresult; nres++){ /* For each resultline */
      /* k1=nres; */       /* k1=nres; */
Line 11948  set ter svg size 640, 480\nunset log y\n Line 11023  set ter svg size 640, 480\nunset log y\n
                 if(cptcovdageprod >0){                  if(cptcovdageprod >0){
                   /* if(j==Tprod[ijp]) { */ /* not necessary */                     /* if(j==Tprod[ijp]) { */ /* not necessary */ 
                     /* printf("Tprod[%d]=%d, j=%d\n", ij, Tprod[ijp], j); */                      /* printf("Tprod[%d]=%d, j=%d\n", ij, Tprod[ijp], j); */
                     if(ijp <=cptcovprod) { /* Product */                      if(ijp <=cptcovprod) { /* Product Vn*Vm and age*VN*Vm*/
                       if(DummyV[Tvard[ijp][1]]==0){/* Vn is dummy */                        if(DummyV[Tvardk[ijp][1]]==0){/* Vn is dummy */
                         if(DummyV[Tvard[ijp][2]]==0){/* Vn and Vm are dummy */                          if(DummyV[Tvardk[ijp][2]]==0){/* Vn and Vm are dummy */
                           /* fprintf(ficgp,"+p%d*%d*%d",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],nbcode[Tvard[ijp][2]][codtabm(k1,j)]); */                            /* fprintf(ficgp,"+p%d*%d*%d",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],nbcode[Tvard[ijp][2]][codtabm(k1,j)]); */
                           fprintf(ficgp,"+p%d*%d*%d*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tinvresult[nres][Tvard[ijp][2]]);                            fprintf(ficgp,"+p%d*%d*%d*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tinvresult[nres][Tvard[ijp][2]]);
                         }else{ /* Vn is dummy and Vm is quanti */                          }else{ /* Vn is dummy and Vm is quanti */
                           /* fprintf(ficgp,"+p%d*%d*%f",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],Tqinvresult[nres][Tvard[ijp][2]]); */                            /* fprintf(ficgp,"+p%d*%d*%f",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],Tqinvresult[nres][Tvard[ijp][2]]); */
                           fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]);                            fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvardk[ijp][1]],Tqinvresult[nres][Tvardk[ijp][2]]);
                         }                          }
                       }else{ /* Vn*Vm Vn is quanti */                        }else{ /* age* Vn*Vm Vn is quanti HERE */
                         if(DummyV[Tvard[ijp][2]]==0){                          if(DummyV[Tvard[ijp][2]]==0){
                           fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][2]],Tqinvresult[nres][Tvard[ijp][1]]);                            fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvardk[ijp][2]],Tqinvresult[nres][Tvardk[ijp][1]]);
                         }else{ /* Both quanti */                          }else{ /* Both quanti */
                           fprintf(ficgp,"+p%d*%f*%f*x",i+j+2+nagesqr-1,Tqinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]);                            fprintf(ficgp,"+p%d*%f*%f*x",i+j+2+nagesqr-1,Tqinvresult[nres][Tvardk[ijp][1]],Tqinvresult[nres][Tvardk[ijp][2]]);
                         }                          }
                       }                        }
                       ijp++;                        ijp++;
Line 12060  set ter svg size 640, 480\nunset log y\n Line 11135  set ter svg size 640, 480\nunset log y\n
                     /* if(j==Tprod[ijp]) { /\* *\/  */                      /* if(j==Tprod[ijp]) { /\* *\/  */
                       /* printf("Tprod[%d]=%d, j=%d\n", ij, Tprod[ijp], j); */                        /* printf("Tprod[%d]=%d, j=%d\n", ij, Tprod[ijp], j); */
                       if(ijp <=cptcovprod) { /* Product */                        if(ijp <=cptcovprod) { /* Product */
                         if(DummyV[Tvard[ijp][1]]==0){/* Vn is dummy */                          if(DummyV[Tvardk[ijp][1]]==0){/* Vn is dummy */
                           if(DummyV[Tvard[ijp][2]]==0){/* Vn and Vm are dummy */                            if(DummyV[Tvardk[ijp][2]]==0){/* Vn and Vm are dummy */
                             /* fprintf(ficgp,"+p%d*%d*%d",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],nbcode[Tvard[ijp][2]][codtabm(k1,j)]); */                              /* fprintf(ficgp,"+p%d*%d*%d",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],nbcode[Tvard[ijp][2]][codtabm(k1,j)]); */
                             fprintf(ficgp,"+p%d*%d*%d*x",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tinvresult[nres][Tvard[ijp][1]],Tinvresult[nres][Tvard[ijp][2]]);                              fprintf(ficgp,"+p%d*%d*%d*x",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tinvresult[nres][Tvardk[ijp][1]],Tinvresult[nres][Tvardk[ijp][2]]);
                             /* fprintf(ficgp,"+p%d*%d*%d",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tinvresult[nres][Tvard[ijp][2]]); */                              /* fprintf(ficgp,"+p%d*%d*%d",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tinvresult[nres][Tvard[ijp][2]]); */
                           }else{ /* Vn is dummy and Vm is quanti */                            }else{ /* Vn is dummy and Vm is quanti */
                             /* fprintf(ficgp,"+p%d*%d*%f",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],Tqinvresult[nres][Tvard[ijp][2]]); */                              /* fprintf(ficgp,"+p%d*%d*%f",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],Tqinvresult[nres][Tvard[ijp][2]]); */
                             fprintf(ficgp,"+p%d*%d*%f*x",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]);                              fprintf(ficgp,"+p%d*%d*%f*x",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tinvresult[nres][Tvardk[ijp][1]],Tqinvresult[nres][Tvardk[ijp][2]]);
                             /* fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]); */                              /* fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]); */
                           }                            }
                         }else{ /* Vn*Vm Vn is quanti */                          }else{ /* Vn*Vm Vn is quanti */
                           if(DummyV[Tvard[ijp][2]]==0){                            if(DummyV[Tvardk[ijp][2]]==0){
                             fprintf(ficgp,"+p%d*%d*%f",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tinvresult[nres][Tvard[ijp][2]],Tqinvresult[nres][Tvard[ijp][1]]);                              fprintf(ficgp,"+p%d*%d*%f",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tinvresult[nres][Tvardk[ijp][2]],Tqinvresult[nres][Tvardk[ijp][1]]);
                             /* fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][2]],Tqinvresult[nres][Tvard[ijp][1]]); */                              /* fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][2]],Tqinvresult[nres][Tvard[ijp][1]]); */
                           }else{ /* Both quanti */                            }else{ /* Both quanti */
                             fprintf(ficgp,"+p%d*%f*%f",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tqinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]);                              fprintf(ficgp,"+p%d*%f*%f",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tqinvresult[nres][Tvardk[ijp][1]],Tqinvresult[nres][Tvardk[ijp][2]]);
                             /* fprintf(ficgp,"+p%d*%f*%f*x",i+j+2+nagesqr-1,Tqinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]); */                              /* fprintf(ficgp,"+p%d*%f*%f*x",i+j+2+nagesqr-1,Tqinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]); */
                           }                             } 
                         }                          }
Line 12381  void prevforecast(char fileres[], double Line 11456  void prevforecast(char fileres[], double
   */    */
   /* double anprojd, mprojd, jprojd; */    /* double anprojd, mprojd, jprojd; */
   /* double anprojf, mprojf, jprojf; */    /* double anprojf, mprojf, jprojf; */
   int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1, k4, nres=0;    int yearp, stepsize, hstepm, nhstepm, j, k, i, h,  nres=0;
   double agec; /* generic age */    double agec; /* generic age */
   double agelim, ppij, yp,yp1,yp2;    double agelim, ppij;
   double *popeffectif,*popcount;    /*double *popcount;*/
   double ***p3mat;    double ***p3mat;
   /* double ***mobaverage; */    /* double ***mobaverage; */
   char fileresf[FILENAMELENGTH];    char fileresf[FILENAMELENGTH];
Line 12437  void prevforecast(char fileres[], double Line 11512  void prevforecast(char fileres[], double
   /* date2dmy(dateintmean,&jintmean,&mintmean,&aintmean); */    /* date2dmy(dateintmean,&jintmean,&mintmean,&aintmean); */
   /* date2dmy(dateprojd,&jprojd, &mprojd, &anprojd); */    /* date2dmy(dateprojd,&jprojd, &mprojd, &anprojd); */
   /* date2dmy(dateprojf,&jprojf, &mprojf, &anprojf); */    /* date2dmy(dateprojf,&jprojf, &mprojf, &anprojf); */
   i1=pow(2,cptcoveff);    /* i1=pow(2,cptcoveff); */
   if (cptcovn < 1){i1=1;}    /* if (cptcovn < 1){i1=1;} */
       
   fprintf(ficresf,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2);     fprintf(ficresf,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2); 
       
   fprintf(ficresf,"#****** Routine prevforecast **\n");    fprintf(ficresf,"#****** Routine prevforecast **\n");
       
 /*            if (h==(int)(YEARM*yearp)){ */  /*            if (h==(int)(YEARM*yearp)){ */
   for(nres=1; nres <= nresult; nres++) /* For each resultline */    for(nres=1; nres <= nresult; nres++){ /* For each resultline */
     for(k=1; k<=i1;k++){ /* We want to find the combination k corresponding to the values of the dummies given in this resut line (to be cleaned one day) */      k=TKresult[nres];
     if(i1 != 1 && TKresult[nres]!= k)      if(TKresult[nres]==0) k=1; /* To be checked for noresult */
       continue;      /*  for(k=1; k<=i1;k++){ /\* We want to find the combination k corresponding to the values of the dummies given in this resut line (to be cleaned one day) *\/ */
     if(invalidvarcomb[k]){      /* if(i1 != 1 && TKresult[nres]!= k) */
       printf("\nCombination (%d) projection ignored because no cases \n",k);       /*   continue; */
       continue;      /* if(invalidvarcomb[k]){ */
     }      /*   printf("\nCombination (%d) projection ignored because no cases \n",k);  */
       /*   continue; */
       /* } */
     fprintf(ficresf,"\n#****** hpijx=probability over h years, hp.jx is weighted by observed prev \n#");      fprintf(ficresf,"\n#****** hpijx=probability over h years, hp.jx is weighted by observed prev \n#");
     for(j=1;j<=cptcoveff;j++) {      for(j=1;j<=cptcovs;j++){
       /* fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,Tvaraff[j])]); */        /* for(j=1;j<=cptcoveff;j++) { */
       fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]);      /*   /\* fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,Tvaraff[j])]); *\/ */
     }      /*   fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); */
     for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */      /* } */
       fprintf(ficresf," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]);      /* for (k4=1; k4<= nsq; k4++){ /\* For each selected (single) quantitative value *\/ */
       /*   fprintf(ficresf," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); */
       /* } */
         fprintf(ficresf," V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]);
     }      }
    
     fprintf(ficresf," yearproj age");      fprintf(ficresf," yearproj age");
     for(j=1; j<=nlstate+ndeath;j++){       for(j=1; j<=nlstate+ndeath;j++){ 
       for(i=1; i<=nlstate;i++)                for(i=1; i<=nlstate;i++)        
Line 12485  void prevforecast(char fileres[], double Line 11566  void prevforecast(char fileres[], double
           }            }
         }          }
         fprintf(ficresf,"\n");          fprintf(ficresf,"\n");
         for(j=1;j<=cptcoveff;j++)           /* for(j=1;j<=cptcoveff;j++)  */
           for(j=1;j<=cptcovs;j++) 
             fprintf(ficresf,"%d %lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]);
           /* fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,Tvaraff[j])]); /\* Tvaraff not correct *\/ */            /* fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,Tvaraff[j])]); /\* Tvaraff not correct *\/ */
           fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); /* TnsdVar[Tvaraff]  correct */            /* fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); /\* TnsdVar[Tvaraff]  correct *\/ */
         fprintf(ficresf,"%.f %.f ",anprojd+yearp,agec+h*hstepm/YEARM*stepm);          fprintf(ficresf,"%.f %.f ",anprojd+yearp,agec+h*hstepm/YEARM*stepm);
                   
         for(j=1; j<=nlstate+ndeath;j++) {          for(j=1; j<=nlstate+ndeath;j++) {
Line 12524  void prevforecast(char fileres[], double Line 11607  void prevforecast(char fileres[], double
      anback2 year of end of backprojection (same day and month as back1).       anback2 year of end of backprojection (same day and month as back1).
      prevacurrent and prev are prevalences.       prevacurrent and prev are prevalences.
   */    */
   int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1, k4, nres=0;    int yearp, stepsize, hstepm, nhstepm, j, k,  i, h, nres=0;
   double agec; /* generic age */    double agec; /* generic age */
   double agelim, ppij, ppi, yp,yp1,yp2; /* ,jintmean,mintmean,aintmean;*/    double agelim, ppij, ppi; /* ,jintmean,mintmean,aintmean;*/
   double *popeffectif,*popcount;    /*double *popcount;*/
   double ***p3mat;    double ***p3mat;
   /* double ***mobaverage; */    /* double ***mobaverage; */
   char fileresfb[FILENAMELENGTH];    char fileresfb[FILENAMELENGTH];
Line 12579  void prevforecast(char fileres[], double Line 11662  void prevforecast(char fileres[], double
   /* if(jintmean==0) jintmean=1; */    /* if(jintmean==0) jintmean=1; */
   /* if(mintmean==0) jintmean=1; */    /* if(mintmean==0) jintmean=1; */
       
   i1=pow(2,cptcoveff);    /* i1=pow(2,cptcoveff); */
   if (cptcovn < 1){i1=1;}    /* if (cptcovn < 1){i1=1;} */
       
   fprintf(ficresfb,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2);    fprintf(ficresfb,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2);
   printf("# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2);    printf("# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2);
       
   fprintf(ficresfb,"#****** Routine prevbackforecast **\n");    fprintf(ficresfb,"#****** Routine prevbackforecast **\n");
       
   for(nres=1; nres <= nresult; nres++) /* For each resultline */    for(nres=1; nres <= nresult; nres++){ /* For each resultline */
   for(k=1; k<=i1;k++){      k=TKresult[nres];
     if(i1 != 1 && TKresult[nres]!= k)      if(TKresult[nres]==0) k=1; /* To be checked for noresult */
       continue;    /* for(k=1; k<=i1;k++){ */
     if(invalidvarcomb[k]){    /*   if(i1 != 1 && TKresult[nres]!= k) */
       printf("\nCombination (%d) projection ignored because no cases \n",k);     /*     continue; */
       continue;    /*   if(invalidvarcomb[k]){ */
     }    /*     printf("\nCombination (%d) projection ignored because no cases \n",k);  */
     /*     continue; */
     /*   } */
     fprintf(ficresfb,"\n#****** hbijx=probability over h years, hb.jx is weighted by observed prev \n#");      fprintf(ficresfb,"\n#****** hbijx=probability over h years, hb.jx is weighted by observed prev \n#");
     for(j=1;j<=cptcoveff;j++) {      for(j=1;j<=cptcovs;j++){
       fprintf(ficresfb," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]);      /* for(j=1;j<=cptcoveff;j++) { */
     }      /*   fprintf(ficresfb," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); */
     for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */      /* } */
       fprintf(ficresf," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]);        fprintf(ficresfb," V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]);
     }      }
      /*  fprintf(ficrespij,"******\n"); */
      /* for (k4=1; k4<= nsq; k4++){ /\* For each selected (single) quantitative value *\/ */
      /*    fprintf(ficresfb," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); */
      /*  } */
     fprintf(ficresfb," yearbproj age");      fprintf(ficresfb," yearbproj age");
     for(j=1; j<=nlstate+ndeath;j++){      for(j=1; j<=nlstate+ndeath;j++){
       for(i=1; i<=nlstate;i++)        for(i=1; i<=nlstate;i++)
Line 12632  void prevforecast(char fileres[], double Line 11721  void prevforecast(char fileres[], double
           }            }
         }          }
         fprintf(ficresfb,"\n");          fprintf(ficresfb,"\n");
         for(j=1;j<=cptcoveff;j++)          /* for(j=1;j<=cptcoveff;j++) */
           fprintf(ficresfb,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]);          for(j=1;j<=cptcovs;j++)
             fprintf(ficresfb,"%d %lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]);
             /* fprintf(ficresfb,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); */
         fprintf(ficresfb,"%.f %.f ",anbackd+yearp,agec-h*hstepm/YEARM*stepm);          fprintf(ficresfb,"%.f %.f ",anbackd+yearp,agec-h*hstepm/YEARM*stepm);
         for(i=1; i<=nlstate+ndeath;i++) {          for(i=1; i<=nlstate+ndeath;i++) {
           ppij=0.;ppi=0.;            ppij=0.;ppi=0.;
Line 13202  void printinggnuplotmort(char fileresu[] Line 12293  void printinggnuplotmort(char fileresu[]
   
   char dirfileres[132],optfileres[132];    char dirfileres[132],optfileres[132];
   
   int ng;    /*int ng;*/
   
   
   /*#ifdef windows */    /*#ifdef windows */
Line 13226  int readdata(char datafile[], int firsto Line 12317  int readdata(char datafile[], int firsto
   /*-------- data file ----------*/    /*-------- data file ----------*/
   FILE *fic;    FILE *fic;
   char dummy[]="                         ";    char dummy[]="                         ";
   int i=0, j=0, n=0, iv=0, v;    int i = 0, j = 0, n = 0, iv = 0;/* , v;*/
   int lstra;    int lstra;
   int linei, month, year,iout;    int linei, month, year,iout;
   int noffset=0; /* This is the offset if BOM data file */    int noffset=0; /* This is the offset if BOM data file */
Line 13597  int decoderesult( char resultline[], int Line 12688  int decoderesult( char resultline[], int
   if (strlen(resultsav) >1){    if (strlen(resultsav) >1){
     j=nbocc(resultsav,'='); /**< j=Number of covariate values'=' in this resultline */      j=nbocc(resultsav,'='); /**< j=Number of covariate values'=' in this resultline */
   }    }
   if(j == 0){ /* Resultline but no = */    if(j == 0 && cptcovs== 0){ /* Resultline but no =  and no covariate in the model */
     TKresult[nres]=0; /* Combination for the nresult and the model */      TKresult[nres]=0; /* Combination for the nresult and the model */
     return (0);      return (0);
   }    }
   if( j != cptcovs ){ /* Be careful if a variable is in a product but not single */    if( j != cptcovs ){ /* Be careful if a variable is in a product but not single */
     printf("ERROR: the number of variables in the resultline which is %d, differs from the number %d of single variables used in the model line, %s.\n",j, cptcovs, model);      fprintf(ficlog,"ERROR: the number of variables in the resultline which is %d, differs from the number %d of single variables used in the model line, 1+age+%s.\n",j, cptcovs, model);fflush(ficlog);
     fprintf(ficlog,"ERROR: the number of variables in the resultline which is %d, differs from the number %d of single variables used in the model line, %s.\n",j, cptcovs, model);      printf("ERROR: the number of variables in the resultline which is %d, differs from the number %d of single variables used in the model line, 1+age+%s.\n",j, cptcovs, model);fflush(stdout);
     /* return 1;*/      if(j==0)
         return 1;
   }    }
   for(k=1; k<=j;k++){ /* Loop on any covariate of the RESULT LINE */    for(k=1; k<=j;k++){ /* Loop on any covariate of the RESULT LINE */
     if(nbocc(resultsav,'=') >1){      if(nbocc(resultsav,'=') >1){
Line 13787  int decoderesult( char resultline[], int Line 12879  int decoderesult( char resultline[], int
       precov[nres][k1]=Tvalsel[k3q];        precov[nres][k1]=Tvalsel[k3q];
       /* printf("Decoderesult Quantitative nres=%d,precov[nres=%d][k1=%d]=%.f V(k2q=V%d)= Tvalsel[%d]=%d, Tvarsel[%d]=%f\n",nres, nres, k1,precov[nres][k1], k2q, k3q, Tvarsel[k3q], k3q, Tvalsel[k3q]); */        /* printf("Decoderesult Quantitative nres=%d,precov[nres=%d][k1=%d]=%.f V(k2q=V%d)= Tvalsel[%d]=%d, Tvarsel[%d]=%f\n",nres, nres, k1,precov[nres][k1], k2q, k3q, Tvarsel[k3q], k3q, Tvalsel[k3q]); */
       k4q++;;        k4q++;;
     }else if( Dummy[k1]==2 ){ /* For dummy with age product */      }else if( Dummy[k1]==2 ){ /* For dummy with age product "V2+V3+V4+V6+V7+V6*V2+V7*V2+V6*V3+V7*V3+V6*V4+V7*V4+age*V2+age*V3+age*V4+age*V6+age*V7+age*V6*V2+age*V6*V3+age*V7*V3+age*V6*V4+age*V7*V4\r"*/
       /* Tvar[k1]; */ /* Age variable */        /* Tvar[k1]; */ /* Age variable */ /* 17 age*V6*V2 ?*/
       /* Wrong we want the value of variable name Tvar[k1] */        /* Wrong we want the value of variable name Tvar[k1] */
               if(Typevar[k1]==2 || Typevar[k1]==3 ){ /* For product quant or dummy (with or without age) */
       k3= resultmodel[nres][k1]; /* nres=1 k1=2 resultmodel[2(V4)] = 1=k3 ; k1=3 resultmodel[3(V3)] = 2=k3*/          precov[nres][k1]=TinvDoQresult[nres][Tvardk[k1][1]] * TinvDoQresult[nres][Tvardk[k1][2]];      
       k2=(int)Tvarsel[k3]; /* nres=1 k1=2=>k3=1 Tvarsel[resultmodel[2]]= Tvarsel[1] = 4=k2 (V4); k1=3=>k3=2 Tvarsel[2]=3 (V3)*/        /* printf("Decoderesult Quantitative or Dummy (not with age) nres=%d k1=%d precov[nres=%d][k1=%d]=%.f V%d(=%.f) * V%d(=%.f) \n",nres, k1, nres, k1,precov[nres][k1], Tvardk[k1][1], TinvDoQresult[nres][Tvardk[k1][1]], Tvardk[k1][2], TinvDoQresult[nres][Tvardk[k1][2]]); */
       TinvDoQresult[nres][(int)Tvarsel[k3]]=Tvalsel[k3]; /* TinvDoQresult[nres][4]=1 */        }else{
       precov[nres][k1]=Tvalsel[k3];          k3= resultmodel[nres][k1]; /* nres=1 k1=2 resultmodel[2(V4)] = 1=k3 ; k1=3 resultmodel[3(V3)] = 2=k3*/
           k2=(int)Tvarsel[k3]; /* nres=1 k1=2=>k3=1 Tvarsel[resultmodel[2]]= Tvarsel[1] = 4=k2 (V4); k1=3=>k3=2 Tvarsel[2]=3 (V3)*/
           TinvDoQresult[nres][(int)Tvarsel[k3]]=Tvalsel[k3]; /* TinvDoQresult[nres][4]=1 */
           precov[nres][k1]=Tvalsel[k3];
         }
       /* printf("Decoderesult Dummy with age k=%d, k1=%d precov[nres=%d][k1=%d]=%.f Tvar[%d]=V%d k2=Tvarsel[%d]=%d Tvalsel[%d]=%d\n",k, k1, nres, k1,precov[nres][k1], k1, Tvar[k1], k3,(int)Tvarsel[k3], k3, (int)Tvalsel[k3]); */        /* printf("Decoderesult Dummy with age k=%d, k1=%d precov[nres=%d][k1=%d]=%.f Tvar[%d]=V%d k2=Tvarsel[%d]=%d Tvalsel[%d]=%d\n",k, k1, nres, k1,precov[nres][k1], k1, Tvar[k1], k3,(int)Tvarsel[k3], k3, (int)Tvalsel[k3]); */
     }else if( Dummy[k1]==3 ){ /* For quant with age product */      }else if( Dummy[k1]==3 ){ /* For quant with age product */
       k3q= resultmodel[nres][k1]; /* resultmodel[1(V5)] = 25.1=k3q */        if(Typevar[k1]==2 || Typevar[k1]==3 ){ /* For product quant or dummy (with or without age) */
       k2q=(int)Tvarsel[k3q]; /*  Tvarsel[resultmodel[1]]= Tvarsel[1] = 4=k2 */          precov[nres][k1]=TinvDoQresult[nres][Tvardk[k1][1]] * TinvDoQresult[nres][Tvardk[k1][2]];      
       TinvDoQresult[nres][(int)Tvarsel[k3q]]=Tvalsel[k3q]; /* TinvDoQresult[nres][5]=25.1 */        /* printf("Decoderesult Quantitative or Dummy (not with age) nres=%d k1=%d precov[nres=%d][k1=%d]=%.f V%d(=%.f) * V%d(=%.f) \n",nres, k1, nres, k1,precov[nres][k1], Tvardk[k1][1], TinvDoQresult[nres][Tvardk[k1][1]], Tvardk[k1][2], TinvDoQresult[nres][Tvardk[k1][2]]); */
       precov[nres][k1]=Tvalsel[k3q];        }else{
           k3q= resultmodel[nres][k1]; /* resultmodel[1(V5)] = 25.1=k3q */
           k2q=(int)Tvarsel[k3q]; /*  Tvarsel[resultmodel[1]]= Tvarsel[1] = 4=k2 */
           TinvDoQresult[nres][(int)Tvarsel[k3q]]=Tvalsel[k3q]; /* TinvDoQresult[nres][5]=25.1 */
           precov[nres][k1]=Tvalsel[k3q];
         }
       /* printf("Decoderesult Quantitative with age nres=%d, k1=%d, precov[nres=%d][k1=%d]=%f Tvar[%d]=V%d V(k2q=%d)= Tvarsel[%d]=%d, Tvalsel[%d]=%f\n",nres, k1, nres, k1,precov[nres][k1], k1,  Tvar[k1], k2q, k3q, Tvarsel[k3q], k3q, Tvalsel[k3q]); */        /* printf("Decoderesult Quantitative with age nres=%d, k1=%d, precov[nres=%d][k1=%d]=%f Tvar[%d]=V%d V(k2q=%d)= Tvarsel[%d]=%d, Tvalsel[%d]=%f\n",nres, k1, nres, k1,precov[nres][k1], k1,  Tvar[k1], k2q, k3q, Tvarsel[k3q], k3q, Tvalsel[k3q]); */
     }else if(Typevar[k1]==2 || Typevar[k1]==3 ){ /* For product quant or dummy (with or without age) */      }else if(Typevar[k1]==2 || Typevar[k1]==3 ){ /* For product quant or dummy (with or without age) */
       precov[nres][k1]=TinvDoQresult[nres][Tvardk[k1][1]] * TinvDoQresult[nres][Tvardk[k1][2]];              precov[nres][k1]=TinvDoQresult[nres][Tvardk[k1][1]] * TinvDoQresult[nres][Tvardk[k1][2]];      
Line 13833  int decodemodel( char model[], int lasto Line 12934  int decodemodel( char model[], int lasto
         */          */
 /* V2+V1+V4+V3*age Tvar[4]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1, Tage[1]=2 */  /* V2+V1+V4+V3*age Tvar[4]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1, Tage[1]=2 */
 {  {
   int i, j, k, ks, v;    int i, j, k, ks;/* , v;*/
   int n,m;    int n,m;
   int  j1, k1, k11, k12, k2, k3, k4;    int  j1, k1, k11, k12, k2, k3, k4;
   char modelsav[300];    char modelsav[300];
Line 13883  int decodemodel( char model[], int lasto Line 12984  int decodemodel( char model[], int lasto
     if (strlen(modelsav) >1){ /* V2 +V3 +V4 +V6 +V7 +V6*V2 +V7*V2 +V6*V3 +V7*V3 +V6*V4 +V7*V4 +age*V2 +age*V3 +age*V4 +age*V6 +age*V7 +age*V6*V2 +V7*V2 +age*V6*V3 +age*V7*V3 +age*V6*V4 +age*V7*V4 */      if (strlen(modelsav) >1){ /* V2 +V3 +V4 +V6 +V7 +V6*V2 +V7*V2 +V6*V3 +V7*V3 +V6*V4 +V7*V4 +age*V2 +age*V3 +age*V4 +age*V6 +age*V7 +age*V6*V2 +V7*V2 +age*V6*V3 +age*V7*V3 +age*V6*V4 +age*V7*V4 */
       j=nbocc(modelsav,'+'); /**< j=Number of '+' */        j=nbocc(modelsav,'+'); /**< j=Number of '+' */
       j1=nbocc(modelsav,'*'); /**< j1=Number of '*' */        j1=nbocc(modelsav,'*'); /**< j1=Number of '*' */
       /* cptcovs=j+1-j1;  */ /* is wrong , see after */        cptcovs=0; /**<  Number of simple covariates V1 +V1*age +V3 +V3*V4 +age*age => V1 + V3 =4+1-3=2  Wrong */
       cptcovt= j+1; /* Number of total covariates in the model, not including        cptcovt= j+1; /* Number of total covariates in the model, not including
                      * cst, age and age*age                        * cst, age and age*age 
                      * V1+V1*age+ V3 + V3*V4+age*age=> 3+1=4*/                       * V1+V1*age+ V3 + V3*V4+age*age=> 3+1=4*/
       /* including age products which are counted in cptcovage.        /* including age products which are counted in cptcovage.
        * but the covariates which are products must be treated          * but the covariates which are products must be treated 
        * separately: ncovn=4- 2=2 (V1+V3). */         * separately: ncovn=4- 2=2 (V1+V3). */
       cptcovprod=0; /**< Number of products and single product with age  V1*V2 +v3*age = 2 */        cptcovprod=0; /**< Number of products  V1*V2 +v3*age = 2 */
       cptcovdageprod=0; /* Number of double products with age age*Vn*VM or Vn*age*Vm or Vn*Vm*age */        cptcovdageprod=0; /* Number of doouble products with age age*Vn*VM or Vn*age*Vm or Vn*Vm*age */
       cptcovprodnoage=0; /**< Number of covariate products without age: V3*V4 =1  */        cptcovprodnoage=0; /**< Number of covariate products without age: V3*V4 =1  */
       cptcovprodage=0; /**< Number of varying covariate products with age: age*V6(v)*V3(f) =1  */        cptcovprodage=0;
       /* cptcovprodage=nboccstr(modelsav,"age");*/        /* cptcovprodage=nboccstr(modelsav,"age");*/
               
       /*   Design        /*   Design
Line 13948  int decodemodel( char model[], int lasto Line 13049  int decodemodel( char model[], int lasto
         Tvar[k]=0; Tprod[k]=0; Tposprod[k]=0;          Tvar[k]=0; Tprod[k]=0; Tposprod[k]=0;
       }        }
       cptcovage=0;        cptcovage=0;
   
         /* First loop in order to calculate */
         /* for age*VN*Vm
          * Provides, Typevar[k], Tage[cptcovage], existcomb[n][m], FixedV[ncovcolt+k12]
          * Tprod[k1]=k  Tposprod[k]=k1;    Tvard[k1][1] =m;
         */
         /* Needs  FixedV[Tvardk[k][1]] */
         /* For others:
          * Sets   Typevar[k];
          * Tvar[k]=ncovcol+nqv+ntv+nqtv+k11;
          *        Tposprod[k]=k11;
          *        Tprod[k11]=k;
          *        Tvardk[k][1] =m;
          * Needs FixedV[Tvardk[k][1]] == 0
         */
         
       for(k=1; k<=cptcovt;k++){ /* Loop on total covariates of the model line */        for(k=1; k<=cptcovt;k++){ /* Loop on total covariates of the model line */
         cutl(stra,strb,modelsav,'+'); /* keeps in strb after the first '+' cutl from left to right          cutl(stra,strb,modelsav,'+'); /* keeps in strb after the first '+' cutl from left to right
                                          modelsav==V2+V1+V5*age+V4+V3*age strb=V3*age stra=V2+V1V5*age+V4 */    /* <model> "V5+V4+V3+V4*V3+V5*age+V1*age+V1" strb="V5" stra="V4+V3+V4*V3+V5*age+V1*age+V1" */                                           modelsav==V2+V1+V5*age+V4+V3*age strb=V3*age stra=V2+V1V5*age+V4 */    /* <model> "V5+V4+V3+V4*V3+V5*age+V1*age+V1" strb="V5" stra="V4+V3+V4*V3+V5*age+V1*age+V1" */
Line 13956  int decodemodel( char model[], int lasto Line 13073  int decodemodel( char model[], int lasto
         /*      printf("i=%d a=%s b=%s sav=%s\n",i, stra,strb,modelsav);*/          /*      printf("i=%d a=%s b=%s sav=%s\n",i, stra,strb,modelsav);*/
         /*scanf("%d",i);*/          /*scanf("%d",i);*/
         if (strchr(strb,'*')) {  /**< Model includes a product V2+V1+V5*age+ V4+V3*age strb=V3*age OR double product with age strb=age*V6*V2 or V6*V2*age or V6*age*V2 */          if (strchr(strb,'*')) {  /**< Model includes a product V2+V1+V5*age+ V4+V3*age strb=V3*age OR double product with age strb=age*V6*V2 or V6*V2*age or V6*age*V2 */
           cutl(strc,strd,strb,'*'); /**< k=1 strd*strc  Vm*Vn: strb=V3*age(input) strc=age strd=V3 ; V3*V2 strc=V2, strd=V3 OR strb=age*V6*V2 strc=V6*V2 strd=age OR strb=V6*age*V2 c=age*V2 d=V6 OR b=V6*V2*age c=V2*age d=V6   */            cutl(strc,strd,strb,'*'); /**< k=1 strd*strc  Vm*Vn: strb=V3*age(input) strc=age strd=V3 ; V3*V2 strc=V2, strd=V3 OR strb=age*V6*V2 strc=V6*V2 strd=age OR c=V2*age OR c=age*V2  */
           if(strchr(strc,'*')) { /**< Model with age and DOUBLE product: allowed since 0.99r44, strc=V6*V2 or V2*age or age*V2, strd=age or V6 or V6 OR (strb=age*V6*V2 or V6*V2*age or V6*age*V2) */            if(strchr(strc,'*')) { /**< Model with age and DOUBLE product: allowed since 0.99r44, strc=V6*V2 or V2*age or age*V2, strd=age or V6 or V6   */
             Typevar[k]=3;  /* 3 for age and double product age*Vn*Vm varying of fixed */              Typevar[k]=3;  /* 3 for age and double product age*Vn*Vm varying of fixed */
             if(strstr(strc,"age")!=0) { /* It means that strc=V2*age=Vm*age or age*V2 (not V6*V2) and thus that strd=Vn and strb=V6*V2*age or V6*age*V2 (but not age*V6*V2) */              if(strstr(strc,"age")!=0) { /* It means that strc=V2*age or age*V2 and thus that strd=Vn */
               cutl(stre,strf,strc,'*') ; /* if strc=age*Vm then stre=Vm and strf=age, if strc=Vm*age then stre=age and strf=Vm. */                cutl(stre,strf,strc,'*') ; /* strf=age or Vm, stre=Vm or age. If strc=V6*V2 then strf=V6 and stre=V2 */
               strcpy(strc,strb); /* save strb(=age*Vn*Vm) into strc ,  strd=Vn */                strcpy(strc,strb); /* save strb(=age*Vn*Vm) into strc */
               /* We want strb=Vn*Vm */                /* We want strb=Vn*Vm */
               if(strcmp(strf,"age")==0){ /* strf is "age" so stre=Vm =V2  (strc=age*Vm and strb Vn*age*Vm) . */                if(strcmp(strf,"age")==0){ /* strf is "age" so that stre=Vm =V2 . */
                 strcpy(strb,strd); /* strd=Vn  */                   strcpy(strb,strd);
                 strcat(strb,"*");                   strcat(strb,"*");
                 strcat(strb,stre);/* strb=Vn*Vm */                  strcat(strb,stre);
               }else{  /* strf=Vm so stre=age. strd=Vn  If strf=V6 then stre=V2 */                }else{  /* strf=Vm  If strf=V6 then stre=V2 */
                 strcpy(strb,strf);                  strcpy(strb,strf);
                 strcat(strb,"*");                  strcat(strb,"*");
                 strcat(strb,strd); /* strb=Vm*Vn */                  strcat(strb,stre);
                 strcpy(strd,strb); /* in order for strd to not be "age"  for next test (will be strd=Vn*Vm */                  strcpy(strd,strb); /* in order for strd to not be "age"  for next test (will be Vn*Vm */
               }                }
               printf("DEBUG FIXED k=%d, Tage[k]=%d, Tvar[Tage[k]=%d,FixedV[Tvar[Tage[k]]]=%d\n",k,Tage[k],Tvar[Tage[k]],FixedV[Tvar[Tage[k]]]);                /* printf("DEBUG FIXED k=%d, Tage[k]=%d, Tvar[Tage[k]=%d,FixedV[Tvar[Tage[k]]]=%d\n",k,Tage[k],Tvar[Tage[k]],FixedV[Tvar[Tage[k]]]); */
               /* FixedV[Tvar[Tage[k]]]=0;*/ /* HERY not sure */                /* FixedV[Tvar[Tage[k]]]=0; /\* HERY not sure if V7*V4*age Fixed might not exist  yet*\/ */
             }else{  /* strb=age*Vn*Vm strc=Vn*Vm (and strd=age) and should be strb=Vn*Vm but want to keep original strb double product  */              }else{  /* strc=Vn*Vm (and strd=age) and should be strb=Vn*Vm but want to keep original strb double product  */
               strcpy(stre,strb); /* save full b in stre */                strcpy(stre,strb); /* save full b in stre */
               strcpy(strb,strc); /* save short c in new short b for next block strb=Vn*Vm*/                strcpy(strb,strc); /* save short c in new short b for next block strb=Vn*Vm*/
               strcpy(strf,strc); /* save short c in new short f */                strcpy(strf,strc); /* save short c in new short f */
Line 14007  int decodemodel( char model[], int lasto Line 13124  int decodemodel( char model[], int lasto
               Tvardk[k][1] =m; /* m 1 for V1*/                Tvardk[k][1] =m; /* m 1 for V1*/
               Tvard[k1][2] =n; /* n 4 for V4*/                Tvard[k1][2] =n; /* n 4 for V4*/
               Tvardk[k][2] =n; /* n 4 for V4*/                Tvardk[k][2] =n; /* n 4 for V4*/
 /*            Tvar[Tage[cptcovage]]=k1;*/ /* Tvar[6=age*V3*V2]=9 (new fixed covariate) */  /*            Tvar[Tage[cptcovage]]=k1;*/ /* Tvar[6=age*V3*V2]=9 (new fixed covariate) */ /* We don't know about Fixed yet HERE */
               if( FixedV[Tvardk[k][1]] == 0 && FixedV[Tvardk[k][2]] == 0){ /* If the product is a fixed covariate then we feed the new column with Vn*Vm */                if( FixedV[Tvardk[k][1]] == 0 && FixedV[Tvardk[k][2]] == 0){ /* If the product is a fixed covariate then we feed the new column with Vn*Vm */
                 for (i=1; i<=lastobs;i++){/* For fixed product */                  for (i=1; i<=lastobs;i++){/* For fixed product */
                   /* Computes the new covariate which is a product of                    /* Computes the new covariate which is a product of
Line 14043  int decodemodel( char model[], int lasto Line 13160  int decodemodel( char model[], int lasto
                 /*Tage[cptcovage]=k;*/ /* For age*V3*V2 Tage[1]=V3*V3=9 HERY too*/                  /*Tage[cptcovage]=k;*/ /* For age*V3*V2 Tage[1]=V3*V3=9 HERY too*/
                 /* Tvar[Tage[cptcovage]]=k1; */                  /* Tvar[Tage[cptcovage]]=k1; */
                 cptcovprodvage++;                  cptcovprodvage++;
                 k12=2*k11-1;  
                 FixedV[ncovcolt+k12]=1; /* We expand Vn*Vm */                  FixedV[ncovcolt+k12]=1; /* We expand Vn*Vm */
                 FixedV[ncovcolt+k12+1]=1;                  k12++;
                   FixedV[ncovcolt+k12]=1;
               }                }
             }              }
             /* Tage[cptcovage]=k;  /\*  V2+V1+V4+V3*age Tvar[4]=3, Tage[1] = 4 or V1+V1*age Tvar[2]=1, Tage[1]=2 *\/ */              /* Tage[cptcovage]=k;  /\*  V2+V1+V4+V3*age Tvar[4]=3, Tage[1] = 4 or V1+V1*age Tvar[2]=1, Tage[1]=2 *\/ */
Line 14157  int decodemodel( char model[], int lasto Line 13274  int decodemodel( char model[], int lasto
                                 /*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav);                                  /*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav);
                                   scanf("%d",i);*/                                    scanf("%d",i);*/
       } /* end of loop + on total covariates */        } /* end of loop + on total covariates */
   
         
     } /* end if strlen(modelsave == 0) age*age might exist */      } /* end if strlen(modelsave == 0) age*age might exist */
   } /* end if strlen(model == 0) */    } /* end if strlen(model == 0) */
   cptcovs=cptcovt - cptcovdageprod - cptcovprod;/**<  Number of simple covariates V1 +V1*age +V3 +V3*V4 +age*age + age*v4*V3=> V1 + V3 =4+1-3=2  */    cptcovs=cptcovt - cptcovdageprod - cptcovprod;/**<  Number of simple covariates V1 +V1*age +V3 +V3*V4 +age*age + age*v4*V3=> V1 + V3 =4+1-3=2  */
Line 14195  Fixed[k] 0=fixed (product or simple), 1 Line 13314  Fixed[k] 0=fixed (product or simple), 1
 Dummy[k] 0=dummy (0 1), 1 quantitative (single or product without age), 2 dummy with age product, 3 quant with age product\n",model);  Dummy[k] 0=dummy (0 1), 1 quantitative (single or product without age), 2 dummy with age product, 3 quant with age product\n",model);
   for(k=-1;k<=NCOVMAX; k++){ Fixed[k]=0; Dummy[k]=0;}    for(k=-1;k<=NCOVMAX; k++){ Fixed[k]=0; Dummy[k]=0;}
   for(k=1;k<=NCOVMAX; k++){TvarFind[k]=0; TvarVind[k]=0;}    for(k=1;k<=NCOVMAX; k++){TvarFind[k]=0; TvarVind[k]=0;}
   
   
     /* Second loop for calculating  Fixed[k], Dummy[k]*/
   
     
   for(k=1, ncovf=0, nsd=0, nsq=0, ncovv=0,ncovva=0,ncovvta=0, ncova=0, ncoveff=0, nqfveff=0, ntveff=0, nqtveff=0, ncovvt=0;k<=cptcovt; k++){ /* or cptocvt loop on k from model */    for(k=1, ncovf=0, nsd=0, nsq=0, ncovv=0,ncovva=0,ncovvta=0, ncova=0, ncoveff=0, nqfveff=0, ntveff=0, nqtveff=0, ncovvt=0;k<=cptcovt; k++){ /* or cptocvt loop on k from model */
     if (Tvar[k] <=ncovcol && Typevar[k]==0 ){ /* Simple fixed dummy (<=ncovcol) covariates */      if (Tvar[k] <=ncovcol && Typevar[k]==0 ){ /* Simple fixed dummy (<=ncovcol) covariates */
       Fixed[k]= 0;        Fixed[k]= 0;
Line 15238  int hPijx(double *p, int bage, int fage) Line 14362  int hPijx(double *p, int bage, int fage)
   int agelim;    int agelim;
   int hstepm;    int hstepm;
   int nhstepm;    int nhstepm;
   int h, i, i1, j, k, k4, nres=0;    int h, i, i1, j, k, nres=0;
   
   double agedeb;    double agedeb;
   double ***p3mat;    double ***p3mat;
Line 15444  int main(int argc, char *argv[]) Line 14568  int main(int argc, char *argv[])
   
   double fret;    double fret;
   double dum=0.; /* Dummy variable */    double dum=0.; /* Dummy variable */
   double ***p3mat;    /* double*** p3mat;*/
   /* double ***mobaverage; */    /* double ***mobaverage; */
   double wald;    double wald;
   
   char line[MAXLINE];    char line[MAXLINE], linetmp[MAXLINE];
   char path[MAXLINE],pathc[MAXLINE],pathcd[MAXLINE],pathtot[MAXLINE];    char path[MAXLINE],pathc[MAXLINE],pathcd[MAXLINE],pathtot[MAXLINE];
   
   char  modeltemp[MAXLINE];    char  modeltemp[MAXLINE];
Line 15457  int main(int argc, char *argv[]) Line 14581  int main(int argc, char *argv[])
   char pathr[MAXLINE], pathimach[MAXLINE];     char pathr[MAXLINE], pathimach[MAXLINE]; 
   char *tok, *val; /* pathtot */    char *tok, *val; /* pathtot */
   /* int firstobs=1, lastobs=10; /\* nobs = lastobs-firstobs declared globally ;*\/ */    /* int firstobs=1, lastobs=10; /\* nobs = lastobs-firstobs declared globally ;*\/ */
   int c,  h , cpt, c2;    int c, h; /* c2; */
   int jl=0;    int jl=0;
   int i1, j1, jk, stepsize=0;    int i1, j1, jk, stepsize=0;
   int count=0;    int count=0;
Line 15492  int main(int argc, char *argv[]) Line 14616  int main(int argc, char *argv[])
   double ***delti3; /* Scale */    double ***delti3; /* Scale */
   double *delti; /* Scale */    double *delti; /* Scale */
   double ***eij, ***vareij;    double ***eij, ***vareij;
   double **varpl; /* Variances of prevalence limits by age */    //double **varpl; /* Variances of prevalence limits by age */
   
   double *epj, vepp;    double *epj, vepp;
   
Line 15550  int main(int argc, char *argv[]) Line 14674  int main(int argc, char *argv[])
   getcwd(pathcd, size);    getcwd(pathcd, size);
 #endif  #endif
   syscompilerinfo(0);    syscompilerinfo(0);
   printf("\nIMaCh version %s, %s\n%s",version, copyright, fullversion);    printf("\nIMaCh prax version %s, %s\n%s",version, copyright, fullversion);
   if(argc <=1){    if(argc <=1){
     printf("\nEnter the parameter file name: ");      printf("\nEnter the parameter file name: ");
     if(!fgets(pathr,FILENAMELENGTH,stdin)){      if(!fgets(pathr,FILENAMELENGTH,stdin)){
Line 15781  int main(int argc, char *argv[]) Line 14905  int main(int argc, char *argv[])
     }else      }else
       break;        break;
   }    }
   if((num_filled=sscanf(line,"model=1+age%[^.\n]", model)) !=EOF){    if((num_filled=sscanf(line,"model=%[^.\n]", model)) !=EOF){ /* Every character after model but dot and  return */
       if (num_filled != 1){
         printf("ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line);
         fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line);
         model[0]='\0';
         goto end;
       }else{
         trimbtab(linetmp,line); /* Trims multiple blanks in line */
         strcpy(line, linetmp);
       }
     }
     if((num_filled=sscanf(line,"model=1+age%[^.\n]", model)) !=EOF){ /* Every character after 1+age but dot and  return */
     if (num_filled != 1){      if (num_filled != 1){
       printf("ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line);        printf("ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line);
       fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line);        fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line);
Line 16154  Please run with mle=-1 to get a correct Line 15289  Please run with mle=-1 to get a correct
   Tvard=imatrix(1,NCOVMAX,1,2); /* n=Tvard[k1][1]  and m=Tvard[k1][2] gives the couple n,m of the k1 th product Vn*Vm    Tvard=imatrix(1,NCOVMAX,1,2); /* n=Tvard[k1][1]  and m=Tvard[k1][2] gives the couple n,m of the k1 th product Vn*Vm
                             * For V3*V2 (in V2+V1+V1*V4+age*V3+V3*V2), V3*V2 position is 2nd.                               * For V3*V2 (in V2+V1+V1*V4+age*V3+V3*V2), V3*V2 position is 2nd. 
                             * Tvard[k1=2][1]=3 (V3) Tvard[k1=2][2]=2(V2) */                              * Tvard[k1=2][1]=3 (V3) Tvard[k1=2][2]=2(V2) */
   Tvardk=imatrix(-1,NCOVMAX,1,2);    Tvardk=imatrix(0,NCOVMAX,1,2);
   Tage=ivector(1,NCOVMAX); /* Gives the covariate id of covariates associated with age: V2 + V1 + age*V4 + V3*age    Tage=ivector(1,NCOVMAX); /* Gives the covariate id of covariates associated with age: V2 + V1 + age*V4 + V3*age
                          4 covariates (3 plus signs)                           4 covariates (3 plus signs)
                          Tage[1=V3*age]= 4; Tage[2=age*V4] = 3                           Tage[1=V3*age]= 4; Tage[2=age*V4] = 3
Line 16441  This file: <a href=\"%s\">%s</a></br>Tit Line 15576  This file: <a href=\"%s\">%s</a></br>Tit
   /* Calculates basic frequencies. Computes observed prevalence at single age     /* Calculates basic frequencies. Computes observed prevalence at single age 
                  and for any valid combination of covariates                   and for any valid combination of covariates
      and prints on file fileres'p'. */       and prints on file fileres'p'. */
   freqsummary(fileres, p, pstart, agemin, agemax, s, agev, nlstate, imx, Tvaraff, invalidvarcomb, nbcode, ncodemax,mint,anint,strstart, \    freqsummary(fileres, p, pstart, (double)agemin, agemax, s, agev, nlstate, imx, Tvaraff, invalidvarcomb, nbcode, ncodemax,mint,anint,strstart, \
               firstpass, lastpass,  stepm,  weightopt, model);                firstpass, lastpass,  stepm,  weightopt, model);
   
   fprintf(fichtm,"\n");    fprintf(fichtm,"\n");
Line 16532  Interval (in months) between two waves: Line 15667  Interval (in months) between two waves:
 #ifdef GSL  #ifdef GSL
     printf("GSL optimization\n");  fprintf(ficlog,"Powell\n");      printf("GSL optimization\n");  fprintf(ficlog,"Powell\n");
 #else  #else
     printf("Powell\n");  fprintf(ficlog,"Powell\n");      printf("Powell-mort\n");  fprintf(ficlog,"Powell-mort\n");
 #endif  #endif
     strcpy(filerespow,"POW-MORT_");       strcpy(filerespow,"POW-MORT_"); 
     strcat(filerespow,fileresu);      strcat(filerespow,fileresu);
Line 16635  Interval (in months) between two waves: Line 15770  Interval (in months) between two waves:
   
     for(i=1; i <=NDIM; i++)      for(i=1; i <=NDIM; i++)
       for(j=i+1;j<=NDIM;j++)        for(j=i+1;j<=NDIM;j++)
                                 matcov[i][j]=matcov[j][i];          matcov[i][j]=matcov[j][i];
           
     printf("\nCovariance matrix\n ");      printf("\nCovariance matrix\n ");
     fprintf(ficlog,"\nCovariance matrix\n ");      fprintf(ficlog,"\nCovariance matrix\n ");
Line 17089  Please run with mle=-1 to get a correct Line 16224  Please run with mle=-1 to get a correct
     }      }
             
     /* Results */      /* Results */
     /* Value of covariate in each resultine will be compututed (if product) and sorted according to model rank */      /* Value of covariate in each resultine will be computed (if product) and sorted according to model rank */
     /* It is precov[] because we need the varying age in order to compute the real cov[] of the model equation */        /* It is precov[] because we need the varying age in order to compute the real cov[] of the model equation */  
     precov=matrix(1,MAXRESULTLINESPONE,1,NCOVMAX+1);      precov=matrix(1,MAXRESULTLINESPONE,1,NCOVMAX+1);
     endishere=0;      endishere=0;
Line 17259  Please run with mle=-1 to get a correct Line 16394  Please run with mle=-1 to get a correct
         date2dmy(datebackf,&jbackf, &mbackf, &anbackf);          date2dmy(datebackf,&jbackf, &mbackf, &anbackf);
       }        }
               
       printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,bage, fage, prevfcast, prevbcast, pathc,p, (int)anprojd-bage, (int)anbackd-fage);        printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,bage, fage, prevfcast, prevbcast, pathc,p, (int)anprojd-bage, (int)anbackd-fage);/* HERE valgrind Tvard*/
     }      }
     printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt, \      printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt, \
                  model,imx,jmin,jmax,jmean,rfileres,popforecast,mobilav,prevfcast,mobilavproj,prevbcast, estepm, \                   model,imx,jmin,jmax,jmean,rfileres,popforecast,mobilav,prevfcast,mobilavproj,prevbcast, estepm, \
Line 17409  Please run with mle=-1 to get a correct Line 16544  Please run with mle=-1 to get a correct
   
     pstamp(ficreseij);      pstamp(ficreseij);
                                   
     i1=pow(2,cptcoveff); /* Number of combination of dummy covariates */      /* i1=pow(2,cptcoveff); /\* Number of combination of dummy covariates *\/ */
     if (cptcovn < 1){i1=1;}      /* if (cptcovn < 1){i1=1;} */
           
     for(nres=1; nres <= nresult; nres++) /* For each resultline */      for(nres=1; nres <= nresult; nres++){ /* For each resultline */
     for(k=1; k<=i1;k++){ /* For any combination of dummy covariates, fixed and varying */      /* for(k=1; k<=i1;k++){ /\* For any combination of dummy covariates, fixed and varying *\/ */
       if(i1 != 1 && TKresult[nres]!= k)        /* if(i1 != 1 && TKresult[nres]!= k) */
         continue;        /*        continue; */
       fprintf(ficreseij,"\n#****** ");        fprintf(ficreseij,"\n#****** ");
       printf("\n#****** ");        printf("\n#****** ");
       for(j=1;j<=cptcoveff;j++) {        for(j=1;j<=cptcovs;j++){
         fprintf(ficreseij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]);        /* for(j=1;j<=cptcoveff;j++) { */
         printf("V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]);          /* fprintf(ficreseij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); */
           fprintf(ficreseij," V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]);
           printf(" V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]);
           /* printf("V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); */
       }        }
       for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */        for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */
         printf(" V%d=%lg ",TvarsQ[j], TinvDoQresult[nres][TvarsQ[j]]); /* TvarsQ[j] gives the name of the jth quantitative (fixed or time v) */          printf(" V%d=%lg ",TvarsQ[j], TinvDoQresult[nres][TvarsQ[j]]); /* TvarsQ[j] gives the name of the jth quantitative (fixed or time v) */
Line 17489  Please run with mle=-1 to get a correct Line 16627  Please run with mle=-1 to get a correct
       /* */        /* */
       if(i1 != 1 && TKresult[nres]!= k) /* TKresult[nres] is the combination of this nres resultline. All the i1 combinations are not output */        if(i1 != 1 && TKresult[nres]!= k) /* TKresult[nres] is the combination of this nres resultline. All the i1 combinations are not output */
         continue;          continue;
       printf("\n# model %s \n#****** Result for:", model);        printf("\n# model=1+age+%s \n#****** Result for:", model);  /* HERE model is empty */
       fprintf(ficrest,"\n# model %s \n#****** Result for:", model);        fprintf(ficrest,"\n# model=1+age+%s \n#****** Result for:", model);
       fprintf(ficlog,"\n# model %s \n#****** Result for:", model);        fprintf(ficlog,"\n# model=1+age+%s \n#****** Result for:", model);
       /* It might not be a good idea to mix dummies and quantitative */        /* It might not be a good idea to mix dummies and quantitative */
       /* for(j=1;j<=cptcoveff;j++){ /\* j=resultpos. Could be a loop on cptcovs: number of single dummy covariate in the result line as well as in the model *\/ */        /* for(j=1;j<=cptcoveff;j++){ /\* j=resultpos. Could be a loop on cptcovs: number of single dummy covariate in the result line as well as in the model *\/ */
       for(j=1;j<=cptcovs;j++){ /* j=resultpos. Could be a loop on cptcovs: number of single covariate (dummy or quantitative) in the result line as well as in the model */        for(j=1;j<=cptcovs;j++){ /* j=resultpos. Could be a loop on cptcovs: number of single covariate (dummy or quantitative) in the result line as well as in the model */
Line 17664  Please run with mle=-1 to get a correct Line 16802  Please run with mle=-1 to get a correct
   
           
     free_vector(weight,firstobs,lastobs);      free_vector(weight,firstobs,lastobs);
     free_imatrix(Tvardk,-1,NCOVMAX,1,2);      free_imatrix(Tvardk,0,NCOVMAX,1,2);
     free_imatrix(Tvard,1,NCOVMAX,1,2);      free_imatrix(Tvard,1,NCOVMAX,1,2);
     free_imatrix(s,1,maxwav+1,firstobs,lastobs);      free_imatrix(s,1,maxwav+1,firstobs,lastobs);
     free_matrix(anint,1,maxwav,firstobs,lastobs);       free_matrix(anint,1,maxwav,firstobs,lastobs); 
Line 17686  Please run with mle=-1 to get a correct Line 16824  Please run with mle=-1 to get a correct
     free_matrix(pmmij,1,nlstate+ndeath,1,nlstate+ndeath);      free_matrix(pmmij,1,nlstate+ndeath,1,nlstate+ndeath);
   }  /* mle==-3 arrives here for freeing */    }  /* mle==-3 arrives here for freeing */
   /* endfree:*/    /* endfree:*/
     if(mle!=-3) free_matrix(precov, 1,MAXRESULTLINESPONE,1,NCOVMAX+1); /* Could be elsewhere ?*/
   free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath);    free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath);
   free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath);    free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath);
   free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath);    free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath);
Line 17747  Please run with mle=-1 to get a correct Line 16886  Please run with mle=-1 to get a correct
   free_ivector(TmodelInvind,1,NCOVMAX);    free_ivector(TmodelInvind,1,NCOVMAX);
   free_ivector(TmodelInvQind,1,NCOVMAX);    free_ivector(TmodelInvQind,1,NCOVMAX);
   
   free_matrix(precov, 1,MAXRESULTLINESPONE,1,NCOVMAX+1); /* Could be elsewhere ?*/    /* free_matrix(precov, 1,MAXRESULTLINESPONE,1,NCOVMAX+1); /\* Could be elsewhere ?*\/ */
   
   free_imatrix(nbcode,0,NCOVMAX,0,NCOVMAX);    free_imatrix(nbcode,0,NCOVMAX,0,NCOVMAX);
   /* free_imatrix(codtab,1,100,1,10); */    /* free_imatrix(codtab,1,100,1,10); */
Removed from v.1.1  
changed lines
  Added in v.1.6

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>