\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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= )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} <>= --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. @ <<*>>= <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}