Diff for /imach/src/imach.c between versions 1.91 and 1.94

version 1.91, 2003/06/25 15:30:29 version 1.94, 2003/06/27 13:00:02
Line 1 Line 1
 /* $Id$  /* $Id$
   $State$    $State$
   $Log$    $Log$
     Revision 1.94  2003/06/27 13:00:02  brouard
     Just cleaning
   
     Revision 1.93  2003/06/25 16:33:55  brouard
     (Module): On windows (cygwin) function asctime_r doesn't
     exist so I changed back to asctime which exists.
     (Module): Version 0.96b
   
     Revision 1.92  2003/06/25 16:30:45  brouard
     (Module): On windows (cygwin) function asctime_r doesn't
     exist so I changed back to asctime which exists.
   
   Revision 1.91  2003/06/25 15:30:29  brouard    Revision 1.91  2003/06/25 15:30:29  brouard
   * imach.c (Repository): Duplicated warning errors corrected.    * imach.c (Repository): Duplicated warning errors corrected.
   (Repository): Elapsed time after each iteration is now output. It    (Repository): Elapsed time after each iteration is now output. It
Line 184 Line 196
 /* $Id$ */  /* $Id$ */
 /* $State$ */  /* $State$ */
   
 char version[]="Imach version 0.96a, June 2003, INED-EUROREVES ";  char version[]="Imach version 0.96b, June 2003, INED-EUROREVES ";
 char fullversion[]="$Revision$ $Date$";   char fullversion[]="$Revision$ $Date$"; 
 int erreur, nberr=0, nbwarn=0; /* Error number, number of errors number of warnings  */  int erreur, nberr=0, nbwarn=0; /* Error number, number of errors number of warnings  */
 int nvar;  int nvar;
Line 233  char command[FILENAMELENGTH]; Line 245  char command[FILENAMELENGTH];
 int  outcmd=0;  int  outcmd=0;
   
 char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filereso[FILENAMELENGTH], rfileres[FILENAMELENGTH];  char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filereso[FILENAMELENGTH], rfileres[FILENAMELENGTH];
 char lfileres[FILENAMELENGTH];  
 char filelog[FILENAMELENGTH]; /* Log file */  char filelog[FILENAMELENGTH]; /* Log file */
 char filerest[FILENAMELENGTH];  char filerest[FILENAMELENGTH];
 char fileregp[FILENAMELENGTH];  char fileregp[FILENAMELENGTH];
Line 553  void free_ma3x(double ***m, long nrl, lo Line 565  void free_ma3x(double ***m, long nrl, lo
   free((FREE_ARG)(m+nrl-NR_END));    free((FREE_ARG)(m+nrl-NR_END));
 }  }
   
   /*************** function subdirf ***********/
   char *subdirf(char fileres[])
   {
     /* Caution optionfilefiname is hidden */
     strcpy(tmpout,optionfilefiname);
     strcat(tmpout,"/"); /* Add to the right */
     strcat(tmpout,fileres);
     return tmpout;
   }
   
   /*************** function subdirf2 ***********/
   char *subdirf2(char fileres[], char *preop)
   {
     
     /* Caution optionfilefiname is hidden */
     strcpy(tmpout,optionfilefiname);
     strcat(tmpout,"/");
     strcat(tmpout,preop);
     strcat(tmpout,fileres);
     return tmpout;
   }
   
   /*************** function subdirf3 ***********/
   char *subdirf3(char fileres[], char *preop, char *preop2)
   {
     
     /* Caution optionfilefiname is hidden */
     strcpy(tmpout,optionfilefiname);
     strcat(tmpout,"/");
     strcat(tmpout,preop);
     strcat(tmpout,preop2);
     strcat(tmpout,fileres);
     return tmpout;
   }
   
 /***************** f1dim *************************/  /***************** f1dim *************************/
 extern int ncom;   extern int ncom; 
 extern double *pcom,*xicom;  extern double *pcom,*xicom;
