divert(-1)
# @(#)Copyright (c), 1987, 1995 StatSci, Inc.  All rights reserved.
# 1 basic definitions, values, structure attributes
# 2 FUNCTION declaration
# 3 Argument processing
# 4 STRUCTURE declarations
# 5 COERCE coerce data structure to specified mode
# 6 return results
# 7 graphics macros
# 8 Miscellaneous operations
# 9 END of function definition

# 1 basic definitions, values, structure attributes
undefine(`DBmode')
define(`DCL',`divert(0)$1
divert(3)')
define(`INCLUDE',`divert(0)
ifelse($1,,`divert(3)',
$1,stack,`errprint(Warning: stack is included automatically
)INCLUDE(shift($*))',
$1,print,`errprint(Warning: print is included automatically
)INCLUDE(shift($*))',
InClUdE($1)
`INCLUDE(shift($*))')')
define(`SETMODE',`')
define(`FATAL',`{ call serrpr(FNAME,"$1",len($1))
	goto ERROR_EXIT}')
define(`WARNING',
`call swarnp(FNAME,"$1",len($1))')
define(`Done',998)define(`ERROR_EXIT',999)
define(`P',`S_$1`'p')define(`PDATA',`S_$1`'e')
define(`KEYNAME',`S_$1`'k')define(`DATANAME',`S_$1`'n')
define(`PDIM',`S_$1`'d')define(`PTSP',`S_$1`'t')
define(`MISSING',`ifelse($1,,`MiSsInG',`S_$1`'m')')
define(`NAME',`is(ifdef(`S_$1',PDATA($1),$1))')
define(`MODE',`is(ifdef(`S_$1',PDATA($1),$1)+1)')
define(`LENGTH',`is(ifdef(`S_$1',PDATA($1),$1)+2)')
define(`VALUE',`is(ifdef(`S_$1',PDATA($1),$1)+3)')
define(`VPTR',`$1v')define(`VSET',`VPTR($1)=VALUE($1)')
define(`DATA',`ifelse(XMD$1,REAL,`RDATA($1,$2,$3,$4)',
  XMD$1,LGL,`LDATA($1,$2,$3,$4)',`IDATA($1,$2,$3,$4)')')
define(`LDATA',`ls(SINDX($*))')
define(`IDATA',`is(SINDX($*))')
define(`RDATA',`rs(SINDX($*))')
define(`CDATA',`is(SINDX($*))')
define(`SINDX',`VPTR(PDATA($1)) ifelse($4,,`ifelse($2,,,+$2-1) ifelse($3,,,+NROW($1)*($3-1))',
	+iqqndx(PDIM($1),$2,$3,$4,ifelse($5,,1,$5),ifelse($6,,1,$6),ifelse($7,,1,$7)))')
define(`NROW',`is(VPTR(PDIM($1)))') define(`NCOL',`is(VPTR(PDIM($1))+1)')
define(`TSTART',`rs(VPTR(PTSP($1)))')define(`TEND',`rs(VPTR(PTSP($1))+1)')
define(`TNPER',`rs(VPTR(PTSP($1))+2)')
define(`NASET',`call setna2($1,$2)')
define(`NAOUT',`call naout(PDATA($1))')
define(`INTEGER',INT)
define(`LOGICAL',LGL)
define(`MA',10)
define(`CTABLE',`define(`tabct',1)
define(`tabnm',$1)
divert(2)
CT2(shift($*))
divert(0)POINTER $1 (tabct)
divert(3)')
define(`CT2',`ifelse($1,,`tabnm (tabct) = USED',
`tabnm (tabct)=STRING($1)
define(`tabct',incr(tabct)) CT2(shift($*))')')
define(`STATIC',`divert(0)
$*
divert(3)')
define(`INITIAL',`divert(1)
data $*
divert(3)')

# 2 FUNCTION declaration
#
define(`FUNCTION',`divert(-1)
define(`QUSRFATAL',`')undefine(`XMDPAR')undefine(`TS_OFF')
define(`NSTR',0)define(`STRLST',`')define(`Narg',0)divert(0)
POINTER function XNAME($1,$2) (instra)
POINTER instra
InClUdE(struct,stack,print)
POINTER FNAME,instr,outstr,copys,dirfnd,cpdir,cstrng,getcha,deref,curkey
POINTER alcvesn,alcmasn,alcarsn,alctssn,alchisn
POINTER alcvesr,alcmasr,alcarsr,alctssr,alchisr
POINTER alcvesi,alcmasi,alcarsi,alctssi,alchisi
POINTER alcvesl,alcmasl,alcarsl,alctssl,alchisl
POINTER alcvesc,alcmasc,alcarsc,alctssc,alchisc
POINTER alcdir,ientry,fndarg,snull,istrng,oldbrk,grzset,xtfrom,qpromp
integer iqqqi,jqqqj,nres; logical qqtspl
SAVE(FNAME, curkey)
divert(2) #3 kinds of calls - on abort, on interrupt  regular
if(instra==ON_ERROR){
	ENCODE("Error in ",C(TEXT(FNAME)))
	# if(curkey!=NULL)ENCODE(": argument ",C(TEXT(curkey)))
	EPRINT
	goto ERROR_EXIT }
if(instra==ON_BREAK)goto ERROR_EXIT
instr=instra; nres=0; snull=istrng(EOS,1)
FNAME=SNAME(instr)
CLEAR
divert(3)')
define(`NOPRINT',`STYPE(outstr)=FUN') define(`YESPRINT',`STYPE(outstr)=TFUN')


# 3 Argument Processing

define(`ARG',`ifelse($1,PAR,`PARARG',$1,`FITTING',`FITARG',`STRUCTURE($1,ARGV,shift($*))')')
define(`KEYARG',`STRUCTURE($1,KRGV,shift($*))')
define(`OPARG',`STRUCTURE($1)
P($1)=ENTRY(instr,NSTR)
ifelse($2,,,`COERCE($*)')')
define(`ARGSTR',`ifelse($1,,instr=instra,instr=cpdir(VALUE(P($1))))')
define(`ALLARG',`ifdef(`S_$1',,`STRUCTURE($1)')
ALLENTRY(instr,P($1)) {
if(is(P($1))==USED ifelse($2,NOKEY,|is(P($1))!=NULL,,))next
PDATA($1)=P($1)
DATANAME($1)=NULL; if(MODE($1)==STR)DATANAME($1)=SNAME(VALUE($1))
if(DATANAME($1)==NULL)DATANAME($1)=snull')
define(`NEXTARG',})
define(`COPY',`ifelse($1,,copy,`ALLOCATE($1,LIKE($1))
ifelse($2,,,`COPY(shift($*))')')')
define(`NARGS',`LENGTH(instr)')
# ENDARGS check for unmatched arg
#
define(`ENDARGS',`{ALLENTRY(instr,iqqqi) {
	jqqqj=is(iqqqi)
	if(jqqqj==USED ||( jqqqj==NULL & MODE(iqqqi)==MISSING)) next #processed or empty
	if(jqqqj==NULL)call serrpr(FNAME,"too many arguments",len(too many argumetns))
	else EPRINT("Error in ",C(TEXT(FNAME)),": Invalid argument name: ",C(TEXT(jqqqj)))
	goto ERROR_EXIT
	} }')

# 4 STRUCTURE declarations
#
define(`STRUCTURE',`{INITDCL($1,$2)DECLARE($*)dnl
ifelse($2,,,`STRUCT2($1)')}')
define(`ALLOCATE',`STRUCTURE($*)')
define(`DECLARE',`ifelse($2,,,
  IF1($1,$2),YES,`DECLARE($1,$3,$4,$5,$6,$7,$8,$9)',
  IF2($1,$2),YES,`DECLARE($1,$3,$4,$5,$6,$7,$8,$9)',
  `DEFLT($2)DECLARE($1,$3,$4,$5,$6,$7,$8,$9)')')

define(`DEFLT',`ifelse(TA:TM,ves:,`define(`TM',$1)define(`NDFLT',0)',
  NDFLT,1,`define(`D1',`DEFLTARGS($1)')',
  NDFLT,2,`define(`D2',`DEFLTARGS($1)')',
  NDFLT,3,`define(`D3',`DEFLTARGS($1)')',
  NDFLT,4,`define(`D4',`DEFLTARGS($1)')',
  `errprint(too many default values)')define(`NDFLT',incr(NDFLT))')

define(`DEFLTARGS',`$1')

define(`INITDCL',`ifelse(index(STRLST,:$1:),-1,`define(`NSTR',incr(NSTR))define(`S_$1',q`'NSTR)dnl
divert(0)POINTER PDATA($1),P($1),KEYNAME($1),DATANAME($1)
logical MISSING($1)
POINTER PDIM($1),PTSP($1),VPTR(PDATA($1)),VPTR(PDIM($1)),VPTR(PTSP($1))
equivalence(P($1),qstble(NSTR,1)),(PDATA($1),qstble(NSTR,2)),(KEYNAME($1),qstble(NSTR,3)),
 (DATANAME($1),qstble(NSTR,4)),(PTSP($1),qstble(NSTR,5)),(PDIM($1),qstble(NSTR,6)),(MISSING($1),qstble(NSTR,7))
divert(2)KEYNAME($1)=istrng("$1",len($1))dnl
ifelse(substr($2,1,3),RGV,`define(`Narg',incr(Narg)); qargky(Narg)=KEYNAME($1)')
divert(3)')dnl
define(`QG',`')define(`QD',`ifelse(D1,NOARG,
`FATAL(missing TG $1 )',`P($1)=QA($1)')')dnl
define(`TG',structure)define(`QE',`')dnl
define(`QA', `define(`LETTER', `ifelse(TM,REAL,r,TM,INT,i,TM,LGL,l,TM,CHAR,c,n)')ifelse(
  TA,ves,`
    alc TA LETTER (TM,D1,ifelse(TM,REAL,D2,D2),ifelse(D2,NOARG,0,1))',
  TA,his,`
    alc TA LETTER (TM,D1,D2,ifelse(D2,NOARG,0,1))',
  TA,tss,`
    alc TA LETTER (TM,D1,D2,D3,ifelse(TM,REAL,D4,D4),ifelse(D4,NOARG,0,1))',
  TA,mas,`
    alc TA LETTER (TM,D1,D2,ifelse(TM,REAL,D3,D3),ifelse(D3,NOARG,0,1))',
  TA,ars,`
    alc TA LETTER (TM,D1,D2,ifelse(TM,REAL,D3,D3),ifelse(D3,NOARG,0,1))',
  `',`
    INTF-ERROR(Unknown structure: alc TA)')')dnl

define(`QC',`COE2($1)')define(`CM',`TM')dnl
define(`D1',`NOARG')define(`D2',`NOARG')define(`D3',`NOARG')define(`D4',`NOARG')define(`NDFLT',1)
define(`TM',`')define(`TA',`ves')define(`TN$1',TRUE)define(`TC',`')
define(`STRLST',STRLST:$1:)')

define(`IF1',`ifelse(
  $2,TS,`define(`TA',tss)ifelse(TM,,`define(`TM',REAL)')YES',
  $2,ARRAY,`define(`TA',ars)ifelse(TM,,`define(`TM',REAL)')YES',
  $2,MATRIX,`define(`TA',mas)ifelse(TM,,`define(`TM',REAL)')YES',
  $2,VECTOR,`define(`TA',vec)ifelse(TM,,`define(`TM',ANY)')YES',
  $2,REAL,`define(`TM',REAL)YES',
  $2,INT,`define(`TM',INT)YES',
  $2,LGL,`define(`TM',LGL)YES',
  $2,CHAR,`define(`TM',CHAR)YES',
  $2,ANY,`define(`TM',ANY)YES',
  $2,STR,`define(`TA',his)define(`TM',STR)YES',
  $2,NULL,`define(`TS',`nul')define(`TM',NULL)YES',
  $2,OPTIONAL,`define(`QD',`P($1)=ientry(0,0,0,0);PDATA($1)=P($1)')define(`QE',`else')YES',
NO)')
define(`IF2',`ifelse(
  $2,ARGV,`define(`QG',`fndarg(instr,KEYNAME($1),qargky,qqnarg,TRUE)')define(`TG',argument)define(`TN$1',FALSE)YES',
  $2,KRGV,`define(`QG',`fndarg(instr,KEYNAME($1),qargky,qqnarg,FALSE)')define(`TG',keyword arg)define(`TN$1',FALSE)YES',
  $2,NAOK,`define(`TN$1',TRUE)YES',
  $2,NAFATAL,`define(`TN$1',FALSE)YES',
  $2,COPY,`define(`TC',YES)YES',
  $2,NODATA,`define(`CM',ANY)YES',
  $2,QFRO,`define(`QG',`xtfrom(P(HF),QF)')dnl
ifdef(`QF',,`define(`QF',`KEYNAME($1)')')YES',
  $2,QCOM,`define(`QF',HC)YES',
  $2,QLIK,`define(`QA',`copys(P(HL))')ifelse(TM,,`define(`TM',HML)')dnl
ifelse(D1,NOARG,`define(`D1',TRUE)')ifelse(TA,ves,`define(`TA',HTL)')YES',
  $2,QPRO,`define(`HM2',ifelse(HMSG,,$1:,HMSG))define(`QD',`P($1)=qpromp("HM2",len(HM2),TM,D1)')YES',
$2,QTYP,`define(`TM',HT)YES',
  NO)')

define(`STRUCT2',
`ifelse(QG,,
	`ifelse(D1,NOARG,,`P($1)=QA($1)
	DATANAME($1)=snull
	ifelse(TC,YES,P($1)=copys(P($1)))
	QC($1)')',
	`P($1)=QG($1)
	MISSING($1)= P($1)==NULL
	if(MODE(P($1))!=STR) DATANAME($1)=NULL; else DATANAME($1)=SNAME(VALUE(P($1)))
	if(DATANAME($1)==NULL)DATANAME($1)=snull
	if(MISSING($1)) {
		QD($1)
		}
	QE {
	ifelse(TC,YES,P($1)=copys(P($1)))
	QC($1)} ')
')
# macros to hide some values for later use
define(`FROM',`define(`HF',$1)ifelse($2,,
`define(`TG',`component $1 $ ')undefine(`QF')',
`define(`TG',`component $1 $ $2 for ')define(`QF',istrng("$2",len($2)))')QFRO')
define(`LIKE',`define(`HL',$1)define(`HML',ifelse(XMD$1,ANY,MODE($1),XMD$1))define(`HTL',XTD$1)QLIK')
define(`MODECALC',`define(`HT',$1)QTYP')
define(`COMPONENT',`define(`HC',`istrng("$1",len($1))')QCOM')
define(`PROMPT',`define(`HMSG',$1)QPRO')

# 5 COERCE coerce data structure to specified mode
#
define(`COERCE',`{INITDCL($1)DECLARE($*)dnl
COE2($1)}')
define(`COE2',`{define(`XMD$1',TM)define(`XTD$1',TA)dnl
curkey=KEYNAME($1) #name for error print if coerce dies
ifelse(
TA,his,`call coehis(P($1),PDATA($1))',
TA,ars,`  call coears(P($1),PDATA($1),PDIM($1),CM,TN$1);  VSET(PDIM($1))',
TA,mas,`  call coemas(P($1),PDATA($1),PDIM($1),CM,TN$1);  VSET(PDIM($1))',
TA,tss,`  call coetss(P($1),PDATA($1),PTSP($1),CM,TN$1);  VSET(PTSP($1))',
TA,vec,`call coevec(P($1),PDATA($1),CM,TN$1)',
TM,,`ifelse($4,copy,`P($1)=copys(P($1));') PDATA($1)=deref(P($1))',
`call coeves(P($1),PDATA($1),CM,TN$1)' )
curkey=NULL #turn off error print
VSET(PDATA($1)) ifelse(TM,CM,,; MODE($1)=TM)}')

# 6 return results
define(`RETURN',`{RETRN2($*)}')
define(`RETRN2',`ifelse($1,,`goto Done',dnl
$1,&,,`ifelse($1,FILTER,`FLTR',index($1,=),-1,
`ifdef(`S_$1',,`errprint(Error: $1 is not an S structure)}}}}}}}')dnl
call zzrtrn(outstr,nres,P($1),KEYNAME($1))',
`KEYRET(BRKUP($1))')
RETRN2(shift($*))')')
define(`BRKUP',`substr($1,0,index($1,=)),substr($1,eval(index($1,=)+1))')
define(`KEYRET',`call zzrtrn(outstr,nres,P($2),ifelse(len($1),0,NULL,istrng("$1",len($1))))')
define(`CHAIN',`{ifelse($1,,,`STYPE(outstr)=CHAINFUN; SNAME(outstr)=istrng("$1",len($1))')
RETURN(shift($*))}')
define(`FLTR',`ALLENTRY(instr,iqqqi)
	if(is(iqqqi)!=USED) call zzrtrn(outstr,nres,iqqqi,NAME(iqqqi))')
define(`INSERT',`ifelse($2,,,`ifelse(index($2,=),-1,`Insert2($1,$2,$2)',`Insert2($1,BRKUP($2))')
INSERT($1,shift(shift($*)))')')
define(`Insert2',`{define(`OTM',XMD$1)define(`OTA',XTD$1)COERCE($1,STR)INITDCL($2)
iqqq2=VALUE($1)
iqqqi=dirfnd(iqqq2,TEXT(KEYNAME($2)))
if(iqqqi==NULL) call zzrtrn(iqqq2,LENGTH(iqqq2),P($3),KEYNAME($2))
else { call pcopy(P($3),iqqqi,LENTRY,INT); NAME(iqqqi)=KEYNAME($2) }
VALUE($1)=iqqq2
define(`TM',OTM)define(`TA',`OTA')COE2($1)}') # coerce back to original form

# 7 graphics macros
define(`NO_TS',`define(`TS_OFF',1)')
define(`TSPLOT',`qqtspl')
define(`PLOTARGS',`ARG(x)
STRUCTURE(y)
iqqqi=NULL; qqtspl=FALSE
if(MODE(x)==STR) { # try for an x,y structure
	iqqqi=dirfnd(VALUE(x),TSTRING(x))
	if(iqqqi!=NULL) {
		P(x)=iqqqi
		P(y)=dirfnd(VALUE(x),TSTRING(y))
		if(P(y)==NULL) FATAL(Invalid x-y structure)
		}
	}
# look for seperate args
if(iqqqi==NULL) {
	ifdef(`TS_OFF',`ARG(y)',
	`ARG(y,OPTIONAL)
	if(MISSING(y)) {
		P(y)=P(x)
		DATANAME(y)=DATANAME(x)
		COERCE(y,TS,ifelse($1,,NAFATAL,$1))
		ALLOCATE(x,REAL,LENGTH(y))
		call tsvecz(RDATA(x),TSTART(y),TEND(y),TNPER(y),LENGTH(y))
		qqtspl=TRUE
		}')
	}
COERCE(x,REAL,ifelse($1,,NAFATAL,$1))
COERCE(y,REAL,ifelse($1,,NAFATAL,$1))')
define(`LOGPLOT',`divert(0)logical logx,logy
CHARACTER(jgetch,1); CHARACTER(i1,1); CHARACTER(i2,1)
divert(3)KEYARG(log,CHAR,OPTIONAL)
if(MISSING(log)){logx=FALSE; logy=FALSE}
else {
	if(islenz(TEXT(CDATA(log)))>0){
		i1=jgetch(TEXT(CDATA(log)),1);i2=jgetch(TEXT(CDATA(log)),2)
		logx=i1=="x" | i2=="x"; logy= i1=="y" | i2=="y"
		}
	else {logx=FALSE; logy=FALSE}
	}')
define(`SETUP',`
ifdef(`XMDPAR',,`INCLUDE(graphics)')
{QUERY( lab(nx,ny,lablen) )
ifelse($1$3,,
	if(LENGTH(x)!=LENGTH(y))FATAL(Lengths of x and y must match)
	ifdef(`XMDlog',
	call naxy2(DATA(x),DATA(y),LENGTH(x),xl,xu,yl,yu,logx,logy),
	call naxy2(DATA(x),DATA(y),LENGTH(x),xl,xu,yl,yu,FALSE,FALSE)
	)
)
ifdef(`XMDlog',`if(logx) call logtrn(DATA(x),LENGTH(x))')
ifdef(`XMDlog',`if(logy) call logtrn(DATA(y),LENGTH(y))')
ifelse($1,,,xl=$1; xu=$2)
KEYARG(xlim,REAL,OPTIONAL)
if(!MISSING(xlim)) { xl=RDATA(xlim); xu=RDATA(xlim,2) }
ifelse($3,,,yl=$3; yu=$4)
KEYARG(ylim,REAL,OPTIONAL)
if(!MISSING(ylim)) { yl=RDATA(ylim); yu=RDATA(ylim,2) }
call beginz
ifdef(`XMDlog',`if(logy)call logaxz(2," ",yl,yu,ny,2); else')
call stdaxz(2," ",yl,yu,ny,2)
ifdef(`TS_OFF',,`if(qqtspl)call timaxz(1," ",TSTART(y),TEND(y),TNPER(y),2); else')
ifdef(`XMDlog',`if(logx) call logaxz(1," ",xl,xu,nx,2); else ')
call stdaxz(1," ",xl,xu,nx,2)}')
define(`PARARG',`INCLUDE(graphics)
KEYARG(PAR,STR,1)
if(MISSING(PAR))VALUE(P(PAR))=grzset(instr,TRUE)')
define(`DEVICE_DRIVER',`INCLUDE(u/action)
action = DEVICE_ACTION
STRUCTURE(junk,INT,1,1)
RETURN(junk,&) #force some result so SNAME is returned
STYPE(outstr)=CHAINFUN
SNAME(outstr)=ifelse($1,,FNAME,`istrng("$1",len($1))')')

# 8 Miscellaneous operations
define(`DEBUG',`define(`DBmode',1){ ifelse($1,,call ssnap(FNAME,qstble,qqnstr),
$1,ON,,`ENCODE("$1: ")
ifdef(`XMD$1',`	if(MISSING($1)) ENCODE(" (default) ")
	call dput(ERRORFC,P($1))',
	`ifelse($3,,call ssnap(FNAME,qstble,qqnstr),
		call vprint(ERRORFC,$1,$2,$3))')')}')
define(`GETSEED',`INCLUDE(search,seeds)
STATIC( POINTER iqqqsd,iqqqse,iqqqsn,getds)
iqqqsn=istrng("Random.seed",11); iqqqse=getds(iqqqsn,ANYPOS)
call coeves(iqqqse,iqqqsd,INT,FALSE)
if(LENGTH(iqqqsd)!=12)FATAL(Bad Random.seed dataset)
call cseedi(is(VALUE(iqqqsd)))')
define(`PUTSEED',`call cseedo(is(VALUE(iqqqsd))) #get back seed vec
call putds(iqqqsn,iqqqsd,WORKPOS)')
define(`PORT',`if(FALSE)call seterr #force our port error handling')


# 8a optimization macros
define(`MIN_Done',8001)undefine(`where_to')
define(`Make_parc',`ifelse($1,,,`define(`Parcopy',Parcopy
call parcpy(RDATA($1),LENGTH($1),where_to,qqincp,qqcpct))
Make_parc(shift($*))')')
define(`FIND',`STATIC(logical qqincp,userg; integer qqcpct,iterm; external qqfcal,qqgcal)
STRUCTURE(min,REAL,1)
NPARS=Accum($*)
ALLOCATE(trace,MATRIX,(3+2*NPARS),max0(ntrace,1))
STRUCTURE(optpars,REAL,NPARS)
STRUCTURE(hfact,MATRIX,NPARS,NPARS)
STRUCTURE(qqgest,REAL,NPARS)
divert(2)userg=FALSE divert(3)
qqincp=TRUE; qqcpct=0
define(`Parcopy',`')
Make_parc($*)
define(`where_to',`RDATA(optpars)')Parcopy
call minop(RDATA(optpars), NPARS, RDATA(min), RDATA(qqgest),RDATA(hfact), RDATA(radius),
	RDATA(xtol), RDATA(gtol), IDATA(iter), qqfcal, userg,
	qqgcal, RDATA(trace),ntrace,iterm)
qqincp=FALSE; qqcpct=0
define(`where_to',`RDATA(optpars)')Parcopy')
define(`Accum',`ifelse($1,,,`+LENGTH($1) Accum(shift($*))')')
define(`MAXIMIZING',`MINIMIZING($1,$2,-)')
define(`MINIMIZING',`define(`Optsign',ifelse($3,,+,$3))
divert(1)
integer qqcn; real qqcx(1),qqcf
divert(2)
goto MIN_Done
entry calcf(qqcx,qqcn,qqcf)
qqincp=FALSE; qqcpct=0
define(`where_to',`qqcx')Parcopy
$2
qqcf=Optsign ($1)
return
MIN_Done continue
divert(3)
if(ntrace>0){
	NCOL(trace)=ntrace; LENGTH(trace)=NROW(trace)*NCOL(trace)
	call transr(RDATA(trace),NROW(trace),NCOL(trace))
	}
ifelse(Optsign,-,`$1= Optsign RDATA(min)
	call negate(RDATA(qqgest),NPARS)
	call negate(RDATA(trace,1,NPARS+1),(NPARS+1)*ntrace)
	call negate(RDATA(hfact),NPARS**2)')
if(ntrace>0)RETURN(trace,&)
')
define(`VARIANCE',`variance=hfact')
define(`DERIVATIVE',`ifelse($1,,derivative=qqgest,`
divert(1)real qqcg(1)
divert(2)userg=TRUE define(`Derivdone',incr(MIN_Done))
goto Derivdone
entry calcg(qqcx,qqcn,qqcg)
qqincp=FALSE; qqcpct=0
define(`where_to',`qqcx')Parcopy
$2
ifelse(Optsign,-,`call negate($1,qqcn)')
call rcopy($1,qqcg,qqcn)
return
Derivdone continue
divert(3)call rcopy(RDATA(qqgest),$1,NPARS)')')
define(`FITARG',`ARG(tolerance,REAL,1,sqrt(PRECISION))
ARG(xtol,REAL,1,RDATA(tolerance))
ARG(gtol,REAL,1,RDATA(tolerance))
ARG(radius,REAL,1,1.)
ARG(iter,INT,1,200)
ARG(trace,INT,1,0)
ntrace=IDATA(trace)')

# 9 END of function definition
define(`ONFATAL',`define(`QUSRFATAL',$1)')
define(`END',`divert(0)
ifdef(`DBmode',`common/qssnap/qqnstr,qstble')
integer qstble(ifelse(NSTR,0,1,NSTR),7),qqnstr,qqnarg
POINTER qargky(ifelse(Narg,0,1,Narg))
divert(1)ifelse(NSTR,0,,`call ifill(0,qstble,eval(NSTR*7))')
qqnstr=NSTR; qqnarg=Narg
divert(2)outstr=alcdir(5,snull,TFUN)
divert(3)dnl
LABEL(Done) continue
ifdef(`XMDPAR',`if(P(PAR)!=0&&dirfnd(outstr,TSTRING(PAR))==0)junk=grzset(VALUE(P(PAR)),FALSE)')
if (nres==1 & STYPE(outstr)!=CHAINFUN) NAME(FIRSTENT(outstr))=NULL
divert(4)dnl
LENGTH(outstr)=nres
 return(outstr)
ERROR_EXIT	continue # here on errors or breaks
QUSRFATAL # user wrapup if any
ifdef(`XMDPAR',`if(P(PAR)!=0)junk=grzset(VALUE(P(PAR)),FALSE)')
return(PROBLEM_DONE)
end

ifdef(`DBmode',`ROUTINE(ssnapr,		interactive debug from interface routine)
subroutine ssnapr(header)
CHARACTER(header,*)

InClUdE(print)
common/qssnap/qqnstr,qstble
integer qqnstr,qstble(NSTR,7)

call ssnap(istrng(header,-1),qstble,qqnstr)
return
end')
divert(0)undivert divert(3)')
divert(3)
SCCS_ID(90004,``@(#)''intf.m 3.13 last edit 5/9/95 StatSci. Basefile BASEFILE)
