\documentclass{article}
\usepackage{axiom}
\begin{document}
\title{\$SPAD/src/algebra asp.spad}
\author{Mike Dewar, Grant Keady, Godfrey Nolan}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{domain ASP1 Asp1}
<<domain ASP1 Asp1>>=
)abbrev domain ASP1 Asp1
++ Author: Mike Dewar, Grant Keady, Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 18 March 1994
++                     6 October 1994
++ Related Constructors: FortranFunctionCategory, FortranProgramCategory.
++ Description: 
++\spadtype{Asp1} produces Fortran for Type 1 ASPs, needed for various
++NAG routines. Type 1 ASPs take a univariate expression (in the symbol
++X) and turn it into a Fortran Function like the following:
++\begin{verbatim}
++      DOUBLE PRECISION FUNCTION F(X)
++      DOUBLE PRECISION X
++      F=DSIN(X)
++      RETURN
++      END
++\end{verbatim}


Asp1(name): Exports == Implementation where
  name : Symbol

  FEXPR  ==> FortranExpression
  FST    ==> FortranScalarType
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float

  Exports ==> FortranFunctionCategory with
    coerce : FEXPR(['X],[],MachineFloat) -> $
      ++coerce(f) takes an object from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns it into an ASP.

  Implementation ==> add

    -- Build Symbol Table for Rep
    syms : SYMTAB := empty()$SYMTAB
    declare!(X,fortranReal()$FT,syms)$SYMTAB
    real : FST := "real"::FST

    Rep := FortranProgram(name,[real]$Union(fst:FST,void:"void"),[X],syms)

    retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
    retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
      foo case "failed" => "failed"
      foo::FEXPR(['X],[],MachineFloat)::$

    retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
    retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
      foo case "failed" => "failed"
      foo::FEXPR(['X],[],MachineFloat)::$

    retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
    retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
      foo case "failed" => "failed"
      foo::FEXPR(['X],[],MachineFloat)::$

    retract(u:EXPR INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
    retractIfCan(u:EXPR INT):Union($,"failed") ==
      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
      foo case "failed" => "failed"
      foo::FEXPR(['X],[],MachineFloat)::$

    retract(u:POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
    retractIfCan(u:POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
      foo case "failed" => "failed"
      foo::FEXPR(['X],[],MachineFloat)::$

    retract(u:POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
    retractIfCan(u:POLY INT):Union($,"failed") ==
      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
      foo case "failed" => "failed"
      foo::FEXPR(['X],[],MachineFloat)::$

    coerce(u:FEXPR(['X],[],MachineFloat)):$ ==
      coerce((u::Expression(MachineFloat))$FEXPR(['X],[],MachineFloat))$Rep

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void == 
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP10 Asp10}
<<domain ASP10 Asp10>>=
)abbrev domain ASP10 Asp10
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 18 March 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description: 
++\spadtype{ASP10} produces Fortran for Type 10 ASPs, needed for NAG routine 
++\axiomOpFrom{d02kef}{d02Package}. This ASP computes the values of a set of functions, for example: 
++\begin{verbatim}
++      SUBROUTINE COEFFN(P,Q,DQDL,X,ELAM,JINT)
++      DOUBLE PRECISION ELAM,P,Q,X,DQDL
++      INTEGER JINT
++      P=1.0D0
++      Q=((-1.0D0*X**3)+ELAM*X*X-2.0D0)/(X*X)
++      DQDL=1.0D0
++      RETURN
++      END
++\end{verbatim}

Asp10(name): Exports == Implementation where
  name : Symbol

  FST  ==> FortranScalarType
  FT   ==> FortranType
  SYMTAB ==> SymbolTable
  EXF ==> Expression Float
  RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FEXPR ==> FortranExpression(['JINT,'X,'ELAM],[],MFLOAT)
  MFLOAT ==> MachineFloat
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2

  Exports ==> FortranVectorFunctionCategory with
    coerce : Vector FEXPR -> %
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : FST := "real"::FST
    syms : SYMTAB := empty()$SYMTAB
    declare!(P,fortranReal()$FT,syms)$SYMTAB
    declare!(Q,fortranReal()$FT,syms)$SYMTAB
    declare!(DQDL,fortranReal()$FT,syms)$SYMTAB
    declare!(X,fortranReal()$FT,syms)$SYMTAB
    declare!(ELAM,fortranReal()$FT,syms)$SYMTAB
    declare!(JINT,fortranInteger()$FT,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"),
                          [P,Q,DQDL,X,ELAM,JINT],syms)

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    coerce(c:FortranCode):% == coerce(c)$Rep

    coerce(r:RSFC):% == coerce(r)$Rep

    coerce(c:List FortranCode):% == coerce(c)$Rep

    -- To help the poor old compiler!
    localAssign(s:Symbol,u:Expression MFLOAT):FortranCode == 
      assign(s,u)$FortranCode

    coerce(u:Vector FEXPR):% ==
      import Vector FEXPR
      not (#u = 3) => error "Incorrect Dimension For Vector"
      ([localAssign(P,elt(u,1)::Expression MFLOAT),_
        localAssign(Q,elt(u,2)::Expression MFLOAT),_
        localAssign(DQDL,elt(u,3)::Expression MFLOAT),_
        returns()$FortranCode ]$List(FortranCode))::Rep

    coerce(u:%):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP12 Asp12}
<<domain ASP12 Asp12>>=
)abbrev domain ASP12 Asp12
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Oct 1993
++ Date Last Updated: 18 March 1994
++                    21 June 1994 Changed print to printStatement
++ Related Constructors:
++ Description:
++\spadtype{Asp12} produces Fortran for Type 12 ASPs, needed for NAG routine 
++\axiomOpFrom{d02kef}{d02Package} etc., for example: 
++\begin{verbatim}
++      SUBROUTINE MONIT (MAXIT,IFLAG,ELAM,FINFO)
++      DOUBLE PRECISION ELAM,FINFO(15)
++      INTEGER MAXIT,IFLAG
++      IF(MAXIT.EQ.-1)THEN
++        PRINT*,"Output from Monit"
++      ENDIF
++      PRINT*,MAXIT,IFLAG,ELAM,(FINFO(I),I=1,4)
++      RETURN
++      END
++\end{verbatim}
Asp12(name): Exports == Implementation where
  name : Symbol

  O      ==> OutputForm
  S      ==> Symbol
  FST    ==> FortranScalarType
  FT     ==> FortranType
  FC     ==> FortranCode
  SYMTAB ==> SymbolTable
  EXI    ==> Expression Integer
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  U      ==> Union(I: Expression Integer,F: Expression Float,_
                   CF: Expression Complex Float,switch:Switch)
  UFST   ==> Union(fst:FST,void:"void")

  Exports ==> FortranProgramCategory with
     outputAsFortran:() -> Void
      ++outputAsFortran() generates the default code for \spadtype{ASP12}.
    
  Implementation ==> add

    import FC
    import Switch

    real : FST := "real"::FST
    syms : SYMTAB := empty()$SYMTAB
    declare!(MAXIT,fortranInteger()$FT,syms)$SYMTAB
    declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB
    declare!(ELAM,fortranReal()$FT,syms)$SYMTAB
    fType : FT := construct([real]$UFST,["15"::Symbol],false)$FT
    declare!(FINFO,fType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,[MAXIT,IFLAG,ELAM,FINFO],syms)

    -- eqn : O := (I::O)=(1@Integer::EXI::O)
    code:=([cond(EQ([MAXIT@S::EXI]$U,[-1::EXI]$U),
                 printStatement(["_"Output from Monit_""::O])),
            printStatement([MAXIT::O,IFLAG::O,ELAM::O,subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]), -- YUCK!
            returns()]$List(FortranCode))::Rep

    coerce(u:%):OutputForm == coerce(u)$Rep

    outputAsFortran(u:%):Void == outputAsFortran(u)$Rep
    outputAsFortran():Void == outputAsFortran(code)$Rep  

@
\section{domain ASP19 Asp19}
<<domain ASP19 Asp19>>=
)abbrev domain ASP19 Asp19
++ Author: Mike Dewar, Godfrey Nolan, Grant Keady
++ Date Created: Mar 1993
++ Date Last Updated: 18 March 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp19} produces Fortran for Type 19 ASPs, evaluating a set of
++functions and their jacobian at a given point, for example:
++\begin{verbatim}
++      SUBROUTINE LSFUN2(M,N,XC,FVECC,FJACC,LJC)
++      DOUBLE PRECISION FVECC(M),FJACC(LJC,N),XC(N)
++      INTEGER M,N,LJC
++      INTEGER I,J
++      DO 25003 I=1,LJC
++        DO 25004 J=1,N
++          FJACC(I,J)=0.0D0
++25004   CONTINUE
++25003 CONTINUE
++      FVECC(1)=((XC(1)-0.14D0)*XC(3)+(15.0D0*XC(1)-2.1D0)*XC(2)+1.0D0)/(
++     &XC(3)+15.0D0*XC(2))
++      FVECC(2)=((XC(1)-0.18D0)*XC(3)+(7.0D0*XC(1)-1.26D0)*XC(2)+1.0D0)/(
++     &XC(3)+7.0D0*XC(2))
++      FVECC(3)=((XC(1)-0.22D0)*XC(3)+(4.333333333333333D0*XC(1)-0.953333
++     &3333333333D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2))
++      FVECC(4)=((XC(1)-0.25D0)*XC(3)+(3.0D0*XC(1)-0.75D0)*XC(2)+1.0D0)/(
++     &XC(3)+3.0D0*XC(2))
++      FVECC(5)=((XC(1)-0.29D0)*XC(3)+(2.2D0*XC(1)-0.6379999999999999D0)*
++     &XC(2)+1.0D0)/(XC(3)+2.2D0*XC(2))
++      FVECC(6)=((XC(1)-0.32D0)*XC(3)+(1.666666666666667D0*XC(1)-0.533333
++     &3333333333D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2))
++      FVECC(7)=((XC(1)-0.35D0)*XC(3)+(1.285714285714286D0*XC(1)-0.45D0)*
++     &XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2))
++      FVECC(8)=((XC(1)-0.39D0)*XC(3)+(XC(1)-0.39D0)*XC(2)+1.0D0)/(XC(3)+
++     &XC(2))
++      FVECC(9)=((XC(1)-0.37D0)*XC(3)+(XC(1)-0.37D0)*XC(2)+1.285714285714
++     &286D0)/(XC(3)+XC(2))
++      FVECC(10)=((XC(1)-0.58D0)*XC(3)+(XC(1)-0.58D0)*XC(2)+1.66666666666
++     &6667D0)/(XC(3)+XC(2))
++      FVECC(11)=((XC(1)-0.73D0)*XC(3)+(XC(1)-0.73D0)*XC(2)+2.2D0)/(XC(3)
++     &+XC(2))
++      FVECC(12)=((XC(1)-0.96D0)*XC(3)+(XC(1)-0.96D0)*XC(2)+3.0D0)/(XC(3)
++     &+XC(2))
++      FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333
++     &3333D0)/(XC(3)+XC(2))
++      FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X
++     &C(2))
++      FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3
++     &)+XC(2))
++      FJACC(1,1)=1.0D0
++      FJACC(1,2)=-15.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2)
++      FJACC(1,3)=-1.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2)
++      FJACC(2,1)=1.0D0
++      FJACC(2,2)=-7.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2)
++      FJACC(2,3)=-1.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2)
++      FJACC(3,1)=1.0D0
++      FJACC(3,2)=((-0.1110223024625157D-15*XC(3))-4.333333333333333D0)/(
++     &XC(3)**2+8.666666666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2)
++     &**2)
++      FJACC(3,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+8.666666
++     &666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2)**2)
++      FJACC(4,1)=1.0D0
++      FJACC(4,2)=-3.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2)
++      FJACC(4,3)=-1.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2)
++      FJACC(5,1)=1.0D0
++      FJACC(5,2)=((-0.1110223024625157D-15*XC(3))-2.2D0)/(XC(3)**2+4.399
++     &999999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2)
++      FJACC(5,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+4.399999
++     &999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2)
++      FJACC(6,1)=1.0D0
++      FJACC(6,2)=((-0.2220446049250313D-15*XC(3))-1.666666666666667D0)/(
++     &XC(3)**2+3.333333333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2)
++     &**2)
++      FJACC(6,3)=(0.2220446049250313D-15*XC(2)-1.0D0)/(XC(3)**2+3.333333
++     &333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2)**2)
++      FJACC(7,1)=1.0D0
++      FJACC(7,2)=((-0.5551115123125783D-16*XC(3))-1.285714285714286D0)/(
++     &XC(3)**2+2.571428571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2)
++     &**2)
++      FJACC(7,3)=(0.5551115123125783D-16*XC(2)-1.0D0)/(XC(3)**2+2.571428
++     &571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2)**2)
++      FJACC(8,1)=1.0D0
++      FJACC(8,2)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      FJACC(8,3)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      FJACC(9,1)=1.0D0
++      FJACC(9,2)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)*
++     &*2)
++      FJACC(9,3)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)*
++     &*2)
++      FJACC(10,1)=1.0D0
++      FJACC(10,2)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)
++     &**2)
++      FJACC(10,3)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)
++     &**2)
++      FJACC(11,1)=1.0D0
++      FJACC(11,2)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      FJACC(11,3)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      FJACC(12,1)=1.0D0
++      FJACC(12,2)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      FJACC(12,3)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      FJACC(13,1)=1.0D0
++      FJACC(13,2)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)
++     &**2)
++      FJACC(13,3)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)
++     &**2)
++      FJACC(14,1)=1.0D0
++      FJACC(14,2)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      FJACC(14,3)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      FJACC(15,1)=1.0D0
++      FJACC(15,2)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      FJACC(15,3)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2)
++      RETURN
++      END
++\end{verbatim}

