/* simo.c

   written by Don Maszle
   22 November 1991
   
   Copyright (c) 1993.  Don Maszle, Frederic Bois.  All rights reserved.

   -- Revisions -----
     Logfile:  SCCS/s.simo.c
    Revision:  1.1
        Date:  7/14/93
     Modtime:  19:14:56
      Author:  @a
   -- SCCS  ---------
   
   Output routines for the simulation
*/

#ifdef __LOCAL_HDR__
#include "stdio.h"
#include "math.h"

#else
#include <stdio.h>
#include <math.h>
#endif

#include "sim.h"


static char vszDefOutFilename[] = "sim.out";
static char vszDefMCOutFilename[] = "simmc.out";

/*. static char vszDefMCPassFilename[] = "simmcp.out"; */
/*. static char vszDefMCFailFilename[] = "simmcf.out"; */
/*. static char vszDefMCBehavFilename[] = "simmcb.out"; */



/* SaveOutputs
   
   saves to memory interpolated outputs at the specified output time
   for each of the variables in the output lists.  Note that each
   variable has its own scheduling, the very confusing 'if' statement
   in the for loop checks if each variable in the loop is scheduled
   for the current output time.

   *pdTout is the time at which to record output value--it is not
   necessarily the time of the current simulation, in which case we
   need to interpolate to get the correct values.

   *pdTrans is the time of the next input transition.  If this time is
   equal to the output time, the output values saved should reflect
   the values of states and varialbes in the new period, that is, with
   the input equal to their new values.  This is so that all model
   variables and inputs are defined across discontinuities in a
   consistent manor.  >> is the following note still correct?

   NOTE: It is crucial for this to be called *before* UpdateInputs(),
         so that the value of the input used in the last calculation
         will still be valid. 
 */

void SaveOutputs (PEXPERIMENT pexp, PDOUBLE pdTout, PDOUBLE pdTtrans)
{
#define SO_EPSILON (1e-100)             /*-- Smaller values are zeroed  */

  matType1 rgdInterpStates, rgdInterpDeriv;
  int i;
  PMODELINFO pmod = pexp->pmodelinfo;
  POUTSPEC pos = &pexp->os;

  interpole(pmod->rgDeriv, &pexp->is.dStep, &pmod->nStates, &pmod->mem,
            &pexp->dTime, pdTout, pmod->pdModelVars, rgdInterpStates);

  if (pexp->dTime > 0.0)			/* Use interpolated values */
    CalcDeriv(rgdInterpStates, rgdInterpDeriv, pdTout);
						/* Update output scaling */
  CalcOutputs (rgdInterpStates, rgdInterpDeriv, pdTout);

  if (pexp->dTime >= *pdTtrans)	{               /* Update inputs *here* so  */
    double dTtransSave = *pdTtrans;
    CorrectInputToTransition (pexp, pdTtrans);  /* the right value is saved */

#ifdef ndef
    if (*pdTout == dTtransSave)                 /* Start model this period */
      CorrectModelToTime(pexp, &dTtransSave);
#endif
  }  /* if */

  for (i = 0; i < pos->nOutputs; i++) {

      /* Save interpolated value if there are still times to output
	 for this variable, and if this time is scheduled
      */

    if (pos->piCurrentOut[i] < pos->pcOutputTimes[i]
	&& *pdTout == pos->prgdOutputTimes[i][pos->piCurrentOut[i]]) {
      double dTmp;

      if (IsModelVar(pos->phvar[i]))	/*-- Use interp'd model value */
                                        /*   (value just before transition */
        dTmp = rgdInterpStates[ ModelIndex(pos->phvar[i])];

      else				/*-- Use current parm/input value  */
        dTmp = GetVarValue (pos->phvar[i]);

      if (fabs(dTmp) < SO_EPSILON)
        dTmp = 0.0;                     /*-- Avoid silly little numbers  */
      pos->prgdOutputVals[i][pos->piCurrentOut[i]++] = dTmp;

    }  /* if */
  }  /* for */

}  /* SaveOutputs */


