//-----------------------------------------------------------------------------
//
//  Peter Richter (prichter@princeton.edu)
//  Princeton Plasma Physics Laboratory
//  August 2000
//
//  f77fs.cpp - Implementation of F77 fusion reaction routines.
//
//-----------------------------------------------------------------------------
 
#include "preact/f77fs.h"
#include <iostream>
#include "preact/fsreaction.h"
 
using namespace std ;

#define M 100
 
static FSReaction *fs[M];
static int pr_next = 0;
 
//-----------------------------------------------------------------------------
 
integer_function F77NAME(fs_init)(integer& icode, integer& ierrlo,
			      	  integer& ierrhi)
{
  if (pr_next == M) {
    cerr << "Error: Too many (over " << M << ") calls to fs_init.\n";
    F77NAME(bad_exit)();
  }
  switch (icode) {
  case 1:  fs[pr_next] = new FSReaction((char *)"D->D(n)", ierrlo, ierrhi); break;
  case 2:  fs[pr_next] = new FSReaction((char *)"D->D(p)", ierrlo, ierrhi); break;
  case 3:  fs[pr_next] = new FSReaction((char *)"D->T",    ierrlo, ierrhi); break;
  case 4:  fs[pr_next] = new FSReaction((char *)"T->D",    ierrlo, ierrhi); break;
  case 5:  fs[pr_next] = new FSReaction((char *)"D->He3",  ierrlo, ierrhi); break;
  case 6:  fs[pr_next] = new FSReaction((char *)"He3->D",  ierrlo, ierrhi); break;
  case 7:  fs[pr_next] = new FSReaction((char *)"T->T",    ierrlo, ierrhi); break;
  case 8:  fs[pr_next] = new FSReaction((char *)"T->He3",  ierrlo, ierrhi); break;
  case 9:  fs[pr_next] = new FSReaction((char *)"He3->T",  ierrlo, ierrhi); break;
  case 10:  fs[pr_next] = new FSReaction((char *)"dpcT->T",  ierrlo, ierrhi); break;
  default: cerr << "Error: Invalid icode value passed to fs_init.\n"; F77NAME(bad_exit)();
  }
  return pr_next++;
}
 
//-----------------------------------------------------------------------------
 
real_function F77NAME(fs_sigma)(integer& ihandle, real_8& Erel)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to fs_sigma.\n";
    F77NAME(bad_exit)();
  }
  return fs[ihandle]->sigma(Erel);
}
 
//-----------------------------------------------------------------------------
 
real_function F77NAME(fs_vrel)(integer& ihandle, real_8& Erel)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to fs_vrel.\n";
    F77NAME(bad_exit)();
  }
  return fs[ihandle]->vrel(Erel);
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_coldtarget_sigmatimesv)(integer& ihandle, real_8 *E,
					      real_8 *f, integer& n)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to "
         << "fs_coldtarget_sigmatimesv.\n";
    F77NAME(bad_exit)();
  }
  fs[ihandle]->coldTarget_sigmaTimesV(E, f, n);
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_coldtarget_erange)(integer& ihandle, real_8& Emin,
					 real_8& Emax,
					 integer& min_policy,
					 integer& max_policy)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to fs_coldtarget_erange.\n";
    F77NAME(bad_exit)();
  }
  range r = fs[ihandle]->coldTarget_ERange();
  Emin = r.minimum;
  Emax = r.maximum;
  min_policy = r.min_policy;
  max_policy = r.max_policy;
}
 
//-----------------------------------------------------------------------------
subroutine F77NAME(fs_coldtarget_epolicy)(integer& ihandle,
					  integer& min_policy,
					  integer& max_policy)
{
  fs[ihandle]->coldTarget_EPolicy(min_policy,max_policy);
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_warmtarget_sigmatimesv)(integer& ihandle, real_8 *E,
					      real_8 *T, real_8 *f, integer& n)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to "
         << "fs_warmtarget_sigmatimesv.\n";
    F77NAME(bad_exit)();
  }
  fs[ihandle]->warmTarget_sigmaTimesV(E, T, f, n);
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_warmtarget_erange)(integer& ihandle, real_8& Emin,
					 real_8& Emax,
					 integer& min_policy,
					 integer& max_policy)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to fs_warmtarget_erange.\n";
    F77NAME(bad_exit)();
  }
  range r = fs[ihandle]->warmTarget_ERange();
  Emin = r.minimum;
  Emax = r.maximum;
  min_policy = r.min_policy;
  max_policy = r.max_policy;
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_warmtarget_trange)(integer& ihandle, real_8& Tmin,
					 real_8& Tmax,
					 integer& min_policy,
					 integer& max_policy)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to fs_warmtarget_trange.\n";
    F77NAME(bad_exit)();
  }
  range r = fs[ihandle]->warmTarget_TRange();
  Tmin = r.minimum;
  Tmax = r.maximum;
  min_policy = r.min_policy;
  max_policy = r.max_policy;
}
 