Asp19(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FT     ==> FortranType
  FC     ==> FortranCode
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FC))
  FSTU   ==> Union(fst:FST,void:"void")
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  MFLOAT ==> MachineFloat
  VEC    ==> Vector
  VF2    ==> VectorFunctions2
  MF2    ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT)
  FEXPR  ==> FortranExpression([],['XC],MFLOAT)
  S      ==> Symbol

  Exports ==> FortranVectorFunctionCategory with
    coerce : VEC FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : FSTU := ["real"::FST]$FSTU
    syms : SYMTAB := empty()$SYMTAB
    declare!(M,fortranInteger()$FT,syms)$SYMTAB
    declare!(N,fortranInteger()$FT,syms)$SYMTAB
    declare!(LJC,fortranInteger()$FT,syms)$SYMTAB
    xcType : FT := construct(real,[N],false)$FT
    declare!(XC,xcType,syms)$SYMTAB
    fveccType : FT := construct(real,[M],false)$FT
    declare!(FVECC,fveccType,syms)$SYMTAB
    fjaccType : FT := construct(real,[LJC,N],false)$FT
    declare!(FJACC,fjaccType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$FSTU,[M,N,XC,FVECC,FJACC,LJC],syms)

    coerce(c:List FC):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FC):$ == coerce(c)$Rep

    -- Take a symbol, pull of the script and turn it into an integer!!
    o2int(u:S):Integer ==
      o : OutputForm := first elt(scripts(u)$S,sub)
      o pretend Integer

    -- To help the poor old compiler!
    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    localAssign1(s:S,j:Matrix FEXPR):FC == 
      j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2
      assign(s,j')$FC

    localAssign2(s:S,j:VEC FEXPR):FC ==
      j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
      assign(s,j')$FC

    coerce(u:VEC FEXPR):$ ==
      -- First zero the Jacobian matrix in case we miss some derivatives which
      -- are zero.
      import POLY INT
      seg1 : Segment (POLY INT) := segment(1::(POLY INT),LJC@S::(POLY INT))
      seg2 : Segment (POLY INT) := segment(1::(POLY INT),N@S::(POLY INT))
      s1 : SegmentBinding POLY INT := equation(I@S,seg1)
      s2 : SegmentBinding POLY INT := equation(J@S,seg2)
      as : FC := assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT)
      clear : FC := forLoop(s1,forLoop(s2,as))
      j:Integer
      x:S := XC::S
      pu:List(S) := []
      -- Work out which variables appear in the expressions
      for e in entries(u) repeat
        pu := setUnion(pu,variables(e)$FEXPR)
      scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer)
      -- This should be the maximum XC_n which occurs (there may be others
      -- which don't):
      n:Integer := reduce(max,scriptList)$List(Integer)
      p:List(S) := []
      for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p)
      p:= reverse(p)
      jac:Matrix(FEXPR) := _
      jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
      c1:FC := localAssign2(FVECC,u)
      c2:FC := localAssign1(FJACC,jac)
      [clear,c1,c2,returns()]$List(FC)::$

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage


    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

@
\section{domain ASP20 Asp20}
<<domain ASP20 Asp20>>=
)abbrev domain ASP20 Asp20
++ Author: Mike Dewar and Godfrey Nolan and Grant Keady
++ Date Created: Dec 1993
++ Date Last Updated: 21 March 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp20} produces Fortran for Type 20 ASPs, for example:
++\begin{verbatim}
++      SUBROUTINE QPHESS(N,NROWH,NCOLH,JTHCOL,HESS,X,HX)
++      DOUBLE PRECISION HX(N),X(N),HESS(NROWH,NCOLH)
++      INTEGER JTHCOL,N,NROWH,NCOLH
++      HX(1)=2.0D0*X(1)
++      HX(2)=2.0D0*X(2)
++      HX(3)=2.0D0*X(4)+2.0D0*X(3)
++      HX(4)=2.0D0*X(4)+2.0D0*X(3)
++      HX(5)=2.0D0*X(5)
++      HX(6)=(-2.0D0*X(7))+(-2.0D0*X(6))
++      HX(7)=(-2.0D0*X(7))+(-2.0D0*X(6))
++      RETURN
++      END
++\end{verbatim}

Asp20(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  PI     ==> PositiveInteger
  UFST   ==> Union(fst:FST,void:"void")
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  MAT    ==> Matrix
  VF2    ==> VectorFunctions2
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression([],['X,'HESS],MFLOAT)
  O      ==> OutputForm
  M2     ==> MatrixCategoryFunctions2
  MF2a   ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT,
                MAT FRAC POLY INT,FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2b   ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT,
                MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2c   ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT,
                FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2d   ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT,
                MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2e   ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT,
                FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2f   ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT,
                MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)


  Exports ==> FortranMatrixFunctionCategory with
    coerce: MAT FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : UFST := ["real"::FST]$UFST
    syms : SYMTAB := empty()
    declare!(N,fortranInteger(),syms)$SYMTAB
    declare!(NROWH,fortranInteger(),syms)$SYMTAB
    declare!(NCOLH,fortranInteger(),syms)$SYMTAB
    declare!(JTHCOL,fortranInteger(),syms)$SYMTAB
    hessType : FT := construct(real,[NROWH,NCOLH],false)$FT
    declare!(HESS,hessType,syms)$SYMTAB
    xType : FT := construct(real,[N],false)$FT
    declare!(X,xType,syms)$SYMTAB
    declare!(HX,xType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,
                          [N,NROWH,NCOLH,JTHCOL,HESS,X,HX],syms)

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    -- To help the poor old compiler!
    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    localAssign(s:Symbol,j:VEC FEXPR):FortranCode ==
      j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
      assign(s,j')$FortranCode

    coerce(u:MAT FEXPR):$ ==
      j:Integer
      x:Symbol := X::Symbol
      n := nrows(u)::PI
      p:VEC FEXPR := [retract(subscript(x,[j::O])$Symbol)@FEXPR for j in 1..n]
      prod:VEC FEXPR := u*p
      ([localAssign(HX,prod),returns()$FortranCode]$List(FortranCode))::$

    retract(u:MAT FRAC POLY INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2a
      v::$

    retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT FRAC POLY FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2b
      v::$

    retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT EXPR INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2e
      v::$

    retractIfCan(u:MAT EXPR INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT EXPR FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2f
      v::$

    retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT POLY INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2c
      v::$

    retractIfCan(u:MAT POLY INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT POLY FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2d
      v::$

    retractIfCan(u:MAT POLY FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    coerce(u:$):O == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP24 Asp24}
<<domain ASP24 Asp24>>=
)abbrev domain ASP24 Asp24
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 21 March 1994
++                     6 October 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp24} produces Fortran for Type 24 ASPs which evaluate a 
++multivariate function at a point (needed for NAG routine \axiomOpFrom{e04jaf}{e04Package}), for example:
++\begin{verbatim}
++      SUBROUTINE FUNCT1(N,XC,FC)
++      DOUBLE PRECISION FC,XC(N)
++      INTEGER N
++      FC=10.0D0*XC(4)**4+(-40.0D0*XC(1)*XC(4)**3)+(60.0D0*XC(1)**2+5
++     &.0D0)*XC(4)**2+((-10.0D0*XC(3))+(-40.0D0*XC(1)**3))*XC(4)+16.0D0*X
++     &C(3)**4+(-32.0D0*XC(2)*XC(3)**3)+(24.0D0*XC(2)**2+5.0D0)*XC(3)**2+
++     &(-8.0D0*XC(2)**3*XC(3))+XC(2)**4+100.0D0*XC(2)**2+20.0D0*XC(1)*XC(
++     &2)+10.0D0*XC(1)**4+XC(1)**2
++      RETURN
++      END
++\end{verbatim}

Asp24(name): Exports == Implementation where
  name : Symbol

  FST  ==> FortranScalarType
  FT   ==> FortranType
  SYMTAB ==> SymbolTable
  RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FSTU ==> Union(fst:FST,void:"void")
  FEXPR ==> FortranExpression([],['XC],MachineFloat)
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float

  Exports ==> FortranFunctionCategory with
      coerce : FEXPR -> $
	++ coerce(f) takes an object from the appropriate instantiation of
      	++ \spadtype{FortranExpression} and turns it into an ASP.


  Implementation ==> add


    real : FSTU := ["real"::FST]$FSTU
    syms : SYMTAB := empty()
    declare!(N,fortranInteger(),syms)$SYMTAB
    xcType : FT := construct(real,[N::Symbol],false)$FT
    declare!(XC,xcType,syms)$SYMTAB
    declare!(FC,fortranReal(),syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$FSTU,[N,XC,FC],syms)

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(u:FEXPR):$ ==
      coerce(assign(FC,u::Expression(MachineFloat))$FortranCode)$Rep

    retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:EXPR INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:POLY INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP27 Asp27}
<<domain ASP27 Asp27>>=
)abbrev domain ASP27 Asp27
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Nov 1993
++ Date Last Updated: 27 April 1994
++                     6 October 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp27} produces Fortran for Type 27 ASPs, needed for NAG routine
++\axiomOpFrom{f02fjf}{f02Package} ,for example:
++\begin{verbatim}
++      FUNCTION DOT(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK)
++      DOUBLE PRECISION W(N),Z(N),RWORK(LRWORK)
++      INTEGER N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK)
++      DOT=(W(16)+(-0.5D0*W(15)))*Z(16)+((-0.5D0*W(16))+W(15)+(-0.5D0*W(1
++     &4)))*Z(15)+((-0.5D0*W(15))+W(14)+(-0.5D0*W(13)))*Z(14)+((-0.5D0*W(
++     &14))+W(13)+(-0.5D0*W(12)))*Z(13)+((-0.5D0*W(13))+W(12)+(-0.5D0*W(1
++     &1)))*Z(12)+((-0.5D0*W(12))+W(11)+(-0.5D0*W(10)))*Z(11)+((-0.5D0*W(
++     &11))+W(10)+(-0.5D0*W(9)))*Z(10)+((-0.5D0*W(10))+W(9)+(-0.5D0*W(8))
++     &)*Z(9)+((-0.5D0*W(9))+W(8)+(-0.5D0*W(7)))*Z(8)+((-0.5D0*W(8))+W(7)
++     &+(-0.5D0*W(6)))*Z(7)+((-0.5D0*W(7))+W(6)+(-0.5D0*W(5)))*Z(6)+((-0.
++     &5D0*W(6))+W(5)+(-0.5D0*W(4)))*Z(5)+((-0.5D0*W(5))+W(4)+(-0.5D0*W(3
++     &)))*Z(4)+((-0.5D0*W(4))+W(3)+(-0.5D0*W(2)))*Z(3)+((-0.5D0*W(3))+W(
++     &2)+(-0.5D0*W(1)))*Z(2)+((-0.5D0*W(2))+W(1))*Z(1)
++      RETURN
++      END
++\end{verbatim}