void NewSaveOutputs (PEXPERIMENT pexp, PDOUBLE pdTout, PDOUBLE pdTtrans)
{
#define SO_EPSILON (1e-100)             /*-- Smaller values are zeroed  */

  matType1 rgdInterpStates, rgdInterpDeriv;
  int i;
  PMODELINFO pmod = pexp->pmodelinfo;
  POUTSPEC pos = &pexp->os;

#ifdef ndef
  if (*pdTout < pexp->dTime) {
    rgdInterpStates = rgdInterpStatesWorkspace;
    interpole(pmod->rgDeriv, &pexp->is.dStep, &pmod->nStates, &pmod->mem,
              &pexp->dTime, pdTout, pmod->pdModelVars, rgdInterpStates);
  }  /* if */
  else
    rgdInterpStates = pmod->pdModelVars; /*-- Outputs get overwritten! */
#endif

  memcpy (rgdInterpStates, pmod->pdModelVars,
          pmod->nModelVars*sizeof(double));
  if (*pdTout < pexp->dTime)            /*-- Find out what states were */
    interpole(pmod->rgDeriv, &pexp->is.dStep, &pmod->nStates, &pmod->mem,
              &pexp->dTime, pdTout, pmod->pdModelVars, rgdInterpStates);


  if (pexp->dTime > 0.0)			/* Use interpolated values */
    CalcDeriv(rgdInterpStates, rgdInterpDeriv, pdTout);
						/* Update output scaling */
  CalcOutputs (rgdInterpStates, rgdInterpDeriv, pdTout);

  if (pexp->dTime >= *pdTtrans)	{               /* Update inputs *here* so  */
#ifdef ndef
    double dTtransSave = *pdTtrans;
    CorrectInputToTransition (pexp, pdTtrans);  /* the right value is saved */
#endif
#ifdef ndef
    if (*pdTout == dTtransSave)                 /* Start model this period */
      CorrectModelToTime(pexp, &dTtransSave);
#endif
  }  /* if */

  for (i = 0; i < pos->nOutputs; i++) {

      /* Save interpolated value if there are still times to output
	 for this variable, and if this time is scheduled
      */

    if (pos->piCurrentOut[i] < pos->pcOutputTimes[i]
	&& *pdTout == pos->prgdOutputTimes[i][pos->piCurrentOut[i]]) {
      double dTmp;

      if (IsModelVar(pos->phvar[i]))	/*-- Use interp'd model value */
                                        /*   (value just before transition */
        dTmp = rgdInterpStates[ ModelIndex(pos->phvar[i])];

      else				/*-- Use current parm/input value  */
        dTmp = GetVarValue (pos->phvar[i]);

      if (fabs(dTmp) < SO_EPSILON)
        dTmp = 0.0;                     /*-- Avoid silly little numbers  */
      pos->prgdOutputVals[i][pos->piCurrentOut[i]++] = dTmp;

    }  /* if */
  }  /* for */

}  /* SaveOutputs */



/* NextOutputTime

   Returns in pdTout,the next time, > pdTout, at which an variable is
   to be output. 
*/
   
void NextOutputTime (PEXPERIMENT pexp, PDOUBLE pdTout, PINT piOut)
{
  if (pexp->dTime < pexp->dTfinal)
    if (++*piOut < pexp->os.cDistinctTimes)
      *pdTout = pexp->os.rgdDistinctTimes[*piOut];
    else
      *pdTout = pexp->dTfinal;

}  /* NextOutputTime */
  


/* WriteOneMod
   
   writes one parameter modification from the list.   Inputs are *not*
   written.
*/

int WriteOneMod (PVOID pData, PVOID pInfo)
{
  PMCVAR pmcvar = (PMCVAR) pData;
  PFILE pfile = (PFILE) pInfo;

  if (!IsInput (pmcvar->hvar))
/*.     fprintf(pfile, "%12.8g ", pmcvar->dVal); */
    fprintf(pfile, "%g\t", pmcvar->dVal);

  return 0;
}  /* WriteOneMod */


/* OpenMCFiles
   
   Open all the files written to be WriteMCOutput()
   
   Return non-NULL on error;
*/

