aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/asp.spad.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
committerdos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
commitab8cc85adde879fb963c94d15675783f2cf4b183 (patch)
treec202482327f474583b750b2c45dedfc4e4312b1d /src/algebra/asp.spad.pamphlet
downloadopen-axiom-ab8cc85adde879fb963c94d15675783f2cf4b183.tar.gz
Initial population.
Diffstat (limited to 'src/algebra/asp.spad.pamphlet')
-rw-r--r--src/algebra/asp.spad.pamphlet4295
1 files changed, 4295 insertions, 0 deletions
diff --git a/src/algebra/asp.spad.pamphlet b/src/algebra/asp.spad.pamphlet
new file mode 100644
index 00000000..7899fb39
--- /dev/null
+++ b/src/algebra/asp.spad.pamphlet
@@ -0,0 +1,4295 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra asp.spad}
+\author{Mike Dewar, Grant Keady, Godfrey Nolan}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{domain ASP1 Asp1}
+<<domain ASP1 Asp1>>=
+)abbrev domain ASP1 Asp1
+++ Author: Mike Dewar, Grant Keady, Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 18 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranFunctionCategory, FortranProgramCategory.
+++ Description:
+++\spadtype{Asp1} produces Fortran for Type 1 ASPs, needed for various
+++NAG routines. Type 1 ASPs take a univariate expression (in the symbol
+++X) and turn it into a Fortran Function like the following:
+++\begin{verbatim}
+++ DOUBLE PRECISION FUNCTION F(X)
+++ DOUBLE PRECISION X
+++ F=DSIN(X)
+++ RETURN
+++ END
+++\end{verbatim}
+
+
+Asp1(name): Exports == Implementation where
+ name : Symbol
+
+ FEXPR ==> FortranExpression
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+
+ Exports ==> FortranFunctionCategory with
+ coerce : FEXPR(['X],[],MachineFloat) -> $
+ ++coerce(f) takes an object from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns it into an ASP.
+
+ Implementation ==> add
+
+ -- Build Symbol Table for Rep
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(X,fortranReal()$FT,syms)$SYMTAB
+ real : FST := "real"::FST
+
+ Rep := FortranProgram(name,[real]$Union(fst:FST,void:"void"),[X],syms)
+
+ retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+ retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR(['X],[],MachineFloat),"failed")
+ foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+ foo case "failed" => "failed"
+ foo::FEXPR(['X],[],MachineFloat)::$
+
+ retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+ retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR(['X],[],MachineFloat),"failed")
+ foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+ foo case "failed" => "failed"
+ foo::FEXPR(['X],[],MachineFloat)::$
+
+ retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+ retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR(['X],[],MachineFloat),"failed")
+ foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+ foo case "failed" => "failed"
+ foo::FEXPR(['X],[],MachineFloat)::$
+
+ retract(u:EXPR INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+ retractIfCan(u:EXPR INT):Union($,"failed") ==
+ foo : Union(FEXPR(['X],[],MachineFloat),"failed")
+ foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+ foo case "failed" => "failed"
+ foo::FEXPR(['X],[],MachineFloat)::$
+
+ retract(u:POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+ retractIfCan(u:POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR(['X],[],MachineFloat),"failed")
+ foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+ foo case "failed" => "failed"
+ foo::FEXPR(['X],[],MachineFloat)::$
+
+ retract(u:POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+ retractIfCan(u:POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR(['X],[],MachineFloat),"failed")
+ foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+ foo case "failed" => "failed"
+ foo::FEXPR(['X],[],MachineFloat)::$
+
+ coerce(u:FEXPR(['X],[],MachineFloat)):$ ==
+ coerce((u::Expression(MachineFloat))$FEXPR(['X],[],MachineFloat))$Rep
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP10 Asp10}
+<<domain ASP10 Asp10>>=
+)abbrev domain ASP10 Asp10
+++ Author: Mike Dewar and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 18 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{ASP10} produces Fortran for Type 10 ASPs, needed for NAG routine
+++\axiomOpFrom{d02kef}{d02Package}. This ASP computes the values of a set of functions, for example:
+++\begin{verbatim}
+++ SUBROUTINE COEFFN(P,Q,DQDL,X,ELAM,JINT)
+++ DOUBLE PRECISION ELAM,P,Q,X,DQDL
+++ INTEGER JINT
+++ P=1.0D0
+++ Q=((-1.0D0*X**3)+ELAM*X*X-2.0D0)/(X*X)
+++ DQDL=1.0D0
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp10(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ EXF ==> Expression Float
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FEXPR ==> FortranExpression(['JINT,'X,'ELAM],[],MFLOAT)
+ MFLOAT ==> MachineFloat
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : Vector FEXPR -> %
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : FST := "real"::FST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(P,fortranReal()$FT,syms)$SYMTAB
+ declare!(Q,fortranReal()$FT,syms)$SYMTAB
+ declare!(DQDL,fortranReal()$FT,syms)$SYMTAB
+ declare!(X,fortranReal()$FT,syms)$SYMTAB
+ declare!(ELAM,fortranReal()$FT,syms)$SYMTAB
+ declare!(JINT,fortranInteger()$FT,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"),
+ [P,Q,DQDL,X,ELAM,JINT],syms)
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ coerce(c:FortranCode):% == coerce(c)$Rep
+
+ coerce(r:RSFC):% == coerce(r)$Rep
+
+ coerce(c:List FortranCode):% == coerce(c)$Rep
+
+ -- To help the poor old compiler!
+ localAssign(s:Symbol,u:Expression MFLOAT):FortranCode ==
+ assign(s,u)$FortranCode
+
+ coerce(u:Vector FEXPR):% ==
+ import Vector FEXPR
+ not (#u = 3) => error "Incorrect Dimension For Vector"
+ ([localAssign(P,elt(u,1)::Expression MFLOAT),_
+ localAssign(Q,elt(u,2)::Expression MFLOAT),_
+ localAssign(DQDL,elt(u,3)::Expression MFLOAT),_
+ returns()$FortranCode ]$List(FortranCode))::Rep
+
+ coerce(u:%):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP12 Asp12}
+<<domain ASP12 Asp12>>=
+)abbrev domain ASP12 Asp12
+++ Author: Mike Dewar and Godfrey Nolan
+++ Date Created: Oct 1993
+++ Date Last Updated: 18 March 1994
+++ 21 June 1994 Changed print to printStatement
+++ Related Constructors:
+++ Description:
+++\spadtype{Asp12} produces Fortran for Type 12 ASPs, needed for NAG routine
+++\axiomOpFrom{d02kef}{d02Package} etc., for example:
+++\begin{verbatim}
+++ SUBROUTINE MONIT (MAXIT,IFLAG,ELAM,FINFO)
+++ DOUBLE PRECISION ELAM,FINFO(15)
+++ INTEGER MAXIT,IFLAG
+++ IF(MAXIT.EQ.-1)THEN
+++ PRINT*,"Output from Monit"
+++ ENDIF
+++ PRINT*,MAXIT,IFLAG,ELAM,(FINFO(I),I=1,4)
+++ RETURN
+++ END
+++\end{verbatim}
+Asp12(name): Exports == Implementation where
+ name : Symbol
+
+ O ==> OutputForm
+ S ==> Symbol
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ FC ==> FortranCode
+ SYMTAB ==> SymbolTable
+ EXI ==> Expression Integer
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ U ==> Union(I: Expression Integer,F: Expression Float,_
+ CF: Expression Complex Float,switch:Switch)
+ UFST ==> Union(fst:FST,void:"void")
+
+ Exports ==> FortranProgramCategory with
+ outputAsFortran:() -> Void
+ ++outputAsFortran() generates the default code for \spadtype{ASP12}.
+
+ Implementation ==> add
+
+ import FC
+ import Switch
+
+ real : FST := "real"::FST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(MAXIT,fortranInteger()$FT,syms)$SYMTAB
+ declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB
+ declare!(ELAM,fortranReal()$FT,syms)$SYMTAB
+ fType : FT := construct([real]$UFST,["15"::Symbol],false)$FT
+ declare!(FINFO,fType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,[MAXIT,IFLAG,ELAM,FINFO],syms)
+
+ -- eqn : O := (I::O)=(1@Integer::EXI::O)
+ code:=([cond(EQ([MAXIT@S::EXI]$U,[-1::EXI]$U),
+ printStatement(["_"Output from Monit_""::O])),
+ printStatement([MAXIT::O,IFLAG::O,ELAM::O,subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]), -- YUCK!
+ returns()]$List(FortranCode))::Rep
+
+ coerce(u:%):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u:%):Void == outputAsFortran(u)$Rep
+ outputAsFortran():Void == outputAsFortran(code)$Rep
+
+@
+\section{domain ASP19 Asp19}
+<<domain ASP19 Asp19>>=
+)abbrev domain ASP19 Asp19
+++ Author: Mike Dewar, Godfrey Nolan, Grant Keady
+++ Date Created: Mar 1993
+++ Date Last Updated: 18 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp19} produces Fortran for Type 19 ASPs, evaluating a set of
+++functions and their jacobian at a given point, for example:
+++\begin{verbatim}
+++ SUBROUTINE LSFUN2(M,N,XC,FVECC,FJACC,LJC)
+++ DOUBLE PRECISION FVECC(M),FJACC(LJC,N),XC(N)
+++ INTEGER M,N,LJC
+++ INTEGER I,J
+++ DO 25003 I=1,LJC
+++ DO 25004 J=1,N
+++ FJACC(I,J)=0.0D0
+++25004 CONTINUE
+++25003 CONTINUE
+++ FVECC(1)=((XC(1)-0.14D0)*XC(3)+(15.0D0*XC(1)-2.1D0)*XC(2)+1.0D0)/(
+++ &XC(3)+15.0D0*XC(2))
+++ FVECC(2)=((XC(1)-0.18D0)*XC(3)+(7.0D0*XC(1)-1.26D0)*XC(2)+1.0D0)/(
+++ &XC(3)+7.0D0*XC(2))
+++ FVECC(3)=((XC(1)-0.22D0)*XC(3)+(4.333333333333333D0*XC(1)-0.953333
+++ &3333333333D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2))
+++ FVECC(4)=((XC(1)-0.25D0)*XC(3)+(3.0D0*XC(1)-0.75D0)*XC(2)+1.0D0)/(
+++ &XC(3)+3.0D0*XC(2))
+++ FVECC(5)=((XC(1)-0.29D0)*XC(3)+(2.2D0*XC(1)-0.6379999999999999D0)*
+++ &XC(2)+1.0D0)/(XC(3)+2.2D0*XC(2))
+++ FVECC(6)=((XC(1)-0.32D0)*XC(3)+(1.666666666666667D0*XC(1)-0.533333
+++ &3333333333D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2))
+++ FVECC(7)=((XC(1)-0.35D0)*XC(3)+(1.285714285714286D0*XC(1)-0.45D0)*
+++ &XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2))
+++ FVECC(8)=((XC(1)-0.39D0)*XC(3)+(XC(1)-0.39D0)*XC(2)+1.0D0)/(XC(3)+
+++ &XC(2))
+++ FVECC(9)=((XC(1)-0.37D0)*XC(3)+(XC(1)-0.37D0)*XC(2)+1.285714285714
+++ &286D0)/(XC(3)+XC(2))
+++ FVECC(10)=((XC(1)-0.58D0)*XC(3)+(XC(1)-0.58D0)*XC(2)+1.66666666666
+++ &6667D0)/(XC(3)+XC(2))
+++ FVECC(11)=((XC(1)-0.73D0)*XC(3)+(XC(1)-0.73D0)*XC(2)+2.2D0)/(XC(3)
+++ &+XC(2))
+++ FVECC(12)=((XC(1)-0.96D0)*XC(3)+(XC(1)-0.96D0)*XC(2)+3.0D0)/(XC(3)
+++ &+XC(2))
+++ FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333
+++ &3333D0)/(XC(3)+XC(2))
+++ FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X
+++ &C(2))
+++ FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3
+++ &)+XC(2))
+++ FJACC(1,1)=1.0D0
+++ FJACC(1,2)=-15.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2)
+++ FJACC(1,3)=-1.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2)
+++ FJACC(2,1)=1.0D0
+++ FJACC(2,2)=-7.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2)
+++ FJACC(2,3)=-1.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2)
+++ FJACC(3,1)=1.0D0
+++ FJACC(3,2)=((-0.1110223024625157D-15*XC(3))-4.333333333333333D0)/(
+++ &XC(3)**2+8.666666666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2)
+++ &**2)
+++ FJACC(3,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+8.666666
+++ &666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2)**2)
+++ FJACC(4,1)=1.0D0
+++ FJACC(4,2)=-3.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2)
+++ FJACC(4,3)=-1.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2)
+++ FJACC(5,1)=1.0D0
+++ FJACC(5,2)=((-0.1110223024625157D-15*XC(3))-2.2D0)/(XC(3)**2+4.399
+++ &999999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2)
+++ FJACC(5,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+4.399999
+++ &999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2)
+++ FJACC(6,1)=1.0D0
+++ FJACC(6,2)=((-0.2220446049250313D-15*XC(3))-1.666666666666667D0)/(
+++ &XC(3)**2+3.333333333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2)
+++ &**2)
+++ FJACC(6,3)=(0.2220446049250313D-15*XC(2)-1.0D0)/(XC(3)**2+3.333333
+++ &333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2)**2)
+++ FJACC(7,1)=1.0D0
+++ FJACC(7,2)=((-0.5551115123125783D-16*XC(3))-1.285714285714286D0)/(
+++ &XC(3)**2+2.571428571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2)
+++ &**2)
+++ FJACC(7,3)=(0.5551115123125783D-16*XC(2)-1.0D0)/(XC(3)**2+2.571428
+++ &571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2)**2)
+++ FJACC(8,1)=1.0D0
+++ FJACC(8,2)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ FJACC(8,3)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ FJACC(9,1)=1.0D0
+++ FJACC(9,2)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)*
+++ &*2)
+++ FJACC(9,3)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)*
+++ &*2)
+++ FJACC(10,1)=1.0D0
+++ FJACC(10,2)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)
+++ &**2)
+++ FJACC(10,3)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)
+++ &**2)
+++ FJACC(11,1)=1.0D0
+++ FJACC(11,2)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ FJACC(11,3)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ FJACC(12,1)=1.0D0
+++ FJACC(12,2)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ FJACC(12,3)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ FJACC(13,1)=1.0D0
+++ FJACC(13,2)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)
+++ &**2)
+++ FJACC(13,3)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)
+++ &**2)
+++ FJACC(14,1)=1.0D0
+++ FJACC(14,2)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ FJACC(14,3)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ FJACC(15,1)=1.0D0
+++ FJACC(15,2)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ FJACC(15,3)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp19(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ FC ==> FortranCode
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FC))
+ FSTU ==> Union(fst:FST,void:"void")
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ MFLOAT ==> MachineFloat
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+ MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT)
+ FEXPR ==> FortranExpression([],['XC],MFLOAT)
+ S ==> Symbol
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : VEC FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : FSTU := ["real"::FST]$FSTU
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(M,fortranInteger()$FT,syms)$SYMTAB
+ declare!(N,fortranInteger()$FT,syms)$SYMTAB
+ declare!(LJC,fortranInteger()$FT,syms)$SYMTAB
+ xcType : FT := construct(real,[N],false)$FT
+ declare!(XC,xcType,syms)$SYMTAB
+ fveccType : FT := construct(real,[M],false)$FT
+ declare!(FVECC,fveccType,syms)$SYMTAB
+ fjaccType : FT := construct(real,[LJC,N],false)$FT
+ declare!(FJACC,fjaccType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$FSTU,[M,N,XC,FVECC,FJACC,LJC],syms)
+
+ coerce(c:List FC):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FC):$ == coerce(c)$Rep
+
+ -- Take a symbol, pull of the script and turn it into an integer!!
+ o2int(u:S):Integer ==
+ o : OutputForm := first elt(scripts(u)$S,sub)
+ o pretend Integer
+
+ -- To help the poor old compiler!
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ localAssign1(s:S,j:Matrix FEXPR):FC ==
+ j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2
+ assign(s,j')$FC
+
+ localAssign2(s:S,j:VEC FEXPR):FC ==
+ j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
+ assign(s,j')$FC
+
+ coerce(u:VEC FEXPR):$ ==
+ -- First zero the Jacobian matrix in case we miss some derivatives which
+ -- are zero.
+ import POLY INT
+ seg1 : Segment (POLY INT) := segment(1::(POLY INT),LJC@S::(POLY INT))
+ seg2 : Segment (POLY INT) := segment(1::(POLY INT),N@S::(POLY INT))
+ s1 : SegmentBinding POLY INT := equation(I@S,seg1)
+ s2 : SegmentBinding POLY INT := equation(J@S,seg2)
+ as : FC := assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT)
+ clear : FC := forLoop(s1,forLoop(s2,as))
+ j:Integer
+ x:S := XC::S
+ pu:List(S) := []
+ -- Work out which variables appear in the expressions
+ for e in entries(u) repeat
+ pu := setUnion(pu,variables(e)$FEXPR)
+ scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer)
+ -- This should be the maximum XC_n which occurs (there may be others
+ -- which don't):
+ n:Integer := reduce(max,scriptList)$List(Integer)
+ p:List(S) := []
+ for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p)
+ p:= reverse(p)
+ jac:Matrix(FEXPR) := _
+ jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
+ c1:FC := localAssign2(FVECC,u)
+ c2:FC := localAssign1(FJACC,jac)
+ [clear,c1,c2,returns()]$List(FC)::$
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+@
+\section{domain ASP20 Asp20}
+<<domain ASP20 Asp20>>=
+)abbrev domain ASP20 Asp20
+++ Author: Mike Dewar and Godfrey Nolan and Grant Keady
+++ Date Created: Dec 1993
+++ Date Last Updated: 21 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp20} produces Fortran for Type 20 ASPs, for example:
+++\begin{verbatim}
+++ SUBROUTINE QPHESS(N,NROWH,NCOLH,JTHCOL,HESS,X,HX)
+++ DOUBLE PRECISION HX(N),X(N),HESS(NROWH,NCOLH)
+++ INTEGER JTHCOL,N,NROWH,NCOLH
+++ HX(1)=2.0D0*X(1)
+++ HX(2)=2.0D0*X(2)
+++ HX(3)=2.0D0*X(4)+2.0D0*X(3)
+++ HX(4)=2.0D0*X(4)+2.0D0*X(3)
+++ HX(5)=2.0D0*X(5)
+++ HX(6)=(-2.0D0*X(7))+(-2.0D0*X(6))
+++ HX(7)=(-2.0D0*X(7))+(-2.0D0*X(6))
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp20(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ PI ==> PositiveInteger
+ UFST ==> Union(fst:FST,void:"void")
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ MAT ==> Matrix
+ VF2 ==> VectorFunctions2
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression([],['X,'HESS],MFLOAT)
+ O ==> OutputForm
+ M2 ==> MatrixCategoryFunctions2
+ MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT,
+ MAT FRAC POLY INT,FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT,
+ MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT,
+ FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT,
+ MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT,
+ FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT,
+ MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+
+
+ Exports ==> FortranMatrixFunctionCategory with
+ coerce: MAT FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : UFST := ["real"::FST]$UFST
+ syms : SYMTAB := empty()
+ declare!(N,fortranInteger(),syms)$SYMTAB
+ declare!(NROWH,fortranInteger(),syms)$SYMTAB
+ declare!(NCOLH,fortranInteger(),syms)$SYMTAB
+ declare!(JTHCOL,fortranInteger(),syms)$SYMTAB
+ hessType : FT := construct(real,[NROWH,NCOLH],false)$FT
+ declare!(HESS,hessType,syms)$SYMTAB
+ xType : FT := construct(real,[N],false)$FT
+ declare!(X,xType,syms)$SYMTAB
+ declare!(HX,xType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,
+ [N,NROWH,NCOLH,JTHCOL,HESS,X,HX],syms)
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ -- To help the poor old compiler!
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ localAssign(s:Symbol,j:VEC FEXPR):FortranCode ==
+ j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
+ assign(s,j')$FortranCode
+
+ coerce(u:MAT FEXPR):$ ==
+ j:Integer
+ x:Symbol := X::Symbol
+ n := nrows(u)::PI
+ p:VEC FEXPR := [retract(subscript(x,[j::O])$Symbol)@FEXPR for j in 1..n]
+ prod:VEC FEXPR := u*p
+ ([localAssign(HX,prod),returns()$FortranCode]$List(FortranCode))::$
+
+ retract(u:MAT FRAC POLY INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2a
+ v::$
+
+ retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT FRAC POLY FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2b
+ v::$
+
+ retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT EXPR INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2e
+ v::$
+
+ retractIfCan(u:MAT EXPR INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT EXPR FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2f
+ v::$
+
+ retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT POLY INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2c
+ v::$
+
+ retractIfCan(u:MAT POLY INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT POLY FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2d
+ v::$
+
+ retractIfCan(u:MAT POLY FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ coerce(u:$):O == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP24 Asp24}
+<<domain ASP24 Asp24>>=
+)abbrev domain ASP24 Asp24
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 21 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp24} produces Fortran for Type 24 ASPs which evaluate a
+++multivariate function at a point (needed for NAG routine \axiomOpFrom{e04jaf}{e04Package}), for example:
+++\begin{verbatim}
+++ SUBROUTINE FUNCT1(N,XC,FC)
+++ DOUBLE PRECISION FC,XC(N)
+++ INTEGER N
+++ FC=10.0D0*XC(4)**4+(-40.0D0*XC(1)*XC(4)**3)+(60.0D0*XC(1)**2+5
+++ &.0D0)*XC(4)**2+((-10.0D0*XC(3))+(-40.0D0*XC(1)**3))*XC(4)+16.0D0*X
+++ &C(3)**4+(-32.0D0*XC(2)*XC(3)**3)+(24.0D0*XC(2)**2+5.0D0)*XC(3)**2+
+++ &(-8.0D0*XC(2)**3*XC(3))+XC(2)**4+100.0D0*XC(2)**2+20.0D0*XC(1)*XC(
+++ &2)+10.0D0*XC(1)**4+XC(1)**2
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp24(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FSTU ==> Union(fst:FST,void:"void")
+ FEXPR ==> FortranExpression([],['XC],MachineFloat)
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+
+ Exports ==> FortranFunctionCategory with
+ coerce : FEXPR -> $
+ ++ coerce(f) takes an object from the appropriate instantiation of
+ ++ \spadtype{FortranExpression} and turns it into an ASP.
+
+
+ Implementation ==> add
+
+
+ real : FSTU := ["real"::FST]$FSTU
+ syms : SYMTAB := empty()
+ declare!(N,fortranInteger(),syms)$SYMTAB
+ xcType : FT := construct(real,[N::Symbol],false)$FT
+ declare!(XC,xcType,syms)$SYMTAB
+ declare!(FC,fortranReal(),syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$FSTU,[N,XC,FC],syms)
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:FEXPR):$ ==
+ coerce(assign(FC,u::Expression(MachineFloat))$FortranCode)$Rep
+
+ retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:EXPR INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP27 Asp27}
+<<domain ASP27 Asp27>>=
+)abbrev domain ASP27 Asp27
+++ Author: Mike Dewar and Godfrey Nolan
+++ Date Created: Nov 1993
+++ Date Last Updated: 27 April 1994
+++ 6 October 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp27} produces Fortran for Type 27 ASPs, needed for NAG routine
+++\axiomOpFrom{f02fjf}{f02Package} ,for example:
+++\begin{verbatim}
+++ FUNCTION DOT(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK)
+++ DOUBLE PRECISION W(N),Z(N),RWORK(LRWORK)
+++ INTEGER N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK)
+++ DOT=(W(16)+(-0.5D0*W(15)))*Z(16)+((-0.5D0*W(16))+W(15)+(-0.5D0*W(1
+++ &4)))*Z(15)+((-0.5D0*W(15))+W(14)+(-0.5D0*W(13)))*Z(14)+((-0.5D0*W(
+++ &14))+W(13)+(-0.5D0*W(12)))*Z(13)+((-0.5D0*W(13))+W(12)+(-0.5D0*W(1
+++ &1)))*Z(12)+((-0.5D0*W(12))+W(11)+(-0.5D0*W(10)))*Z(11)+((-0.5D0*W(
+++ &11))+W(10)+(-0.5D0*W(9)))*Z(10)+((-0.5D0*W(10))+W(9)+(-0.5D0*W(8))
+++ &)*Z(9)+((-0.5D0*W(9))+W(8)+(-0.5D0*W(7)))*Z(8)+((-0.5D0*W(8))+W(7)
+++ &+(-0.5D0*W(6)))*Z(7)+((-0.5D0*W(7))+W(6)+(-0.5D0*W(5)))*Z(6)+((-0.
+++ &5D0*W(6))+W(5)+(-0.5D0*W(4)))*Z(5)+((-0.5D0*W(5))+W(4)+(-0.5D0*W(3
+++ &)))*Z(4)+((-0.5D0*W(4))+W(3)+(-0.5D0*W(2)))*Z(3)+((-0.5D0*W(3))+W(
+++ &2)+(-0.5D0*W(1)))*Z(2)+((-0.5D0*W(2))+W(1))*Z(1)
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp27(name): Exports == Implementation where
+ name : Symbol
+
+ O ==> OutputForm
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ UFST ==> Union(fst:FST,void:"void")
+ FC ==> FortranCode
+ PI ==> PositiveInteger
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ EXPR ==> Expression
+ MAT ==> Matrix
+ MFLOAT ==> MachineFloat
+
+
+
+ Exports == FortranMatrixCategory
+
+ Implementation == add
+
+
+ real : UFST := ["real"::FST]$UFST
+ integer : UFST := ["integer"::FST]$UFST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+ declare!(N,fortranInteger(),syms)$SYMTAB
+ declare!(LRWORK,fortranInteger(),syms)$SYMTAB
+ declare!(LIWORK,fortranInteger(),syms)$SYMTAB
+ zType : FT := construct(real,[N],false)$FT
+ declare!(Z,zType,syms)$SYMTAB
+ declare!(W,zType,syms)$SYMTAB
+ rType : FT := construct(real,[LRWORK],false)$FT
+ declare!(RWORK,rType,syms)$SYMTAB
+ iType : FT := construct(integer,[LIWORK],false)$FT
+ declare!(IWORK,iType,syms)$SYMTAB
+ Rep := FortranProgram(name,real,
+ [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms)
+
+ -- To help the poor old compiler!
+ localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT)
+
+ coerce (u:MAT MFLOAT):$ ==
+ Ws: Symbol := W
+ Zs: Symbol := Z
+ code : List FC
+ l:EXPR MFLOAT := "+"/ _
+ [("+"/[localCoerce(elt(Ws,[j::O])$Symbol) * u(j,i)_
+ for j in 1..nrows(u)::PI])_
+ *localCoerce(elt(Zs,[i::O])$Symbol) for i in 1..ncols(u)::PI]
+ c := assign(name,l)$FC
+ code := [c,returns()]$List(FC)
+ code::$
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP28 Asp28}
+<<domain ASP28 Asp28>>=
+)abbrev domain ASP28 Asp28
+++ Author: Mike Dewar
+++ Date Created: 21 March 1994
+++ Date Last Updated: 28 April 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp28} produces Fortran for Type 28 ASPs, used in NAG routine
+++\axiomOpFrom{f02fjf}{f02Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE IMAGE(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK)
+++ DOUBLE PRECISION Z(N),W(N),IWORK(LRWORK),RWORK(LRWORK)
+++ INTEGER N,LIWORK,IFLAG,LRWORK
+++ W(1)=0.01707454969713436D0*Z(16)+0.001747395874954051D0*Z(15)+0.00
+++ &2106973900813502D0*Z(14)+0.002957434991769087D0*Z(13)+(-0.00700554
+++ &0882865317D0*Z(12))+(-0.01219194009813166D0*Z(11))+0.0037230647365
+++ &3087D0*Z(10)+0.04932374658377151D0*Z(9)+(-0.03586220812223305D0*Z(
+++ &8))+(-0.04723268012114625D0*Z(7))+(-0.02434652144032987D0*Z(6))+0.
+++ &2264766947290192D0*Z(5)+(-0.1385343580686922D0*Z(4))+(-0.116530050
+++ &8238904D0*Z(3))+(-0.2803531651057233D0*Z(2))+1.019463911841327D0*Z
+++ &(1)
+++ W(2)=0.0227345011107737D0*Z(16)+0.008812321197398072D0*Z(15)+0.010
+++ &94012210519586D0*Z(14)+(-0.01764072463999744D0*Z(13))+(-0.01357136
+++ &72105995D0*Z(12))+0.00157466157362272D0*Z(11)+0.05258889186338282D
+++ &0*Z(10)+(-0.01981532388243379D0*Z(9))+(-0.06095390688679697D0*Z(8)
+++ &)+(-0.04153119955569051D0*Z(7))+0.2176561076571465D0*Z(6)+(-0.0532
+++ &5555586632358D0*Z(5))+(-0.1688977368984641D0*Z(4))+(-0.32440166056
+++ &67343D0*Z(3))+0.9128222941872173D0*Z(2)+(-0.2419652703415429D0*Z(1
+++ &))
+++ W(3)=0.03371198197190302D0*Z(16)+0.02021603150122265D0*Z(15)+(-0.0
+++ &06607305534689702D0*Z(14))+(-0.03032392238968179D0*Z(13))+0.002033
+++ &305231024948D0*Z(12)+0.05375944956767728D0*Z(11)+(-0.0163213312502
+++ &9967D0*Z(10))+(-0.05483186562035512D0*Z(9))+(-0.04901428822579872D
+++ &0*Z(8))+0.2091097927887612D0*Z(7)+(-0.05760560341383113D0*Z(6))+(-
+++ &0.1236679206156403D0*Z(5))+(-0.3523683853026259D0*Z(4))+0.88929961
+++ &32269974D0*Z(3)+(-0.2995429545781457D0*Z(2))+(-0.02986582812574917
+++ &D0*Z(1))
+++ W(4)=0.05141563713660119D0*Z(16)+0.005239165960779299D0*Z(15)+(-0.
+++ &01623427735779699D0*Z(14))+(-0.01965809746040371D0*Z(13))+0.054688
+++ &97337339577D0*Z(12)+(-0.014224695935687D0*Z(11))+(-0.0505181779315
+++ &6355D0*Z(10))+(-0.04353074206076491D0*Z(9))+0.2012230497530726D0*Z
+++ &(8)+(-0.06630874514535952D0*Z(7))+(-0.1280829963720053D0*Z(6))+(-0
+++ &.305169742604165D0*Z(5))+0.8600427128450191D0*Z(4)+(-0.32415033802
+++ &68184D0*Z(3))+(-0.09033531980693314D0*Z(2))+0.09089205517109111D0*
+++ &Z(1)
+++ W(5)=0.04556369767776375D0*Z(16)+(-0.001822737697581869D0*Z(15))+(
+++ &-0.002512226501941856D0*Z(14))+0.02947046460707379D0*Z(13)+(-0.014
+++ &45079632086177D0*Z(12))+(-0.05034242196614937D0*Z(11))+(-0.0376966
+++ &3291725935D0*Z(10))+0.2171103102175198D0*Z(9)+(-0.0824949256021352
+++ &4D0*Z(8))+(-0.1473995209288945D0*Z(7))+(-0.315042193418466D0*Z(6))
+++ &+0.9591623347824002D0*Z(5)+(-0.3852396953763045D0*Z(4))+(-0.141718
+++ &5427288274D0*Z(3))+(-0.03423495461011043D0*Z(2))+0.319820917706851
+++ &6D0*Z(1)
+++ W(6)=0.04015147277405744D0*Z(16)+0.01328585741341559D0*Z(15)+0.048
+++ &26082005465965D0*Z(14)+(-0.04319641116207706D0*Z(13))+(-0.04931323
+++ &319055762D0*Z(12))+(-0.03526886317505474D0*Z(11))+0.22295383396730
+++ &01D0*Z(10)+(-0.07375317649315155D0*Z(9))+(-0.1589391311991561D0*Z(
+++ &8))+(-0.328001910890377D0*Z(7))+0.952576555482747D0*Z(6)+(-0.31583
+++ &09975786731D0*Z(5))+(-0.1846882042225383D0*Z(4))+(-0.0703762046700
+++ &4427D0*Z(3))+0.2311852964327382D0*Z(2)+0.04254083491825025D0*Z(1)
+++ W(7)=0.06069778964023718D0*Z(16)+0.06681263884671322D0*Z(15)+(-0.0
+++ &2113506688615768D0*Z(14))+(-0.083996867458326D0*Z(13))+(-0.0329843
+++ &8523869648D0*Z(12))+0.2276878326327734D0*Z(11)+(-0.067356038933017
+++ &95D0*Z(10))+(-0.1559813965382218D0*Z(9))+(-0.3363262957694705D0*Z(
+++ &8))+0.9442791158560948D0*Z(7)+(-0.3199955249404657D0*Z(6))+(-0.136
+++ &2463839920727D0*Z(5))+(-0.1006185171570586D0*Z(4))+0.2057504515015
+++ &423D0*Z(3)+(-0.02065879269286707D0*Z(2))+0.03160990266745513D0*Z(1
+++ &)
+++ W(8)=0.126386868896738D0*Z(16)+0.002563370039476418D0*Z(15)+(-0.05
+++ &581757739455641D0*Z(14))+(-0.07777893205900685D0*Z(13))+0.23117338
+++ &45834199D0*Z(12)+(-0.06031581134427592D0*Z(11))+(-0.14805474755869
+++ &52D0*Z(10))+(-0.3364014128402243D0*Z(9))+0.9364014128402244D0*Z(8)
+++ &+(-0.3269452524413048D0*Z(7))+(-0.1396841886557241D0*Z(6))+(-0.056
+++ &1733845834199D0*Z(5))+0.1777789320590069D0*Z(4)+(-0.04418242260544
+++ &359D0*Z(3))+(-0.02756337003947642D0*Z(2))+0.07361313110326199D0*Z(
+++ &1)
+++ W(9)=0.07361313110326199D0*Z(16)+(-0.02756337003947642D0*Z(15))+(-
+++ &0.04418242260544359D0*Z(14))+0.1777789320590069D0*Z(13)+(-0.056173
+++ &3845834199D0*Z(12))+(-0.1396841886557241D0*Z(11))+(-0.326945252441
+++ &3048D0*Z(10))+0.9364014128402244D0*Z(9)+(-0.3364014128402243D0*Z(8
+++ &))+(-0.1480547475586952D0*Z(7))+(-0.06031581134427592D0*Z(6))+0.23
+++ &11733845834199D0*Z(5)+(-0.07777893205900685D0*Z(4))+(-0.0558175773
+++ &9455641D0*Z(3))+0.002563370039476418D0*Z(2)+0.126386868896738D0*Z(
+++ &1)
+++ W(10)=0.03160990266745513D0*Z(16)+(-0.02065879269286707D0*Z(15))+0
+++ &.2057504515015423D0*Z(14)+(-0.1006185171570586D0*Z(13))+(-0.136246
+++ &3839920727D0*Z(12))+(-0.3199955249404657D0*Z(11))+0.94427911585609
+++ &48D0*Z(10)+(-0.3363262957694705D0*Z(9))+(-0.1559813965382218D0*Z(8
+++ &))+(-0.06735603893301795D0*Z(7))+0.2276878326327734D0*Z(6)+(-0.032
+++ &98438523869648D0*Z(5))+(-0.083996867458326D0*Z(4))+(-0.02113506688
+++ &615768D0*Z(3))+0.06681263884671322D0*Z(2)+0.06069778964023718D0*Z(
+++ &1)
+++ W(11)=0.04254083491825025D0*Z(16)+0.2311852964327382D0*Z(15)+(-0.0
+++ &7037620467004427D0*Z(14))+(-0.1846882042225383D0*Z(13))+(-0.315830
+++ &9975786731D0*Z(12))+0.952576555482747D0*Z(11)+(-0.328001910890377D
+++ &0*Z(10))+(-0.1589391311991561D0*Z(9))+(-0.07375317649315155D0*Z(8)
+++ &)+0.2229538339673001D0*Z(7)+(-0.03526886317505474D0*Z(6))+(-0.0493
+++ &1323319055762D0*Z(5))+(-0.04319641116207706D0*Z(4))+0.048260820054
+++ &65965D0*Z(3)+0.01328585741341559D0*Z(2)+0.04015147277405744D0*Z(1)
+++ W(12)=0.3198209177068516D0*Z(16)+(-0.03423495461011043D0*Z(15))+(-
+++ &0.1417185427288274D0*Z(14))+(-0.3852396953763045D0*Z(13))+0.959162
+++ &3347824002D0*Z(12)+(-0.315042193418466D0*Z(11))+(-0.14739952092889
+++ &45D0*Z(10))+(-0.08249492560213524D0*Z(9))+0.2171103102175198D0*Z(8
+++ &)+(-0.03769663291725935D0*Z(7))+(-0.05034242196614937D0*Z(6))+(-0.
+++ &01445079632086177D0*Z(5))+0.02947046460707379D0*Z(4)+(-0.002512226
+++ &501941856D0*Z(3))+(-0.001822737697581869D0*Z(2))+0.045563697677763
+++ &75D0*Z(1)
+++ W(13)=0.09089205517109111D0*Z(16)+(-0.09033531980693314D0*Z(15))+(
+++ &-0.3241503380268184D0*Z(14))+0.8600427128450191D0*Z(13)+(-0.305169
+++ &742604165D0*Z(12))+(-0.1280829963720053D0*Z(11))+(-0.0663087451453
+++ &5952D0*Z(10))+0.2012230497530726D0*Z(9)+(-0.04353074206076491D0*Z(
+++ &8))+(-0.05051817793156355D0*Z(7))+(-0.014224695935687D0*Z(6))+0.05
+++ &468897337339577D0*Z(5)+(-0.01965809746040371D0*Z(4))+(-0.016234277
+++ &35779699D0*Z(3))+0.005239165960779299D0*Z(2)+0.05141563713660119D0
+++ &*Z(1)
+++ W(14)=(-0.02986582812574917D0*Z(16))+(-0.2995429545781457D0*Z(15))
+++ &+0.8892996132269974D0*Z(14)+(-0.3523683853026259D0*Z(13))+(-0.1236
+++ &679206156403D0*Z(12))+(-0.05760560341383113D0*Z(11))+0.20910979278
+++ &87612D0*Z(10)+(-0.04901428822579872D0*Z(9))+(-0.05483186562035512D
+++ &0*Z(8))+(-0.01632133125029967D0*Z(7))+0.05375944956767728D0*Z(6)+0
+++ &.002033305231024948D0*Z(5)+(-0.03032392238968179D0*Z(4))+(-0.00660
+++ &7305534689702D0*Z(3))+0.02021603150122265D0*Z(2)+0.033711981971903
+++ &02D0*Z(1)
+++ W(15)=(-0.2419652703415429D0*Z(16))+0.9128222941872173D0*Z(15)+(-0
+++ &.3244016605667343D0*Z(14))+(-0.1688977368984641D0*Z(13))+(-0.05325
+++ &555586632358D0*Z(12))+0.2176561076571465D0*Z(11)+(-0.0415311995556
+++ &9051D0*Z(10))+(-0.06095390688679697D0*Z(9))+(-0.01981532388243379D
+++ &0*Z(8))+0.05258889186338282D0*Z(7)+0.00157466157362272D0*Z(6)+(-0.
+++ &0135713672105995D0*Z(5))+(-0.01764072463999744D0*Z(4))+0.010940122
+++ &10519586D0*Z(3)+0.008812321197398072D0*Z(2)+0.0227345011107737D0*Z
+++ &(1)
+++ W(16)=1.019463911841327D0*Z(16)+(-0.2803531651057233D0*Z(15))+(-0.
+++ &1165300508238904D0*Z(14))+(-0.1385343580686922D0*Z(13))+0.22647669
+++ &47290192D0*Z(12)+(-0.02434652144032987D0*Z(11))+(-0.04723268012114
+++ &625D0*Z(10))+(-0.03586220812223305D0*Z(9))+0.04932374658377151D0*Z
+++ &(8)+0.00372306473653087D0*Z(7)+(-0.01219194009813166D0*Z(6))+(-0.0
+++ &07005540882865317D0*Z(5))+0.002957434991769087D0*Z(4)+0.0021069739
+++ &00813502D0*Z(3)+0.001747395874954051D0*Z(2)+0.01707454969713436D0*
+++ &Z(1)
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp28(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ FC ==> FortranCode
+ PI ==> PositiveInteger
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ EXPR ==> Expression
+ MFLOAT ==> MachineFloat
+ VEC ==> Vector
+ UFST ==> Union(fst:FST,void:"void")
+ MAT ==> Matrix
+
+ Exports == FortranMatrixCategory
+
+ Implementation == add
+
+
+ real : UFST := ["real"::FST]$UFST
+ syms : SYMTAB := empty()
+ declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+ declare!(N,fortranInteger(),syms)$SYMTAB
+ declare!(LRWORK,fortranInteger(),syms)$SYMTAB
+ declare!(LIWORK,fortranInteger(),syms)$SYMTAB
+ xType : FT := construct(real,[N],false)$FT
+ declare!(Z,xType,syms)$SYMTAB
+ declare!(W,xType,syms)$SYMTAB
+ rType : FT := construct(real,[LRWORK],false)$FT
+ declare!(RWORK,rType,syms)$SYMTAB
+ iType : FT := construct(real,[LIWORK],false)$FT
+ declare!(IWORK,rType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,
+ [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms)
+
+ -- To help the poor old compiler!
+ localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT)
+
+ coerce (u:MAT MFLOAT):$ ==
+ Zs: Symbol := Z
+ code : List FC
+ r: List EXPR MFLOAT
+ r := ["+"/[u(j,i)*localCoerce(elt(Zs,[i::OutputForm])$Symbol)_
+ for i in 1..ncols(u)$MAT(MFLOAT)::PI]_
+ for j in 1..nrows(u)$MAT(MFLOAT)::PI]
+ code := [assign(W@Symbol,vector(r)$VEC(EXPR MFLOAT)),returns()]$List(FC)
+ code::$
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP29 Asp29}
+<<domain ASP29 Asp29>>=
+)abbrev domain ASP29 Asp29
+++ Author: Mike Dewar and Godfrey Nolan
+++ Date Created: Nov 1993
+++ Date Last Updated: 18 March 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp29} produces Fortran for Type 29 ASPs, needed for NAG routine
+++\axiomOpFrom{f02fjf}{f02Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE MONIT(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)
+++ DOUBLE PRECISION D(K),F(K)
+++ INTEGER K,NEXTIT,NEVALS,NVECS,ISTATE
+++ CALL F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp29(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ FSTU ==> Union(fst:FST,void:"void")
+ SYMTAB ==> SymbolTable
+ FC ==> FortranCode
+ PI ==> PositiveInteger
+ EXF ==> Expression Float
+ EXI ==> Expression Integer
+ VEF ==> Vector Expression Float
+ VEI ==> Vector Expression Integer
+ MEI ==> Matrix Expression Integer
+ MEF ==> Matrix Expression Float
+ UEXPR ==> Union(I: Expression Integer,F: Expression Float,_
+ CF: Expression Complex Float)
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+
+ Exports == FortranProgramCategory with
+ outputAsFortran:() -> Void
+ ++outputAsFortran() generates the default code for \spadtype{ASP29}.
+
+
+ Implementation == add
+
+ import FST
+ import FT
+ import FC
+ import SYMTAB
+
+ real : FSTU := ["real"::FST]$FSTU
+ integer : FSTU := ["integer"::FST]$FSTU
+ syms : SYMTAB := empty()
+ declare!(ISTATE,fortranInteger(),syms)
+ declare!(NEXTIT,fortranInteger(),syms)
+ declare!(NEVALS,fortranInteger(),syms)
+ declare!(NVECS,fortranInteger(),syms)
+ declare!(K,fortranInteger(),syms)
+ kType : FT := construct(real,[K],false)$FT
+ declare!(F,kType,syms)
+ declare!(D,kType,syms)
+ Rep := FortranProgram(name,["void"]$FSTU,
+ [ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D],syms)
+
+
+ outputAsFortran():Void ==
+ callOne := call("F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)")
+ code : List FC := [callOne,returns()]$List(FC)
+ outputAsFortran(coerce(code)@Rep)$Rep
+
+@
+\section{domain ASP30 Asp30}
+<<domain ASP30 Asp30>>=
+)abbrev domain ASP30 Asp30
+++ Author: Mike Dewar and Godfrey Nolan
+++ Date Created: Nov 1993
+++ Date Last Updated: 28 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp30} produces Fortran for Type 30 ASPs, needed for NAG routine
+++\axiomOpFrom{f04qaf}{f04Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE APROD(MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK)
+++ DOUBLE PRECISION X(N),Y(M),RWORK(LRWORK)
+++ INTEGER M,N,LIWORK,IFAIL,LRWORK,IWORK(LIWORK),MODE
+++ DOUBLE PRECISION A(5,5)
+++ EXTERNAL F06PAF
+++ A(1,1)=1.0D0
+++ A(1,2)=0.0D0
+++ A(1,3)=0.0D0
+++ A(1,4)=-1.0D0
+++ A(1,5)=0.0D0
+++ A(2,1)=0.0D0
+++ A(2,2)=1.0D0
+++ A(2,3)=0.0D0
+++ A(2,4)=0.0D0
+++ A(2,5)=-1.0D0
+++ A(3,1)=0.0D0
+++ A(3,2)=0.0D0
+++ A(3,3)=1.0D0
+++ A(3,4)=-1.0D0
+++ A(3,5)=0.0D0
+++ A(4,1)=-1.0D0
+++ A(4,2)=0.0D0
+++ A(4,3)=-1.0D0
+++ A(4,4)=4.0D0
+++ A(4,5)=-1.0D0
+++ A(5,1)=0.0D0
+++ A(5,2)=-1.0D0
+++ A(5,3)=0.0D0
+++ A(5,4)=-1.0D0
+++ A(5,5)=4.0D0
+++ IF(MODE.EQ.1)THEN
+++ CALL F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)
+++ ELSEIF(MODE.EQ.2)THEN
+++ CALL F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)
+++ ENDIF
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp30(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ FC ==> FortranCode
+ PI ==> PositiveInteger
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ UFST ==> Union(fst:FST,void:"void")
+ MAT ==> Matrix
+ MFLOAT ==> MachineFloat
+ EXI ==> Expression Integer
+ UEXPR ==> Union(I:Expression Integer,F:Expression Float,_
+ CF:Expression Complex Float,switch:Switch)
+ S ==> Symbol
+
+ Exports == FortranMatrixCategory
+
+ Implementation == add
+
+ import FC
+ import FT
+ import Switch
+
+ real : UFST := ["real"::FST]$UFST
+ integer : UFST := ["integer"::FST]$UFST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(MODE,fortranInteger()$FT,syms)$SYMTAB
+ declare!(M,fortranInteger()$FT,syms)$SYMTAB
+ declare!(N,fortranInteger()$FT,syms)$SYMTAB
+ declare!(LRWORK,fortranInteger()$FT,syms)$SYMTAB
+ declare!(LIWORK,fortranInteger()$FT,syms)$SYMTAB
+ xType : FT := construct(real,[N],false)$FT
+ declare!(X,xType,syms)$SYMTAB
+ yType : FT := construct(real,[M],false)$FT
+ declare!(Y,yType,syms)$SYMTAB
+ rType : FT := construct(real,[LRWORK],false)$FT
+ declare!(RWORK,rType,syms)$SYMTAB
+ iType : FT := construct(integer,[LIWORK],false)$FT
+ declare!(IWORK,iType,syms)$SYMTAB
+ declare!(IFAIL,fortranInteger()$FT,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,
+ [MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms)
+
+ coerce(a:MAT MFLOAT):$ ==
+ locals : SYMTAB := empty()
+ numRows := nrows(a) :: Polynomial Integer
+ numCols := ncols(a) :: Polynomial Integer
+ declare!(A,[real,[numRows,numCols],false]$FT,locals)
+ declare!(F06PAF@S,construct(["void"]$UFST,[]@List(S),true)$FT,locals)
+ ptA:UEXPR := [("MODE"::S)::EXI]
+ ptB:UEXPR := [1::EXI]
+ ptC:UEXPR := [2::EXI]
+ sw1 : Switch := EQ(ptA,ptB)$Switch
+ sw2 : Switch := EQ(ptA,ptC)$Switch
+ callOne := call("F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)")
+ callTwo := call("F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)")
+ c : FC := cond(sw1,callOne,cond(sw2,callTwo))
+ code : List FC := [assign(A,a),c,returns()]
+ ([locals,code]$RSFC)::$
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP31 Asp31}
+<<domain ASP31 Asp31>>=
+)abbrev domain ASP31 Asp31
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 22 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp31} produces Fortran for Type 31 ASPs, needed for NAG routine
+++\axiomOpFrom{d02ejf}{d02Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE PEDERV(X,Y,PW)
+++ DOUBLE PRECISION X,Y(*)
+++ DOUBLE PRECISION PW(3,3)
+++ PW(1,1)=-0.03999999999999999D0
+++ PW(1,2)=10000.0D0*Y(3)
+++ PW(1,3)=10000.0D0*Y(2)
+++ PW(2,1)=0.03999999999999999D0
+++ PW(2,2)=(-10000.0D0*Y(3))+(-60000000.0D0*Y(2))
+++ PW(2,3)=-10000.0D0*Y(2)
+++ PW(3,1)=0.0D0
+++ PW(3,2)=60000000.0D0*Y(2)
+++ PW(3,3)=0.0D0
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp31(name): Exports == Implementation where
+ name : Symbol
+
+ O ==> OutputForm
+ FST ==> FortranScalarType
+ UFST ==> Union(fst:FST,void:"void")
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression(['X],['Y],MFLOAT)
+ FT ==> FortranType
+ FC ==> FortranCode
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ MAT ==> Matrix
+ VF2 ==> VectorFunctions2
+ MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR,
+ EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT)
+
+
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : VEC FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+
+ real : UFST := ["real"::FST]$UFST
+ syms : SYMTAB := empty()
+ declare!(X,fortranReal(),syms)$SYMTAB
+ yType : FT := construct(real,["*"::Symbol],false)$FT
+ declare!(Y,yType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,[X,Y,PW],syms)
+
+ -- To help the poor old compiler!
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ localAssign(s:Symbol,j:MAT FEXPR):FC ==
+ j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2
+ assign(s,j')$FC
+
+ makeXList(n:Integer):List(Symbol) ==
+ j:Integer
+ y:Symbol := Y::Symbol
+ p:List(Symbol) := []
+ for j in 1 .. n repeat p:= cons(subscript(y,[j::OutputForm])$Symbol,p)
+ p:= reverse(p)
+
+ coerce(u:VEC FEXPR):$ ==
+ dimension := #u::Polynomial Integer
+ locals : SYMTAB := empty()
+ declare!(PW,[real,[dimension,dimension],false]$FT,locals)$SYMTAB
+ n:Integer := maxIndex(u)$VEC(FEXPR)
+ p:List(Symbol) := makeXList(n)
+ jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_
+ Symbol,FEXPR ,VEC FEXPR,List(Symbol))
+ code : List FC := [localAssign(PW,jac),returns()$FC]$List(FC)
+ ([locals,code]$RSFC)::$
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ coerce(c:List FC):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FC):$ == coerce(c)$Rep
+
+ coerce(u:$):O == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP33 Asp33}
+<<domain ASP33 Asp33>>=
+)abbrev domain ASP33 Asp33
+++ Author: Mike Dewar and Godfrey Nolan
+++ Date Created: Nov 1993
+++ Date Last Updated: 30 March 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory.
+++ Description:
+++\spadtype{Asp33} produces Fortran for Type 33 ASPs, needed for NAG routine
+++\axiomOpFrom{d02kef}{d02Package}. The code is a dummy ASP:
+++\begin{verbatim}
+++ SUBROUTINE REPORT(X,V,JINT)
+++ DOUBLE PRECISION V(3),X
+++ INTEGER JINT
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp33(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ UFST ==> Union(fst:FST,void:"void")
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ FC ==> FortranCode
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+
+ Exports ==> FortranProgramCategory with
+ outputAsFortran:() -> Void
+ ++outputAsFortran() generates the default code for \spadtype{ASP33}.
+
+
+ Implementation ==> add
+
+ real : UFST := ["real"::FST]$UFST
+ syms : SYMTAB := empty()
+ declare!(JINT,fortranInteger(),syms)$SYMTAB
+ declare!(X,fortranReal(),syms)$SYMTAB
+ vType : FT := construct(real,["3"::Symbol],false)$FT
+ declare!(V,vType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,[X,V,JINT],syms)
+
+ outputAsFortran():Void ==
+ outputAsFortran( (returns()$FortranCode)::Rep )$Rep
+
+ outputAsFortran(u):Void == outputAsFortran(u)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+@
+\section{domain ASP34 Asp34}
+<<domain ASP34 Asp34>>=
+)abbrev domain ASP34 Asp34
+++ Author: Mike Dewar and Godfrey Nolan
+++ Date Created: Nov 1993
+++ Date Last Updated: 14 June 1994 (Themos Tsikas)
+++ 6 October 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp34} produces Fortran for Type 34 ASPs, needed for NAG routine
+++\axiomOpFrom{f04mbf}{f04Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE MSOLVE(IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK)
+++ DOUBLE PRECISION RWORK(LRWORK),X(N),Y(N)
+++ INTEGER I,J,N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK)
+++ DOUBLE PRECISION W1(3),W2(3),MS(3,3)
+++ IFLAG=-1
+++ MS(1,1)=2.0D0
+++ MS(1,2)=1.0D0
+++ MS(1,3)=0.0D0
+++ MS(2,1)=1.0D0
+++ MS(2,2)=2.0D0
+++ MS(2,3)=1.0D0
+++ MS(3,1)=0.0D0
+++ MS(3,2)=1.0D0
+++ MS(3,3)=2.0D0
+++ CALL F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)
+++ IFLAG=-IFLAG
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp34(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ UFST ==> Union(fst:FST,void:"void")
+ SYMTAB ==> SymbolTable
+ FC ==> FortranCode
+ PI ==> PositiveInteger
+ EXI ==> Expression Integer
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+
+ Exports == FortranMatrixCategory
+
+ Implementation == add
+
+ real : UFST := ["real"::FST]$UFST
+ integer : UFST := ["integer"::FST]$UFST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+ declare!(N,fortranInteger(),syms)$SYMTAB
+ xType : FT := construct(real,[N],false)$FT
+ declare!(X,xType,syms)$SYMTAB
+ declare!(Y,xType,syms)$SYMTAB
+ declare!(LRWORK,fortranInteger(),syms)$SYMTAB
+ declare!(LIWORK,fortranInteger(),syms)$SYMTAB
+ rType : FT := construct(real,[LRWORK],false)$FT
+ declare!(RWORK,rType,syms)$SYMTAB
+ iType : FT := construct(integer,[LIWORK],false)$FT
+ declare!(IWORK,iType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,
+ [IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms)
+
+ -- To help the poor old compiler
+ localAssign(s:Symbol,u:EXI):FC == assign(s,u)$FC
+
+ coerce(u:Matrix MachineFloat):$ ==
+ dimension := nrows(u) ::Polynomial Integer
+ locals : SYMTAB := empty()$SYMTAB
+ declare!(I,fortranInteger(),syms)$SYMTAB
+ declare!(J,fortranInteger(),syms)$SYMTAB
+ declare!(W1,[real,[dimension],false]$FT,locals)$SYMTAB
+ declare!(W2,[real,[dimension],false]$FT,locals)$SYMTAB
+ declare!(MS,[real,[dimension,dimension],false]$FT,locals)$SYMTAB
+ assign1 : FC := localAssign(IFLAG@Symbol,(-1)@EXI)
+ call : FC := call("F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)")$FC
+ assign2 : FC := localAssign(IFLAG::Symbol,-(IFLAG@Symbol::EXI))
+ assign3 : FC := assign(MS,u)$FC
+ code : List FC := [assign1,assign3,call,assign2,returns()]$List(FC)
+ ([locals,code]$RSFC)::$
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP35 Asp35}
+<<domain ASP35 Asp35>>=
+)abbrev domain ASP35 Asp35
+++ Author: Mike Dewar, Godfrey Nolan, Grant Keady
+++ Date Created: Mar 1993
+++ Date Last Updated: 22 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp35} produces Fortran for Type 35 ASPs, needed for NAG routines
+++\axiomOpFrom{c05pbf}{c05Package}, \axiomOpFrom{c05pcf}{c05Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE FCN(N,X,FVEC,FJAC,LDFJAC,IFLAG)
+++ DOUBLE PRECISION X(N),FVEC(N),FJAC(LDFJAC,N)
+++ INTEGER LDFJAC,N,IFLAG
+++ IF(IFLAG.EQ.1)THEN
+++ FVEC(1)=(-1.0D0*X(2))+X(1)
+++ FVEC(2)=(-1.0D0*X(3))+2.0D0*X(2)
+++ FVEC(3)=3.0D0*X(3)
+++ ELSEIF(IFLAG.EQ.2)THEN
+++ FJAC(1,1)=1.0D0
+++ FJAC(1,2)=-1.0D0
+++ FJAC(1,3)=0.0D0
+++ FJAC(2,1)=0.0D0
+++ FJAC(2,2)=2.0D0
+++ FJAC(2,3)=-1.0D0
+++ FJAC(3,1)=0.0D0
+++ FJAC(3,2)=0.0D0
+++ FJAC(3,3)=3.0D0
+++ ENDIF
+++ END
+++\end{verbatim}
+
+Asp35(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ UFST ==> Union(fst:FST,void:"void")
+ SYMTAB ==> SymbolTable
+ FC ==> FortranCode
+ PI ==> PositiveInteger
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ MAT ==> Matrix
+ VF2 ==> VectorFunctions2
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression([],['X],MFLOAT)
+ MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR,
+ EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT)
+ SWU ==> Union(I:Expression Integer,F:Expression Float,
+ CF:Expression Complex Float,switch:Switch)
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : VEC FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : UFST := ["real"::FST]$UFST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(N,fortranInteger(),syms)$SYMTAB
+ xType : FT := construct(real,[N],false)$FT
+ declare!(X,xType,syms)$SYMTAB
+ declare!(FVEC,xType,syms)$SYMTAB
+ declare!(LDFJAC,fortranInteger(),syms)$SYMTAB
+ jType : FT := construct(real,[LDFJAC,N],false)$FT
+ declare!(FJAC,jType,syms)$SYMTAB
+ declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,[N,X,FVEC,FJAC,LDFJAC,IFLAG],syms)
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ makeXList(n:Integer):List(Symbol) ==
+ x:Symbol := X::Symbol
+ [subscript(x,[j::OutputForm])$Symbol for j in 1..n]
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ localAssign1(s:Symbol,j:MAT FEXPR):FC ==
+ j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2
+ assign(s,j')$FC
+
+ localAssign2(s:Symbol,j:VEC FEXPR):FC ==
+ j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
+ assign(s,j')$FC
+
+ coerce(u:VEC FEXPR):$ ==
+ n:Integer := maxIndex(u)
+ p:List(Symbol) := makeXList(n)
+ jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_
+ Symbol,FEXPR,VEC FEXPR,List(Symbol))
+ assf:FC := localAssign2(FVEC,u)
+ assj:FC := localAssign1(FJAC,jac)
+ iflag:SWU := [IFLAG@Symbol::EXPR(INT)]$SWU
+ sw1:Switch := EQ(iflag,[1::EXPR(INT)]$SWU)
+ sw2:Switch := EQ(iflag,[2::EXPR(INT)]$SWU)
+ cond(sw1,assf,cond(sw2,assj)$FC)$FC::$
+
+ coerce(c:List FC):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FC):$ == coerce(c)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+@
+\section{domain ASP4 Asp4}
+<<domain ASP4 Asp4>>=
+)abbrev domain ASP4 Asp4
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 18 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp4} produces Fortran for Type 4 ASPs, which take an expression
+++in X(1) .. X(NDIM) and produce a real function of the form:
+++\begin{verbatim}
+++ DOUBLE PRECISION FUNCTION FUNCTN(NDIM,X)
+++ DOUBLE PRECISION X(NDIM)
+++ INTEGER NDIM
+++ FUNCTN=(4.0D0*X(1)*X(3)**2*DEXP(2.0D0*X(1)*X(3)))/(X(4)**2+(2.0D0*
+++ &X(2)+2.0D0)*X(4)+X(2)**2+2.0D0*X(2)+1.0D0)
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp4(name): Exports == Implementation where
+ name : Symbol
+
+ FEXPR ==> FortranExpression([],['X],MachineFloat)
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FSTU ==> Union(fst:FST,void:"void")
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+
+ Exports ==> FortranFunctionCategory with
+ coerce : FEXPR -> $
+ ++coerce(f) takes an object from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns it into an ASP.
+
+ Implementation ==> add
+
+ real : FSTU := ["real"::FST]$FSTU
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(NDIM,fortranInteger(),syms)$SYMTAB
+ xType : FT := construct(real,[NDIM],false)$FT
+ declare!(X,xType,syms)$SYMTAB
+ Rep := FortranProgram(name,real,[NDIM,X],syms)
+
+ retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ foo::FEXPR::$
+
+ retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ foo::FEXPR::$
+
+ retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ foo::FEXPR::$
+
+ retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:EXPR INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ foo::FEXPR::$
+
+ retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ foo::FEXPR::$
+
+ retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ foo::FEXPR::$
+
+ coerce(u:FEXPR):$ ==
+ coerce((u::Expression(MachineFloat))$FEXPR)$Rep
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP41 Asp41}
+<<domain ASP41 Asp41>>=
+)abbrev domain ASP41 Asp41
+++ Author: Mike Dewar, Godfrey Nolan
+++ Date Created:
+++ Date Last Updated: 29 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranFunctionCategory, FortranProgramCategory.
+++ Description:
+++\spadtype{Asp41} produces Fortran for Type 41 ASPs, needed for NAG
+++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package}
+++in particular. These ASPs are in fact
+++three Fortran routines which return a vector of functions, and their
+++derivatives wrt Y(i) and also a continuation parameter EPS, for example:
+++\begin{verbatim}
+++ SUBROUTINE FCN(X,EPS,Y,F,N)
+++ DOUBLE PRECISION EPS,F(N),X,Y(N)
+++ INTEGER N
+++ F(1)=Y(2)
+++ F(2)=Y(3)
+++ F(3)=(-1.0D0*Y(1)*Y(3))+2.0D0*EPS*Y(2)**2+(-2.0D0*EPS)
+++ RETURN
+++ END
+++ SUBROUTINE JACOBF(X,EPS,Y,F,N)
+++ DOUBLE PRECISION EPS,F(N,N),X,Y(N)
+++ INTEGER N
+++ F(1,1)=0.0D0
+++ F(1,2)=1.0D0
+++ F(1,3)=0.0D0
+++ F(2,1)=0.0D0
+++ F(2,2)=0.0D0
+++ F(2,3)=1.0D0
+++ F(3,1)=-1.0D0*Y(3)
+++ F(3,2)=4.0D0*EPS*Y(2)
+++ F(3,3)=-1.0D0*Y(1)
+++ RETURN
+++ END
+++ SUBROUTINE JACEPS(X,EPS,Y,F,N)
+++ DOUBLE PRECISION EPS,F(N),X,Y(N)
+++ INTEGER N
+++ F(1)=0.0D0
+++ F(2)=0.0D0
+++ F(3)=2.0D0*Y(2)**2-2.0D0
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp41(nameOne,nameTwo,nameThree): Exports == Implementation where
+ nameOne : Symbol
+ nameTwo : Symbol
+ nameThree : Symbol
+
+ D ==> differentiate
+ FST ==> FortranScalarType
+ UFST ==> Union(fst:FST,void:"void")
+ FT ==> FortranType
+ FC ==> FortranCode
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression(['X,'EPS],['Y],MFLOAT)
+ S ==> Symbol
+ MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,
+ EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT)
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : VEC FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+ real : UFST := ["real"::FST]$UFST
+
+ symOne : SYMTAB := empty()$SYMTAB
+ declare!(N,fortranInteger(),symOne)$SYMTAB
+ declare!(X,fortranReal(),symOne)$SYMTAB
+ declare!(EPS,fortranReal(),symOne)$SYMTAB
+ yType : FT := construct(real,[N],false)$FT
+ declare!(Y,yType,symOne)$SYMTAB
+ declare!(F,yType,symOne)$SYMTAB
+
+ symTwo : SYMTAB := empty()$SYMTAB
+ declare!(N,fortranInteger(),symTwo)$SYMTAB
+ declare!(X,fortranReal(),symTwo)$SYMTAB
+ declare!(EPS,fortranReal(),symTwo)$SYMTAB
+ declare!(Y,yType,symTwo)$SYMTAB
+ fType : FT := construct(real,[N,N],false)$FT
+ declare!(F,fType,symTwo)$SYMTAB
+
+ symThree : SYMTAB := empty()$SYMTAB
+ declare!(N,fortranInteger(),symThree)$SYMTAB
+ declare!(X,fortranReal(),symThree)$SYMTAB
+ declare!(EPS,fortranReal(),symThree)$SYMTAB
+ declare!(Y,yType,symThree)$SYMTAB
+ declare!(F,yType,symThree)$SYMTAB
+
+ R1:=FortranProgram(nameOne,["void"]$UFST,[X,EPS,Y,F,N],symOne)
+ R2:=FortranProgram(nameTwo,["void"]$UFST,[X,EPS,Y,F,N],symTwo)
+ R3:=FortranProgram(nameThree,["void"]$UFST,[X,EPS,Y,F,N],symThree)
+ Rep := Record(f:R1,fJacob:R2,eJacob:R3)
+ Fsym:Symbol:=coerce "F"
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ localAssign1(s:S,j:Matrix FEXPR):FC ==
+ j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2
+ assign(s,j')$FC
+
+ localAssign2(s:S,j:VEC FEXPR):FC ==
+ j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
+ assign(s,j')$FC
+
+ makeCodeOne(u:VEC FEXPR):FortranCode ==
+ -- simple assign
+ localAssign2(Fsym,u)
+
+ makeCodeThree(u:VEC FEXPR):FortranCode ==
+ -- compute jacobian wrt to eps
+ jacEps:VEC FEXPR := [D(v,EPS) for v in entries(u)]$VEC(FEXPR)
+ makeCodeOne(jacEps)
+
+ makeYList(n:Integer):List(Symbol) ==
+ j:Integer
+ y:Symbol := Y::Symbol
+ p:List(Symbol) := []
+ [subscript(y,[j::OutputForm])$Symbol for j in 1..n]
+
+ makeCodeTwo(u:VEC FEXPR):FortranCode ==
+ -- compute jacobian wrt to f
+ n:Integer := maxIndex(u)$VEC(FEXPR)
+ p:List(Symbol) := makeYList(n)
+ jac:Matrix(FEXPR) := _
+ jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
+ localAssign1(Fsym,jac)
+
+ coerce(u:VEC FEXPR):$ ==
+ aF:FortranCode := makeCodeOne(u)
+ bF:FortranCode := makeCodeTwo(u)
+ cF:FortranCode := makeCodeThree(u)
+ -- add returns() to complete subroutines
+ aLF:List(FortranCode) := [aF,returns()$FortranCode]$List(FortranCode)
+ bLF:List(FortranCode) := [bF,returns()$FortranCode]$List(FortranCode)
+ cLF:List(FortranCode) := [cF,returns()$FortranCode]$List(FortranCode)
+ [coerce(aLF)$R1,coerce(bLF)$R2,coerce(cLF)$R3]
+
+ coerce(u:$):OutputForm ==
+ bracket commaSeparate
+ [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm]
+
+ outputAsFortran(u:$):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran elt(u,f)$Rep
+ outputAsFortran elt(u,fJacob)$Rep
+ outputAsFortran elt(u,eJacob)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+@
+\section{domain ASP42 Asp42}
+<<domain ASP42 Asp42>>=
+)abbrev domain ASP42 Asp42
+++ Author: Mike Dewar, Godfrey Nolan
+++ Date Created:
+++ Date Last Updated: 29 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranFunctionCategory, FortranProgramCategory.
+++ Description:
+++\spadtype{Asp42} produces Fortran for Type 42 ASPs, needed for NAG
+++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package}
+++in particular. These ASPs are in fact
+++three Fortran routines which return a vector of functions, and their
+++derivatives wrt Y(i) and also a continuation parameter EPS, for example:
+++\begin{verbatim}
+++ SUBROUTINE G(EPS,YA,YB,BC,N)
+++ DOUBLE PRECISION EPS,YA(N),YB(N),BC(N)
+++ INTEGER N
+++ BC(1)=YA(1)
+++ BC(2)=YA(2)
+++ BC(3)=YB(2)-1.0D0
+++ RETURN
+++ END
+++ SUBROUTINE JACOBG(EPS,YA,YB,AJ,BJ,N)
+++ DOUBLE PRECISION EPS,YA(N),AJ(N,N),BJ(N,N),YB(N)
+++ INTEGER N
+++ AJ(1,1)=1.0D0
+++ AJ(1,2)=0.0D0
+++ AJ(1,3)=0.0D0
+++ AJ(2,1)=0.0D0
+++ AJ(2,2)=1.0D0
+++ AJ(2,3)=0.0D0
+++ AJ(3,1)=0.0D0
+++ AJ(3,2)=0.0D0
+++ AJ(3,3)=0.0D0
+++ BJ(1,1)=0.0D0
+++ BJ(1,2)=0.0D0
+++ BJ(1,3)=0.0D0
+++ BJ(2,1)=0.0D0
+++ BJ(2,2)=0.0D0
+++ BJ(2,3)=0.0D0
+++ BJ(3,1)=0.0D0
+++ BJ(3,2)=1.0D0
+++ BJ(3,3)=0.0D0
+++ RETURN
+++ END
+++ SUBROUTINE JACGEP(EPS,YA,YB,BCEP,N)
+++ DOUBLE PRECISION EPS,YA(N),YB(N),BCEP(N)
+++ INTEGER N
+++ BCEP(1)=0.0D0
+++ BCEP(2)=0.0D0
+++ BCEP(3)=0.0D0
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp42(nameOne,nameTwo,nameThree): Exports == Implementation where
+ nameOne : Symbol
+ nameTwo : Symbol
+ nameThree : Symbol
+
+ D ==> differentiate
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ FP ==> FortranProgram
+ FC ==> FortranCode
+ PI ==> PositiveInteger
+ NNI ==> NonNegativeInteger
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ UFST ==> Union(fst:FST,void:"void")
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression(['EPS],['YA,'YB],MFLOAT)
+ S ==> Symbol
+ MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,
+ EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT)
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : VEC FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+ real : UFST := ["real"::FST]$UFST
+
+ symOne : SYMTAB := empty()$SYMTAB
+ declare!(EPS,fortranReal(),symOne)$SYMTAB
+ declare!(N,fortranInteger(),symOne)$SYMTAB
+ yType : FT := construct(real,[N],false)$FT
+ declare!(YA,yType,symOne)$SYMTAB
+ declare!(YB,yType,symOne)$SYMTAB
+ declare!(BC,yType,symOne)$SYMTAB
+
+ symTwo : SYMTAB := empty()$SYMTAB
+ declare!(EPS,fortranReal(),symTwo)$SYMTAB
+ declare!(N,fortranInteger(),symTwo)$SYMTAB
+ declare!(YA,yType,symTwo)$SYMTAB
+ declare!(YB,yType,symTwo)$SYMTAB
+ ajType : FT := construct(real,[N,N],false)$FT
+ declare!(AJ,ajType,symTwo)$SYMTAB
+ declare!(BJ,ajType,symTwo)$SYMTAB
+
+ symThree : SYMTAB := empty()$SYMTAB
+ declare!(EPS,fortranReal(),symThree)$SYMTAB
+ declare!(N,fortranInteger(),symThree)$SYMTAB
+ declare!(YA,yType,symThree)$SYMTAB
+ declare!(YB,yType,symThree)$SYMTAB
+ declare!(BCEP,yType,symThree)$SYMTAB
+
+ rt := ["void"]$UFST
+ R1:=FortranProgram(nameOne,rt,[EPS,YA,YB,BC,N],symOne)
+ R2:=FortranProgram(nameTwo,rt,[EPS,YA,YB,AJ,BJ,N],symTwo)
+ R3:=FortranProgram(nameThree,rt,[EPS,YA,YB,BCEP,N],symThree)
+ Rep := Record(g:R1,gJacob:R2,geJacob:R3)
+ BCsym:Symbol:=coerce "BC"
+ AJsym:Symbol:=coerce "AJ"
+ BJsym:Symbol:=coerce "BJ"
+ BCEPsym:Symbol:=coerce "BCEP"
+
+ makeList(n:Integer,s:Symbol):List(Symbol) ==
+ j:Integer
+ p:List(Symbol) := []
+ for j in 1 .. n repeat p:= cons(subscript(s,[j::OutputForm])$Symbol,p)
+ reverse(p)
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ localAssign1(s:S,j:Matrix FEXPR):FC ==
+ j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2
+ assign(s,j')$FC
+
+ localAssign2(s:S,j:VEC FEXPR):FC ==
+ j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
+ assign(s,j')$FC
+
+ makeCodeOne(u:VEC FEXPR):FortranCode ==
+ -- simple assign
+ localAssign2(BCsym,u)
+
+ makeCodeTwo(u:VEC FEXPR):List(FortranCode) ==
+ -- compute jacobian wrt to ya
+ n:Integer := maxIndex(u)
+ p:List(Symbol) := makeList(n,YA::Symbol)
+ jacYA:Matrix(FEXPR) := _
+ jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
+ -- compute jacobian wrt to yb
+ p:List(Symbol) := makeList(n,YB::Symbol)
+ jacYB: Matrix(FEXPR) := _
+ jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
+ -- assign jacobians to AJ & BJ
+ [localAssign1(AJsym,jacYA),localAssign1(BJsym,jacYB),returns()$FC]$List(FC)
+
+ makeCodeThree(u:VEC FEXPR):FortranCode ==
+ -- compute jacobian wrt to eps
+ jacEps:VEC FEXPR := [D(v,EPS) for v in entries u]$VEC(FEXPR)
+ localAssign2(BCEPsym,jacEps)
+
+ coerce(u:VEC FEXPR):$ ==
+ aF:FortranCode := makeCodeOne(u)
+ bF:List(FortranCode) := makeCodeTwo(u)
+ cF:FortranCode := makeCodeThree(u)
+ -- add returns() to complete subroutines
+ aLF:List(FortranCode) := [aF,returns()$FC]$List(FortranCode)
+ cLF:List(FortranCode) := [cF,returns()$FC]$List(FortranCode)
+ [coerce(aLF)$R1,coerce(bF)$R2,coerce(cLF)$R3]
+
+ coerce(u:$) : OutputForm ==
+ bracket commaSeparate
+ [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm]
+
+ outputAsFortran(u:$):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran elt(u,g)$Rep
+ outputAsFortran elt(u,gJacob)$Rep
+ outputAsFortran elt(u,geJacob)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+@
+\section{domain ASP49 Asp49}
+<<domain ASP49 Asp49>>=
+)abbrev domain ASP49 Asp49
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 23 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp49} produces Fortran for Type 49 ASPs, needed for NAG routines
+++\axiomOpFrom{e04dgf}{e04Package}, \axiomOpFrom{e04ucf}{e04Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE OBJFUN(MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER)
+++ DOUBLE PRECISION X(N),OBJF,OBJGRD(N),USER(*)
+++ INTEGER N,IUSER(*),MODE,NSTATE
+++ OBJF=X(4)*X(9)+((-1.0D0*X(5))+X(3))*X(8)+((-1.0D0*X(3))+X(1))*X(7)
+++ &+(-1.0D0*X(2)*X(6))
+++ OBJGRD(1)=X(7)
+++ OBJGRD(2)=-1.0D0*X(6)
+++ OBJGRD(3)=X(8)+(-1.0D0*X(7))
+++ OBJGRD(4)=X(9)
+++ OBJGRD(5)=-1.0D0*X(8)
+++ OBJGRD(6)=-1.0D0*X(2)
+++ OBJGRD(7)=(-1.0D0*X(3))+X(1)
+++ OBJGRD(8)=(-1.0D0*X(5))+X(3)
+++ OBJGRD(9)=X(4)
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp49(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ UFST ==> Union(fst:FST,void:"void")
+ FT ==> FortranType
+ FC ==> FortranCode
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FC))
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression([],['X],MFLOAT)
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+ S ==> Symbol
+
+ Exports ==> FortranFunctionCategory with
+ coerce : FEXPR -> $
+ ++coerce(f) takes an object from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns it into an ASP.
+
+ Implementation ==> add
+
+ real : UFST := ["real"::FST]$UFST
+ integer : UFST := ["integer"::FST]$UFST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(MODE,fortranInteger(),syms)$SYMTAB
+ declare!(N,fortranInteger(),syms)$SYMTAB
+ xType : FT := construct(real,[N::S],false)$FT
+ declare!(X,xType,syms)$SYMTAB
+ declare!(OBJF,fortranReal(),syms)$SYMTAB
+ declare!(OBJGRD,xType,syms)$SYMTAB
+ declare!(NSTATE,fortranInteger(),syms)$SYMTAB
+ iuType : FT := construct(integer,["*"::S],false)$FT
+ declare!(IUSER,iuType,syms)$SYMTAB
+ uType : FT := construct(real,["*"::S],false)$FT
+ declare!(USER,uType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,
+ [MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER],syms)
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ localAssign(s:S,j:VEC FEXPR):FC ==
+ j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
+ assign(s,j')$FC
+
+ coerce(u:FEXPR):$ ==
+ vars:List(S) := variables(u)
+ grd:VEC FEXPR := gradient(u,vars)$MultiVariableCalculusFunctions(_
+ S,FEXPR,VEC FEXPR,List(S))
+ code : List(FC) := [assign(OBJF@S,fexpr2expr u)$FC,_
+ localAssign(OBJGRD@S,grd),_
+ returns()$FC]
+ code::$
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ coerce(c:List FC):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FC):$ == coerce(c)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:EXPR INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+@
+\section{domain ASP50 Asp50}
+<<domain ASP50 Asp50>>=
+)abbrev domain ASP50 Asp50
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 23 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp50} produces Fortran for Type 50 ASPs, needed for NAG routine
+++\axiomOpFrom{e04fdf}{e04Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE LSFUN1(M,N,XC,FVECC)
+++ DOUBLE PRECISION FVECC(M),XC(N)
+++ INTEGER I,M,N
+++ FVECC(1)=((XC(1)-2.4D0)*XC(3)+(15.0D0*XC(1)-36.0D0)*XC(2)+1.0D0)/(
+++ &XC(3)+15.0D0*XC(2))
+++ FVECC(2)=((XC(1)-2.8D0)*XC(3)+(7.0D0*XC(1)-19.6D0)*XC(2)+1.0D0)/(X
+++ &C(3)+7.0D0*XC(2))
+++ FVECC(3)=((XC(1)-3.2D0)*XC(3)+(4.333333333333333D0*XC(1)-13.866666
+++ &66666667D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2))
+++ FVECC(4)=((XC(1)-3.5D0)*XC(3)+(3.0D0*XC(1)-10.5D0)*XC(2)+1.0D0)/(X
+++ &C(3)+3.0D0*XC(2))
+++ FVECC(5)=((XC(1)-3.9D0)*XC(3)+(2.2D0*XC(1)-8.579999999999998D0)*XC
+++ &(2)+1.0D0)/(XC(3)+2.2D0*XC(2))
+++ FVECC(6)=((XC(1)-4.199999999999999D0)*XC(3)+(1.666666666666667D0*X
+++ &C(1)-7.0D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2))
+++ FVECC(7)=((XC(1)-4.5D0)*XC(3)+(1.285714285714286D0*XC(1)-5.7857142
+++ &85714286D0)*XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2))
+++ FVECC(8)=((XC(1)-4.899999999999999D0)*XC(3)+(XC(1)-4.8999999999999
+++ &99D0)*XC(2)+1.0D0)/(XC(3)+XC(2))
+++ FVECC(9)=((XC(1)-4.699999999999999D0)*XC(3)+(XC(1)-4.6999999999999
+++ &99D0)*XC(2)+1.285714285714286D0)/(XC(3)+XC(2))
+++ FVECC(10)=((XC(1)-6.8D0)*XC(3)+(XC(1)-6.8D0)*XC(2)+1.6666666666666
+++ &67D0)/(XC(3)+XC(2))
+++ FVECC(11)=((XC(1)-8.299999999999999D0)*XC(3)+(XC(1)-8.299999999999
+++ &999D0)*XC(2)+2.2D0)/(XC(3)+XC(2))
+++ FVECC(12)=((XC(1)-10.6D0)*XC(3)+(XC(1)-10.6D0)*XC(2)+3.0D0)/(XC(3)
+++ &+XC(2))
+++ FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333
+++ &3333D0)/(XC(3)+XC(2))
+++ FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X
+++ &C(2))
+++ FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3
+++ &)+XC(2))
+++ END
+++\end{verbatim}
+
+Asp50(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ UFST ==> Union(fst:FST,void:"void")
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+ FEXPR ==> FortranExpression([],['XC],MFLOAT)
+ MFLOAT ==> MachineFloat
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : VEC FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : UFST := ["real"::FST]$UFST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(M,fortranInteger(),syms)$SYMTAB
+ declare!(N,fortranInteger(),syms)$SYMTAB
+ xcType : FT := construct(real,[N],false)$FT
+ declare!(XC,xcType,syms)$SYMTAB
+ fveccType : FT := construct(real,[M],false)$FT
+ declare!(FVECC,fveccType,syms)$SYMTAB
+ declare!(I,fortranInteger(),syms)$SYMTAB
+ tType : FT := construct(real,[M,N],false)$FT
+-- declare!(TC,tType,syms)$SYMTAB
+-- declare!(Y,fveccType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST, [M,N,XC,FVECC],syms)
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ coerce(u:VEC FEXPR):$ ==
+ u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
+ assign(FVECC,u')$FortranCode::$
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP55 Asp55}
+<<domain ASP55 Asp55>>=
+)abbrev domain ASP55 Asp55
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: June 1993
+++ Date Last Updated: 23 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp55} produces Fortran for Type 55 ASPs, needed for NAG routines
+++\axiomOpFrom{e04dgf}{e04Package} and \axiomOpFrom{e04ucf}{e04Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE CONFUN(MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER
+++ &,USER)
+++ DOUBLE PRECISION C(NCNLN),X(N),CJAC(NROWJ,N),USER(*)
+++ INTEGER N,IUSER(*),NEEDC(NCNLN),NROWJ,MODE,NCNLN,NSTATE
+++ IF(NEEDC(1).GT.0)THEN
+++ C(1)=X(6)**2+X(1)**2
+++ CJAC(1,1)=2.0D0*X(1)
+++ CJAC(1,2)=0.0D0
+++ CJAC(1,3)=0.0D0
+++ CJAC(1,4)=0.0D0
+++ CJAC(1,5)=0.0D0
+++ CJAC(1,6)=2.0D0*X(6)
+++ ENDIF
+++ IF(NEEDC(2).GT.0)THEN
+++ C(2)=X(2)**2+(-2.0D0*X(1)*X(2))+X(1)**2
+++ CJAC(2,1)=(-2.0D0*X(2))+2.0D0*X(1)
+++ CJAC(2,2)=2.0D0*X(2)+(-2.0D0*X(1))
+++ CJAC(2,3)=0.0D0
+++ CJAC(2,4)=0.0D0
+++ CJAC(2,5)=0.0D0
+++ CJAC(2,6)=0.0D0
+++ ENDIF
+++ IF(NEEDC(3).GT.0)THEN
+++ C(3)=X(3)**2+(-2.0D0*X(1)*X(3))+X(2)**2+X(1)**2
+++ CJAC(3,1)=(-2.0D0*X(3))+2.0D0*X(1)
+++ CJAC(3,2)=2.0D0*X(2)
+++ CJAC(3,3)=2.0D0*X(3)+(-2.0D0*X(1))
+++ CJAC(3,4)=0.0D0
+++ CJAC(3,5)=0.0D0
+++ CJAC(3,6)=0.0D0
+++ ENDIF
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp55(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ FSTU ==> Union(fst:FST,void:"void")
+ SYMTAB ==> SymbolTable
+ FC ==> FortranCode
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ S ==> Symbol
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+ MAT ==> Matrix
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression([],['X],MFLOAT)
+ MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR,
+ EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT)
+ SWU ==> Union(I:Expression Integer,F:Expression Float,
+ CF:Expression Complex Float,switch:Switch)
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : VEC FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : FSTU := ["real"::FST]$FSTU
+ integer : FSTU := ["integer"::FST]$FSTU
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(MODE,fortranInteger(),syms)$SYMTAB
+ declare!(NCNLN,fortranInteger(),syms)$SYMTAB
+ declare!(N,fortranInteger(),syms)$SYMTAB
+ declare!(NROWJ,fortranInteger(),syms)$SYMTAB
+ needcType : FT := construct(integer,[NCNLN::Symbol],false)$FT
+ declare!(NEEDC,needcType,syms)$SYMTAB
+ xType : FT := construct(real,[N::Symbol],false)$FT
+ declare!(X,xType,syms)$SYMTAB
+ cType : FT := construct(real,[NCNLN::Symbol],false)$FT
+ declare!(C,cType,syms)$SYMTAB
+ cjacType : FT := construct(real,[NROWJ::Symbol,N::Symbol],false)$FT
+ declare!(CJAC,cjacType,syms)$SYMTAB
+ declare!(NSTATE,fortranInteger(),syms)$SYMTAB
+ iuType : FT := construct(integer,["*"::Symbol],false)$FT
+ declare!(IUSER,iuType,syms)$SYMTAB
+ uType : FT := construct(real,["*"::Symbol],false)$FT
+ declare!(USER,uType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$FSTU,
+ [MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER,USER],syms)
+
+ -- Take a symbol, pull of the script and turn it into an integer!!
+ o2int(u:S):Integer ==
+ o : OutputForm := first elt(scripts(u)$S,sub)
+ o pretend Integer
+
+ localAssign(s:Symbol,dim:List POLY INT,u:FEXPR):FC ==
+ assign(s,dim,(u::EXPR MFLOAT)$FEXPR)$FC
+
+ makeCond(index:INT,fun:FEXPR,jac:VEC FEXPR):FC ==
+ needc : EXPR INT := (subscript(NEEDC,[index::OutputForm])$S)::EXPR(INT)
+ sw : Switch := GT([needc]$SWU,[0::EXPR(INT)]$SWU)$Switch
+ ass : List FC := [localAssign(CJAC,[index::POLY INT,i::POLY INT],jac.i)_
+ for i in 1..maxIndex(jac)]
+ cond(sw,block([localAssign(C,[index::POLY INT],fun),:ass])$FC)$FC
+
+ coerce(u:VEC FEXPR):$ ==
+ ncnln:Integer := maxIndex(u)
+ x:S := X::S
+ pu:List(S) := []
+ -- Work out which variables appear in the expressions
+ for e in entries(u) repeat
+ pu := setUnion(pu,variables(e)$FEXPR)
+ scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer)
+ -- This should be the maximum X_n which occurs (there may be others
+ -- which don't):
+ n:Integer := reduce(max,scriptList)$List(Integer)
+ p:List(S) := []
+ for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p)
+ p:= reverse(p)
+ jac:MAT FEXPR := _
+ jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
+ code : List FC := [makeCond(j,u.j,row(jac,j)) for j in 1..ncnln]
+ [:code,returns()$FC]::$
+
+ coerce(c:List FC):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FC):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+@
+\section{domain ASP6 Asp6}
+<<domain ASP6 Asp6>>=
+)abbrev domain ASP6 Asp6
+++ Author: Mike Dewar and Godfrey Nolan and Grant Keady
+++ Date Created: Mar 1993
+++ Date Last Updated: 18 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp6} produces Fortran for Type 6 ASPs, needed for NAG routines
+++\axiomOpFrom{c05nbf}{c05Package}, \axiomOpFrom{c05ncf}{c05Package}.
+++These represent vectors of functions of X(i) and look like:
+++\begin{verbatim}
+++ SUBROUTINE FCN(N,X,FVEC,IFLAG)
+++ DOUBLE PRECISION X(N),FVEC(N)
+++ INTEGER N,IFLAG
+++ FVEC(1)=(-2.0D0*X(2))+(-2.0D0*X(1)**2)+3.0D0*X(1)+1.0D0
+++ FVEC(2)=(-2.0D0*X(3))+(-2.0D0*X(2)**2)+3.0D0*X(2)+(-1.0D0*X(1))+1.
+++ &0D0
+++ FVEC(3)=(-2.0D0*X(4))+(-2.0D0*X(3)**2)+3.0D0*X(3)+(-1.0D0*X(2))+1.
+++ &0D0
+++ FVEC(4)=(-2.0D0*X(5))+(-2.0D0*X(4)**2)+3.0D0*X(4)+(-1.0D0*X(3))+1.
+++ &0D0
+++ FVEC(5)=(-2.0D0*X(6))+(-2.0D0*X(5)**2)+3.0D0*X(5)+(-1.0D0*X(4))+1.
+++ &0D0
+++ FVEC(6)=(-2.0D0*X(7))+(-2.0D0*X(6)**2)+3.0D0*X(6)+(-1.0D0*X(5))+1.
+++ &0D0
+++ FVEC(7)=(-2.0D0*X(8))+(-2.0D0*X(7)**2)+3.0D0*X(7)+(-1.0D0*X(6))+1.
+++ &0D0
+++ FVEC(8)=(-2.0D0*X(9))+(-2.0D0*X(8)**2)+3.0D0*X(8)+(-1.0D0*X(7))+1.
+++ &0D0
+++ FVEC(9)=(-2.0D0*X(9)**2)+3.0D0*X(9)+(-1.0D0*X(8))+1.0D0
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp6(name): Exports == Implementation where
+ name : Symbol
+
+ FEXPR ==> FortranExpression([],['X],MFLOAT)
+ MFLOAT ==> MachineFloat
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ UFST ==> Union(fst:FST,void:"void")
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+
+ Exports == FortranVectorFunctionCategory with
+ coerce: Vector FEXPR -> %
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation == add
+
+ real : UFST := ["real"::FST]$UFST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(N,fortranInteger()$FT,syms)$SYMTAB
+ xType : FT := construct(real,[N],false)$FT
+ declare!(X,xType,syms)$SYMTAB
+ declare!(FVEC,xType,syms)$SYMTAB
+ declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"),
+ [N,X,FVEC,IFLAG],syms)
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VectorFunctions2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT ==
+ (u::EXPR MFLOAT)$FEXPR
+
+ coerce(u:VEC FEXPR):% ==
+ v : VEC EXPR MFLOAT
+ v := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
+ ([assign(FVEC,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::$
+
+ coerce(c:List FortranCode):% == coerce(c)$Rep
+
+ coerce(r:RSFC):% == coerce(r)$Rep
+
+ coerce(c:FortranCode):% == coerce(c)$Rep
+
+ coerce(u:%):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP7 Asp7}
+<<domain ASP7 Asp7>>=
+)abbrev domain ASP7 Asp7
+++ Author: Mike Dewar and Godfrey Nolan and Grant Keady
+++ Date Created: Mar 1993
+++ Date Last Updated: 18 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp7} produces Fortran for Type 7 ASPs, needed for NAG routines
+++\axiomOpFrom{d02bbf}{d02Package}, \axiomOpFrom{d02gaf}{d02Package}.
+++These represent a vector of functions of the scalar X and
+++the array Z, and look like:
+++\begin{verbatim}
+++ SUBROUTINE FCN(X,Z,F)
+++ DOUBLE PRECISION F(*),X,Z(*)
+++ F(1)=DTAN(Z(3))
+++ F(2)=((-0.03199999999999999D0*DCOS(Z(3))*DTAN(Z(3)))+(-0.02D0*Z(2)
+++ &**2))/(Z(2)*DCOS(Z(3)))
+++ F(3)=-0.03199999999999999D0/(X*Z(2)**2)
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp7(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression(['X],['Y],MFLOAT)
+ UFST ==> Union(fst:FST,void:"void")
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : Vector FEXPR -> %
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : UFST := ["real"::FST]$UFST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(X,fortranReal(),syms)$SYMTAB
+ yType : FT := construct(real,["*"::Symbol],false)$FT
+ declare!(Y,yType,syms)$SYMTAB
+ declare!(F,yType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,[X,Y,F],syms)
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT ==
+ (u::EXPR MFLOAT)$FEXPR
+
+ coerce(u:Vector FEXPR ):% ==
+ v : Vector EXPR MFLOAT
+ v:=map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
+ ([assign(F,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::%
+
+ coerce(c:List FortranCode):% == coerce(c)$Rep
+
+ coerce(r:RSFC):% == coerce(r)$Rep
+
+ coerce(c:FortranCode):% == coerce(c)$Rep
+
+ coerce(u:%):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{domain ASP73 Asp73}
+<<domain ASP73 Asp73>>=
+)abbrev domain ASP73 Asp73
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 30 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp73} produces Fortran for Type 73 ASPs, needed for NAG routine
+++\axiomOpFrom{d03eef}{d03Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE PDEF(X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI)
+++ DOUBLE PRECISION ALPHA,EPSOLN,PHI,X,Y,BETA,DELTA,GAMMA,PSI
+++ ALPHA=DSIN(X)
+++ BETA=Y
+++ GAMMA=X*Y
+++ DELTA=DCOS(X)*DSIN(Y)
+++ EPSOLN=Y+X
+++ PHI=X
+++ PSI=Y
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp73(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FSTU ==> Union(fst:FST,void:"void")
+ FEXPR ==> FortranExpression(['X,'Y],[],MachineFloat)
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : VEC FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(X,fortranReal(),syms) $SYMTAB
+ declare!(Y,fortranReal(),syms) $SYMTAB
+ declare!(ALPHA,fortranReal(),syms)$SYMTAB
+ declare!(BETA,fortranReal(),syms) $SYMTAB
+ declare!(GAMMA,fortranReal(),syms) $SYMTAB
+ declare!(DELTA,fortranReal(),syms) $SYMTAB
+ declare!(EPSOLN,fortranReal(),syms) $SYMTAB
+ declare!(PHI,fortranReal(),syms) $SYMTAB
+ declare!(PSI,fortranReal(),syms) $SYMTAB
+ Rep := FortranProgram(name,["void"]$FSTU,
+ [X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI],syms)
+
+ -- To help the poor compiler!
+ localAssign(u:Symbol,v:FEXPR):FortranCode ==
+ assign(u,(v::EXPR MachineFloat)$FEXPR)$FortranCode
+
+ coerce(u:VEC FEXPR):$ ==
+ maxIndex(u) ^= 7 => error "Vector is not of dimension 7"
+ [localAssign(ALPHA@Symbol,elt(u,1)),_
+ localAssign(BETA@Symbol,elt(u,2)),_
+ localAssign(GAMMA@Symbol,elt(u,3)),_
+ localAssign(DELTA@Symbol,elt(u,4)),_
+ localAssign(EPSOLN@Symbol,elt(u,5)),_
+ localAssign(PHI@Symbol,elt(u,6)),_
+ localAssign(PSI@Symbol,elt(u,7)),_
+ returns()$FortranCode]$List(FortranCode)::$
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+@
+\section{domain ASP74 Asp74}
+<<domain ASP74 Asp74>>=
+)abbrev domain ASP74 Asp74
+++ Author: Mike Dewar and Godfrey Nolan
+++ Date Created: Oct 1993
+++ Date Last Updated: 30 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory.
+++ Description:
+++\spadtype{Asp74} produces Fortran for Type 74 ASPs, needed for NAG routine
+++\axiomOpFrom{d03eef}{d03Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE BNDY(X,Y,A,B,C,IBND)
+++ DOUBLE PRECISION A,B,C,X,Y
+++ INTEGER IBND
+++ IF(IBND.EQ.0)THEN
+++ A=0.0D0
+++ B=1.0D0
+++ C=-1.0D0*DSIN(X)
+++ ELSEIF(IBND.EQ.1)THEN
+++ A=1.0D0
+++ B=0.0D0
+++ C=DSIN(X)*DSIN(Y)
+++ ELSEIF(IBND.EQ.2)THEN
+++ A=1.0D0
+++ B=0.0D0
+++ C=DSIN(X)*DSIN(Y)
+++ ELSEIF(IBND.EQ.3)THEN
+++ A=0.0D0
+++ B=1.0D0
+++ C=-1.0D0*DSIN(Y)
+++ ENDIF
+++ END
+++\end{verbatim}
+
+Asp74(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FSTU ==> Union(fst:FST,void:"void")
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ FC ==> FortranCode
+ PI ==> PositiveInteger
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression(['X,'Y],[],MFLOAT)
+ U ==> Union(I: Expression Integer,F: Expression Float,_
+ CF: Expression Complex Float,switch:Switch)
+ VEC ==> Vector
+ MAT ==> Matrix
+ M2 ==> MatrixCategoryFunctions2
+ MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT,
+ MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT,
+ MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT,
+ FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT,
+ MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT,
+ FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT,
+ MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+
+ Exports ==> FortranMatrixFunctionCategory with
+ coerce : MAT FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(X,fortranReal(),syms)$SYMTAB
+ declare!(Y,fortranReal(),syms)$SYMTAB
+ declare!(A,fortranReal(),syms)$SYMTAB
+ declare!(B,fortranReal(),syms)$SYMTAB
+ declare!(C,fortranReal(),syms)$SYMTAB
+ declare!(IBND,fortranInteger(),syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$FSTU,[X,Y,A,B,C,IBND],syms)
+
+ -- To help the poor compiler!
+ localAssign(u:Symbol,v:FEXPR):FC == assign(u,(v::EXPR MFLOAT)$FEXPR)$FC
+
+ coerce(u:MAT FEXPR):$ ==
+ (nrows(u) ^= 4 or ncols(u) ^= 3) => error "Not a 4X3 matrix"
+ flag:U := [IBND@Symbol::EXPR INT]$U
+ pt0:U := [0::EXPR INT]$U
+ pt1:U := [1::EXPR INT]$U
+ pt2:U := [2::EXPR INT]$U
+ pt3:U := [3::EXPR INT]$U
+ sw1: Switch := EQ(flag,pt0)$Switch
+ sw2: Switch := EQ(flag,pt1)$Switch
+ sw3: Switch := EQ(flag,pt2)$Switch
+ sw4: Switch := EQ(flag,pt3)$Switch
+ a11 : FC := localAssign(A,u(1,1))
+ a12 : FC := localAssign(B,u(1,2))
+ a13 : FC := localAssign(C,u(1,3))
+ a21 : FC := localAssign(A,u(2,1))
+ a22 : FC := localAssign(B,u(2,2))
+ a23 : FC := localAssign(C,u(2,3))
+ a31 : FC := localAssign(A,u(3,1))
+ a32 : FC := localAssign(B,u(3,2))
+ a33 : FC := localAssign(C,u(3,3))
+ a41 : FC := localAssign(A,u(4,1))
+ a42 : FC := localAssign(B,u(4,2))
+ a43 : FC := localAssign(C,u(4,3))
+ c : FC := cond(sw1,block([a11,a12,a13])$FC,
+ cond(sw2,block([a21,a22,a23])$FC,
+ cond(sw3,block([a31,a32,a33])$FC,
+ cond(sw4,block([a41,a42,a43])$FC)$FC)$FC)$FC)$FC
+ c::$
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ retract(u:MAT FRAC POLY INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2a
+ v::$
+
+ retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT FRAC POLY FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2b
+ v::$
+
+ retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT EXPR INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2e
+ v::$
+
+ retractIfCan(u:MAT EXPR INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT EXPR FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2f
+ v::$
+
+ retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT POLY INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2c
+ v::$
+
+ retractIfCan(u:MAT POLY INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT POLY FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2d
+ v::$
+
+ retractIfCan(u:MAT POLY FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+@
+\section{domain ASP77 Asp77}
+<<domain ASP77 Asp77>>=
+)abbrev domain ASP77 Asp77
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 30 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp77} produces Fortran for Type 77 ASPs, needed for NAG routine
+++\axiomOpFrom{d02gbf}{d02Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE FCNF(X,F)
+++ DOUBLE PRECISION X
+++ DOUBLE PRECISION F(2,2)
+++ F(1,1)=0.0D0
+++ F(1,2)=1.0D0
+++ F(2,1)=0.0D0
+++ F(2,2)=-10.0D0
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp77(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FSTU ==> Union(fst:FST,void:"void")
+ FT ==> FortranType
+ FC ==> FortranCode
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FC))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression(['X],[],MFLOAT)
+ VEC ==> Vector
+ MAT ==> Matrix
+ M2 ==> MatrixCategoryFunctions2
+ MF2 ==> M2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT,
+ VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT)
+ MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT,
+ MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT,
+ MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT,
+ FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT,
+ MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT,
+ FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT,
+ MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+
+
+ Exports ==> FortranMatrixFunctionCategory with
+ coerce : MAT FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : FSTU := ["real"::FST]$FSTU
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(X,fortranReal(),syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$FSTU,[X,F],syms)
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ localAssign(s:Symbol,j:MAT FEXPR):FortranCode ==
+ j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2
+ assign(s,j')$FortranCode
+
+ coerce(u:MAT FEXPR):$ ==
+ dimension := nrows(u)::POLY(INT)
+ locals : SYMTAB := empty()
+ declare!(F,[real,[dimension,dimension]$List(POLY(INT)),false]$FT,locals)
+ code : List FC := [localAssign(F,u),returns()$FC]
+ ([locals,code]$RSFC)::$
+
+ coerce(c:List FC):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FC):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ retract(u:MAT FRAC POLY INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2a
+ v::$
+
+ retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT FRAC POLY FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2b
+ v::$
+
+ retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT EXPR INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2e
+ v::$
+
+ retractIfCan(u:MAT EXPR INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT EXPR FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2f
+ v::$
+
+ retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT POLY INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2c
+ v::$
+
+ retractIfCan(u:MAT POLY INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT POLY FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2d
+ v::$
+
+ retractIfCan(u:MAT POLY FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+@
+\section{domain ASP78 Asp78}
+<<domain ASP78 Asp78>>=
+)abbrev domain ASP78 Asp78
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 30 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp78} produces Fortran for Type 78 ASPs, needed for NAG routine
+++\axiomOpFrom{d02gbf}{d02Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE FCNG(X,G)
+++ DOUBLE PRECISION G(*),X
+++ G(1)=0.0D0
+++ G(2)=0.0D0
+++ END
+++\end{verbatim}
+
+Asp78(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FSTU ==> Union(fst:FST,void:"void")
+ FT ==> FortranType
+ FC ==> FortranCode
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FC))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ VEC ==> Vector
+ VF2 ==> VectorFunctions2
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression(['X],[],MFLOAT)
+
+ Exports ==> FortranVectorFunctionCategory with
+ coerce : VEC FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : FSTU := ["real"::FST]$FSTU
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(X,fortranReal(),syms)$SYMTAB
+ gType : FT := construct(real,["*"::Symbol],false)$FT
+ declare!(G,gType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$FSTU,[X,G],syms)
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ coerce(u:VEC FEXPR):$ ==
+ u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
+ (assign(G,u')$FC)::$
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ coerce(c:List FC):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FC):$ == coerce(c)$Rep
+
+ retract(u:VEC FRAC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC FRAC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC EXPR FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY INT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+ retract(u:VEC POLY FLOAT):$ ==
+ v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+ v::$
+
+ retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+ v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+ v case "failed" => "failed"
+ (v::VEC FEXPR)::$
+
+@
+\section{domain ASP8 Asp8}
+<<domain ASP8 Asp8>>=
+)abbrev domain ASP8 Asp8
+++ Author: Godfrey Nolan and Mike Dewar
+++ Date Created: 11 February 1994
+++ Date Last Updated: 18 March 1994
+++ 31 May 1994 to use alternative interface. MCD
+++ 30 June 1994 to handle the end condition correctly. MCD
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp8} produces Fortran for Type 8 ASPs, needed for NAG routine
+++\axiomOpFrom{d02bbf}{d02Package}. This ASP prints intermediate values of the computed solution of
+++an ODE and might look like:
+++\begin{verbatim}
+++ SUBROUTINE OUTPUT(XSOL,Y,COUNT,M,N,RESULT,FORWRD)
+++ DOUBLE PRECISION Y(N),RESULT(M,N),XSOL
+++ INTEGER M,N,COUNT
+++ LOGICAL FORWRD
+++ DOUBLE PRECISION X02ALF,POINTS(8)
+++ EXTERNAL X02ALF
+++ INTEGER I
+++ POINTS(1)=1.0D0
+++ POINTS(2)=2.0D0
+++ POINTS(3)=3.0D0
+++ POINTS(4)=4.0D0
+++ POINTS(5)=5.0D0
+++ POINTS(6)=6.0D0
+++ POINTS(7)=7.0D0
+++ POINTS(8)=8.0D0
+++ COUNT=COUNT+1
+++ DO 25001 I=1,N
+++ RESULT(COUNT,I)=Y(I)
+++25001 CONTINUE
+++ IF(COUNT.EQ.M)THEN
+++ IF(FORWRD)THEN
+++ XSOL=X02ALF()
+++ ELSE
+++ XSOL=-X02ALF()
+++ ENDIF
+++ ELSE
+++ XSOL=POINTS(COUNT)
+++ ENDIF
+++ END
+++\end{verbatim}
+
+Asp8(name): Exports == Implementation where
+ name : Symbol
+
+ O ==> OutputForm
+ S ==> Symbol
+ FST ==> FortranScalarType
+ UFST ==> Union(fst:FST,void:"void")
+ FT ==> FortranType
+ FC ==> FortranCode
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ EX ==> Expression Integer
+ MFLOAT ==> MachineFloat
+ EXPR ==> Expression
+ PI ==> Polynomial Integer
+ EXU ==> Union(I: EXPR Integer,F: EXPR Float,CF: EXPR Complex Float,
+ switch: Switch)
+
+ Exports ==> FortranVectorCategory
+
+ Implementation ==> add
+
+ real : UFST := ["real"::FST]$UFST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!([COUNT,M,N],fortranInteger(),syms)$SYMTAB
+ declare!(XSOL,fortranReal(),syms)$SYMTAB
+ yType : FT := construct(real,[N],false)$FT
+ declare!(Y,yType,syms)$SYMTAB
+ declare!(FORWRD,fortranLogical(),syms)$SYMTAB
+ declare!(RESULT,construct(real,[M,N],false)$FT,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$UFST,[XSOL,Y,COUNT,M,N,RESULT,FORWRD],syms)
+
+ coerce(c:List FC):% == coerce(c)$Rep
+
+ coerce(r:RSFC):% == coerce(r)$Rep
+
+ coerce(c:FC):% == coerce(c)$Rep
+
+ coerce(u:%):O == coerce(u)$Rep
+
+ outputAsFortran(u:%):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+
+ f2ex(u:MFLOAT):EXPR MFLOAT == (u::EXPR MFLOAT)$EXPR(MFLOAT)
+
+ coerce(points:Vector MFLOAT):% ==
+ import PI
+ import EXPR Integer
+ -- Create some extra declarations
+ locals : SYMTAB := empty()$SYMTAB
+ nPol : PI := "N"::S::PI
+ iPol : PI := "I"::S::PI
+ countPol : PI := "COUNT"::S::PI
+ pointsDim : PI := max(#points,1)::PI
+ declare!(POINTS,[real,[pointsDim],false]$FT,locals)$SYMTAB
+ declare!(X02ALF,[real,[],true]$FT,locals)$SYMTAB
+ -- Now build up the code fragments
+ index : SegmentBinding PI := equation(I@S,1::PI..nPol)$SegmentBinding(PI)
+ ySym : EX := (subscript("Y"::S,[I::O])$S)::EX
+ loop := forLoop(index,assign(RESULT,[countPol,iPol],ySym)$FC)$FC
+ v:Vector EXPR MFLOAT
+ v := map(f2ex,points)$VectorFunctions2(MFLOAT,EXPR MFLOAT)
+ assign1 : FC := assign(POINTS,v)$FC
+ countExp: EX := COUNT@S::EX
+ newValue: EX := 1 + countExp
+ assign2 : FC := assign(COUNT,newValue)$FC
+ newSymbol : S := subscript(POINTS,[COUNT]@List(O))$S
+ assign3 : FC := assign(XSOL, newSymbol::EX )$FC
+ fphuge : EX := kernel(operator X02ALF,empty()$List(EX))
+ assign4 : FC := assign(XSOL, fphuge)$FC
+ assign5 : FC := assign(XSOL, -fphuge)$FC
+ innerCond : FC := cond("FORWRD"::Symbol::Switch,assign4,assign5)
+ mExp : EX := M@S::EX
+ endCase : FC := cond(EQ([countExp]$EXU,[mExp]$EXU)$Switch,innerCond,assign3)
+ code := [assign1, assign2, loop, endCase]$List(FC)
+ ([locals,code]$RSFC)::%
+
+@
+\section{domain ASP80 Asp80}
+<<domain ASP80 Asp80>>=
+)abbrev domain ASP80 Asp80
+++ Author: Mike Dewar and Godfrey Nolan
+++ Date Created: Oct 1993
+++ Date Last Updated: 30 March 1994
+++ 6 October 1994
+++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp80} produces Fortran for Type 80 ASPs, needed for NAG routine
+++\axiomOpFrom{d02kef}{d02Package}, for example:
+++\begin{verbatim}
+++ SUBROUTINE BDYVAL(XL,XR,ELAM,YL,YR)
+++ DOUBLE PRECISION ELAM,XL,YL(3),XR,YR(3)
+++ YL(1)=XL
+++ YL(2)=2.0D0
+++ YR(1)=1.0D0
+++ YR(2)=-1.0D0*DSQRT(XR+(-1.0D0*ELAM))
+++ RETURN
+++ END
+++\end{verbatim}
+
+Asp80(name): Exports == Implementation where
+ name : Symbol
+
+ FST ==> FortranScalarType
+ FSTU ==> Union(fst:FST,void:"void")
+ FT ==> FortranType
+ FC ==> FortranCode
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+ MFLOAT ==> MachineFloat
+ FEXPR ==> FortranExpression(['XL,'XR,'ELAM],[],MFLOAT)
+ VEC ==> Vector
+ MAT ==> Matrix
+ VF2 ==> VectorFunctions2
+ M2 ==> MatrixCategoryFunctions2
+ MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT,
+ MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT,
+ MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT,
+ FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT,
+ MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT,
+ FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+ MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT,
+ MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
+
+ Exports ==> FortranMatrixFunctionCategory with
+ coerce : MAT FEXPR -> $
+ ++coerce(f) takes objects from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns them into an ASP.
+
+ Implementation ==> add
+
+ real : FSTU := ["real"::FST]$FSTU
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(XL,fortranReal(),syms)$SYMTAB
+ declare!(XR,fortranReal(),syms)$SYMTAB
+ declare!(ELAM,fortranReal(),syms)$SYMTAB
+ yType : FT := construct(real,["3"::Symbol],false)$FT
+ declare!(YL,yType,syms)$SYMTAB
+ declare!(YR,yType,syms)$SYMTAB
+ Rep := FortranProgram(name,["void"]$FSTU, [XL,XR,ELAM,YL,YR],syms)
+
+ fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+ vecAssign(s:Symbol,u:VEC FEXPR):FC ==
+ u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
+ assign(s,u')$FC
+
+ coerce(u:MAT FEXPR):$ ==
+ [vecAssign(YL,row(u,1)),vecAssign(YR,row(u,2)),returns()$FC]$List(FC)::$
+
+ coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+ coerce(r:RSFC):$ == coerce(r)$Rep
+
+ coerce(c:FortranCode):$ == coerce(c)$Rep
+
+ coerce(u:$):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+ retract(u:MAT FRAC POLY INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2a
+ v::$
+
+ retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT FRAC POLY FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2b
+ v::$
+
+ retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT EXPR INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2e
+ v::$
+
+ retractIfCan(u:MAT EXPR INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT EXPR FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2f
+ v::$
+
+ retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT POLY INT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2c
+ v::$
+
+ retractIfCan(u:MAT POLY INT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+ retract(u:MAT POLY FLOAT):$ ==
+ v : MAT FEXPR := map(retract,u)$MF2d
+ v::$
+
+ retractIfCan(u:MAT POLY FLOAT):Union($,"failed") ==
+ v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d
+ v case "failed" => "failed"
+ (v::MAT FEXPR)::$
+
+@
+\section{domain ASP9 Asp9}
+<<domain ASP9 Asp9>>=
+)abbrev domain ASP9 Asp9
+++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
+++ Date Created: Mar 1993
+++ Date Last Updated: 18 March 1994
+++ 12 July 1994 added COMMON blocks for d02cjf, d02ejf
+++ 6 October 1994
+++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
+++ Description:
+++\spadtype{Asp9} produces Fortran for Type 9 ASPs, needed for NAG routines
+++\axiomOpFrom{d02bhf}{d02Package}, \axiomOpFrom{d02cjf}{d02Package}, \axiomOpFrom{d02ejf}{d02Package}.
+++These ASPs represent a function of a scalar X and a vector Y, for example:
+++\begin{verbatim}
+++ DOUBLE PRECISION FUNCTION G(X,Y)
+++ DOUBLE PRECISION X,Y(*)
+++ G=X+Y(1)
+++ RETURN
+++ END
+++\end{verbatim}
+++If the user provides a constant value for G, then extra information is added
+++via COMMON blocks used by certain routines. This specifies that the value
+++returned by G in this case is to be ignored.
+
+Asp9(name): Exports == Implementation where
+ name : Symbol
+
+ FEXPR ==> FortranExpression(['X],['Y],MFLOAT)
+ MFLOAT ==> MachineFloat
+ FC ==> FortranCode
+ FST ==> FortranScalarType
+ FT ==> FortranType
+ SYMTAB ==> SymbolTable
+ RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
+ UFST ==> Union(fst:FST,void:"void")
+ FRAC ==> Fraction
+ POLY ==> Polynomial
+ EXPR ==> Expression
+ INT ==> Integer
+ FLOAT ==> Float
+
+ Exports ==> FortranFunctionCategory with
+ coerce : FEXPR -> %
+ ++coerce(f) takes an object from the appropriate instantiation of
+ ++\spadtype{FortranExpression} and turns it into an ASP.
+
+ Implementation ==> add
+
+ real : FST := "real"::FST
+ syms : SYMTAB := empty()$SYMTAB
+ declare!(X,fortranReal()$FT,syms)$SYMTAB
+ yType : FT := construct([real]$UFST,["*"::Symbol],false)$FT
+ declare!(Y,yType,syms)$SYMTAB
+ Rep := FortranProgram(name,[real]$UFST,[X,Y],syms)
+
+ retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:EXPR INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:POLY FLOAT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
+ retractIfCan(u:POLY INT):Union($,"failed") ==
+ foo : Union(FEXPR,"failed")
+ foo := retractIfCan(u)$FEXPR
+ foo case "failed" => "failed"
+ (foo::FEXPR)::$
+
+ coerce(u:FEXPR):% ==
+ expr : Expression MachineFloat := (u::Expression(MachineFloat))$FEXPR
+ (retractIfCan(u)@Union(MFLOAT,"failed"))$FEXPR case "failed" =>
+ coerce(expr)$Rep
+ locals : SYMTAB := empty()
+ charType : FT := construct(["character"::FST]$UFST,[6::POLY(INT)],false)$FT
+ declare!([CHDUM1,CHDUM2,GOPT1,CHDUM,GOPT2],charType,locals)$SYMTAB
+ common1 := common(CD02EJ,[CHDUM1,CHDUM2,GOPT1] )$FC
+ common2 := common(AD02CJ,[CHDUM,GOPT2] )$FC
+ assign1 := assign(GOPT1,"NOGOPT")$FC
+ assign2 := assign(GOPT2,"NOGOPT")$FC
+ result := assign(name,expr)$FC
+ code : List FC := [common1,common2,assign1,assign2,result]
+ ([locals,code]$RSFC)::Rep
+
+ coerce(c:List FortranCode):% == coerce(c)$Rep
+
+ coerce(r:RSFC):% == coerce(r)$Rep
+
+ coerce(c:FortranCode):% == coerce(c)$Rep
+
+ coerce(u:%):OutputForm == coerce(u)$Rep
+
+ outputAsFortran(u):Void ==
+ p := checkPrecision()$NAGLinkSupportPackage
+ outputAsFortran(u)$Rep
+ p => restorePrecision()$NAGLinkSupportPackage
+
+@
+\section{License}
+<<license>>=
+--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+--All rights reserved.
+--
+--Redistribution and use in source and binary forms, with or without
+--modification, are permitted provided that the following conditions are
+--met:
+--
+-- - Redistributions of source code must retain the above copyright
+-- notice, this list of conditions and the following disclaimer.
+--
+-- - Redistributions in binary form must reproduce the above copyright
+-- notice, this list of conditions and the following disclaimer in
+-- the documentation and/or other materials provided with the
+-- distribution.
+--
+-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- names of its contributors may be used to endorse or promote products
+-- derived from this software without specific prior written permission.
+--
+--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+@
+<<*>>=
+<<license>>
+
+<<domain ASP1 Asp1>>
+<<domain ASP10 Asp10>>
+<<domain ASP12 Asp12>>
+<<domain ASP19 Asp19>>
+<<domain ASP20 Asp20>>
+<<domain ASP24 Asp24>>
+<<domain ASP27 Asp27>>
+<<domain ASP28 Asp28>>
+<<domain ASP29 Asp29>>
+<<domain ASP30 Asp30>>
+<<domain ASP31 Asp31>>
+<<domain ASP33 Asp33>>
+<<domain ASP34 Asp34>>
+<<domain ASP35 Asp35>>
+<<domain ASP4 Asp4>>
+<<domain ASP41 Asp41>>
+<<domain ASP42 Asp42>>
+<<domain ASP49 Asp49>>
+<<domain ASP50 Asp50>>
+<<domain ASP55 Asp55>>
+<<domain ASP6 Asp6>>
+<<domain ASP7 Asp7>>
+<<domain ASP73 Asp73>>
+<<domain ASP74 Asp74>>
+<<domain ASP77 Asp77>>
+<<domain ASP78 Asp78>>
+<<domain ASP8 Asp8>>
+<<domain ASP80 Asp80>>
+<<domain ASP9 Asp9>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-12 13:29:17 +0000