Asp27(name): Exports == Implementation where
  name : Symbol

  O      ==> OutputForm
  FST    ==> FortranScalarType
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  UFST   ==> Union(fst:FST,void:"void")
  FC     ==> FortranCode
  PI     ==> PositiveInteger
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  EXPR   ==> Expression
  MAT    ==> Matrix
  MFLOAT ==> MachineFloat



  Exports == FortranMatrixCategory

  Implementation == add


    real : UFST := ["real"::FST]$UFST
    integer : UFST := ["integer"::FST]$UFST
    syms : SYMTAB := empty()$SYMTAB
    declare!(IFLAG,fortranInteger(),syms)$SYMTAB
    declare!(N,fortranInteger(),syms)$SYMTAB
    declare!(LRWORK,fortranInteger(),syms)$SYMTAB
    declare!(LIWORK,fortranInteger(),syms)$SYMTAB
    zType : FT := construct(real,[N],false)$FT
    declare!(Z,zType,syms)$SYMTAB
    declare!(W,zType,syms)$SYMTAB
    rType : FT := construct(real,[LRWORK],false)$FT
    declare!(RWORK,rType,syms)$SYMTAB
    iType : FT := construct(integer,[LIWORK],false)$FT
    declare!(IWORK,iType,syms)$SYMTAB
    Rep := FortranProgram(name,real,
                          [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms)

    -- To help the poor old compiler!
    localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT)

    coerce (u:MAT MFLOAT):$ ==
      Ws: Symbol := W
      Zs: Symbol := Z
      code : List FC
      l:EXPR MFLOAT := "+"/ _
          [("+"/[localCoerce(elt(Ws,[j::O])$Symbol) * u(j,i)_
                                              for j in 1..nrows(u)::PI])_
           *localCoerce(elt(Zs,[i::O])$Symbol) for i in 1..ncols(u)::PI]
      c := assign(name,l)$FC
      code := [c,returns()]$List(FC)
      code::$

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP28 Asp28}
<<domain ASP28 Asp28>>=
)abbrev domain ASP28 Asp28
++ Author: Mike Dewar
++ Date Created: 21 March 1994
++ Date Last Updated: 28 April 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp28} produces Fortran for Type 28 ASPs, used in NAG routine 
++\axiomOpFrom{f02fjf}{f02Package}, for example:
++\begin{verbatim}
++      SUBROUTINE IMAGE(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK)
++      DOUBLE PRECISION Z(N),W(N),IWORK(LRWORK),RWORK(LRWORK)
++      INTEGER N,LIWORK,IFLAG,LRWORK
++      W(1)=0.01707454969713436D0*Z(16)+0.001747395874954051D0*Z(15)+0.00
++     &2106973900813502D0*Z(14)+0.002957434991769087D0*Z(13)+(-0.00700554
++     &0882865317D0*Z(12))+(-0.01219194009813166D0*Z(11))+0.0037230647365
++     &3087D0*Z(10)+0.04932374658377151D0*Z(9)+(-0.03586220812223305D0*Z(
++     &8))+(-0.04723268012114625D0*Z(7))+(-0.02434652144032987D0*Z(6))+0.
++     &2264766947290192D0*Z(5)+(-0.1385343580686922D0*Z(4))+(-0.116530050
++     &8238904D0*Z(3))+(-0.2803531651057233D0*Z(2))+1.019463911841327D0*Z
++     &(1)
++      W(2)=0.0227345011107737D0*Z(16)+0.008812321197398072D0*Z(15)+0.010
++     &94012210519586D0*Z(14)+(-0.01764072463999744D0*Z(13))+(-0.01357136
++     &72105995D0*Z(12))+0.00157466157362272D0*Z(11)+0.05258889186338282D
++     &0*Z(10)+(-0.01981532388243379D0*Z(9))+(-0.06095390688679697D0*Z(8)
++     &)+(-0.04153119955569051D0*Z(7))+0.2176561076571465D0*Z(6)+(-0.0532
++     &5555586632358D0*Z(5))+(-0.1688977368984641D0*Z(4))+(-0.32440166056
++     &67343D0*Z(3))+0.9128222941872173D0*Z(2)+(-0.2419652703415429D0*Z(1
++     &))
++      W(3)=0.03371198197190302D0*Z(16)+0.02021603150122265D0*Z(15)+(-0.0
++     &06607305534689702D0*Z(14))+(-0.03032392238968179D0*Z(13))+0.002033
++     &305231024948D0*Z(12)+0.05375944956767728D0*Z(11)+(-0.0163213312502
++     &9967D0*Z(10))+(-0.05483186562035512D0*Z(9))+(-0.04901428822579872D
++     &0*Z(8))+0.2091097927887612D0*Z(7)+(-0.05760560341383113D0*Z(6))+(-
++     &0.1236679206156403D0*Z(5))+(-0.3523683853026259D0*Z(4))+0.88929961
++     &32269974D0*Z(3)+(-0.2995429545781457D0*Z(2))+(-0.02986582812574917
++     &D0*Z(1))
++      W(4)=0.05141563713660119D0*Z(16)+0.005239165960779299D0*Z(15)+(-0.
++     &01623427735779699D0*Z(14))+(-0.01965809746040371D0*Z(13))+0.054688
++     &97337339577D0*Z(12)+(-0.014224695935687D0*Z(11))+(-0.0505181779315
++     &6355D0*Z(10))+(-0.04353074206076491D0*Z(9))+0.2012230497530726D0*Z
++     &(8)+(-0.06630874514535952D0*Z(7))+(-0.1280829963720053D0*Z(6))+(-0
++     &.305169742604165D0*Z(5))+0.8600427128450191D0*Z(4)+(-0.32415033802
++     &68184D0*Z(3))+(-0.09033531980693314D0*Z(2))+0.09089205517109111D0*
++     &Z(1)
++      W(5)=0.04556369767776375D0*Z(16)+(-0.001822737697581869D0*Z(15))+(
++     &-0.002512226501941856D0*Z(14))+0.02947046460707379D0*Z(13)+(-0.014
++     &45079632086177D0*Z(12))+(-0.05034242196614937D0*Z(11))+(-0.0376966
++     &3291725935D0*Z(10))+0.2171103102175198D0*Z(9)+(-0.0824949256021352
++     &4D0*Z(8))+(-0.1473995209288945D0*Z(7))+(-0.315042193418466D0*Z(6))
++     &+0.9591623347824002D0*Z(5)+(-0.3852396953763045D0*Z(4))+(-0.141718
++     &5427288274D0*Z(3))+(-0.03423495461011043D0*Z(2))+0.319820917706851
++     &6D0*Z(1)
++      W(6)=0.04015147277405744D0*Z(16)+0.01328585741341559D0*Z(15)+0.048
++     &26082005465965D0*Z(14)+(-0.04319641116207706D0*Z(13))+(-0.04931323
++     &319055762D0*Z(12))+(-0.03526886317505474D0*Z(11))+0.22295383396730
++     &01D0*Z(10)+(-0.07375317649315155D0*Z(9))+(-0.1589391311991561D0*Z(
++     &8))+(-0.328001910890377D0*Z(7))+0.952576555482747D0*Z(6)+(-0.31583
++     &09975786731D0*Z(5))+(-0.1846882042225383D0*Z(4))+(-0.0703762046700
++     &4427D0*Z(3))+0.2311852964327382D0*Z(2)+0.04254083491825025D0*Z(1)
++      W(7)=0.06069778964023718D0*Z(16)+0.06681263884671322D0*Z(15)+(-0.0
++     &2113506688615768D0*Z(14))+(-0.083996867458326D0*Z(13))+(-0.0329843
++     &8523869648D0*Z(12))+0.2276878326327734D0*Z(11)+(-0.067356038933017
++     &95D0*Z(10))+(-0.1559813965382218D0*Z(9))+(-0.3363262957694705D0*Z(
++     &8))+0.9442791158560948D0*Z(7)+(-0.3199955249404657D0*Z(6))+(-0.136
++     &2463839920727D0*Z(5))+(-0.1006185171570586D0*Z(4))+0.2057504515015
++     &423D0*Z(3)+(-0.02065879269286707D0*Z(2))+0.03160990266745513D0*Z(1
++     &)
++      W(8)=0.126386868896738D0*Z(16)+0.002563370039476418D0*Z(15)+(-0.05
++     &581757739455641D0*Z(14))+(-0.07777893205900685D0*Z(13))+0.23117338
++     &45834199D0*Z(12)+(-0.06031581134427592D0*Z(11))+(-0.14805474755869
++     &52D0*Z(10))+(-0.3364014128402243D0*Z(9))+0.9364014128402244D0*Z(8)
++     &+(-0.3269452524413048D0*Z(7))+(-0.1396841886557241D0*Z(6))+(-0.056
++     &1733845834199D0*Z(5))+0.1777789320590069D0*Z(4)+(-0.04418242260544
++     &359D0*Z(3))+(-0.02756337003947642D0*Z(2))+0.07361313110326199D0*Z(
++     &1)
++      W(9)=0.07361313110326199D0*Z(16)+(-0.02756337003947642D0*Z(15))+(-
++     &0.04418242260544359D0*Z(14))+0.1777789320590069D0*Z(13)+(-0.056173
++     &3845834199D0*Z(12))+(-0.1396841886557241D0*Z(11))+(-0.326945252441
++     &3048D0*Z(10))+0.9364014128402244D0*Z(9)+(-0.3364014128402243D0*Z(8
++     &))+(-0.1480547475586952D0*Z(7))+(-0.06031581134427592D0*Z(6))+0.23
++     &11733845834199D0*Z(5)+(-0.07777893205900685D0*Z(4))+(-0.0558175773
++     &9455641D0*Z(3))+0.002563370039476418D0*Z(2)+0.126386868896738D0*Z(
++     &1)
++      W(10)=0.03160990266745513D0*Z(16)+(-0.02065879269286707D0*Z(15))+0
++     &.2057504515015423D0*Z(14)+(-0.1006185171570586D0*Z(13))+(-0.136246
++     &3839920727D0*Z(12))+(-0.3199955249404657D0*Z(11))+0.94427911585609
++     &48D0*Z(10)+(-0.3363262957694705D0*Z(9))+(-0.1559813965382218D0*Z(8
++     &))+(-0.06735603893301795D0*Z(7))+0.2276878326327734D0*Z(6)+(-0.032
++     &98438523869648D0*Z(5))+(-0.083996867458326D0*Z(4))+(-0.02113506688
++     &615768D0*Z(3))+0.06681263884671322D0*Z(2)+0.06069778964023718D0*Z(
++     &1)
++      W(11)=0.04254083491825025D0*Z(16)+0.2311852964327382D0*Z(15)+(-0.0
++     &7037620467004427D0*Z(14))+(-0.1846882042225383D0*Z(13))+(-0.315830
++     &9975786731D0*Z(12))+0.952576555482747D0*Z(11)+(-0.328001910890377D
++     &0*Z(10))+(-0.1589391311991561D0*Z(9))+(-0.07375317649315155D0*Z(8)
++     &)+0.2229538339673001D0*Z(7)+(-0.03526886317505474D0*Z(6))+(-0.0493
++     &1323319055762D0*Z(5))+(-0.04319641116207706D0*Z(4))+0.048260820054
++     &65965D0*Z(3)+0.01328585741341559D0*Z(2)+0.04015147277405744D0*Z(1)
++      W(12)=0.3198209177068516D0*Z(16)+(-0.03423495461011043D0*Z(15))+(-
++     &0.1417185427288274D0*Z(14))+(-0.3852396953763045D0*Z(13))+0.959162
++     &3347824002D0*Z(12)+(-0.315042193418466D0*Z(11))+(-0.14739952092889
++     &45D0*Z(10))+(-0.08249492560213524D0*Z(9))+0.2171103102175198D0*Z(8
++     &)+(-0.03769663291725935D0*Z(7))+(-0.05034242196614937D0*Z(6))+(-0.
++     &01445079632086177D0*Z(5))+0.02947046460707379D0*Z(4)+(-0.002512226
++     &501941856D0*Z(3))+(-0.001822737697581869D0*Z(2))+0.045563697677763
++     &75D0*Z(1)
++      W(13)=0.09089205517109111D0*Z(16)+(-0.09033531980693314D0*Z(15))+(
++     &-0.3241503380268184D0*Z(14))+0.8600427128450191D0*Z(13)+(-0.305169
++     &742604165D0*Z(12))+(-0.1280829963720053D0*Z(11))+(-0.0663087451453
++     &5952D0*Z(10))+0.2012230497530726D0*Z(9)+(-0.04353074206076491D0*Z(
++     &8))+(-0.05051817793156355D0*Z(7))+(-0.014224695935687D0*Z(6))+0.05
++     &468897337339577D0*Z(5)+(-0.01965809746040371D0*Z(4))+(-0.016234277
++     &35779699D0*Z(3))+0.005239165960779299D0*Z(2)+0.05141563713660119D0
++     &*Z(1)
++      W(14)=(-0.02986582812574917D0*Z(16))+(-0.2995429545781457D0*Z(15))
++     &+0.8892996132269974D0*Z(14)+(-0.3523683853026259D0*Z(13))+(-0.1236
++     &679206156403D0*Z(12))+(-0.05760560341383113D0*Z(11))+0.20910979278
++     &87612D0*Z(10)+(-0.04901428822579872D0*Z(9))+(-0.05483186562035512D
++     &0*Z(8))+(-0.01632133125029967D0*Z(7))+0.05375944956767728D0*Z(6)+0
++     &.002033305231024948D0*Z(5)+(-0.03032392238968179D0*Z(4))+(-0.00660
++     &7305534689702D0*Z(3))+0.02021603150122265D0*Z(2)+0.033711981971903
++     &02D0*Z(1)
++      W(15)=(-0.2419652703415429D0*Z(16))+0.9128222941872173D0*Z(15)+(-0
++     &.3244016605667343D0*Z(14))+(-0.1688977368984641D0*Z(13))+(-0.05325
++     &555586632358D0*Z(12))+0.2176561076571465D0*Z(11)+(-0.0415311995556
++     &9051D0*Z(10))+(-0.06095390688679697D0*Z(9))+(-0.01981532388243379D
++     &0*Z(8))+0.05258889186338282D0*Z(7)+0.00157466157362272D0*Z(6)+(-0.
++     &0135713672105995D0*Z(5))+(-0.01764072463999744D0*Z(4))+0.010940122
++     &10519586D0*Z(3)+0.008812321197398072D0*Z(2)+0.0227345011107737D0*Z
++     &(1)
++      W(16)=1.019463911841327D0*Z(16)+(-0.2803531651057233D0*Z(15))+(-0.
++     &1165300508238904D0*Z(14))+(-0.1385343580686922D0*Z(13))+0.22647669
++     &47290192D0*Z(12)+(-0.02434652144032987D0*Z(11))+(-0.04723268012114
++     &625D0*Z(10))+(-0.03586220812223305D0*Z(9))+0.04932374658377151D0*Z
++     &(8)+0.00372306473653087D0*Z(7)+(-0.01219194009813166D0*Z(6))+(-0.0
++     &07005540882865317D0*Z(5))+0.002957434991769087D0*Z(4)+0.0021069739
++     &00813502D0*Z(3)+0.001747395874954051D0*Z(2)+0.01707454969713436D0*
++     &Z(1)
++      RETURN
++      END
++\end{verbatim}

Asp28(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  FC     ==> FortranCode
  PI     ==> PositiveInteger
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  EXPR   ==> Expression
  MFLOAT ==> MachineFloat
  VEC    ==> Vector
  UFST   ==> Union(fst:FST,void:"void")
  MAT    ==> Matrix

  Exports == FortranMatrixCategory 

  Implementation == add


    real : UFST := ["real"::FST]$UFST
    syms : SYMTAB := empty()
    declare!(IFLAG,fortranInteger(),syms)$SYMTAB
    declare!(N,fortranInteger(),syms)$SYMTAB
    declare!(LRWORK,fortranInteger(),syms)$SYMTAB
    declare!(LIWORK,fortranInteger(),syms)$SYMTAB
    xType : FT := construct(real,[N],false)$FT
    declare!(Z,xType,syms)$SYMTAB
    declare!(W,xType,syms)$SYMTAB
    rType : FT := construct(real,[LRWORK],false)$FT
    declare!(RWORK,rType,syms)$SYMTAB
    iType : FT := construct(real,[LIWORK],false)$FT
    declare!(IWORK,rType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,
                          [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms)

    -- To help the poor old compiler!
    localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT)

    coerce (u:MAT MFLOAT):$ ==
      Zs: Symbol := Z
      code : List FC
      r: List EXPR MFLOAT
      r := ["+"/[u(j,i)*localCoerce(elt(Zs,[i::OutputForm])$Symbol)_
                         for i in 1..ncols(u)$MAT(MFLOAT)::PI]_
                         for j in 1..nrows(u)$MAT(MFLOAT)::PI]
      code := [assign(W@Symbol,vector(r)$VEC(EXPR MFLOAT)),returns()]$List(FC)
      code::$

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP29 Asp29}
<<domain ASP29 Asp29>>=
)abbrev domain ASP29 Asp29
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Nov 1993
++ Date Last Updated: 18 March 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp29} produces Fortran for Type 29 ASPs, needed for NAG routine
++\axiomOpFrom{f02fjf}{f02Package}, for example:
++\begin{verbatim}
++      SUBROUTINE MONIT(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)
++      DOUBLE PRECISION D(K),F(K)
++      INTEGER K,NEXTIT,NEVALS,NVECS,ISTATE
++      CALL F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)
++      RETURN
++      END
++\end{verbatim}

Asp29(name): Exports == Implementation where
  name : Symbol

  FST  ==> FortranScalarType
  FT   ==> FortranType
  FSTU   ==> Union(fst:FST,void:"void")
  SYMTAB ==> SymbolTable
  FC   ==> FortranCode
  PI   ==> PositiveInteger
  EXF   ==> Expression Float
  EXI   ==> Expression Integer
  VEF  ==> Vector Expression Float
  VEI  ==> Vector Expression Integer
  MEI  ==> Matrix Expression Integer
  MEF  ==> Matrix Expression Float
  UEXPR ==> Union(I: Expression Integer,F: Expression Float,_
                  CF: Expression Complex Float)
  RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))

  Exports == FortranProgramCategory  with
     outputAsFortran:() -> Void
       ++outputAsFortran() generates the default code for \spadtype{ASP29}.


  Implementation == add

    import FST
    import FT
    import FC    
    import SYMTAB

    real : FSTU := ["real"::FST]$FSTU
    integer : FSTU := ["integer"::FST]$FSTU
    syms : SYMTAB := empty()
    declare!(ISTATE,fortranInteger(),syms)
    declare!(NEXTIT,fortranInteger(),syms)    
    declare!(NEVALS,fortranInteger(),syms)
    declare!(NVECS,fortranInteger(),syms)
    declare!(K,fortranInteger(),syms)
    kType : FT := construct(real,[K],false)$FT
    declare!(F,kType,syms)
    declare!(D,kType,syms)
    Rep := FortranProgram(name,["void"]$FSTU,
                          [ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D],syms)


    outputAsFortran():Void ==
      callOne := call("F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)")
      code : List FC := [callOne,returns()]$List(FC)
      outputAsFortran(coerce(code)@Rep)$Rep