int OpenMCFiles (PANALYSIS panal, PFILE *ppfileMC, 
		 PFILE *ppfilePass, PFILE *ppfileFail,
		 PFILE *ppfileBehav, PFILE *ppfileSum)
{
  int iErr = 0;
  static char vszOpenMC[] = "OpenMCFiles()";

  if (!panal->mc.szMCPassFilename) {	/*-- If distributed output files */
					/*   not specified, use one file */

					/*-- Use command line spec if given */
    if (panal->expGlobal.os.bCommandLineSpec)
      panal->mc.szMCOutfilename = panal->expGlobal.os.szOutfilename;
    
    else if (!(panal->mc.szMCOutfilename))	/*-- Default if none given */
      panal->mc.szMCOutfilename = vszDefMCOutFilename;
  
    if (!panal->mc.pfileMCOut
	&& !(panal->mc.pfileMCOut = fopen (panal->mc.szMCOutfilename, "w"))) {
      iErr++;
      ReportError (NULL, RE_FATAL | RE_CANNOTOPEN,
		   panal->mc.szMCOutfilename, vszOpenMC);
    }  /* if */
  }  /* if */

  else{					/*-- Otherwise, Use 4 output files */
    if (panal->mc.szMCPassFilename
	&& !panal->mc.pfileMCPass
	&& !(panal->mc.pfileMCPass = fopen (panal->mc.szMCPassFilename, "w"))) {
      iErr++;
      ReportError (NULL, RE_FATAL | RE_CANNOTOPEN,
		   panal->mc.szMCPassFilename, vszOpenMC);
    }  /* if */

    if (panal->mc.szMCFailFilename
	&& !panal->mc.pfileMCFail
	&& !(panal->mc.pfileMCFail = fopen (panal->mc.szMCFailFilename, "w"))) {
      iErr++;
      ReportError (NULL, RE_FATAL | RE_CANNOTOPEN,
		   panal->mc.szMCFailFilename, vszOpenMC);
    }  /* if */

    if (panal->mc.szMCBehavFilename
	&& !panal->mc.pfileMCBehav
	&& !(panal->mc.pfileMCBehav = fopen (panal->mc.szMCBehavFilename, "w"))) {
      iErr++;
      ReportError (NULL, RE_FATAL | RE_CANNOTOPEN,
		   panal->mc.szMCBehavFilename, vszOpenMC);
    }  /* if */

    if (panal->mc.szMCSumFilename
	&& !panal->mc.pfileMCSum
	&& !(panal->mc.pfileMCSum = fopen (panal->mc.szMCSumFilename, "w"))) {
      iErr++;
      ReportError (NULL, RE_FATAL | RE_CANNOTOPEN,
		   panal->mc.szMCSumFilename, vszOpenMC);
    }  /* if */
  }  /* else */
  
  
  *ppfileMC = panal->mc.pfileMCOut;
  *ppfilePass = panal->mc.pfileMCPass;
  *ppfileFail = panal->mc.pfileMCFail;
  *ppfileBehav = panal->mc.pfileMCBehav;
  *ppfileSum = panal->mc.pfileMCSum;

  return (iErr);
}  /* OpenMCFiles */



/* CloseMCFiles
   
   Closes output files associated with Monte Carlo and set points runs
*/

void CloseMCFiles (PANALYSIS panal)
{
  if (panal->mc.pfileMCOut) {
    fclose (panal->mc.pfileMCOut);  
    fprintf (stderr, "\nWrote results to \"%s\"\n", panal->mc.szMCOutfilename);
  }  /* if */
  else {
    fclose (panal->mc.pfileMCPass);  
    fclose (panal->mc.pfileMCFail);  
    fclose (panal->mc.pfileMCBehav);  
    fclose (panal->mc.pfileMCSum);  
    fprintf (stderr, "\nWrote results to 4 outputs files\n");
  }  /* else */
}  /* CloseMCFiles */


/* WriteMCOutput

   Output the variations for this run and results of the Monte Carlo
   (1 or 0 for pass or fail).
*/

void WriteMCOutput (PANALYSIS panal,
		    PMCDATAOUT pmcdataout)
{
/*.   int i; */
  PFILE pfileMC;
  PFILE pfilePass, pfileFail, pfileBehav, pfileSum;
  

  if (OpenMCFiles (panal, &pfileMC, &pfilePass, &pfileFail,
		   &pfileBehav, &pfileSum))
    return;	/* Cannot open files, Abort */

  
	/*-- Choose Output File.  If separate pass and fail files are
	     specified, use them depending on the pass criteria
        */

  if (pfilePass && pfileFail) {		/* PASS / FAIL CRITERIA */
    if (pmcdataout->data[pmcdataout->nbrdy3 - 1] == 1.0) {
      panal->mc.nPasses++;
      pfileMC = pfilePass;	/* Use pass file */
    }  /* if */
    else {
      panal->mc.nFails++;
      pfileMC = pfileFail;	/* Use fail file */
    }  /* else */
  }  /* if */

  /*-- else pfileMC is normal MC output and contains both passes and fails */

  /*-- Write variations, the actual outputs, and the results of the
    -- model specific TransformData() analysis depending on how the
    -- fOptions flags are set in panal.
  */
    
  fprintf (pfileMC, "%d\t", panal->mc.iRun);
  if (panal->fOptions & OF_PARMLIST) { /*--Include MC Variations for run--*/
    WriteArray (pfileMC, panal->mc.nParms, panal->mc.rgdParms);
    fprintf (pfileMC, "\t");
  }
	/*-- If the four files are not specified, then write the
	     output values to the regular output file.
        */
  
	/* Outdata array is the compiled output of all experiments */
	/* Outdata [0..<nbrdy2] are the transformed output values  */
	/* Outdata [nbrdy2..nbrdy3-1] are the ln-likelihoods       */
  
/* FB did it: allways write the output
  if (panal->fOptions & OF_MCOUTPUTS) { */ /*--Include Monte Carlo Outputs--*/
    if (!pfileBehav)			/* Behavior file not spec'd */
      WriteArray (pfileMC, pmcdataout->nbrdy2, pmcdataout->data);
/*  }*/ /* if */
  
	/*-- Write result of analysis to behavior file if specified.
	     Also write result to chosen output file in all cases */

  if (panal->fOptions & OF_MCRESULT) { /*--Include Monte Carlo Results--*/
    double dTmp = pmcdataout->data[pmcdataout->nbrdy3-1];

    if (pfileBehav)
      fprintf (pfileBehav, "%2.0g\n", pmcdataout->data[pmcdataout->nbrdy3-1]);
  
    /*-- Only write 1 or 0 if the value is exactly 1 or 0, which
      -- is used to indicate pass or fail.
    */

    if (dTmp == 0.0)
      fprintf (pfileMC, "0\n");
    else if (dTmp == 1.0)
      fprintf (pfileMC, "1\n");
    else {
      fputc ('\t', pfileMC);
      WriteArray (pfileMC, pmcdataout->nbrdy3 - pmcdataout->nbrdy2,
                  pmcdataout->data + pmcdataout->nbrdy2);
      fprintf (pfileMC, "\n");
    } /* else */
  } /* if */

  /* Hack for monster search */
 fflush (pfileMC);
  
}  /* WriteMCOutput */



