double MatCoatingCat( char *name, double wl )
{
double value ;
if( wl <= 0.0 )
{
IOerror( MatBomb, "MatOpacityCat", "invalid wavelength %g", wl ) ;
return nan("") ;
}
EXPR* array = DbaseGetExpr( name, "transmission" ) ;
if( array )
{
value = ExprInterp( array, wl ) ;
if( isnan(value) )
{
IOerror( MatBomb, "MatCoatingCat", "bad transmission data array for %s", name ) ;
return nan("") ;
}
}
else
{
IOerror( MatBomb, "MatCoatingCat", "transmission data not found for %s", name ) ;
return nan("") ;
}
// old range-check stuff...
// if( (ret == 1) && DbaseCheck( name, "OPACITY_RANGE" ) )
// IOerror( MatBomb, "MatOpacityCat", "wavelength %g out of range for %s -- extrapolating", wl, name ) ;
return value ;
}
DBDAT* DbaseSet( TAG* list, DBDAT* dbdat )
{
FOLDER* folder ;
if( !dbdat )
{
IOerror( IO_WARN, "DbaseFind", "setting null value" ) ;
return (DBDAT*) 0 ;
}
if( !*list )
{
IOerror( IO_WARN, "DbaseFind", "null taglist" ) ;
return (DBDAT*) 0 ;
}
for( folder = &DbaseRoot ; *(list + 1) ; list++ )
{
FOLDER* son = (FOLDER*) TreeFind( folder->kids, kid_cmp, *list ) ;
if( !son )
{
DbaseAddFolder( folder, *list ) ;
son = (FOLDER*) TreeFind( folder->kids, kid_cmp, *list ) ;
}
folder = son ;
}
return folder->EntryOverwrite( *list, dbdat ) ;
}
void GlobalSet(void)
{
TraceCoating = (int) ExprGetTaggedNumber( NULL, "Trace", "Coating", 0.0 ) ;
GlobalOptInt( "OpticNoStops", &OpticNoStops ) ; /* optic */
GlobalOptInt( "OpticViewAll", &OpticViewAll ) ;
SpotCount = (int) ExprGetTaggedNumber( NULL, NULL, "SpotCount", 0.0 ) ;
if( SpotCount )
IOerror( IO_WARN, "GlobalSet", "Old-Style SpotCount" ) ;
SpotCount = (int) ExprGetTaggedNumber( NULL, "Spot", "Count", 1000.0 ) ;
SPOT_PRINT_ANGLE = (int) ExprGetTaggedNumber( NULL, "Spot", "PrintAngle", 0.0 ) ;
SPOT_PIXEL_SIZE = ExprGetTaggedNumber( NULL, "Spot", "PixelSize", 0.0 ) ;
SPOT_DISK_SIZE = ExprGetTaggedNumber( NULL, "Spot", "DiskSize", 0.0 ) ;
WAVE_LOGSPACE =
(int) ExprGetTaggedNumber( NULL, "Wavelength", "LogSpace", 0.0 ) ;
FieldRadius = ExprGetTaggedNumber( NULL, "Field", "Radius", 0.0 ) ;
FieldHole = ExprGetTaggedNumber( NULL, "Field", "Hole", 0.0 ) ;
FWX = ExprGetTaggedNumber( NULL, "Field", "HalfWidthX", 0.0 ) ;
FWY = ExprGetTaggedNumber( NULL, "Field", "HalfWidthY", 0.0 ) ;
FOX = ExprGetTaggedNumber( NULL, "Field", "OffsetX", 0.0 ) ;
FOY = ExprGetTaggedNumber( NULL, "Field", "OffsetY", 0.0 ) ;
if( FieldRadius == 0.0 )
{
FieldRadius = ExprGetTaggedNumber( NULL, NULL, "FieldRadius", 0.0 ) ;
if( FieldRadius )
IOerror( IO_WARN, "GlobalSet", "Old-Style FieldRadius" ) ;
}
if( FWX == 0.0 )
{
FWX = ExprGetTaggedNumber( NULL, NULL, "FieldHalfWidthX", 0.0 ) ;
if( FWX )
IOerror( IO_WARN, "GlobalSet", "Old-Style FieldHalfWidthX" ) ;
}
if( (FWX == 0.0) && (FWY == 0.0) && (FieldRadius != 0.0) )
FWX = FWY = FieldRadius ;
GlobalOptReal( "Wavelength", &Wavelength ) ;
wlmin = ExprGetTaggedNumber( NULL, "Wavelength", "Minimum", Wavelength ) ;
wlmax = ExprGetTaggedNumber( NULL, "Wavelength", "Maximum", Wavelength ) ;
wlcen = sqrt( wlmin * wlmax ) ;
wlcount = (int) ExprGetTaggedNumber( NULL, "Wavelength", "Count", 1.0 ) ;
if( Wavelength == 0.0 )
Wavelength = wlcen ;
OpticDrawStart = (int) SystemGetNumber( "OpticDrawStart" ) ;
OpticDrawEnd = (int) SystemGetNumber( "OpticDrawEnd" ) ;
}
DBDAT* DbaseLookup( char* opath, TAG keytag )
{
static char path[1000] ;
DBDAT* dbdat = (DBDAT*) 0 ;
FOLDER* folder = &DbaseRoot ;
(void) strcpy( path, DataBasePath ) ;
dbdat = folder->EntryFind( keytag ) ;
for( TAG* list = DbasePathtoList( opath ) ; *list ; list++ )
{
(void) strcat( path, "/" ) ;
(void) strcat( path, TagString( *list ) ) ;
FOLDER* son = (FOLDER*) TreeFind( folder->kids, kid_cmp, *list ) ;
if( !son )
{
IOerror( IO_WARN, "DbaseLookup", "no such directory %s\n", path ) ;
return dbdat ;
}
if( !son->loaded )
DbaseLoadDir( path, son ) ;
folder = son ;
if( DBDAT* new_dbdat = folder->EntryFind( keytag ) )
dbdat = new_dbdat ;
}
return dbdat ;
}
DBDAT* DbaseGetData( char* path, char* keyword )
{
DBDAT* dbdat = DbaseLookup( path, Tag( keyword ) ) ;
if( !dbdat )
IOerror( IO_WARN, "DbaseGetData", "no value found for %s in %s", keyword, path ) ;
return dbdat ;
}
int UnitAdd( EXPR *name, EXPR *def )
{
unsigned int i ;
EXPR *expr ;
for( i = 0 ; i < U(UnitList)->used ; i++ )
{
if( UN(i) == name )
{
if( Compare( def, U(UN(i))->Eeval ) )
return 0 ;
else
{
IOerror( IO_WARN, "UnitAdd", "unit %s already refined", LabelValue(name) ) ;
return 1 ;
}
}
}
expr = FindBasic( def ) ;
delete U(expr)->Ehead ;
U(expr)->Ehead = name ;
U(expr)->Eeval = def->Copy() ;
ListAppend( UnitList, expr ) ;
return 0 ;
}
static void PathStart( PLOT *plot, int style, int axis, double unit )
{
double res ;
if( PathState != 0 )
IOerror( OpticBomb, "PathStart", "state mismatch" ) ;
PathFile = PlotKludge( plot ) ;
PathStyle = PlotKludge2( plot ) ;
PathAxis = axis ;
PathUnit = unit ;
switch( PathStyle )
{
case PLOT_PS:
PT( "newpath\n" ) ;
res = 1.0 / 25400.0 ; /* 1.0 microns */
break ;
case PLOT_MG:
res = 1.0 / 25400.0 ; /* 1.0 microns */
break ;
case PLOT_AC:
PathAxis = 0 ;
res = 0.1 / 25.4 ; /* 0.1 mm */
break ;
default:
res = 0.0 ;
}
PathRes = (int) ( 0.99 - log10( PathUnit * res ) ) ;
if( PathRes < 0 )
PathRes = 0 ;
PathState = 1 ;
}
EXPR *StringEvaluate( expr_oper op, STRING *left, STRING *right )
{
if( right )
{
switch(op)
{
case OPER_CATENATE:
unsigned int count ;
char *string ;
EXPR *result ;
count = 1 + strlen( StringValue(left) ) + strlen( StringValue(right) ) ;
string = new char[count] ;
(void) strcpy( string, StringValue(left) ) ;
(void) strcat( string, StringValue(right) ) ;
result = String( string ) ;
delete[] string ;
return result ;
case OPER_EQ:
return Boolean( !strcmp( StringValue(left), StringValue(right) ) ) ;
case OPER_NEQ:
return Boolean( strcmp( StringValue(left), StringValue(right) ) ) ;
default:
IOerror( IO_WARN, "StringEvaluate",
"passing string values to non-string operator" ) ;
return NULL_EXPR ;
}
}
else
{
switch(op)
{
case OPER_SYMBOLIC:
return ExprParseString( StringValue(left) ) ;
default:
IOerror( IO_WARN, "StringEvaluate",
"passing string value to non-string operator" ) ;
return NULL_EXPR ;
}
}
return NULL_EXPR ; // never get here
}
static FUNC *SetSkip( FUNC *func )
{
int match ;
unsigned int reverse ;
match = func->match ;
reverse = func->reverse ;
for( func = func->next ; func && (func->match != match) ; func = func->next ) ;
if( func )
{
if( func->reverse == reverse )
IOerror( FuncBomb, "SetSkip", "syntax error in if/else" ) ;
}
else
IOerror( FuncBomb, "SetSkip", "match not found" ) ;
return func ;
}
void OpticDrawEnvelopes( PLOT *plot, SYSTEM *system, int style, int axis, double unit )
{
int n, state, do_surface, complete ;
OPTIC *optic ;
ENSEMBLE *view ;
if( OpticUpdate( system ) )
IOerror( IO_ERR, "OpticDrawEnvelopes", "system is not ready to trace" ) ;
OpticPositions( system ) ; /* set coordinates */
do_surface = 1 ;
for( view = system->view ; view ; view = view->next )
{
optic = &( system->optic[ view->surface ] ) ;
/*
* Determine if this surface is shown at all
*
*/
if( optic->terms[TERM_MARK].v == OpticDrawStart )
do_surface = 1 ;
if( optic->terms[TERM_MARK].v == OpticDrawEnd )
do_surface = 0 ;
if( !do_surface )
continue ;
state = complete = 0 ;
for( n = 0 ; n < view->N ; n++ )
{
if( view->ray[n].state )
{
if( state )
PathEnd(0) ;
state = 0 ;
}
else
{
if( !state )
{
state = 1 ;
PathStart( plot, style, axis, unit ) ;
if( n == 0 )
complete = 1 ;
}
PathDraw3( optic, Q(view->ray+n) ) ;
}
}
if( state )
{
if( complete )
PathDraw3( optic, Q(view->ray) ) ;
PathEnd(0) ;
}
}
}
static FUNC *SetTrue( FUNC *func )
{
int match ;
unsigned int reverse ;
func->ignore = 1 ; /* $if() */
match = func->match ;
reverse = func->reverse ;
for( func = func->next ; func && (func->match != match) ; func = func->next ) ;
if( func )
{
func->ignore = 1 ; /* ~$if() */
if( func->reverse == reverse )
IOerror( FuncBomb, "SetTrue", "syntax error in if/else" ) ;
}
else
IOerror( FuncBomb, "SetTrue", "match not found" ) ;
return func ;
}
TpFanDriver::~TpFanDriver()
{
std::ofstream f(path_);
try {
f.exceptions(f.failbit | f.badbit);
f << "level " << initial_state_ << std::flush;
} catch (std::ios_base::failure &e) {
throw IOerror(MSG_FAN_RESET(path_), errno);
}
}
double MatCTECat( EXPR *name, EXPR *nothing )
{
char *string ;
string = ExprValueString( name ) ;
if( !string )
{
IOerror( MatBomb, "MatCTECat", "cannot evaluate name" ) ;
return nan("") ;
}
return ExprValue( DbaseGetExpr( string, "CTE" ) ) ;
}
static int FuncCompileSet2( FUNC *func )
{
FUNC *loop ;
EXPR *var ;
int work ;
double SystemGetNumber( char * ) ;
work = 0 ;
for( loop = func ; loop ; loop = loop->next )
{
if( loop->ignore || loop->unknown )
continue ;
if( !ExprLabelEqual(loop->label, iset) && !ExprLabelEqual(loop->label, iinit) )
continue ;
var = FuncArg( loop, 0 ) ;
if( !ExprIsVariable( var ) )
{
IOerror( FuncBomb, "FuncCompileSet2", "argument not a variable" ) ;
continue ;
}
/* I don't check here for VAR_TYPE conflicts */
if( ExprGetFlags( var, VAR_SET ) )
{
IOerror( FuncBomb, "FuncCompileSet2",
"`%s' is multiply defined or initialized", ExprName( var ) ) ;
loop->ignore = 1 ;
continue ;
}
ExprSetDefinition( var, FuncArg( loop, 1 ) ) ;
ExprSetFlags( var, VAR_SET ) ;
loop->ignore = 1 ;
work++ ;
}
return work ;
}
FOLDER* DbaseAddFolder( FOLDER* folder, TAG tag )
{
FOLDER** gnew ;
gnew = (FOLDER**) TreeInsert( folder->kids, kid_cmp, tag ) ;
if( *gnew )
{
IOerror( IO_WARN, "DbaseAddFolder", "%s/%s already exists\n", TagString( folder->tag ), TagString( tag ) ) ;
return *gnew ; // already exists!
}
*gnew = new FOLDER ;
(*gnew)->tag = tag ;
return *gnew ;
}
double SystemGetNumber( char *string )
{
EXPR *expr ;
expr = Label( string ) ;
expr = ExprGetDefinition( expr ) ;
if( !expr )
{
IOerror( IO_WARN, "SystemGetNumber",
"no value set for `%s'", string ) ;
return 0.0 ;
}
return ExprValue( expr ) ;
}
char *SystemGetString( char *string )
{
EXPR *expr ;
expr = Label( string ) ;
expr = ExprGetDefinition( expr ) ;
if( !expr )
{
IOerror( IO_WARN, "SystemGetString",
"no value set for `%s'", string ) ;
return (char *) 0 ;
}
return ExprValueString( expr ) ;
}
void OpticDrawRays( PLOT *plot, SYSTEM *system, int style, int axis, double unit )
{
ENSEMBLE *view ;
if( OpticUpdate( system ) )
IOerror( IO_ERR, "OpticDrawRays", "system is not ready to trace" ) ;
OpticPositions( system ) ; /* set coordinates */
if( SystemGetNumber( "OpticDrawAlt" ) )
{
for( view = system->view ; view ; view = view->next )
{
if( view->alt )
OpticDrawRays0( plot, system, style, axis, unit, view->alt ) ;
}
}
else
OpticDrawRays0( plot, system, style, axis, unit, system->view ) ;
}
static void PathEnd( int close )
{
if( !PathState )
IOerror( OpticBomb, "PathEnd", "state mismatch" ) ;
switch( PathStyle )
{
case PLOT_PS:
if( PathState == 1 ) /* don't bother... */
break ;
if( close )
PT( "closepath " ) ;
PT( "stroke\n" ) ;
break ;
case PLOT_AC:
if( close )
PT( "close\n" ) ;
else
PT( "\n\n" ) ;
break ;
}
PathState = 0 ;
}
DBDAT* DbaseFind( TAG* list )
{
FOLDER* folder ;
if( !*list )
{
IOerror( IO_WARN, "DbaseFind", "null taglist" ) ;
return (DBDAT*) 0 ;
}
for( folder = &DbaseRoot ; *(list + 1) ; list++ )
{
FOLDER* son = (FOLDER*) TreeFind( folder->kids, kid_cmp, *list ) ;
if( !son )
{
DbaseAddFolder( folder, *list ) ;
son = (FOLDER*) TreeFind( folder->kids, kid_cmp, *list ) ;
}
folder = son ;
}
return folder->EntryFind( *list ) ;
}
void TraceZemax( SYSTEM *system )
{
int surface ;
OPTIC *optic ;
PLOT *plot = PlotStuff( 1.0, 1e-5/25.4 ) ; // units are inches; resolution is 0.01 micron
if( OpticUpdate( system ) )
IOerror( IO_ERR, "TraceZemax", "system not ready to trace" ) ;
OpticPositions( system ) ; /* set coordinates */
int NSURF = 0 ;
FP( PlotKludge( plot ), "SURF %d\n", NSURF++ ) ;
FP( PlotKludge( plot ), " TYPE STANDARD\n" ) ;
FP( PlotKludge( plot ), " DISZ INFINITY\n" ) ;
FP( PlotKludge( plot ), " COMM Object\n" ) ;
/*
* loop through each surface
*
*/
for( surface = 0 ; surface < system->nsurf ; surface++ )
{
optic = &( system->optic[ surface ] ) ;
// XFORM START
#ifndef BROKEN
static EDAT inv[16] ;
//---inverse--------------------------------------------------------------//
const int d_ = 4 ;
double W[2*d_*d_] ;
for( int c = 0 ; c < d_ ; ++c )
for( int r = 0 ; r < d_ ; ++r )
{
W[c*d_+r] = optic->terms[ TERM_XFORM + RC(c,r) ].v ;
W[c*d_+r+d_*d_] = (c == r) ;
}
for( int col = 0 ; col < d_ ; ++col )
{
// find pivot row, given by largest absolute value
int row = col ;
long double big = W[col*d_+row] ;
for( int r = row+1 ; r < d_ ; ++r )
{
if( fabs( W[col*d_+r] ) > fabsl(big) )
{
row = r ;
big = W[col*d_+r] ;
}
}
for( int c = col + 1 ; c < 2*d_ ; ++c )
{
W[c*d_+row] /= big ;
for( int r = 0 ; r < d_ ; ++r )
{
if( r != row )
W[c*d_+r] -= W[col*d_+r] * W[c*d_+row] ;
}
// swap
if( row != col )
{
long double tmp = W[c*d_+row] ;
W[c*d_+row] = W[c*d_+col] ;
W[c*d_+col] = tmp ;
}
}
}
for( int c = 0 ; c < d_ ; ++c )
for( int r = 0 ; r < d_ ; ++r )
inv[ RC(c,r) ].v = W[c*d_+r+d_*d_] ;
//---inverse--------------------------------------------------------------//
#else
EDAT* inv = optic->terms + TERM_XFORM ;
#endif
double unit = PlotMultiplier( plot ) ;
double Tx = unit * inv[ RC(0,3) ].v ;
double Ty = unit * inv[ RC(1,3) ].v ;
double Tz = unit * inv[ RC(2,3) ].v ;
double Rx = (180/M_PI) * atan2( inv[ RC(1,2) ].v, inv[ RC(2,2) ].v ) ;
double Ry = (180/M_PI) * -asin( inv[ RC(0,2) ].v ) ;
double Rz = (180/M_PI) * atan2( inv[ RC(0,1) ].v, inv[ RC(0,0) ].v ) ;
bool brk = Tx || Ty || Rx || Ry || Rz ;
brk = true ; // hack because distances are before the surface in this code, but after in Zemax
// so just make every motion a coordinate break
if( (surface != 0) && brk ) // no coord break on first surface
{
FP( PlotKludge( plot ), "SURF %d\n", NSURF++ ) ;
FP( PlotKludge( plot ), " TYPE COORDBRK\n" ) ;
FP( PlotKludge( plot ), " FIMP\n" ) ; // no clue what this is
FP( PlotKludge( plot ), " CURV 0.0 0 0.0 0.0 0\n" ) ; // no clue what this is
FP( PlotKludge( plot ), " HIDE 0 0 0 0 0 0 0 0 0 0\n" ) ; // no clue what this is
FP( PlotKludge( plot ), " MIRR 2 0\n" ) ; // no clue what this is
FP( PlotKludge( plot ), " PARM 1 %.10f\n", Tx ) ;
FP( PlotKludge( plot ), " PARM 2 %.10f\n", Ty ) ;
FP( PlotKludge( plot ), " PARM 3 %.10f\n", Rx ) ;
FP( PlotKludge( plot ), " PARM 4 %.10f\n", Ry ) ;
FP( PlotKludge( plot ), " PARM 5 %.10f\n", Rz ) ;
FP( PlotKludge( plot ), " PARM 6 0\n" ) ; // [0,1] for forward/reverse
FP( PlotKludge( plot ), " DISZ %.10f\n", Tz ) ;
FP( PlotKludge( plot ), " DIAM 0 0 0 0 1 ""\n" ) ;
FP( PlotKludge( plot ), " POPS 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0\n" ) ;
}
// XFORM END
// LABEL START
FP( PlotKludge( plot ), "SURF %d\n", NSURF++ ) ;
if( surface == 0 )
FP( PlotKludge( plot ), " STOP\n" ) ;
FP( PlotKludge( plot ), " TCED 0 0\n" ) ;
FP( PlotKludge( plot ), " CURV %.10f\n", optic->terms[TERM_CURV].v / unit ) ;
double conic = optic->terms[TERM_CONIC].v ;
if( conic )
FP( PlotKludge( plot ), " CONI %.10f\n", conic ) ;
if( !brk )
FP( PlotKludge( plot ), " DISZ %.10f\n", Tz ) ;
// FP( PlotKludge( plot ), " GLAS CAF2 0 0 0 0 1 1 1\n" ) ;
if( optic->function & FUNCTION_GRATING )
{
FP( PlotKludge( plot ), " TYPE DGRATING\n" ) ;
double lines = optic->terms[TERM_LINES].v ;
double order = optic->terms[TERM_ORDER].v ;
FP( PlotKludge( plot ), " PARM 1 %.10f\n", lines/1000 ) ; // line/micron
FP( PlotKludge( plot ), " PARM 2 %.10f\n", order ) ; // order
}
else
FP( PlotKludge( plot ), " TYPE STANDARD\n" ) ;
if( optic->function & FUNCTION_MIRROR )
FP( PlotKludge( plot ), " GLAS MIRROR\n" ) ;
if( optic->terms[ TERM_LABEL ].E )
{ FP( PlotKludge( plot ), " COMM %s\n",
ExprValueString( optic->terms[ TERM_LABEL ].E ) ) ;
}
// LABEL END
// STOP START
if( (optic->StopCount == 1) && (OpticStopType( optic, 0 ) == STOP_CIRCLE) )
FP( PlotKludge( plot ), " DIAM %.10f\n", OpticStopScale( optic, 0 ) ) ; // already returns radius
if( optic->StopCount == 2 )
{
int type0 = OpticStopType( optic, 0 ) ;
int type1 = OpticStopType( optic, 1 ) ;
double X, Y ;
if( (type0 == STOP_X) && (type1 == STOP_Y) )
{
X = OpticStopScale( optic, 0 ) ;
Y = OpticStopScale( optic, 1 ) ;
}
else
if( (type0 == STOP_Y) && (type1 == STOP_X) )
{
X = OpticStopScale( optic, 1 ) ;
Y = OpticStopScale( optic, 0 ) ;
}
else
continue ;
FP( PlotKludge( plot ), " SQAP %.10f %.10f\n", X, Y ) ;
}
// STOP END
}
PlotClose( plot ) ;
}
EXPR* OPER::Text( bool protect ) const
{
int i ;
EXPR* result ;
for( i = 0 ; OperTab[i].op ; i++ )
{
if( OperTab[i].op == oper )
break ;
}
if( OperTab[i].op == OPER_ERROR )
{
IOerror( IO_WARN, "PrintExpr",
"unknown OPERATOR type 0x%02x", oper ) ;
return String( "<unknown operator>" ) ;
}
if( OperTab[i].style == SF )
{
result = String( OperTab[i].name ) ;
result->Append( "(" ) ;
if( Eleft )
{
result->Append(" " ) ;
result->Append( PrintExpr( Eleft, 1 ) ) ;
}
if( Eright )
{
result->Append( ", " ) ;
result->Append( PrintExpr( Eright, 1 ) ) ;
}
result->Append( " )" ) ;
return result ;
}
if( OperTab[i].style == SU )
{
result = String( "" ) ;
if( !protect )
result->Append( "( " ) ;
result->Append( OperTab[i].name ) ;
result->Append( PrintExpr( Eleft, 0 ) ) ;
if( !protect )
result->Append( " )" ) ;
return result ;
}
if( OperTab[i].style == SB )
{
result = String( "" ) ;
if( !protect )
result->Append( "( " ) ;
result->Append( PrintExpr( Eleft, 0 ) ) ;
result->Append( " " ) ;
result->Append( OperTab[i].name ) ;
result->Append( " " ) ;
result->Append( PrintExpr( Eright, 0 ) ) ;
if( !protect )
result->Append( " )" ) ;
return result ;
}
if( OperTab[i].style == SE ) /* unprotected op */
{
result = PrintExpr( Eleft, 0 ) ;
result->Append( " " ) ;
result->Append( OperTab[i].name ) ;
result->Append( " " ) ;
result->Append( PrintExpr( Eright, 0 ) ) ;
return result ;
}
if( OperTab[i].style == SD ) /* units */
{
result = PrintExpr( Eleft, 0 ) ;
result->Append( " «" ) ;
result->Append( PrintExpr( Eright, 1 ) ) ;
result->Append( "»" ) ;
return result ;
}
if( OperTab[i].style == SS ) /* unit set */
{
result = PrintExpr( Eleft, 0 ) ;
result->Append( " = «" ) ;
result->Append( PrintExpr( Eright, 1 ) ) ;
result->Append( "»" ) ;
return result ;
}
if( OperTab[i].style == SA ) /* array set */
{
result = PrintExpr( Eleft, 0 ) ;
result->Append( "[" ) ;
result->Append( PrintExpr( Eright, 1 ) ) ;
result->Append( "]" ) ;
return result ;
}
IOerror( IO_WARN, "PrintExpr", "unknown OPERATOR style" ) ;
return String( "$error" ) ;
}
int SystemUpdate( SYSTEM *system, int verbose )
{
int nsurf ;
switch( system->hardstate )
{
default: /* never happens */
case SYSTEM_BIZARRE: /* never happens */
IOerror( OpticBomb, "SystemUpdate", "unknown hard-state" ) ;
/*FALLTHRU*/
case SYSTEM_NULLNAME:
/*FALLTHRU*/
case SYSTEM_SYNTAX:
return ( system->softstate = system->hardstate ) ;
case SYSTEM_UNDECIDED:
/*
* Do the compile which takes into account the `:=' statements.
*
* What about external variable sets?
*
*/
FuncCompile1( &system->input ) ;
if( verbose )
{
IOreportHeader( "Reversible Compile" ) ;
FuncPrint( system->input, 0 ) ;
}
if( FuncCheckUnknown( system->input ) )
return ( system->softstate = SYSTEM_UNDECIDED ) ;
/*FALLTHRU*/
case SYSTEM_INVALID:
/*
* Count the number of surfaces and check for invalid functions.
* If the system is valid, then make the actual OPTIC.
*
*/
nsurf = OpticCount( system->input ) ;
if( nsurf < 0 )
return ( system->softstate = SYSTEM_INVALID ) ;
if( OpticMake( system, nsurf ) )
return ( system->softstate = SYSTEM_INVALID ) ;
/*FALLTHRU*/
case SYSTEM_UNFIXED:
/*
* Update the variable-dependent complex expressions
*
*/
system->nvars = FuncPrintUnset( system->input, verbose ) ;
/* I don't think this belongs here...perhaps below? */
if( !OpticIsSet( system, verbose ) )
return ( system->softstate = SYSTEM_UNSET ) ;
/*FALLTHRU*/
case SYSTEM_UNSET: /* never happens */
/*FALLTHRU*/
case SYSTEM_BADARG:
/*
* Evaluate the arguments
*
*/
if( OpticEvaluate( system ) )
return ( system->softstate = SYSTEM_BADARG ) ;
/*FALLTHRU*/
case SYSTEM_READY:
return ( system->softstate = SYSTEM_READY ) ;
}
}
EXPR *FindBasic( EXPR *def )
{
unsigned int i ;
EXPR *expr, *E1, *E2 ;
if( IsReal(def) )
{
expr = new UNIT ;
U(expr)->Ehead = String( "Ordinate" ) ;
ListAppend( expr, def->Copy() ) ;
return expr ;
}
if( IsLabel( def ) )
{
for( i = 0 ; i < U(UnitList)->used ; i++ )
{
if( U(UN(i))->Ehead == def )
{
expr = UN(i)->Copy() ;
delete U(expr)->Eeval ;
U(expr)->Eeval = NULL_EXPR ;
return expr ;
}
}
IOerror( IO_ERR, "FindBasic", "%s is an undefined unit", LabelValue(def) ) ;
return garbageunit() ;
}
if( !IsOper(def) )
{
IOerror( IO_FATAL, "FindBasic", "unexpected in units definition" ) ;
return garbageunit() ;
}
if( D(def)->oper == OPER_MINUS )
{
expr = FindBasic( D(def)->Eleft ) ;
if( U(expr)->used > 1 )
{
IOerror( IO_ERR, "FindBasic", "illegal negation of unit" ) ;
return garbageunit() ;
}
E1 = OP3( "u-", U(expr)->list[0], NULL_EXPR ) ;
delete U(expr)->list[0] ;
U(expr)->list[0] = E1 ;
return expr ;
}
E1 = FindBasic( D(def)->Eleft ) ;
E2 = FindBasic( D(def)->Eright ) ;
switch( D(def)->oper )
{
case OPER_MULTIPLY:
expr = UnitOP3( "*", "+", E1, E2 ) ;
break ;
case OPER_DIVIDE:
expr = UnitOP3( "/", "-", E1, E2 ) ;
break ;
case OPER_POW:
expr = UnitOP3( "^", "*", E1, E2 ) ;
break ;
default:
IOerror( IO_ERR, "FindBasic", "unexpected operator in unit" ) ;
expr = garbageunit() ;
break ;
}
delete E1 ;
delete E2 ;
return expr ;
}
static void PathDraw3( OPTIC *optic, double *V )
{
static double save[3] ;
double X, Y, Z ;
if( PathState == 0 )
IOerror( OpticBomb, "PathDraw3", "state mismatch" ) ;
if( (PathState == 2) && (V[0] == save[0]) && (V[1] == save[1]) && (V[2] == save[2]) )
return ;
save[0] = V[0] ;
save[1] = V[1] ;
save[2] = V[2] ;
if( PathStyle == PLOT_AC )
{
X = PathUnit * RayPos3( optic, 0, V ) ;
Y = PathUnit * RayPos3( optic, 1, V ) ;
Z = PathUnit * RayPos3( optic, 2, V ) ;
}
else
{
X = PathUnit * RayPos3( optic, (PathAxis + 2) % 3, V ) ;
Y = PathUnit * RayPos3( optic, (PathAxis + 1) % 3, V ) ;
Z = 0.0 ; /* unused */
}
if( PathState == 1 )
{
switch( PathStyle )
{
case PLOT_PS:
PN( X ) ;
PT( " " ) ;
PN( Y ) ;
PT( " moveto\n" ) ;
break ;
case PLOT_MG:
PT( "relo " ) ;
PN( X ) ;
PT( " " ) ;
PN( Y ) ;
PT( "\n" ) ;
break ;
case PLOT_AC:
PT( "line " ) ;
PN( X ) ;
PT( "," ) ;
PN( Y ) ;
PT( "," ) ;
PN( Z ) ;
}
PathState = 2 ;
}
else
{
switch( PathStyle )
{
case PLOT_PS:
PN( X ) ;
PT( " " ) ;
PN( Y ) ;
PT( " lineto\n" ) ;
break ;
case PLOT_MG:
PT( "draw " ) ;
PN( X ) ;
PT( " " ) ;
PN( Y ) ;
PT( "\n" ) ;
break ;
case PLOT_AC:
PT( " " ) ;
PN( X ) ;
PT( "," ) ;
PN( Y ) ;
PT( "," ) ;
PN( Z ) ;
}
}
}
int OpticMake( SYSTEM *system, int nsurf )
{
int s, n ;
OPTIC *optic ;
FUNC *func ;
aperture_set = 0 ;
origin_set = 0 ;
failed = 0 ;
if( system->optic )
OpticFree( system->optic, system->nsurf ) ;
system->optic = OpticAllocate( nsurf ) ;
system->nsurf = nsurf ;
SystemSetNumber( "MatTemperature", MatTemperature ) ; // kludge warning
MatPush( String( "Gas/AIR" ), Label( "MatTemperature" ), 0 ) ;
/* just in case */
func = OpticForward( system->input ) ;
for( Surface = 0 ; func ; Surface++ )
{
optic = &( system->optic[Surface] ) ;
if( Surface >= nsurf )
{
IOerror( OpticBomb, "OpticMake",
"surface count exceeded, Surface = %d nsurf = %d",
Surface, nsurf ) ;
failed = 1 ;
}
func = ConvertTransform( func, optic->terms + TERM_XFORM ) ;
func = ConvertSurface( func, optic ) ;
}
if( Surface != nsurf )
{
IOerror( OpticBomb, "OpticMake",
"surface count not met, Surface = %d nsurf = %d",
Surface, nsurf ) ;
failed = 1 ;
}
MatClear() ;
/* OpticPositions( system ) ; # now done when needed */
for( s = 0 ; s < nsurf ; s++ )
{
optic = &( system->optic[s] ) ;
optic->fixed = 1 ;
for( n = 0 ; n < NTERMS ; n++ )
{
ExprSimplify( &optic->terms[n].E, 1 ) ;
if( (n < TERM_COORD) && optic->terms[n].E
&& !ExprIsNumber( optic->terms[n].E )
&& !ExprIsString( optic->terms[n].E ) )
optic->fixed = 0 ;
}
optic->axial_xform = XformIsAxial( optic->terms + TERM_XFORM ) ;
if( optic->surface & SURFACE_TRIAXIAL )
optic->axial_surface = 0 ;
else
optic->axial_surface = 1 ;
if( !optic->reverse )
{
int t ;
IOerror( IO_ERR, "OpticMake", "surface has no shape given" ) ;
failed = 1 ;
IOerrorPrint( " label: " ) ;
ExprIOerror( optic->terms[ TERM_LABEL ].E ) ;
IOerrorPrint( "\nSurface #%d\n", Surface ) ;
for( t = s - 1 ; t >= 0 ; t-- )
{
if( system->optic[t].terms[ TERM_LABEL ].E )
break ;
}
IOerrorPrint( "Previous surface with label is: " ) ;
if( t >= 0 )
ExprIOerror( system->optic[t].terms[ TERM_LABEL ].E ) ;
else
IOerrorPrint( "(none)" ) ;
IOerrorPrint( "\n" ) ;
for( t = s + 1 ; t < nsurf ; t++ )
{
if( system->optic[t].terms[ TERM_LABEL ].E )
break ;
}
IOerrorPrint( "Following surface with label is: " ) ;
if( t < nsurf )
ExprIOerror( system->optic[t].terms[ TERM_LABEL ].E ) ;
else
IOerrorPrint( "(none)" ) ;
IOerrorPrint( "\n" ) ;
}
/* KLUDGE for mirrors, since they don't reverse! */
if( (optic->reverse == -1) && (optic->function & FUNCTION_MIRROR) )
optic->reverse = 1 ;
}
return failed ;
}
static FUNC *ConvertSurface( FUNC *func, OPTIC *optic )
{
FUNC *loop ;
EXPR *EA0, *separate ;
int ea0used, which, rev ;
optic->terms[ TERM_MAT ].E = Copy( MatGet() ) ;
optic->terms[ TERM_TEMP ].E = Copy( MatGetTemp() ) ;
for( loop = func ; loop ; loop = OpticForward( FuncNext(loop) ) )
{
which = (int) ( ExprValue( FuncArg( loop, 0 ) ) + 0.49 ) ;
if( which < 6 )
break ;
EA0 = Copy( FuncArg( loop, 1 ) ) ;
ea0used = 0 ;
switch( which )
{
case 6: /* INDX */
if( FuncArgCount( loop ) == 4 )
{
MatPush( EA0, FuncArg( loop, 2 ),
FuncIsReversed( loop ) ) ;
optic->mutant = 1 ;
(optic - 1)->mutant = -1 ; /* kludge-o-rama */
optic->terms[TERM_MUTANT].E = Copy( FuncArg( loop, 3 ) ) ;
}
else
if( FuncArgCount( loop ) == 3 )
{
MatPush( EA0, FuncArg( loop, 2 ),
FuncIsReversed( loop ) ) ;
}
else
if( FuncArgCount( loop ) == 2 )
{
MatPush( EA0, Label( "MatTemperature" ),
FuncIsReversed( loop ) ) ;
}
break ;
case 7: /* PARAX */
optic->terms[TERM_FOCLEN].E = EA0 ;
optic->function |= FUNCTION_PARAX ;
ea0used = 1 ;
break ;
case 8: /* MIRROR */
optic->function |= FUNCTION_MIRROR ;
break ;
case 9: /* GRATING */
optic->function |= FUNCTION_GRATING ;
optic->terms[TERM_LINES].E = EA0 ;
optic->terms[TERM_ORDER].E = Copy( FuncArg( loop, 2 ) ) ;
ea0used = 1 ;
break ;
case 10: /* VIEW */
optic->function |= FUNCTION_VIEW ;
break ;
case 11: /* STOP */
if( FuncArgCount( loop ) == 1 ) /* EXIT */
optic->function |= FUNCTION_EXIT ;
else
if( FuncArgCount( loop ) == 7 ) /* STOP */
{
int i ;
EDAT *S ;
if( optic->StopCount == NSTOPS )
{
IOerror( IO_ERR, "ConvertSurface", "too many stops" ) ;
failed = 1 ;
break ;
}
S = &optic->terms[ TERM_STOPS + 6 * optic->StopCount ] ;
for( i = 0 ; i < 6 ; i++ )
S[i].E = Copy( FuncArg( loop, i + 1 ) ) ;
optic->StopCount++ ;
}
break ;
case 12: /* PDIST */
if( FuncIsReversed( loop ) )
optic->terms[TERM_PDIST].E = Ecc( EA0, "u-", Garbage() ) ;
else
optic->terms[TERM_PDIST].E = EA0 ;
optic->function |= FUNCTION_PDIST ;
ea0used = 1 ;
break ;
case 13: /* PRINT */
break ;
case 14: /* LABEL */
separate = String( " & " ) ;
if( optic->terms[ TERM_LABEL ].E )
{
optic->terms[ TERM_LABEL ].E = Ecc(
optic->terms[ TERM_LABEL ].E, "//", separate ) ;
optic->terms[ TERM_LABEL ].E = Ecc(
optic->terms[ TERM_LABEL ].E, "//", EA0 ) ;
}
else
optic->terms[ TERM_LABEL ].E = EA0 ;
ea0used = 1 ;
break ;
case 15: /* SURF */
rev = ( FuncIsReversed( loop ) ? -1 : 1 ) ;
if( optic->reverse != rev )
{
if( !optic->reverse )
optic->reverse = rev ;
else
{
IOerror( IO_ERR, "ConvertSurface",
"inconsistent surface reversal on surface #%d",
Surface ) ;
failed = 1 ;
}
}
if( FuncArgCount( loop ) == 4 )
{
optic->surface |= SURFACE_SYMBOLIC ;
optic->terms[TERM_Sx].E = Copy( FuncArg( loop, 1 ) ) ;
optic->terms[TERM_Sy].E = Copy( FuncArg( loop, 2 ) ) ;
optic->terms[TERM_Sf].E = Copy( FuncArg( loop, 3 ) ) ;
if( !ExprIsVariable( optic->terms[TERM_Sx].E ) )
IOerror( IO_ERR, "ConvertSurface", "X not a variable" ) ;
if( !ExprIsVariable( optic->terms[TERM_Sy].E ) )
IOerror( IO_ERR, "ConvertSurface", "Y not a variable" ) ;
break ;
}
optic->terms[TERM_CURV].E = EA0 ;
ea0used = 1 ;
if( FuncArgCount( loop ) == 1 )
optic->surface |= SURFACE_FLAT ;
else
if( FuncArgCount( loop ) == 2 )
optic->surface |= SURFACE_SPHERE ;
else
if( FuncArgCount( loop ) == 3 )
{
optic->surface |= SURFACE_CONIC ;
optic->terms[TERM_CONIC].E = Copy( FuncArg( loop, 2 ) ) ;
}
else /* count = 6 */
{
optic->surface |= SURFACE_ASPHERE ;
optic->terms[TERM_CONIC].E = Copy( FuncArg( loop, 2 ) ) ;
optic->terms[TERM_A4].E = Copy( FuncArg( loop, 3 ) ) ;
optic->terms[TERM_A6].E = Copy( FuncArg( loop, 4 ) ) ;
optic->terms[TERM_A8].E = Copy( FuncArg( loop, 5 ) ) ;
optic->terms[TERM_A10].E = Copy( FuncArg( loop, 6 ) ) ;
}
break ;
case 16: /* TRIX */
rev = ( FuncIsReversed( loop ) ? -1 : 1 ) ;
if( optic->reverse != rev )
{
if( !optic->reverse )
optic->reverse = rev ;
else
{
IOerror( IO_ERR, "ConvertSurface",
"inconsistent surface reversal on surface #%d",
Surface ) ;
failed = 1 ;
}
}
optic->terms[TERM_Ex].E = EA0 ;
optic->terms[TERM_Ey].E = Copy( FuncArg( loop, 2 ) ) ;
optic->terms[TERM_Ez].E = Copy( FuncArg( loop, 3 ) ) ;
optic->terms[TERM_Eo].E = Copy( FuncArg( loop, 4 ) ) ;
optic->surface |= SURFACE_TRIAXIAL ;
ea0used = 1 ;
break ;
case 17: /* MARK */
if( FuncArgCount( loop ) == 2 ) /* surface */
{
optic->terms[TERM_MARK].E = EA0 ;
ea0used = 1 ;
}
else
if( FuncArgCount( loop ) == 3 ) /* variable */
{
if( !ExprIsVariable( FuncArg( loop, 1 ) ) )
{
IOerror( OpticBomb, "ConvertSurface",
"EXPR not a VARIABLE" ) ;
}
ExprSetFlags( FuncArg( loop, 1 ),
(int) ExprValue( FuncArg( loop, 2 ) ) & VAR_OPTIC ) ;
}
break ;
case 18: /* COAT */
if( optic->terms[ TERM_COATING ].E )
{
IOerror( IO_ERR, "ConvertSurface",
"multiple coating declarations on surface %d",
Surface ) ;
failed = 1 ;
}
else
{
optic->terms[ TERM_COATING ].E = EA0 ;
ea0used = 1 ;
}
break ;
case 19: /* BOUND */
break ;
case 20: /* BAFFLE */
optic->function |= FUNCTION_BAFFLE ;
break ;
case 21: /* MERIT */
break ;
case 22: /* APERTURE */
optic->function |= FUNCTION_APERTURE ;
if( aperture_set )
{
IOerror( IO_ERR, "ConvertSurface", "multiple apertures" ) ;
failed = 1 ;
}
aperture_set = 1 ;
break ;
case 23: /* PINHOLE */
optic->function |= FUNCTION_PINHOLE ;
break ;
case 24: /* ORIGIN */
if( origin_set )
{
IOerror( IO_WARN, "ConvertSurface", "multiple origins" ) ;
/* EVIL HACK!!!! */
/* failed = 1 ; */
}
else
{
optic->function |= FUNCTION_ORIGIN ;
origin_set = 1 ;
}
break ;
case 25: /* FRESNEL */
rev = ( FuncIsReversed( loop ) ? -1 : 1 ) ;
if( optic->reverse != rev )
{
if( !optic->reverse )
optic->reverse = rev ;
else
{
IOerror( IO_ERR, "ConvertSurface",
"inconsistent surface reversal on surface #%d",
Surface ) ;
failed = 1 ;
}
}
optic->surface |= SURFACE_FRESNEL ;
optic->terms[TERM_FOCLEN].E = EA0 ;
ea0used = 1 ;
break ;
default:
IOerror( OpticBomb, "ConvertSurface",
"unexpected surface function on surface #%d", Surface ) ;
failed = 1 ;
}
if( !ea0used )
Free( EA0 ) ;
}
if( !Compare( optic->terms[ TERM_MAT ].E, MatGet() ) )
optic->function |= FUNCTION_SNELL ;
return loop ;
}
void Physical( PLOT *plot, SYSTEM *system, int axis )
{
OPTIC *optic ;
int n, s ;
if( OpticUpdate( system ) )
IOerror( IO_ERR, "Physical", "system is not ready to trace" ) ;
OpticPositions( system ) ; /* set coordinates */
PhysicalAxis = axis ;
for( n = 0 ; n < system->nsurf ; n++ )
{
optic = &( system->optic[n] ) ;
if( optic->terms[ TERM_LABEL ].E || optic->StopCount )
{
PlotComment( plot, "________________________________________" ) ;
PlotComment( plot, (char *) 0 ) ;
if( optic->terms[ TERM_LABEL ].E )
{
PlotComment( plot,
ExprValueString( optic->terms[ TERM_LABEL ].E ) ) ;
}
else
PlotComment( plot, "Mysterious Unlabeled Surface" ) ;
PlotComment( plot, (char *) 0 ) ;
}
for( s = 0 ; s < optic->StopCount ; s++ )
{
double T, R, X, Y ;
int type ;
type = OpticStopType( optic, s ) ;
if( abs(type) == STOP_CIRCLE )
{
R = OpticStopScale( optic, s ) ;
Plot2Start( plot ) ;
for( T = 0.0 ; T < RESH * 2.0 * M_PI ; T += M_PI / RES )
PhysicalDraw2( plot, optic, R * cos(T), R * sin(T) ) ;
Plot2End( plot, 1 ) ;
Plot2Start( plot ) ;
PhysicalLine( plot, optic, -R, 0.0, R, 0.0 ) ;
Plot2End( plot, 0 ) ;
Plot2Start( plot ) ;
PhysicalLine( plot, optic, 0.0, -R, 0.0, R ) ;
Plot2End( plot, 0 ) ;
continue ;
}
if( type == STOP_HALF_PLANE )
{
X = optic->terms[ TERM_STOPS + 6 * s + 3 ].v ;
Y = optic->terms[ TERM_STOPS + 6 * s + 4 ].v ;
R = optic->terms[ TERM_STOPS + 6 * s + 5 ].v ;
T = -R / ( X*X + Y*Y ) ;
Plot2Start( plot ) ;
PhysicalLine( plot, optic,
T*X - 10*Y, T*Y + 10*X, T*X + 10*Y, T*Y - 10*X ) ;
Plot2End( plot, 0 ) ;
continue ;
}
/* now we only accept pairs, (x,y) */
if( s == optic->StopCount - 1 )
continue ;
if( abs(type) == STOP_X )
{
if( abs( OpticStopType( optic, s+1 ) != STOP_Y ) )
continue ;
X = OpticStopScale( optic, s ) ;
s++ ;
Y = OpticStopScale( optic, s ) ;
}
else
if( abs(type) == STOP_Y )
{
if( abs( OpticStopType( optic, s+1 ) != STOP_X ) )
continue ;
Y = OpticStopScale( optic, s ) ;
s++ ;
X = OpticStopScale( optic, s ) ;
}
else
continue ;
Plot2Start( plot ) ;
PhysicalLine( plot, optic, -X, -Y, X, -Y ) ;
PhysicalLine( plot, optic, X, -Y, X, Y ) ;
PhysicalLine( plot, optic, X, Y, -X, Y ) ;
PhysicalLine( plot, optic, -X, Y, -X, -Y ) ;
Plot2End( plot, 1 ) ;
Plot2Start( plot ) ;
PhysicalLine( plot, optic, -X, 0.0, X, 0.0 ) ;
Plot2End( plot, 0 ) ;
Plot2Start( plot ) ;
PhysicalLine( plot, optic, 0.0, -Y, 0.0, Y ) ;
Plot2End( plot, 0 ) ;
}
}
}
double MatOpacityCat( char *name, double wl )
{
double low, high, depth, T ;
char *type ;
if( wl <= 0.0 )
{
IOerror( MatBomb, "MatOpacityCat", "invalid wavelength %g", wl ) ;
return nan("") ;
}
low = ExprValue( DbaseGetExpr( name, "TransmissionLow" ) ) ;
if( (wl < low) && DbaseCheck( name, "OPACITY_LOW" ) )
{
IOerror( MatBomb, "MatOpacityCat", "wavelength %g out of range for %s: lower bound is %g", wl, name, low ) ;
IOerror( MatBomb, "MatOpacityCat", "extrapolating beyond range\n" ) ;
wl = low ;
}
high = ExprValue( DbaseGetExpr( name, "TransmissionHigh" ) ) ;
if( (wl > high) && DbaseCheck( name, "OPACITY_HIGH" ) )
{
IOerror( MatBomb, "MatOpacityCat", "wavelength %g out of range for %s: upper bound is %g", wl, name, high ) ;
IOerror( MatBomb, "MatOpacityCat", "extrapolating beyond range\n" ) ;
wl = high ;
}
type = ExprValueString( DbaseGetExpr( name, "TransmissionFormula" ) ) ;
if( strcmp( type, "table" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "transmission" ) ;
if( array )
{
T = ExprInterp( array, wl ) ;
if( isnan(T) )
{
IOerror( MatBomb, "MatOpacityCat", "bad transmission data array for %s", name ) ;
return nan("") ;
}
}
else
{
IOerror( MatBomb, "MatOpacityCat", "transmission data not found for %s", name ) ;
return nan("") ;
// old stuff here that we should incorporate...
// if( (ret == 1) && DbaseCheck( name, "OPACITY_RANGE" ) )
// IOerror( MatBomb, "MatOpacityCat", "wavelength %g out of range for %s -- extrapolating", wl, name ) ;
}
depth = ExprValue( DbaseGetExpr( name, "TransmissionDepth" ) ) ;
if( T == 1.0 )
return 0.0 ;
else
if( T <= 0.0 )
return HUGE ;
else
return -( depth / 25.4 ) / log(T) ;
}
else
if( strcmp( type, "clear" ) == 0 )
return 0.0 ;
else
{
IOerror( MatBomb, "MatOpacityCat", "unknown type of transmission formula for %s", name ) ;
return nan("") ;
}
}
double MatIndexCat( char *name, double temp, double wl )
{
double low, high, S2, index2, Tcat, dndT ;
int count ;
char *type ;
if( wl <= 0.0 )
{
IOerror( MatBomb, "MatIndexCat", "invalid wavelength %g", wl ) ;
return nan("") ;
}
/*
* First get the index at the catalogue temperature
*
*/
low = ExprValue( DbaseGetExpr( name, "DispersionLow" ) ) ;
if( (wl < low) && DbaseCheck( name, "DISP_LOW" ) )
{
IOerror( MatBomb, "MatIndexCat", "wavelength %g out of range for %s: lower bound is %g", wl, name, low ) ;
IOerror( MatBomb, "MatIndexCat", "extrapolating beyond range\n" ) ;
}
high = ExprValue( DbaseGetExpr( name, "DispersionHigh" ) ) ;
if( (wl > high) && DbaseCheck( name, "DISP_HIGH" ) )
{
IOerror( MatBomb, "MatIndexCat", "wavelength %g out of range for %s: upper bound is %g", wl, name, high ) ;
IOerror( MatBomb, "MatIndexCat", "extrapolating beyond range\n" ) ;
}
S2 = 1.0 / ( wl * wl ) ;
type = ExprValueString( DbaseGetExpr( name, "DispersionFormula" ) ) ;
if( strcmp( type, "sellmeier" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "sellmeier" ) ;
if( !array )
{
IOerror( MatBomb, "MatIndexCat", "sellmeier data array not found for %s", name ) ;
return nan("") ;
}
count = ExprArrayCount(array) ;
if( count % 2 )
{
IOerror( MatBomb, "MatIndexCat", "sellmeier formula has %d terms for %s", count, name ) ;
return nan("") ;
}
double table[count] ;
for( int i = 0 ; i < count ; i++ )
table[i] = ExprValue( ExprArrayValue( array, i ) ) ;
index2 = 1.0 ;
for( int i = 0 ; i < count / 2 ; i++ )
index2 += table[ 2 * i ] / ( 1.0 - table[ 2 * i + 1 ] * S2 ) ;
if( index2 < 1.0 )
{
IOerror( MatBomb, "MatIndexCat", "unphysical index of n[%s]^2 = %g at %g microns", name, index2, wl ) ;
return nan("") ;
}
}
else
if( strcmp( type, "schott" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "schott" ) ;
if( !array )
{
IOerror( MatBomb, "MatIndexCat", "schott data array not found for %s", name ) ;
return nan("") ;
}
count = ExprArrayCount(array) ;
if( count != 6 )
{
IOerror( MatBomb, "MatIndexCat", "Schott formula has %d terms for %s", count, name ) ;
return nan("") ;
}
double table[6] ;
for( int i = 0 ; i < 6 ; i++ )
table[i] = ExprValue( ExprArrayValue( array, i ) ) ;
index2 = table[0]
+ table[1] / S2
+ ( table[2]
+ ( table[3]
+ ( table[4]
+ table[5] * S2 ) * S2 ) * S2 ) * S2 ;
if( index2 < 1.0 )
{
IOerror( MatBomb, "MatIndexCat", "unphysical index of n[%s]^2 = %g at %g microns", name, index2, wl ) ;
return nan("") ;
}
}
else
if( strcmp( type, "polyindex" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "polyindex" ) ;
if( !array )
{
IOerror( MatBomb, "MatIndexCat", "polyindex data array not found for %s", name ) ;
return nan("") ;
}
count = ExprArrayCount(array) ;
if( !count || (count % 3 != 0) )
{
IOerror( MatBomb, "MatIndexCat", "Poly Index has %d terms for %s", count, name ) ;
return nan("") ;
}
double table[count] ;
for( int i = 0 ; i < count ; i++ )
table[i] = ExprValue( ExprArrayValue( array, i ) ) ;
index2 = 0.0 ;
for( int i = 0 ; i < count / 3 ; i++ )
{
index2 += table[ 3 * i + 2 ]
* pow( S2, table[ 3 * i ] )
* pow( temp, table[ 3 * i + 1 ] ) ;
}
if( index2 < 1.0 )
{
IOerror( MatBomb, "MatIndexCat", "unphysical index of n[%s]^2 = %g at %g microns", name, index2, wl ) ;
return nan("") ;
}
return sqrt( index2 ) ; /* TEMP done already! */
}
else
{
IOerror( MatBomb, "MatIndexCat", "unknown type of dispersion formula for %s", name ) ;
return nan("") ;
}
/*
* Now adjust for temperature effects
*
*/
Tcat = ExprValue( DbaseGetExpr( name, "DispersionTemperature" ) ) ;
if( Tcat == temp )
return sqrt( index2 ) ; /* all done! */
type = ExprValueString( DbaseGetExpr( name, "dndTFormula" ) ) ;
if( strcmp( type, "table" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "dndT" ) ;
if( array )
{
dndT = ExprInterp( array, wl ) ;
if( isnan(dndT) )
{
IOerror( MatBomb, "MatIndexCat", "bad dndT data array for %s", name ) ;
return nan("") ;
}
}
else
{
IOerror( MatBomb, "MatIndexCat", "dndT data not found for %s", name ) ;
return nan("") ;
}
// if( (ret == 1) && DbaseCheck( name, "DNDT_RANGE" ) )
// IOerror( MatBomb, "MatIndexCat", "wavelength %g out of range of dndT table for %s -- extrapolating", wl, name ) ;
}
else
if( strcmp( type, "constant" ) == 0 )
dndT = ExprValue( DbaseGetExpr( name, "dndTConstant" ) ) ;
else
{
IOerror( MatBomb, "MatIndexCat", "unknown form of dndT table for %s",
name ) ;
return nan("") ;
}
return sqrt( index2 ) + dndT * ( temp - Tcat ) ;
}