@
\section{domain ASP30 Asp30}
<<domain ASP30 Asp30>>=
)abbrev domain ASP30 Asp30
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Nov 1993
++ Date Last Updated: 28 March 1994
++                     6 October 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp30} produces Fortran for Type 30 ASPs, needed for NAG routine
++\axiomOpFrom{f04qaf}{f04Package}, for example:
++\begin{verbatim}
++      SUBROUTINE APROD(MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK)
++      DOUBLE PRECISION X(N),Y(M),RWORK(LRWORK)
++      INTEGER M,N,LIWORK,IFAIL,LRWORK,IWORK(LIWORK),MODE
++      DOUBLE PRECISION A(5,5)
++      EXTERNAL F06PAF
++      A(1,1)=1.0D0
++      A(1,2)=0.0D0
++      A(1,3)=0.0D0
++      A(1,4)=-1.0D0
++      A(1,5)=0.0D0
++      A(2,1)=0.0D0
++      A(2,2)=1.0D0
++      A(2,3)=0.0D0
++      A(2,4)=0.0D0
++      A(2,5)=-1.0D0
++      A(3,1)=0.0D0
++      A(3,2)=0.0D0
++      A(3,3)=1.0D0
++      A(3,4)=-1.0D0
++      A(3,5)=0.0D0
++      A(4,1)=-1.0D0
++      A(4,2)=0.0D0
++      A(4,3)=-1.0D0
++      A(4,4)=4.0D0
++      A(4,5)=-1.0D0
++      A(5,1)=0.0D0
++      A(5,2)=-1.0D0
++      A(5,3)=0.0D0
++      A(5,4)=-1.0D0
++      A(5,5)=4.0D0
++      IF(MODE.EQ.1)THEN
++        CALL F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)
++      ELSEIF(MODE.EQ.2)THEN
++        CALL F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)
++      ENDIF
++      RETURN
++      END
++\end{verbatim}

Asp30(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  FC     ==> FortranCode
  PI     ==> PositiveInteger
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  UFST   ==> Union(fst:FST,void:"void")
  MAT    ==> Matrix
  MFLOAT ==> MachineFloat
  EXI    ==> Expression Integer
  UEXPR  ==> Union(I:Expression Integer,F:Expression Float,_
                   CF:Expression Complex Float,switch:Switch)
  S      ==> Symbol

  Exports == FortranMatrixCategory 

  Implementation == add

    import FC    
    import FT    
    import Switch

    real : UFST := ["real"::FST]$UFST
    integer : UFST := ["integer"::FST]$UFST
    syms : SYMTAB := empty()$SYMTAB
    declare!(MODE,fortranInteger()$FT,syms)$SYMTAB
    declare!(M,fortranInteger()$FT,syms)$SYMTAB
    declare!(N,fortranInteger()$FT,syms)$SYMTAB
    declare!(LRWORK,fortranInteger()$FT,syms)$SYMTAB
    declare!(LIWORK,fortranInteger()$FT,syms)$SYMTAB
    xType : FT := construct(real,[N],false)$FT
    declare!(X,xType,syms)$SYMTAB
    yType : FT := construct(real,[M],false)$FT
    declare!(Y,yType,syms)$SYMTAB
    rType : FT := construct(real,[LRWORK],false)$FT
    declare!(RWORK,rType,syms)$SYMTAB
    iType : FT := construct(integer,[LIWORK],false)$FT
    declare!(IWORK,iType,syms)$SYMTAB
    declare!(IFAIL,fortranInteger()$FT,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,
                          [MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms)

    coerce(a:MAT MFLOAT):$ ==
      locals : SYMTAB := empty()
      numRows := nrows(a) :: Polynomial Integer
      numCols := ncols(a) :: Polynomial Integer
      declare!(A,[real,[numRows,numCols],false]$FT,locals)
      declare!(F06PAF@S,construct(["void"]$UFST,[]@List(S),true)$FT,locals)
      ptA:UEXPR := [("MODE"::S)::EXI]
      ptB:UEXPR := [1::EXI]
      ptC:UEXPR := [2::EXI]
      sw1 : Switch := EQ(ptA,ptB)$Switch
      sw2 : Switch := EQ(ptA,ptC)$Switch
      callOne := call("F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)")
      callTwo := call("F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)")
      c : FC := cond(sw1,callOne,cond(sw2,callTwo))
      code : List FC := [assign(A,a),c,returns()]
      ([locals,code]$RSFC)::$

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP31 Asp31}
<<domain ASP31 Asp31>>=
)abbrev domain ASP31 Asp31
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 22 March 1994
++                     6 October 1994
++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp31} produces Fortran for Type 31 ASPs, needed for NAG routine 
++\axiomOpFrom{d02ejf}{d02Package}, for example:
++\begin{verbatim}
++      SUBROUTINE PEDERV(X,Y,PW)
++      DOUBLE PRECISION X,Y(*)
++      DOUBLE PRECISION PW(3,3)
++      PW(1,1)=-0.03999999999999999D0
++      PW(1,2)=10000.0D0*Y(3)
++      PW(1,3)=10000.0D0*Y(2)
++      PW(2,1)=0.03999999999999999D0
++      PW(2,2)=(-10000.0D0*Y(3))+(-60000000.0D0*Y(2))
++      PW(2,3)=-10000.0D0*Y(2)
++      PW(3,1)=0.0D0
++      PW(3,2)=60000000.0D0*Y(2)
++      PW(3,3)=0.0D0
++      RETURN
++      END
++\end{verbatim}

Asp31(name): Exports == Implementation where
  name : Symbol

  O      ==> OutputForm
  FST    ==> FortranScalarType
  UFST   ==> Union(fst:FST,void:"void")
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression(['X],['Y],MFLOAT)
  FT     ==> FortranType
  FC     ==> FortranCode
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  MAT    ==> Matrix
  VF2    ==> VectorFunctions2
  MF2    ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR,
                    EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT)



  Exports ==> FortranVectorFunctionCategory with
    coerce : VEC FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add


    real : UFST := ["real"::FST]$UFST
    syms : SYMTAB := empty()
    declare!(X,fortranReal(),syms)$SYMTAB
    yType : FT := construct(real,["*"::Symbol],false)$FT
    declare!(Y,yType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,[X,Y,PW],syms)

    -- To help the poor old compiler!
    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    localAssign(s:Symbol,j:MAT FEXPR):FC ==
      j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2
      assign(s,j')$FC

    makeXList(n:Integer):List(Symbol) ==
      j:Integer
      y:Symbol := Y::Symbol
      p:List(Symbol) := []
      for j in 1 .. n repeat p:= cons(subscript(y,[j::OutputForm])$Symbol,p)
      p:= reverse(p)

    coerce(u:VEC FEXPR):$ == 
      dimension := #u::Polynomial Integer
      locals : SYMTAB := empty()
      declare!(PW,[real,[dimension,dimension],false]$FT,locals)$SYMTAB
      n:Integer := maxIndex(u)$VEC(FEXPR)
      p:List(Symbol) := makeXList(n)
      jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_
                                     Symbol,FEXPR ,VEC FEXPR,List(Symbol))
      code : List FC := [localAssign(PW,jac),returns()$FC]$List(FC)
      ([locals,code]$RSFC)::$

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    coerce(c:List FC):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FC):$ == coerce(c)$Rep

    coerce(u:$):O == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP33 Asp33}
<<domain ASP33 Asp33>>=
)abbrev domain ASP33 Asp33
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Nov 1993
++ Date Last Updated: 30 March 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory.
++ Description:
++\spadtype{Asp33} produces Fortran for Type 33 ASPs, needed for NAG routine 
++\axiomOpFrom{d02kef}{d02Package}.  The code is a dummy ASP:
++\begin{verbatim}
++      SUBROUTINE REPORT(X,V,JINT)
++      DOUBLE PRECISION V(3),X
++      INTEGER JINT
++      RETURN
++      END
++\end{verbatim}

Asp33(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  UFST   ==> Union(fst:FST,void:"void")
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  FC     ==> FortranCode
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))

  Exports ==> FortranProgramCategory with
     outputAsFortran:() -> Void
      ++outputAsFortran() generates the default code for \spadtype{ASP33}.


  Implementation ==> add

    real : UFST := ["real"::FST]$UFST
    syms : SYMTAB := empty()
    declare!(JINT,fortranInteger(),syms)$SYMTAB
    declare!(X,fortranReal(),syms)$SYMTAB
    vType : FT := construct(real,["3"::Symbol],false)$FT
    declare!(V,vType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,[X,V,JINT],syms)

    outputAsFortran():Void == 
      outputAsFortran( (returns()$FortranCode)::Rep )$Rep

    outputAsFortran(u):Void == outputAsFortran(u)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

@
\section{domain ASP34 Asp34}
<<domain ASP34 Asp34>>=
)abbrev domain ASP34 Asp34
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Nov 1993
++ Date Last Updated: 14 June 1994 (Themos Tsikas)
++                     6 October 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp34} produces Fortran for Type 34 ASPs, needed for NAG routine 
++\axiomOpFrom{f04mbf}{f04Package}, for example:
++\begin{verbatim}
++      SUBROUTINE MSOLVE(IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK)
++      DOUBLE PRECISION RWORK(LRWORK),X(N),Y(N)
++      INTEGER I,J,N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK)
++      DOUBLE PRECISION W1(3),W2(3),MS(3,3)
++      IFLAG=-1
++      MS(1,1)=2.0D0
++      MS(1,2)=1.0D0
++      MS(1,3)=0.0D0
++      MS(2,1)=1.0D0
++      MS(2,2)=2.0D0
++      MS(2,3)=1.0D0
++      MS(3,1)=0.0D0
++      MS(3,2)=1.0D0
++      MS(3,3)=2.0D0
++      CALL F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)
++      IFLAG=-IFLAG
++      RETURN
++      END
++\end{verbatim}

Asp34(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FT     ==> FortranType
  UFST   ==> Union(fst:FST,void:"void")
  SYMTAB ==> SymbolTable
  FC     ==> FortranCode
  PI     ==> PositiveInteger
  EXI    ==> Expression Integer
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))

  Exports == FortranMatrixCategory 

  Implementation == add

    real : UFST := ["real"::FST]$UFST
    integer : UFST := ["integer"::FST]$UFST
    syms : SYMTAB := empty()$SYMTAB
    declare!(IFLAG,fortranInteger(),syms)$SYMTAB
    declare!(N,fortranInteger(),syms)$SYMTAB
    xType : FT := construct(real,[N],false)$FT
    declare!(X,xType,syms)$SYMTAB
    declare!(Y,xType,syms)$SYMTAB
    declare!(LRWORK,fortranInteger(),syms)$SYMTAB
    declare!(LIWORK,fortranInteger(),syms)$SYMTAB
    rType : FT := construct(real,[LRWORK],false)$FT
    declare!(RWORK,rType,syms)$SYMTAB
    iType : FT := construct(integer,[LIWORK],false)$FT
    declare!(IWORK,iType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,
                          [IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms)

    -- To help the poor old compiler
    localAssign(s:Symbol,u:EXI):FC == assign(s,u)$FC

    coerce(u:Matrix MachineFloat):$ == 
      dimension := nrows(u) ::Polynomial Integer
      locals : SYMTAB := empty()$SYMTAB
      declare!(I,fortranInteger(),syms)$SYMTAB
      declare!(J,fortranInteger(),syms)$SYMTAB
      declare!(W1,[real,[dimension],false]$FT,locals)$SYMTAB
      declare!(W2,[real,[dimension],false]$FT,locals)$SYMTAB
      declare!(MS,[real,[dimension,dimension],false]$FT,locals)$SYMTAB
      assign1 : FC := localAssign(IFLAG@Symbol,(-1)@EXI)
      call : FC := call("F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)")$FC
      assign2 : FC := localAssign(IFLAG::Symbol,-(IFLAG@Symbol::EXI))
      assign3 : FC := assign(MS,u)$FC
      code : List FC := [assign1,assign3,call,assign2,returns()]$List(FC)
      ([locals,code]$RSFC)::$

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP35 Asp35}
<<domain ASP35 Asp35>>=
)abbrev domain ASP35 Asp35
++ Author: Mike Dewar, Godfrey Nolan, Grant Keady
++ Date Created: Mar 1993
++ Date Last Updated: 22 March 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp35} produces Fortran for Type 35 ASPs, needed for NAG routines 
++\axiomOpFrom{c05pbf}{c05Package}, \axiomOpFrom{c05pcf}{c05Package}, for example:
++\begin{verbatim}
++      SUBROUTINE FCN(N,X,FVEC,FJAC,LDFJAC,IFLAG)
++      DOUBLE PRECISION X(N),FVEC(N),FJAC(LDFJAC,N)
++      INTEGER LDFJAC,N,IFLAG
++      IF(IFLAG.EQ.1)THEN
++        FVEC(1)=(-1.0D0*X(2))+X(1)
++        FVEC(2)=(-1.0D0*X(3))+2.0D0*X(2)
++        FVEC(3)=3.0D0*X(3)
++      ELSEIF(IFLAG.EQ.2)THEN
++        FJAC(1,1)=1.0D0
++        FJAC(1,2)=-1.0D0
++        FJAC(1,3)=0.0D0
++        FJAC(2,1)=0.0D0
++        FJAC(2,2)=2.0D0
++        FJAC(2,3)=-1.0D0
++        FJAC(3,1)=0.0D0
++        FJAC(3,2)=0.0D0
++        FJAC(3,3)=3.0D0
++      ENDIF
++      END
++\end{verbatim}

Asp35(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FT     ==> FortranType
  UFST   ==> Union(fst:FST,void:"void")
  SYMTAB ==> SymbolTable
  FC     ==> FortranCode
  PI     ==> PositiveInteger
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  MAT    ==> Matrix
  VF2    ==> VectorFunctions2
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression([],['X],MFLOAT)
  MF2    ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR,
                    EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT)
  SWU    ==> Union(I:Expression Integer,F:Expression Float,
                   CF:Expression Complex Float,switch:Switch)

  Exports ==> FortranVectorFunctionCategory with
    coerce : VEC FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : UFST := ["real"::FST]$UFST
    syms : SYMTAB := empty()$SYMTAB
    declare!(N,fortranInteger(),syms)$SYMTAB
    xType : FT := construct(real,[N],false)$FT
    declare!(X,xType,syms)$SYMTAB
    declare!(FVEC,xType,syms)$SYMTAB
    declare!(LDFJAC,fortranInteger(),syms)$SYMTAB
    jType : FT := construct(real,[LDFJAC,N],false)$FT
    declare!(FJAC,jType,syms)$SYMTAB
    declare!(IFLAG,fortranInteger(),syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,[N,X,FVEC,FJAC,LDFJAC,IFLAG],syms)

    coerce(u:$):OutputForm == coerce(u)$Rep

    makeXList(n:Integer):List(Symbol) ==
      x:Symbol := X::Symbol
      [subscript(x,[j::OutputForm])$Symbol for j in 1..n]

    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    localAssign1(s:Symbol,j:MAT FEXPR):FC ==
      j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2
      assign(s,j')$FC

    localAssign2(s:Symbol,j:VEC FEXPR):FC ==
      j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
      assign(s,j')$FC

    coerce(u:VEC FEXPR):$ ==
      n:Integer := maxIndex(u)
      p:List(Symbol) := makeXList(n)
      jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_
                                         Symbol,FEXPR,VEC FEXPR,List(Symbol))
      assf:FC := localAssign2(FVEC,u)
      assj:FC := localAssign1(FJAC,jac)
      iflag:SWU := [IFLAG@Symbol::EXPR(INT)]$SWU
      sw1:Switch := EQ(iflag,[1::EXPR(INT)]$SWU)
      sw2:Switch := EQ(iflag,[2::EXPR(INT)]$SWU)
      cond(sw1,assf,cond(sw2,assj)$FC)$FC::$

    coerce(c:List FC):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FC):$ == coerce(c)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

@
\section{domain ASP4 Asp4}
<<domain ASP4 Asp4>>=
)abbrev domain ASP4 Asp4
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 18 March 1994
++                     6 October 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp4} produces Fortran for Type 4 ASPs, which take an expression
++in X(1) .. X(NDIM) and produce a real function of the form:
++\begin{verbatim}
++      DOUBLE PRECISION FUNCTION FUNCTN(NDIM,X)
++      DOUBLE PRECISION X(NDIM)
++      INTEGER NDIM
++      FUNCTN=(4.0D0*X(1)*X(3)**2*DEXP(2.0D0*X(1)*X(3)))/(X(4)**2+(2.0D0*
++     &X(2)+2.0D0)*X(4)+X(2)**2+2.0D0*X(2)+1.0D0)
++      RETURN
++      END
++\end{verbatim}