/* WriteMCSummary
   
   Write a summary file for MonteCarlo output.
*/

void WriteMCSummary (PANALYSIS panal)
{
  PMONTECARLO  pmc;
  PFILE	pfileSum;
  
  if (!panal || !(pmc = &panal->mc) || !(pfileSum = pmc->pfileMCSum))
    return;
  
  fprintf (pfileSum, "%s\t%d\n", pmc->szMCPassFilename, pmc->nPasses);
  fprintf (pfileSum, "%s\t%d\n", pmc->szMCFailFilename, pmc->nFails);
}  /* WriteMCSummary */


/* WriteNormalOutput
   
   Write the results in the output file. This procedure is
   called only from time to time in order to save storage space
*/
   
void WriteNormalOutput (PANALYSIS panal, PEXPERIMENT pexp)
{
  int i, j;
  PFILE pfile;
  POUTSPEC posGlo, pos;
  int iTW = 8;		/* Width for times */
  int iOW = 12;		/* Width for Outputs */

  if (!panal)
    return;

  posGlo = &panal->expGlobal.os;
  pos = &pexp->os;

  if (!posGlo->szOutfilename)
    posGlo->szOutfilename = vszDefOutFilename;
  
  if (!(posGlo->pfileOut))
    if (!(posGlo->pfileOut = fopen (posGlo->szOutfilename, "w")))
      ReportError (NULL, RE_CANNOTOPEN | RE_FATAL,
	           posGlo->szOutfilename, NULL);

  pfile = posGlo->pfileOut;
  fprintf (pfile, "Results of Experiment %d\n\n", pexp->iExp);

#ifdef ndef

	/* Horizontal output: Formatted  Var1  Time_Out1  Time_Out2 ... */
  
  for (i = 0; i < pos->nOutputs; i++) {
    fprintf (pfile, "%s ", pos->pszOutputNames[i]);
    for (j = 0; j < pos->pcOutputTimes[i]; j++)
      fprintf (pfile, "[%g] %g ",
	       pos->prgdOutputTimes[i][j],
	       pos->prgdOutputVals[i][j]);
    fprintf (pfile, "\n");
  }  /* for */
#endif
  
	/* Vertical output:  Formatted  Time1    Out_Var1  Out_Var2 ... */

/*.   fprintf (pfile, "%*c ", iTW, ' '); */
  fprintf (pfile, "Times");
  for (i = 0; i < pos->nOutputs; i++)
    fprintf (pfile, "\t%s", pos->pszOutputNames[i]);
/*.     fprintf (pfile, "%*s ", iOW, pos->pszOutputNames[i]); */
  fprintf (pfile, "\n");

  for (j = 0; j < pos->nOutputs; j++)
    pos->piCurrentOut[j] = 0;
  
  for (i = 0; i < pos->cDistinctTimes; i++) {
    fprintf (pfile, "%g", pos->rgdDistinctTimes[i]);
/*.     fprintf (pfile, "%*g ", iTW, pos->rgdDistinctTimes[i]); */
    for (j = 0; j < pos->nOutputs; j++) {

      if (pos->piCurrentOut[j] < pos->pcOutputTimes[j]
	  && pos->rgdDistinctTimes[i]
	     == pos->prgdOutputTimes[j][pos->piCurrentOut[j]])

/*. 	fprintf (pfile, "%*.6lg ", iOW, */
	fprintf (pfile, "\t%g",
                 pos->prgdOutputVals[j][pos->piCurrentOut[j]++]);

      else
	fprintf (pfile, "\t");
/*. 	fprintf (pfile, "%*c ", iOW, ' '); */
    }  /* for */
    fprintf (pfile, "\n");

  }  /* for */
  fprintf (pfile, "\n");  

  
}  /* WriteNormalOutput */
