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