Asp4(name): Exports == Implementation where
  name : Symbol

  FEXPR  ==> FortranExpression([],['X],MachineFloat)
  FST    ==> FortranScalarType
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FSTU   ==> Union(fst:FST,void:"void")
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float

  Exports ==> FortranFunctionCategory with
    coerce : FEXPR -> $
      ++coerce(f) takes an object from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns it into an ASP.

  Implementation ==> add

    real : FSTU := ["real"::FST]$FSTU
    syms : SYMTAB := empty()$SYMTAB
    declare!(NDIM,fortranInteger(),syms)$SYMTAB
    xType : FT := construct(real,[NDIM],false)$FT
    declare!(X,xType,syms)$SYMTAB
    Rep := FortranProgram(name,real,[NDIM,X],syms)

    retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      foo::FEXPR::$

    retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      foo::FEXPR::$

    retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      foo::FEXPR::$

    retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:EXPR INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      foo::FEXPR::$

    retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      foo::FEXPR::$

    retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:POLY INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed") 
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      foo::FEXPR::$

    coerce(u:FEXPR):$ ==
      coerce((u::Expression(MachineFloat))$FEXPR)$Rep

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP41 Asp41}
<<domain ASP41 Asp41>>=
)abbrev domain ASP41 Asp41
++ Author: Mike Dewar, Godfrey Nolan
++ Date Created: 
++ Date Last Updated: 29 March 1994
++                     6 October 1994
++ Related Constructors: FortranFunctionCategory, FortranProgramCategory.
++ Description:
++\spadtype{Asp41} produces Fortran for Type 41 ASPs, needed for NAG
++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package}
++in particular.  These ASPs are in fact 
++three Fortran routines which return a vector of functions, and their
++derivatives wrt Y(i) and also a continuation parameter EPS, for example:
++\begin{verbatim}
++      SUBROUTINE FCN(X,EPS,Y,F,N)
++      DOUBLE PRECISION EPS,F(N),X,Y(N)
++      INTEGER N
++      F(1)=Y(2)
++      F(2)=Y(3)
++      F(3)=(-1.0D0*Y(1)*Y(3))+2.0D0*EPS*Y(2)**2+(-2.0D0*EPS)
++      RETURN
++      END
++      SUBROUTINE JACOBF(X,EPS,Y,F,N)
++      DOUBLE PRECISION EPS,F(N,N),X,Y(N)
++      INTEGER N
++      F(1,1)=0.0D0
++      F(1,2)=1.0D0
++      F(1,3)=0.0D0
++      F(2,1)=0.0D0
++      F(2,2)=0.0D0
++      F(2,3)=1.0D0
++      F(3,1)=-1.0D0*Y(3)
++      F(3,2)=4.0D0*EPS*Y(2)
++      F(3,3)=-1.0D0*Y(1)
++      RETURN
++      END
++      SUBROUTINE JACEPS(X,EPS,Y,F,N)
++      DOUBLE PRECISION EPS,F(N),X,Y(N)
++      INTEGER N
++      F(1)=0.0D0
++      F(2)=0.0D0
++      F(3)=2.0D0*Y(2)**2-2.0D0
++      RETURN
++      END
++\end{verbatim}

Asp41(nameOne,nameTwo,nameThree): Exports == Implementation where
  nameOne : Symbol
  nameTwo : Symbol
  nameThree : Symbol

  D      ==> differentiate
  FST    ==> FortranScalarType
  UFST   ==> Union(fst:FST,void:"void")
  FT     ==> FortranType
  FC     ==> FortranCode
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression(['X,'EPS],['Y],MFLOAT)
  S      ==> Symbol
  MF2    ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,
                 EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT)

  Exports ==> FortranVectorFunctionCategory with
    coerce : VEC FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add
    real : UFST := ["real"::FST]$UFST

    symOne : SYMTAB := empty()$SYMTAB
    declare!(N,fortranInteger(),symOne)$SYMTAB
    declare!(X,fortranReal(),symOne)$SYMTAB
    declare!(EPS,fortranReal(),symOne)$SYMTAB
    yType : FT := construct(real,[N],false)$FT
    declare!(Y,yType,symOne)$SYMTAB
    declare!(F,yType,symOne)$SYMTAB

    symTwo : SYMTAB := empty()$SYMTAB
    declare!(N,fortranInteger(),symTwo)$SYMTAB
    declare!(X,fortranReal(),symTwo)$SYMTAB
    declare!(EPS,fortranReal(),symTwo)$SYMTAB
    declare!(Y,yType,symTwo)$SYMTAB
    fType : FT := construct(real,[N,N],false)$FT
    declare!(F,fType,symTwo)$SYMTAB

    symThree : SYMTAB := empty()$SYMTAB
    declare!(N,fortranInteger(),symThree)$SYMTAB
    declare!(X,fortranReal(),symThree)$SYMTAB
    declare!(EPS,fortranReal(),symThree)$SYMTAB
    declare!(Y,yType,symThree)$SYMTAB
    declare!(F,yType,symThree)$SYMTAB

    R1:=FortranProgram(nameOne,["void"]$UFST,[X,EPS,Y,F,N],symOne)
    R2:=FortranProgram(nameTwo,["void"]$UFST,[X,EPS,Y,F,N],symTwo)
    R3:=FortranProgram(nameThree,["void"]$UFST,[X,EPS,Y,F,N],symThree)
    Rep := Record(f:R1,fJacob:R2,eJacob:R3)
    Fsym:Symbol:=coerce "F"

    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    localAssign1(s:S,j:Matrix FEXPR):FC ==
      j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2
      assign(s,j')$FC

    localAssign2(s:S,j:VEC FEXPR):FC ==
      j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
      assign(s,j')$FC

    makeCodeOne(u:VEC FEXPR):FortranCode ==
      -- simple assign
      localAssign2(Fsym,u)

    makeCodeThree(u:VEC FEXPR):FortranCode ==
      -- compute jacobian wrt to eps
      jacEps:VEC FEXPR := [D(v,EPS) for v in entries(u)]$VEC(FEXPR)
      makeCodeOne(jacEps)

    makeYList(n:Integer):List(Symbol) ==
      j:Integer
      y:Symbol := Y::Symbol
      p:List(Symbol) := []
      [subscript(y,[j::OutputForm])$Symbol for j in 1..n]

    makeCodeTwo(u:VEC FEXPR):FortranCode ==
      -- compute jacobian wrt to f
      n:Integer := maxIndex(u)$VEC(FEXPR)
      p:List(Symbol) := makeYList(n)
      jac:Matrix(FEXPR) := _
      jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
      localAssign1(Fsym,jac)

    coerce(u:VEC FEXPR):$ == 
      aF:FortranCode := makeCodeOne(u)
      bF:FortranCode := makeCodeTwo(u)
      cF:FortranCode := makeCodeThree(u)
      -- add returns() to complete subroutines
      aLF:List(FortranCode) := [aF,returns()$FortranCode]$List(FortranCode)
      bLF:List(FortranCode) := [bF,returns()$FortranCode]$List(FortranCode)
      cLF:List(FortranCode) := [cF,returns()$FortranCode]$List(FortranCode)
      [coerce(aLF)$R1,coerce(bLF)$R2,coerce(cLF)$R3]

    coerce(u:$):OutputForm == 
      bracket commaSeparate 
        [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm]

    outputAsFortran(u:$):Void ==  
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran elt(u,f)$Rep
      outputAsFortran elt(u,fJacob)$Rep
      outputAsFortran elt(u,eJacob)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

@
\section{domain ASP42 Asp42}
<<domain ASP42 Asp42>>=
)abbrev domain ASP42 Asp42
++ Author: Mike Dewar, Godfrey Nolan
++ Date Created:
++ Date Last Updated: 29 March 1994
++                     6 October 1994
++ Related Constructors: FortranFunctionCategory, FortranProgramCategory.
++ Description:
++\spadtype{Asp42} produces Fortran for Type 42 ASPs, needed for NAG
++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package}
++in particular.  These ASPs are in fact
++three Fortran routines which return a vector of functions, and their
++derivatives wrt Y(i) and also a continuation parameter EPS, for example:
++\begin{verbatim}
++      SUBROUTINE G(EPS,YA,YB,BC,N)
++      DOUBLE PRECISION EPS,YA(N),YB(N),BC(N)
++      INTEGER N
++      BC(1)=YA(1)
++      BC(2)=YA(2)
++      BC(3)=YB(2)-1.0D0
++      RETURN
++      END
++      SUBROUTINE JACOBG(EPS,YA,YB,AJ,BJ,N)
++      DOUBLE PRECISION EPS,YA(N),AJ(N,N),BJ(N,N),YB(N)
++      INTEGER N
++      AJ(1,1)=1.0D0
++      AJ(1,2)=0.0D0
++      AJ(1,3)=0.0D0
++      AJ(2,1)=0.0D0
++      AJ(2,2)=1.0D0
++      AJ(2,3)=0.0D0
++      AJ(3,1)=0.0D0
++      AJ(3,2)=0.0D0
++      AJ(3,3)=0.0D0
++      BJ(1,1)=0.0D0
++      BJ(1,2)=0.0D0
++      BJ(1,3)=0.0D0
++      BJ(2,1)=0.0D0
++      BJ(2,2)=0.0D0
++      BJ(2,3)=0.0D0
++      BJ(3,1)=0.0D0
++      BJ(3,2)=1.0D0
++      BJ(3,3)=0.0D0
++      RETURN
++      END
++      SUBROUTINE JACGEP(EPS,YA,YB,BCEP,N)
++      DOUBLE PRECISION EPS,YA(N),YB(N),BCEP(N)
++      INTEGER N
++      BCEP(1)=0.0D0
++      BCEP(2)=0.0D0
++      BCEP(3)=0.0D0
++      RETURN
++      END
++\end{verbatim}

Asp42(nameOne,nameTwo,nameThree): Exports == Implementation where
  nameOne : Symbol
  nameTwo : Symbol
  nameThree : Symbol

  D      ==> differentiate
  FST    ==> FortranScalarType
  FT     ==> FortranType
  FP     ==> FortranProgram
  FC     ==> FortranCode
  PI     ==> PositiveInteger
  NNI    ==> NonNegativeInteger
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  UFST   ==> Union(fst:FST,void:"void")
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression(['EPS],['YA,'YB],MFLOAT)
  S      ==> Symbol
  MF2    ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,
                 EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT)

  Exports ==> FortranVectorFunctionCategory with
    coerce : VEC FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add
    real : UFST := ["real"::FST]$UFST

    symOne : SYMTAB := empty()$SYMTAB
    declare!(EPS,fortranReal(),symOne)$SYMTAB
    declare!(N,fortranInteger(),symOne)$SYMTAB
    yType : FT := construct(real,[N],false)$FT
    declare!(YA,yType,symOne)$SYMTAB
    declare!(YB,yType,symOne)$SYMTAB
    declare!(BC,yType,symOne)$SYMTAB

    symTwo : SYMTAB := empty()$SYMTAB
    declare!(EPS,fortranReal(),symTwo)$SYMTAB
    declare!(N,fortranInteger(),symTwo)$SYMTAB
    declare!(YA,yType,symTwo)$SYMTAB
    declare!(YB,yType,symTwo)$SYMTAB
    ajType : FT := construct(real,[N,N],false)$FT
    declare!(AJ,ajType,symTwo)$SYMTAB
    declare!(BJ,ajType,symTwo)$SYMTAB

    symThree : SYMTAB := empty()$SYMTAB
    declare!(EPS,fortranReal(),symThree)$SYMTAB
    declare!(N,fortranInteger(),symThree)$SYMTAB
    declare!(YA,yType,symThree)$SYMTAB
    declare!(YB,yType,symThree)$SYMTAB
    declare!(BCEP,yType,symThree)$SYMTAB

    rt := ["void"]$UFST
    R1:=FortranProgram(nameOne,rt,[EPS,YA,YB,BC,N],symOne)
    R2:=FortranProgram(nameTwo,rt,[EPS,YA,YB,AJ,BJ,N],symTwo)
    R3:=FortranProgram(nameThree,rt,[EPS,YA,YB,BCEP,N],symThree)
    Rep := Record(g:R1,gJacob:R2,geJacob:R3)
    BCsym:Symbol:=coerce "BC"
    AJsym:Symbol:=coerce "AJ"
    BJsym:Symbol:=coerce "BJ"
    BCEPsym:Symbol:=coerce "BCEP"

    makeList(n:Integer,s:Symbol):List(Symbol) ==
      j:Integer
      p:List(Symbol) := []
      for j in 1 .. n repeat p:= cons(subscript(s,[j::OutputForm])$Symbol,p)
      reverse(p)

    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    localAssign1(s:S,j:Matrix FEXPR):FC ==
      j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2
      assign(s,j')$FC

    localAssign2(s:S,j:VEC FEXPR):FC ==
      j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
      assign(s,j')$FC

    makeCodeOne(u:VEC FEXPR):FortranCode ==
      -- simple assign
      localAssign2(BCsym,u)

    makeCodeTwo(u:VEC FEXPR):List(FortranCode) ==
      -- compute jacobian wrt to ya
      n:Integer := maxIndex(u)
      p:List(Symbol) := makeList(n,YA::Symbol)
      jacYA:Matrix(FEXPR) := _
        jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
      -- compute jacobian wrt to yb
      p:List(Symbol) := makeList(n,YB::Symbol)
      jacYB: Matrix(FEXPR) := _
        jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
      -- assign jacobians to AJ & BJ
      [localAssign1(AJsym,jacYA),localAssign1(BJsym,jacYB),returns()$FC]$List(FC)

    makeCodeThree(u:VEC FEXPR):FortranCode ==
      -- compute jacobian wrt to eps
      jacEps:VEC FEXPR := [D(v,EPS) for v in entries u]$VEC(FEXPR)
      localAssign2(BCEPsym,jacEps)

    coerce(u:VEC FEXPR):$ == 
      aF:FortranCode := makeCodeOne(u)
      bF:List(FortranCode) := makeCodeTwo(u)
      cF:FortranCode := makeCodeThree(u)
      -- add returns() to complete subroutines
      aLF:List(FortranCode) := [aF,returns()$FC]$List(FortranCode)
      cLF:List(FortranCode) := [cF,returns()$FC]$List(FortranCode)
      [coerce(aLF)$R1,coerce(bF)$R2,coerce(cLF)$R3]

    coerce(u:$) : OutputForm ==
      bracket commaSeparate 
        [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm]

    outputAsFortran(u:$):Void ==  
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran elt(u,g)$Rep
      outputAsFortran elt(u,gJacob)$Rep
      outputAsFortran elt(u,geJacob)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

@
\section{domain ASP49 Asp49}
<<domain ASP49 Asp49>>=
)abbrev domain ASP49 Asp49
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 23 March 1994
++                     6 October 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp49} produces Fortran for Type 49 ASPs, needed for NAG routines
++\axiomOpFrom{e04dgf}{e04Package}, \axiomOpFrom{e04ucf}{e04Package}, for example:
++\begin{verbatim}
++      SUBROUTINE OBJFUN(MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER)
++      DOUBLE PRECISION X(N),OBJF,OBJGRD(N),USER(*)
++      INTEGER N,IUSER(*),MODE,NSTATE
++      OBJF=X(4)*X(9)+((-1.0D0*X(5))+X(3))*X(8)+((-1.0D0*X(3))+X(1))*X(7)
++     &+(-1.0D0*X(2)*X(6))
++      OBJGRD(1)=X(7)
++      OBJGRD(2)=-1.0D0*X(6)
++      OBJGRD(3)=X(8)+(-1.0D0*X(7))
++      OBJGRD(4)=X(9)
++      OBJGRD(5)=-1.0D0*X(8)
++      OBJGRD(6)=-1.0D0*X(2)
++      OBJGRD(7)=(-1.0D0*X(3))+X(1)
++      OBJGRD(8)=(-1.0D0*X(5))+X(3)
++      OBJGRD(9)=X(4)
++      RETURN
++      END
++\end{verbatim}

Asp49(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  UFST   ==> Union(fst:FST,void:"void")
  FT     ==> FortranType
  FC     ==> FortranCode
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FC))
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression([],['X],MFLOAT)
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2
  S      ==> Symbol

  Exports ==> FortranFunctionCategory with
    coerce : FEXPR -> $
      ++coerce(f) takes an object from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns it into an ASP.

  Implementation ==> add

    real : UFST := ["real"::FST]$UFST
    integer : UFST := ["integer"::FST]$UFST
    syms : SYMTAB := empty()$SYMTAB
    declare!(MODE,fortranInteger(),syms)$SYMTAB
    declare!(N,fortranInteger(),syms)$SYMTAB
    xType : FT := construct(real,[N::S],false)$FT
    declare!(X,xType,syms)$SYMTAB
    declare!(OBJF,fortranReal(),syms)$SYMTAB
    declare!(OBJGRD,xType,syms)$SYMTAB
    declare!(NSTATE,fortranInteger(),syms)$SYMTAB
    iuType : FT := construct(integer,["*"::S],false)$FT
    declare!(IUSER,iuType,syms)$SYMTAB
    uType : FT := construct(real,["*"::S],false)$FT
    declare!(USER,uType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,
                          [MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER],syms)

    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    localAssign(s:S,j:VEC FEXPR):FC ==
      j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
      assign(s,j')$FC

    coerce(u:FEXPR):$ ==
      vars:List(S) := variables(u)
      grd:VEC FEXPR := gradient(u,vars)$MultiVariableCalculusFunctions(_
                                           S,FEXPR,VEC FEXPR,List(S))
      code : List(FC) := [assign(OBJF@S,fexpr2expr u)$FC,_
                          localAssign(OBJGRD@S,grd),_
                          returns()$FC]
      code::$

    coerce(u:$):OutputForm == coerce(u)$Rep

    coerce(c:List FC):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FC):$ == coerce(c)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:EXPR INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:POLY INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

@
\section{domain ASP50 Asp50}
<<domain ASP50 Asp50>>=
)abbrev domain ASP50 Asp50
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 23 March 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp50} produces Fortran for Type 50 ASPs, needed for NAG routine 
++\axiomOpFrom{e04fdf}{e04Package}, for example:
++\begin{verbatim}
++      SUBROUTINE LSFUN1(M,N,XC,FVECC)
++      DOUBLE PRECISION FVECC(M),XC(N)
++      INTEGER I,M,N
++      FVECC(1)=((XC(1)-2.4D0)*XC(3)+(15.0D0*XC(1)-36.0D0)*XC(2)+1.0D0)/(
++     &XC(3)+15.0D0*XC(2))
++      FVECC(2)=((XC(1)-2.8D0)*XC(3)+(7.0D0*XC(1)-19.6D0)*XC(2)+1.0D0)/(X
++     &C(3)+7.0D0*XC(2))
++      FVECC(3)=((XC(1)-3.2D0)*XC(3)+(4.333333333333333D0*XC(1)-13.866666
++     &66666667D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2))
++      FVECC(4)=((XC(1)-3.5D0)*XC(3)+(3.0D0*XC(1)-10.5D0)*XC(2)+1.0D0)/(X
++     &C(3)+3.0D0*XC(2))
++      FVECC(5)=((XC(1)-3.9D0)*XC(3)+(2.2D0*XC(1)-8.579999999999998D0)*XC
++     &(2)+1.0D0)/(XC(3)+2.2D0*XC(2))
++      FVECC(6)=((XC(1)-4.199999999999999D0)*XC(3)+(1.666666666666667D0*X
++     &C(1)-7.0D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2))
++      FVECC(7)=((XC(1)-4.5D0)*XC(3)+(1.285714285714286D0*XC(1)-5.7857142
++     &85714286D0)*XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2))
++      FVECC(8)=((XC(1)-4.899999999999999D0)*XC(3)+(XC(1)-4.8999999999999
++     &99D0)*XC(2)+1.0D0)/(XC(3)+XC(2))
++      FVECC(9)=((XC(1)-4.699999999999999D0)*XC(3)+(XC(1)-4.6999999999999
++     &99D0)*XC(2)+1.285714285714286D0)/(XC(3)+XC(2))
++      FVECC(10)=((XC(1)-6.8D0)*XC(3)+(XC(1)-6.8D0)*XC(2)+1.6666666666666
++     &67D0)/(XC(3)+XC(2))
++      FVECC(11)=((XC(1)-8.299999999999999D0)*XC(3)+(XC(1)-8.299999999999
++     &999D0)*XC(2)+2.2D0)/(XC(3)+XC(2))
++      FVECC(12)=((XC(1)-10.6D0)*XC(3)+(XC(1)-10.6D0)*XC(2)+3.0D0)/(XC(3)
++     &+XC(2))
++      FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333
++     &3333D0)/(XC(3)+XC(2))
++      FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X
++     &C(2))
++      FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3
++     &)+XC(2))
++      END
++\end{verbatim}