Line 778  void powell(double p[], double **xi, int Line 825  void powell(double p[], double **xi, int
     fprintf(ficrespow,"\n");fflush(ficrespow);      fprintf(ficrespow,"\n");fflush(ficrespow);
     if(*iter <=3){      if(*iter <=3){
       tm = *localtime(&curr_time.tv_sec);        tm = *localtime(&curr_time.tv_sec);
       asctime_r(&tm,strcurr);        strcpy(strcurr,asctime(&tmf));
   /*       asctime_r(&tm,strcurr); */
       forecast_time=curr_time;        forecast_time=curr_time;
       itmp = strlen(strcurr);        itmp = strlen(strcurr);
       if(strcurr[itmp-1]=='\n')        if(strcurr[itmp-1]=='\n')
Line 788  void powell(double p[], double **xi, int Line 836  void powell(double p[], double **xi, int
       for(niterf=10;niterf<=30;niterf+=10){        for(niterf=10;niterf<=30;niterf+=10){
         forecast_time.tv_sec=curr_time.tv_sec+(niterf-*iter)*(curr_time.tv_sec-last_time.tv_sec);          forecast_time.tv_sec=curr_time.tv_sec+(niterf-*iter)*(curr_time.tv_sec-last_time.tv_sec);
         tmf = *localtime(&forecast_time.tv_sec);          tmf = *localtime(&forecast_time.tv_sec);
         asctime_r(&tmf,strfor);  /*      asctime_r(&tmf,strfor); */
 /*      strcpy(strfor,asctime(&tmf)); */          strcpy(strfor,asctime(&tmf));
         itmp = strlen(strfor);          itmp = strlen(strfor);
         if(strfor[itmp-1]=='\n')          if(strfor[itmp-1]=='\n')
         strfor[itmp-1]='\0';          strfor[itmp-1]='\0';
Line 1209  double func( double *x) Line 1257  double func( double *x)
           oldm=newm;            oldm=newm;
         } /* end mult */          } /* end mult */
               
         /*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 and large stepm.  
          * 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   
          * 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  
          * (i.e to dh[mi][i]-1) saved in 'savm'. The we inter(extra)polate the  
          * probability in order to take into account the bias as a fraction of the way  
          * from savm to out if bh is neagtive or even beyond if bh is positive. bh varies  
          * -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 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 is positive if real duration  
          * is higher than the multiple of stepm and negative otherwise.  
          */  
         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= (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= (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.-+bh)*out[s1][s2])); */ /* exponential interpolation */  
         /*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/  
         /*if(lli ==000.0)*/  
         /*printf("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;          ipmx +=1;
         sw += weight[i];          sw += weight[i];
         ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;          ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
Line 1260  double func( double *x) Line 1287  double func( double *x)
           oldm=newm;            oldm=newm;
         } /* end mult */          } /* end mult */
               
         /*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 and large stepm.  
          * 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   
          * 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  
          * (i.e to dh[mi][i]-1) saved in 'savm'. The we inter(extra)polate the  
          * probability in order to take into account the bias as a fraction of the way  
          * from savm to out if bh is neagtive or even beyond if bh is positive. bh varies  
          * -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 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 is positive if real duration  
          * is higher than the multiple of stepm and negative otherwise.  
          */  
         /* 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= (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 */          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 */
         /*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/  
         /*if(lli ==000.0)*/  
         /*printf("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;          ipmx +=1;
         sw += weight[i];          sw += weight[i];
         ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;          ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
Line 1449  double funcone( double *x) Line 1456  double funcone( double *x)
   return -l;    return -l;
 }  }
   
 char *subdirf(char fileres[])  
 {  
   /* Caution optionfilefiname is hidden */  
   strcpy(tmpout,optionfilefiname);  
   strcat(tmpout,"/"); /* Add to the right */  
   strcat(tmpout,fileres);  
   return tmpout;  
 }  
   
 char *subdirf2(char fileres[], char *preop)  
 {  
     
   strcpy(tmpout,optionfilefiname);  
   strcat(tmpout,"/");  
   strcat(tmpout,preop);  
   strcat(tmpout,fileres);  
   return tmpout;  
 }  
 char *subdirf3(char fileres[], char *preop, char *preop2)  
 {  
     
   strcpy(tmpout,optionfilefiname);  
   strcat(tmpout,"/");  
   strcat(tmpout,preop);  
   strcat(tmpout,preop2);  
   strcat(tmpout,fileres);  
   return tmpout;  
 }  
   
   /*************** function likelione ***********/
 void likelione(FILE *ficres,double p[], int npar, int nlstate, int *globpri, long *ipmx, double *sw, double *fretone, double (*funcone)(double []))  void likelione(FILE *ficres,double p[], int npar, int nlstate, int *globpri, long *ipmx, double *sw, double *fretone, double (*funcone)(double []))
 {  {
   /* This routine should help understanding what is done with     /* This routine should help understanding what is done with 
Line 3741  int fileappend(FILE *fichier, char *opti Line 3721  int fileappend(FILE *fichier, char *opti
   fflush(fichier);    fflush(fichier);
   return (1);    return (1);
 }  }
   
   
   /**************** function prwizard **********************/
 void prwizard(int ncovmodel, int nlstate, int ndeath,  char model[], FILE *ficparo)  void prwizard(int ncovmodel, int nlstate, int ndeath,  char model[], FILE *ficparo)
 {  {
   
     /* Wizard to print covariance matrix template */
   
   char ca[32], cb[32], cc[32];    char ca[32], cb[32], cc[32];
   int i,j, k, l, li, lj, lk, ll, jj, npar, itimes;    int i,j, k, l, li, lj, lk, ll, jj, npar, itimes;
   int numlinepar;    int numlinepar;
Line 3999  int main(int argc, char *argv[]) Line 3984  int main(int argc, char *argv[])
  optionfilext=%s\n\   optionfilext=%s\n\
  optionfilefiname=%s\n",pathtot,path,optionfile,optionfilext,optionfilefiname);   optionfilefiname=%s\n",pathtot,path,optionfile,optionfilext,optionfilefiname);
   
   printf("Localtime (at start):%s",strstart);    printf("Local time (at start):%s",strstart);
   fprintf(ficlog,"Localtime (at start): %s",strstart);    fprintf(ficlog,"Local time (at start): %s",strstart);
   fflush(ficlog);    fflush(ficlog);
 /*   (void) gettimeofday(&curr_time,&tzp); */  /*   (void) gettimeofday(&curr_time,&tzp); */
 /*   printf("Elapsed time %d\n", asc_diff_time(curr_time.tv_sec-start_time.tv_sec,tmpout)); */  /*   printf("Elapsed time %d\n", asc_diff_time(curr_time.tv_sec-start_time.tv_sec,tmpout)); */
Line 4576  Title=%s <br>Datafile=%s Firstpass=%d La Line 4561  Title=%s <br>Datafile=%s Firstpass=%d La
   strcpy(pathr,path);    strcpy(pathr,path);
   strcat(pathr,optionfilefiname);    strcat(pathr,optionfilefiname);
   chdir(optionfilefiname); /* Move to directory named optionfile */    chdir(optionfilefiname); /* Move to directory named optionfile */
   strcpy(lfileres,fileres);  
   strcat(lfileres,"/");  
   strcat(lfileres,optionfilefiname);  
       
   /* Calculates basic frequencies. Computes observed prevalence at single age    /* Calculates basic frequencies. Computes observed prevalence at single age
      and prints on file fileres'p'. */       and prints on file fileres'p'. */
Line 5119  ageminpar, agemax, s[lastpass][imx], age Line 5101  ageminpar, agemax, s[lastpass][imx], age
   tm = *localtime(&end_time.tv_sec);    tm = *localtime(&end_time.tv_sec);
   tmg = *gmtime(&end_time.tv_sec);    tmg = *gmtime(&end_time.tv_sec);
   strcpy(strtend,asctime(&tm));    strcpy(strtend,asctime(&tm));
   printf("Localtime at start %s\nLocaltime at end   %s",strstart, strtend);     printf("Local time at start %s\nLocaltime at end   %s",strstart, strtend); 
   fprintf(ficlog,"Localtime at start %s\nLocal time at end   %s\n",strstart, strtend);     fprintf(ficlog,"Local time at start %s\nLocal time at end   %s\n",strstart, strtend); 
   printf("Total time used %s\n", asc_diff_time(end_time.tv_sec -start_time.tv_sec,tmpout));    printf("Total time used %s\n", asc_diff_time(end_time.tv_sec -start_time.tv_sec,tmpout));
   
   printf("Total time was %d Sec.\n", end_time.tv_sec -start_time.tv_sec);    printf("Total time was %d Sec.\n", end_time.tv_sec -start_time.tv_sec);

Removed from v.1.91  
changed lines
  Added in v.1.94


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