//-----------------------------------------------------------------------------
subroutine F77NAME(fs_warmtarget_epolicy)(integer& ihandle,
					  integer& min_policy,
					  integer& max_policy)
{
  fs[ihandle]->warmTarget_EPolicy(min_policy,max_policy);
}
 
//-----------------------------------------------------------------------------
subroutine F77NAME(fs_warmtarget_tpolicy)(integer& ihandle,
					  integer& min_policy,
					  integer& max_policy)
{
  fs[ihandle]->warmTarget_TPolicy(min_policy,max_policy);
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_thermonuclear_sigmatimesv)(integer& ihandle, real_8 *T,
						 real_8 *f, integer& n)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to "
         << "fs_thermonuclear_sigmatimesv.\n";
    F77NAME(bad_exit)();
  }
  fs[ihandle]->thermonuclear_sigmaTimesV(T, f, n);
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_thermonuclear_trange)(integer& ihandle, real_8& Tmin,
					    real_8& Tmax,
					    integer& min_policy,
					    integer& max_policy)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to "
         << "fs_thermonuclear_trange.\n";
    F77NAME(bad_exit)();
  }
  range r = fs[ihandle]->thermonuclear_TRange();
  Tmin = r.minimum;
  Tmax = r.maximum;
  min_policy = r.min_policy;
  max_policy = r.max_policy;
}
 
//-----------------------------------------------------------------------------
subroutine F77NAME(fs_thermonuclear_tpolicy)(integer& ihandle,
					  integer& min_policy,
					  integer& max_policy)
{
  fs[ihandle]->thermonuclear_TPolicy(min_policy,max_policy);
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_gyroavg_sigmatimesv)(integer& ihandle, real_8 *E,
					   real_8 *T, real_8 *f, integer& n)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to fs_gyroavg_sigmatimesv.\n";
    F77NAME(bad_exit)();
  }
  fs[ihandle]->gyroAvg_sigmaTimesV(E, T, f, n);
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_gyroavg_erange)(integer& ihandle, real_8& Emin,
				      real_8& Emax,
				      integer& min_policy,
				      integer& max_policy)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to fs_gyroavg_erange.\n";
    F77NAME(bad_exit)();
  }
  range r = fs[ihandle]->gyroAvg_ERange();
  Emin = r.minimum;
  Emax = r.maximum;
  min_policy = r.min_policy;
  max_policy = r.max_policy;
}
 
//-----------------------------------------------------------------------------
 
subroutine F77NAME(fs_gyroavg_varrange)(integer& ihandle, real_8& Varmin,
					real_8& Varmax,
					integer& min_policy,
					integer& max_policy)
{
  if (ihandle < 0 || ihandle >= pr_next) {
    cerr << "Error: Invalid ihandle value passed to fs_gyroavg_varrange.\n";
    F77NAME(bad_exit)();
  }
  range r = fs[ihandle]->gyroAvg_VarRange();
  Varmin = r.minimum;
  Varmax = r.maximum;
  min_policy = r.min_policy;
  max_policy = r.max_policy;
}
 
//-----------------------------------------------------------------------------
subroutine F77NAME(fs_gyroavg_epolicy)(integer& ihandle,
					  integer& min_policy,
					  integer& max_policy)
{
  fs[ihandle]->gyroAvg_EPolicy(min_policy,max_policy);
}
 
//-----------------------------------------------------------------------------
subroutine F77NAME(fs_gyroavg_varpolicy)(integer& ihandle,
					  integer& min_policy,
					  integer& max_policy)
{
  fs[ihandle]->gyroAvg_VPolicy(min_policy,max_policy);
}
 
//-----------------------------------------------------------------------------