Asp50(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FT     ==> FortranType
  UFST   ==> Union(fst:FST,void:"void")
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2
  FEXPR  ==> FortranExpression([],['XC],MFLOAT)
  MFLOAT ==> MachineFloat

  Exports ==> FortranVectorFunctionCategory with
    coerce : VEC FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : UFST := ["real"::FST]$UFST
    syms : SYMTAB := empty()$SYMTAB
    declare!(M,fortranInteger(),syms)$SYMTAB
    declare!(N,fortranInteger(),syms)$SYMTAB
    xcType : FT := construct(real,[N],false)$FT
    declare!(XC,xcType,syms)$SYMTAB
    fveccType : FT := construct(real,[M],false)$FT
    declare!(FVECC,fveccType,syms)$SYMTAB
    declare!(I,fortranInteger(),syms)$SYMTAB
    tType : FT := construct(real,[M,N],false)$FT
--    declare!(TC,tType,syms)$SYMTAB
--    declare!(Y,fveccType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST, [M,N,XC,FVECC],syms)

    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    coerce(u:VEC FEXPR):$ ==
      u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
      assign(FVECC,u')$FortranCode::$

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP55 Asp55}
<<domain ASP55 Asp55>>=
)abbrev domain ASP55 Asp55
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: June 1993
++ Date Last Updated: 23 March 1994
++                     6 October 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp55} produces Fortran for Type 55 ASPs, needed for NAG routines 
++\axiomOpFrom{e04dgf}{e04Package} and \axiomOpFrom{e04ucf}{e04Package}, for example:
++\begin{verbatim}
++      SUBROUTINE CONFUN(MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER
++     &,USER)
++      DOUBLE PRECISION C(NCNLN),X(N),CJAC(NROWJ,N),USER(*)
++      INTEGER N,IUSER(*),NEEDC(NCNLN),NROWJ,MODE,NCNLN,NSTATE
++      IF(NEEDC(1).GT.0)THEN
++        C(1)=X(6)**2+X(1)**2
++        CJAC(1,1)=2.0D0*X(1)
++        CJAC(1,2)=0.0D0
++        CJAC(1,3)=0.0D0
++        CJAC(1,4)=0.0D0
++        CJAC(1,5)=0.0D0
++        CJAC(1,6)=2.0D0*X(6)
++      ENDIF
++      IF(NEEDC(2).GT.0)THEN
++        C(2)=X(2)**2+(-2.0D0*X(1)*X(2))+X(1)**2
++        CJAC(2,1)=(-2.0D0*X(2))+2.0D0*X(1)
++        CJAC(2,2)=2.0D0*X(2)+(-2.0D0*X(1))
++        CJAC(2,3)=0.0D0
++        CJAC(2,4)=0.0D0
++        CJAC(2,5)=0.0D0
++        CJAC(2,6)=0.0D0
++      ENDIF
++      IF(NEEDC(3).GT.0)THEN
++        C(3)=X(3)**2+(-2.0D0*X(1)*X(3))+X(2)**2+X(1)**2
++        CJAC(3,1)=(-2.0D0*X(3))+2.0D0*X(1)
++        CJAC(3,2)=2.0D0*X(2)
++        CJAC(3,3)=2.0D0*X(3)+(-2.0D0*X(1))
++        CJAC(3,4)=0.0D0
++        CJAC(3,5)=0.0D0
++        CJAC(3,6)=0.0D0
++      ENDIF
++      RETURN
++      END
++\end{verbatim}

Asp55(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FT     ==> FortranType
  FSTU   ==> Union(fst:FST,void:"void")
  SYMTAB ==> SymbolTable
  FC     ==> FortranCode
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  S      ==> Symbol
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2
  MAT    ==> Matrix
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression([],['X],MFLOAT)
  MF2    ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR,
                    EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT)
  SWU    ==> Union(I:Expression Integer,F:Expression Float,
                   CF:Expression Complex Float,switch:Switch)

  Exports ==> FortranVectorFunctionCategory with
    coerce : VEC FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : FSTU := ["real"::FST]$FSTU
    integer : FSTU := ["integer"::FST]$FSTU
    syms : SYMTAB := empty()$SYMTAB
    declare!(MODE,fortranInteger(),syms)$SYMTAB
    declare!(NCNLN,fortranInteger(),syms)$SYMTAB
    declare!(N,fortranInteger(),syms)$SYMTAB
    declare!(NROWJ,fortranInteger(),syms)$SYMTAB
    needcType : FT := construct(integer,[NCNLN::Symbol],false)$FT
    declare!(NEEDC,needcType,syms)$SYMTAB
    xType : FT := construct(real,[N::Symbol],false)$FT
    declare!(X,xType,syms)$SYMTAB
    cType : FT := construct(real,[NCNLN::Symbol],false)$FT
    declare!(C,cType,syms)$SYMTAB
    cjacType : FT := construct(real,[NROWJ::Symbol,N::Symbol],false)$FT
    declare!(CJAC,cjacType,syms)$SYMTAB
    declare!(NSTATE,fortranInteger(),syms)$SYMTAB
    iuType : FT := construct(integer,["*"::Symbol],false)$FT
    declare!(IUSER,iuType,syms)$SYMTAB
    uType : FT := construct(real,["*"::Symbol],false)$FT
    declare!(USER,uType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$FSTU,
                    [MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER,USER],syms)

    -- Take a symbol, pull of the script and turn it into an integer!!
    o2int(u:S):Integer ==
      o : OutputForm := first elt(scripts(u)$S,sub)
      o pretend Integer

    localAssign(s:Symbol,dim:List POLY INT,u:FEXPR):FC ==
      assign(s,dim,(u::EXPR MFLOAT)$FEXPR)$FC

    makeCond(index:INT,fun:FEXPR,jac:VEC FEXPR):FC ==
      needc : EXPR INT := (subscript(NEEDC,[index::OutputForm])$S)::EXPR(INT)
      sw : Switch := GT([needc]$SWU,[0::EXPR(INT)]$SWU)$Switch
      ass : List FC := [localAssign(CJAC,[index::POLY INT,i::POLY INT],jac.i)_
                                                    for i in 1..maxIndex(jac)]
      cond(sw,block([localAssign(C,[index::POLY INT],fun),:ass])$FC)$FC
      
    coerce(u:VEC FEXPR):$ ==
      ncnln:Integer := maxIndex(u)
      x:S := X::S
      pu:List(S) := []
      -- Work out which variables appear in the expressions
      for e in entries(u) repeat
        pu := setUnion(pu,variables(e)$FEXPR)
      scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer)
      -- This should be the maximum X_n which occurs (there may be others
      -- which don't):
      n:Integer := reduce(max,scriptList)$List(Integer)
      p:List(S) := []
      for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p)
      p:= reverse(p)
      jac:MAT FEXPR := _
         jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
      code : List FC := [makeCond(j,u.j,row(jac,j)) for j in 1..ncnln]
      [:code,returns()$FC]::$

    coerce(c:List FC):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FC):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

@
\section{domain ASP6 Asp6}
<<domain ASP6 Asp6>>=
)abbrev domain ASP6 Asp6
++ Author: Mike Dewar and Godfrey Nolan and Grant Keady
++ Date Created: Mar 1993
++ Date Last Updated: 18 March 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp6} produces Fortran for Type 6 ASPs, needed for NAG routines
++\axiomOpFrom{c05nbf}{c05Package}, \axiomOpFrom{c05ncf}{c05Package}.
++These represent vectors of functions of X(i) and look like:
++\begin{verbatim}
++      SUBROUTINE FCN(N,X,FVEC,IFLAG)
++      DOUBLE PRECISION X(N),FVEC(N)
++      INTEGER N,IFLAG
++      FVEC(1)=(-2.0D0*X(2))+(-2.0D0*X(1)**2)+3.0D0*X(1)+1.0D0
++      FVEC(2)=(-2.0D0*X(3))+(-2.0D0*X(2)**2)+3.0D0*X(2)+(-1.0D0*X(1))+1.
++     &0D0
++      FVEC(3)=(-2.0D0*X(4))+(-2.0D0*X(3)**2)+3.0D0*X(3)+(-1.0D0*X(2))+1.
++     &0D0
++      FVEC(4)=(-2.0D0*X(5))+(-2.0D0*X(4)**2)+3.0D0*X(4)+(-1.0D0*X(3))+1.
++     &0D0
++      FVEC(5)=(-2.0D0*X(6))+(-2.0D0*X(5)**2)+3.0D0*X(5)+(-1.0D0*X(4))+1.
++     &0D0
++      FVEC(6)=(-2.0D0*X(7))+(-2.0D0*X(6)**2)+3.0D0*X(6)+(-1.0D0*X(5))+1.
++     &0D0
++      FVEC(7)=(-2.0D0*X(8))+(-2.0D0*X(7)**2)+3.0D0*X(7)+(-1.0D0*X(6))+1.
++     &0D0
++      FVEC(8)=(-2.0D0*X(9))+(-2.0D0*X(8)**2)+3.0D0*X(8)+(-1.0D0*X(7))+1.
++     &0D0
++      FVEC(9)=(-2.0D0*X(9)**2)+3.0D0*X(9)+(-1.0D0*X(8))+1.0D0
++      RETURN
++      END
++\end{verbatim}

Asp6(name): Exports == Implementation where
  name : Symbol

  FEXPR  ==> FortranExpression([],['X],MFLOAT)
  MFLOAT ==> MachineFloat
  FST    ==> FortranScalarType
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  UFST   ==> Union(fst:FST,void:"void")
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2

  Exports == FortranVectorFunctionCategory with
    coerce: Vector FEXPR -> %
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation == add

    real : UFST := ["real"::FST]$UFST
    syms : SYMTAB := empty()$SYMTAB
    declare!(N,fortranInteger()$FT,syms)$SYMTAB
    xType : FT := construct(real,[N],false)$FT
    declare!(X,xType,syms)$SYMTAB
    declare!(FVEC,xType,syms)$SYMTAB
    declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"),
                          [N,X,FVEC,IFLAG],syms)

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VectorFunctions2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    fexpr2expr(u:FEXPR):EXPR MFLOAT ==
      (u::EXPR MFLOAT)$FEXPR

    coerce(u:VEC FEXPR):% ==
      v : VEC EXPR MFLOAT
      v := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
      ([assign(FVEC,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::$

    coerce(c:List FortranCode):% == coerce(c)$Rep

    coerce(r:RSFC):% == coerce(r)$Rep

    coerce(c:FortranCode):% == coerce(c)$Rep

    coerce(u:%):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP7 Asp7}
<<domain ASP7 Asp7>>=
)abbrev domain ASP7 Asp7
++ Author: Mike Dewar and Godfrey Nolan and Grant Keady
++ Date Created: Mar 1993
++ Date Last Updated: 18 March 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp7} produces Fortran for Type 7 ASPs, needed for NAG routines
++\axiomOpFrom{d02bbf}{d02Package}, \axiomOpFrom{d02gaf}{d02Package}.
++These represent a vector of functions of the scalar X and
++the array Z, and look like:
++\begin{verbatim}
++      SUBROUTINE FCN(X,Z,F)
++      DOUBLE PRECISION F(*),X,Z(*)
++      F(1)=DTAN(Z(3))
++      F(2)=((-0.03199999999999999D0*DCOS(Z(3))*DTAN(Z(3)))+(-0.02D0*Z(2)
++     &**2))/(Z(2)*DCOS(Z(3)))
++      F(3)=-0.03199999999999999D0/(X*Z(2)**2)
++      RETURN
++      END
++\end{verbatim}

Asp7(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression(['X],['Y],MFLOAT)
  UFST   ==> Union(fst:FST,void:"void")
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2

  Exports ==> FortranVectorFunctionCategory with
    coerce : Vector FEXPR -> %
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : UFST := ["real"::FST]$UFST
    syms : SYMTAB := empty()$SYMTAB
    declare!(X,fortranReal(),syms)$SYMTAB
    yType : FT := construct(real,["*"::Symbol],false)$FT
    declare!(Y,yType,syms)$SYMTAB
    declare!(F,yType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,[X,Y,F],syms)

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    fexpr2expr(u:FEXPR):EXPR MFLOAT ==
      (u::EXPR MFLOAT)$FEXPR

    coerce(u:Vector FEXPR ):% ==
      v : Vector EXPR MFLOAT
      v:=map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
      ([assign(F,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::%

    coerce(c:List FortranCode):% == coerce(c)$Rep

    coerce(r:RSFC):% == coerce(r)$Rep

    coerce(c:FortranCode):% == coerce(c)$Rep

    coerce(u:%):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{domain ASP73 Asp73}
<<domain ASP73 Asp73>>=
)abbrev domain ASP73 Asp73
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 30 March 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp73} produces Fortran for Type 73 ASPs, needed for NAG routine
++\axiomOpFrom{d03eef}{d03Package}, for example:
++\begin{verbatim}
++      SUBROUTINE PDEF(X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI)
++      DOUBLE PRECISION ALPHA,EPSOLN,PHI,X,Y,BETA,DELTA,GAMMA,PSI
++      ALPHA=DSIN(X)
++      BETA=Y
++      GAMMA=X*Y
++      DELTA=DCOS(X)*DSIN(Y)
++      EPSOLN=Y+X
++      PHI=X
++      PSI=Y
++      RETURN
++      END
++\end{verbatim}

Asp73(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FSTU   ==> Union(fst:FST,void:"void")
  FEXPR  ==> FortranExpression(['X,'Y],[],MachineFloat)
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2

  Exports ==> FortranVectorFunctionCategory with
    coerce : VEC FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    syms : SYMTAB := empty()$SYMTAB
    declare!(X,fortranReal(),syms) $SYMTAB
    declare!(Y,fortranReal(),syms) $SYMTAB
    declare!(ALPHA,fortranReal(),syms)$SYMTAB
    declare!(BETA,fortranReal(),syms) $SYMTAB
    declare!(GAMMA,fortranReal(),syms) $SYMTAB
    declare!(DELTA,fortranReal(),syms) $SYMTAB
    declare!(EPSOLN,fortranReal(),syms) $SYMTAB
    declare!(PHI,fortranReal(),syms) $SYMTAB
    declare!(PSI,fortranReal(),syms) $SYMTAB
    Rep := FortranProgram(name,["void"]$FSTU,
                          [X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI],syms)

    -- To help the poor compiler!
    localAssign(u:Symbol,v:FEXPR):FortranCode ==
      assign(u,(v::EXPR MachineFloat)$FEXPR)$FortranCode

    coerce(u:VEC FEXPR):$ ==
      maxIndex(u) ~= 7 => error "Vector is not of dimension 7"
      [localAssign(ALPHA@Symbol,elt(u,1)),_
       localAssign(BETA@Symbol,elt(u,2)),_
       localAssign(GAMMA@Symbol,elt(u,3)),_
       localAssign(DELTA@Symbol,elt(u,4)),_
       localAssign(EPSOLN@Symbol,elt(u,5)),_
       localAssign(PHI@Symbol,elt(u,6)),_
       localAssign(PSI@Symbol,elt(u,7)),_
       returns()$FortranCode]$List(FortranCode)::$

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

@
\section{domain ASP74 Asp74}
<<domain ASP74 Asp74>>=
)abbrev domain ASP74 Asp74
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Oct 1993
++ Date Last Updated: 30 March 1994
++                     6 October 1994
++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory.
++ Description:
++\spadtype{Asp74} produces Fortran for Type 74 ASPs, needed for NAG routine 
++\axiomOpFrom{d03eef}{d03Package}, for example:
++\begin{verbatim}
++      SUBROUTINE BNDY(X,Y,A,B,C,IBND)
++      DOUBLE PRECISION A,B,C,X,Y
++      INTEGER IBND
++      IF(IBND.EQ.0)THEN
++        A=0.0D0
++        B=1.0D0
++        C=-1.0D0*DSIN(X)
++      ELSEIF(IBND.EQ.1)THEN
++        A=1.0D0
++        B=0.0D0
++        C=DSIN(X)*DSIN(Y)
++      ELSEIF(IBND.EQ.2)THEN
++        A=1.0D0
++        B=0.0D0
++        C=DSIN(X)*DSIN(Y)
++      ELSEIF(IBND.EQ.3)THEN
++        A=0.0D0
++        B=1.0D0
++        C=-1.0D0*DSIN(Y)
++      ENDIF
++      END
++\end{verbatim}

Asp74(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FSTU   ==> Union(fst:FST,void:"void")
  FT     ==> FortranType
  SYMTAB ==> SymbolTable
  FC     ==> FortranCode
  PI     ==> PositiveInteger
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression(['X,'Y],[],MFLOAT)
  U      ==> Union(I: Expression Integer,F: Expression Float,_
                   CF: Expression Complex Float,switch:Switch)
  VEC    ==> Vector
  MAT    ==> Matrix
  M2     ==> MatrixCategoryFunctions2
  MF2a   ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT,
                MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2b   ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT,
                MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2c   ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT,
                FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2d   ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT,
                MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2e   ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT,
                FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2f   ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT,
                MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)

  Exports ==> FortranMatrixFunctionCategory with
    coerce : MAT FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    syms : SYMTAB := empty()$SYMTAB
    declare!(X,fortranReal(),syms)$SYMTAB
    declare!(Y,fortranReal(),syms)$SYMTAB
    declare!(A,fortranReal(),syms)$SYMTAB
    declare!(B,fortranReal(),syms)$SYMTAB
    declare!(C,fortranReal(),syms)$SYMTAB
    declare!(IBND,fortranInteger(),syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$FSTU,[X,Y,A,B,C,IBND],syms)

    -- To help the poor compiler!
    localAssign(u:Symbol,v:FEXPR):FC == assign(u,(v::EXPR MFLOAT)$FEXPR)$FC

    coerce(u:MAT FEXPR):$ == 
      (nrows(u) ~= 4 or ncols(u) ~= 3) => error "Not a 4X3 matrix"
      flag:U := [IBND@Symbol::EXPR INT]$U
      pt0:U  := [0::EXPR INT]$U
      pt1:U  := [1::EXPR INT]$U
      pt2:U  := [2::EXPR INT]$U
      pt3:U  := [3::EXPR INT]$U
      sw1: Switch := EQ(flag,pt0)$Switch
      sw2: Switch := EQ(flag,pt1)$Switch
      sw3: Switch := EQ(flag,pt2)$Switch
      sw4: Switch := EQ(flag,pt3)$Switch
      a11 : FC := localAssign(A,u(1,1))
      a12 : FC := localAssign(B,u(1,2))
      a13 : FC := localAssign(C,u(1,3))
      a21 : FC := localAssign(A,u(2,1))
      a22 : FC := localAssign(B,u(2,2))
      a23 : FC := localAssign(C,u(2,3))
      a31 : FC := localAssign(A,u(3,1))
      a32 : FC := localAssign(B,u(3,2))
      a33 : FC := localAssign(C,u(3,3))
      a41 : FC := localAssign(A,u(4,1))
      a42 : FC := localAssign(B,u(4,2))
      a43 : FC := localAssign(C,u(4,3))
      c : FC := cond(sw1,block([a11,a12,a13])$FC,
                     cond(sw2,block([a21,a22,a23])$FC,
                          cond(sw3,block([a31,a32,a33])$FC,
                               cond(sw4,block([a41,a42,a43])$FC)$FC)$FC)$FC)$FC
      c::$

    coerce(u:$):OutputForm == coerce(u)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:List FortranCode):$ == coerce(c)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    retract(u:MAT FRAC POLY INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2a
      v::$

    retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT FRAC POLY FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2b
      v::$

    retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT EXPR INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2e
      v::$

    retractIfCan(u:MAT EXPR INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT EXPR FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2f
      v::$

    retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT POLY INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2c
      v::$

    retractIfCan(u:MAT POLY INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT POLY FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2d
      v::$

    retractIfCan(u:MAT POLY FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

@
\section{domain ASP77 Asp77}
<<domain ASP77 Asp77>>=
)abbrev domain ASP77 Asp77
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 30 March 1994
++                     6 October 1994
++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp77} produces Fortran for Type 77 ASPs, needed for NAG routine 
++\axiomOpFrom{d02gbf}{d02Package}, for example:
++\begin{verbatim}
++      SUBROUTINE FCNF(X,F)
++      DOUBLE PRECISION X
++      DOUBLE PRECISION F(2,2)
++      F(1,1)=0.0D0
++      F(1,2)=1.0D0
++      F(2,1)=0.0D0
++      F(2,2)=-10.0D0
++      RETURN
++      END
++\end{verbatim}

Asp77(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FSTU   ==> Union(fst:FST,void:"void") 
  FT     ==> FortranType
  FC     ==> FortranCode
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FC))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression(['X],[],MFLOAT)
  VEC    ==> Vector
  MAT    ==> Matrix
  M2     ==> MatrixCategoryFunctions2
  MF2    ==> M2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT,
                VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT)
  MF2a   ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT,
                MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2b   ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT,
                MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2c   ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT,
                FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2d   ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT,
                MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2e   ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT,
                FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2f   ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT,
                MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)


  Exports ==> FortranMatrixFunctionCategory with
    coerce : MAT FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : FSTU := ["real"::FST]$FSTU
    syms : SYMTAB := empty()$SYMTAB
    declare!(X,fortranReal(),syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$FSTU,[X,F],syms)

    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    localAssign(s:Symbol,j:MAT FEXPR):FortranCode ==
      j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2
      assign(s,j')$FortranCode

    coerce(u:MAT FEXPR):$ ==
      dimension := nrows(u)::POLY(INT)
      locals : SYMTAB := empty()
      declare!(F,[real,[dimension,dimension]$List(POLY(INT)),false]$FT,locals)
      code : List FC := [localAssign(F,u),returns()$FC]
      ([locals,code]$RSFC)::$

    coerce(c:List FC):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FC):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    retract(u:MAT FRAC POLY INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2a
      v::$

    retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT FRAC POLY FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2b
      v::$

    retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT EXPR INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2e
      v::$

    retractIfCan(u:MAT EXPR INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT EXPR FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2f
      v::$

    retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT POLY INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2c
      v::$

    retractIfCan(u:MAT POLY INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT POLY FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2d
      v::$

    retractIfCan(u:MAT POLY FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

@
\section{domain ASP78 Asp78}
<<domain ASP78 Asp78>>=
)abbrev domain ASP78 Asp78
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 30 March 1994
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp78} produces Fortran for Type 78 ASPs, needed for NAG routine 
++\axiomOpFrom{d02gbf}{d02Package}, for example:
++\begin{verbatim}
++      SUBROUTINE FCNG(X,G)
++      DOUBLE PRECISION G(*),X
++      G(1)=0.0D0
++      G(2)=0.0D0
++      END
++\end{verbatim}

Asp78(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FSTU   ==> Union(fst:FST,void:"void")
  FT     ==> FortranType
  FC     ==> FortranCode
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FC))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression(['X],[],MFLOAT)

  Exports ==> FortranVectorFunctionCategory with
    coerce : VEC FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : FSTU := ["real"::FST]$FSTU
    syms : SYMTAB := empty()$SYMTAB
    declare!(X,fortranReal(),syms)$SYMTAB
    gType : FT := construct(real,["*"::Symbol],false)$FT
    declare!(G,gType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$FSTU,[X,G],syms)

    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    coerce(u:VEC FEXPR):$ ==
      u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
      (assign(G,u')$FC)::$

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    coerce(c:List FC):$ == coerce(c)$Rep

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FC):$ == coerce(c)$Rep

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

@
\section{domain ASP8 Asp8}
<<domain ASP8 Asp8>>=
)abbrev domain ASP8 Asp8
++ Author: Godfrey Nolan and Mike Dewar
++ Date Created: 11 February 1994
++ Date Last Updated: 18 March 1994
++                    31 May 1994 to use alternative interface. MCD
++                    30 June 1994 to handle the end condition correctly. MCD
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp8} produces Fortran for Type 8 ASPs, needed for NAG routine
++\axiomOpFrom{d02bbf}{d02Package}.  This ASP prints intermediate values of the computed solution of
++an ODE and might look like:
++\begin{verbatim}
++      SUBROUTINE OUTPUT(XSOL,Y,COUNT,M,N,RESULT,FORWRD)
++      DOUBLE PRECISION Y(N),RESULT(M,N),XSOL
++      INTEGER M,N,COUNT
++      LOGICAL FORWRD
++      DOUBLE PRECISION X02ALF,POINTS(8)
++      EXTERNAL X02ALF
++      INTEGER I
++      POINTS(1)=1.0D0
++      POINTS(2)=2.0D0
++      POINTS(3)=3.0D0
++      POINTS(4)=4.0D0
++      POINTS(5)=5.0D0
++      POINTS(6)=6.0D0
++      POINTS(7)=7.0D0
++      POINTS(8)=8.0D0
++      COUNT=COUNT+1
++      DO 25001 I=1,N
++        RESULT(COUNT,I)=Y(I)
++25001 CONTINUE
++      IF(COUNT.EQ.M)THEN
++        IF(FORWRD)THEN
++          XSOL=X02ALF()
++        ELSE
++          XSOL=-X02ALF()
++        ENDIF
++      ELSE
++        XSOL=POINTS(COUNT)
++      ENDIF
++      END
++\end{verbatim}

Asp8(name): Exports == Implementation where
  name : Symbol

  O      ==> OutputForm
  S      ==> Symbol
  FST    ==> FortranScalarType
  UFST   ==> Union(fst:FST,void:"void")
  FT     ==> FortranType
  FC     ==> FortranCode
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  EX     ==> Expression Integer
  MFLOAT ==> MachineFloat
  EXPR   ==> Expression
  PI     ==> Polynomial Integer
  EXU    ==> Union(I: EXPR Integer,F: EXPR Float,CF: EXPR Complex Float,
                   switch: Switch)

  Exports ==> FortranVectorCategory 

  Implementation ==> add

    real : UFST := ["real"::FST]$UFST
    syms : SYMTAB := empty()$SYMTAB
    declare!([COUNT,M,N],fortranInteger(),syms)$SYMTAB
    declare!(XSOL,fortranReal(),syms)$SYMTAB
    yType : FT := construct(real,[N],false)$FT
    declare!(Y,yType,syms)$SYMTAB
    declare!(FORWRD,fortranLogical(),syms)$SYMTAB
    declare!(RESULT,construct(real,[M,N],false)$FT,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$UFST,[XSOL,Y,COUNT,M,N,RESULT,FORWRD],syms)

    coerce(c:List FC):% == coerce(c)$Rep

    coerce(r:RSFC):% == coerce(r)$Rep

    coerce(c:FC):% == coerce(c)$Rep

    coerce(u:%):O == coerce(u)$Rep

    outputAsFortran(u:%):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage


    f2ex(u:MFLOAT):EXPR MFLOAT == (u::EXPR MFLOAT)$EXPR(MFLOAT)

    coerce(points:Vector MFLOAT):% ==
      import PI
      import EXPR Integer
      -- Create some extra declarations
      locals : SYMTAB := empty()$SYMTAB
      nPol : PI := "N"::S::PI
      iPol : PI := "I"::S::PI
      countPol : PI := "COUNT"::S::PI
      pointsDim : PI := max(#points,1)::PI
      declare!(POINTS,[real,[pointsDim],false]$FT,locals)$SYMTAB
      declare!(X02ALF,[real,[],true]$FT,locals)$SYMTAB
      -- Now build up the code fragments
      index : SegmentBinding PI := equation(I@S,1::PI..nPol)$SegmentBinding(PI)
      ySym : EX := (subscript("Y"::S,[I::O])$S)::EX
      loop := forLoop(index,assign(RESULT,[countPol,iPol],ySym)$FC)$FC
      v:Vector EXPR MFLOAT
      v := map(f2ex,points)$VectorFunctions2(MFLOAT,EXPR MFLOAT)
      assign1 : FC := assign(POINTS,v)$FC
      countExp: EX := COUNT@S::EX
      newValue: EX := 1 + countExp
      assign2 : FC := assign(COUNT,newValue)$FC
      newSymbol : S := subscript(POINTS,[COUNT]@List(O))$S
      assign3 : FC := assign(XSOL, newSymbol::EX )$FC
      fphuge : EX := kernel(operator X02ALF,empty()$List(EX))
      assign4 : FC := assign(XSOL, fphuge)$FC
      assign5 : FC := assign(XSOL, -fphuge)$FC
      innerCond : FC := cond("FORWRD"::Symbol::Switch,assign4,assign5)
      mExp : EX := M@S::EX
      endCase : FC := cond(EQ([countExp]$EXU,[mExp]$EXU)$Switch,innerCond,assign3)
      code := [assign1, assign2, loop, endCase]$List(FC)
      ([locals,code]$RSFC)::%

@
\section{domain ASP80 Asp80}
<<domain ASP80 Asp80>>=
)abbrev domain ASP80 Asp80
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Oct 1993
++ Date Last Updated: 30 March 1994
++                     6 October 1994
++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp80} produces Fortran for Type 80 ASPs, needed for NAG routine 
++\axiomOpFrom{d02kef}{d02Package}, for example:
++\begin{verbatim}
++      SUBROUTINE BDYVAL(XL,XR,ELAM,YL,YR)
++      DOUBLE PRECISION ELAM,XL,YL(3),XR,YR(3)
++      YL(1)=XL
++      YL(2)=2.0D0
++      YR(1)=1.0D0
++      YR(2)=-1.0D0*DSQRT(XR+(-1.0D0*ELAM))
++      RETURN
++      END
++\end{verbatim}

Asp80(name): Exports == Implementation where
  name : Symbol

  FST    ==> FortranScalarType
  FSTU   ==> Union(fst:FST,void:"void")
  FT     ==> FortranType
  FC     ==> FortranCode
  SYMTAB ==> SymbolTable
  RSFC   ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  MFLOAT ==> MachineFloat
  FEXPR  ==> FortranExpression(['XL,'XR,'ELAM],[],MFLOAT)
  VEC    ==> Vector
  MAT    ==> Matrix
  VF2    ==> VectorFunctions2
  M2     ==> MatrixCategoryFunctions2
  MF2a   ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT,
                MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2b   ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT,
                MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2c   ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT,
                FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2d   ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT,
                MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2e   ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT,
                FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)
  MF2f   ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT,
                MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR)

  Exports ==> FortranMatrixFunctionCategory with
    coerce : MAT FEXPR -> $
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  Implementation ==> add

    real : FSTU := ["real"::FST]$FSTU
    syms : SYMTAB := empty()$SYMTAB
    declare!(XL,fortranReal(),syms)$SYMTAB
    declare!(XR,fortranReal(),syms)$SYMTAB
    declare!(ELAM,fortranReal(),syms)$SYMTAB
    yType : FT := construct(real,["3"::Symbol],false)$FT
    declare!(YL,yType,syms)$SYMTAB
    declare!(YR,yType,syms)$SYMTAB
    Rep := FortranProgram(name,["void"]$FSTU, [XL,XR,ELAM,YL,YR],syms)

    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR

    vecAssign(s:Symbol,u:VEC FEXPR):FC ==
      u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT)
      assign(s,u')$FC

    coerce(u:MAT FEXPR):$ ==
      [vecAssign(YL,row(u,1)),vecAssign(YR,row(u,2)),returns()$FC]$List(FC)::$

    coerce(c:List FortranCode):$ == coerce(c)$Rep  

    coerce(r:RSFC):$ == coerce(r)$Rep

    coerce(c:FortranCode):$ == coerce(c)$Rep

    coerce(u:$):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

    retract(u:MAT FRAC POLY INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2a
      v::$

    retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT FRAC POLY FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2b
      v::$

    retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT EXPR INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2e
      v::$

    retractIfCan(u:MAT EXPR INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT EXPR FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2f
      v::$

    retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT POLY INT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2c
      v::$

    retractIfCan(u:MAT POLY INT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

    retract(u:MAT POLY FLOAT):$ ==
      v : MAT FEXPR := map(retract,u)$MF2d
      v::$

    retractIfCan(u:MAT POLY FLOAT):Union($,"failed") ==
      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d
      v case "failed" => "failed"
      (v::MAT FEXPR)::$

@
\section{domain ASP9 Asp9}
<<domain ASP9 Asp9>>=
)abbrev domain ASP9 Asp9
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 18 March 1994
++                    12 July 1994 added COMMON blocks for d02cjf, d02ejf
++                     6 October 1994
++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory
++ Description:
++\spadtype{Asp9} produces Fortran for Type 9 ASPs, needed for NAG routines
++\axiomOpFrom{d02bhf}{d02Package}, \axiomOpFrom{d02cjf}{d02Package}, \axiomOpFrom{d02ejf}{d02Package}.
++These ASPs represent a function of a scalar X and a vector Y, for example:
++\begin{verbatim}
++      DOUBLE PRECISION FUNCTION G(X,Y)
++      DOUBLE PRECISION X,Y(*)
++      G=X+Y(1)
++      RETURN
++      END
++\end{verbatim}
++If the user provides a constant value for G, then extra information is added
++via COMMON blocks used by certain routines.  This specifies that the value
++returned by G in this case is to be ignored.

Asp9(name): Exports == Implementation where
  name : Symbol

  FEXPR   ==> FortranExpression(['X],['Y],MFLOAT)
  MFLOAT  ==> MachineFloat
  FC      ==> FortranCode
  FST     ==> FortranScalarType
  FT      ==> FortranType
  SYMTAB  ==> SymbolTable
  RSFC    ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  UFST    ==> Union(fst:FST,void:"void")
  FRAC    ==> Fraction
  POLY    ==> Polynomial
  EXPR    ==> Expression
  INT     ==> Integer
  FLOAT   ==> Float

  Exports ==> FortranFunctionCategory with
    coerce : FEXPR -> %
      ++coerce(f) takes an object from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns it into an ASP.

  Implementation ==> add

    real : FST := "real"::FST
    syms : SYMTAB := empty()$SYMTAB
    declare!(X,fortranReal()$FT,syms)$SYMTAB
    yType : FT := construct([real]$UFST,["*"::Symbol],false)$FT
    declare!(Y,yType,syms)$SYMTAB
    Rep := FortranProgram(name,[real]$UFST,[X,Y],syms)

    retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:EXPR INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:POLY FLOAT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
    retractIfCan(u:POLY INT):Union($,"failed") ==
      foo : Union(FEXPR,"failed")
      foo := retractIfCan(u)$FEXPR
      foo case "failed" => "failed"
      (foo::FEXPR)::$

    coerce(u:FEXPR):% ==
      expr : Expression MachineFloat := (u::Expression(MachineFloat))$FEXPR
      (retractIfCan(u)@Union(MFLOAT,"failed"))$FEXPR case "failed" => 
          coerce(expr)$Rep
      locals : SYMTAB := empty()
      charType : FT := construct(["character"::FST]$UFST,[6::POLY(INT)],false)$FT
      declare!([CHDUM1,CHDUM2,GOPT1,CHDUM,GOPT2],charType,locals)$SYMTAB
      common1 := common(CD02EJ,[CHDUM1,CHDUM2,GOPT1] )$FC
      common2 := common(AD02CJ,[CHDUM,GOPT2] )$FC
      assign1 := assign(GOPT1,"NOGOPT")$FC
      assign2 := assign(GOPT2,"NOGOPT")$FC
      result  := assign(name,expr)$FC
      code : List FC := [common1,common2,assign1,assign2,result]
      ([locals,code]$RSFC)::Rep

    coerce(c:List FortranCode):% == coerce(c)$Rep

    coerce(r:RSFC):% == coerce(r)$Rep

    coerce(c:FortranCode):% == coerce(c)$Rep

    coerce(u:%):OutputForm == coerce(u)$Rep

    outputAsFortran(u):Void ==
      p := checkPrecision()$NAGLinkSupportPackage
      outputAsFortran(u)$Rep
      p => restorePrecision()$NAGLinkSupportPackage

@
\section{License}
<<license>>=
--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@
<<*>>=
<<license>>

<<domain ASP1 Asp1>>
<<domain ASP10 Asp10>>
<<domain ASP12 Asp12>>
<<domain ASP19 Asp19>>
<<domain ASP20 Asp20>>
<<domain ASP24 Asp24>>
<<domain ASP27 Asp27>>
<<domain ASP28 Asp28>>
<<domain ASP29 Asp29>>
<<domain ASP30 Asp30>>
<<domain ASP31 Asp31>>
<<domain ASP33 Asp33>>
<<domain ASP34 Asp34>>
<<domain ASP35 Asp35>>
<<domain ASP4 Asp4>>
<<domain ASP41 Asp41>>
<<domain ASP42 Asp42>>
<<domain ASP49 Asp49>>
<<domain ASP50 Asp50>>
<<domain ASP55 Asp55>>
<<domain ASP6 Asp6>>
<<domain ASP7 Asp7>>
<<domain ASP73 Asp73>>
<<domain ASP74 Asp74>>
<<domain ASP77 Asp77>>
<<domain ASP78 Asp78>>
<<domain ASP8 Asp8>>
<<domain ASP80 Asp80>>
<<domain ASP9 Asp9>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}