/usr/share/axiom-20170501/src/algebra/ASP27.spad is in axiom-source 20170501-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | )abbrev domain ASP27 Asp27
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Nov 1993
++ Date Last Updated: 6 October 1994
++ References:
++ Hawk95 Two more links to NAG numerics involving CA systems
++ Kead93 Production of Argument SubPrograms in the AXIOM -- NAG link
++ Description:
++\spadtype{Asp27} produces Fortran for Type 27 ASPs, needed for NAG routine
++f02fjf ,for example:
++
++\tab{5}FUNCTION DOT(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK)\br
++\tab{5}DOUBLE PRECISION W(N),Z(N),RWORK(LRWORK)\br
++\tab{5}INTEGER N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK)\br
++\tab{5}DOT=(W(16)+(-0.5D0*W(15)))*Z(16)+((-0.5D0*W(16))+W(15)+(-0.5D0*W(1\br
++\tab{4}&4)))*Z(15)+((-0.5D0*W(15))+W(14)+(-0.5D0*W(13)))*Z(14)+((-0.5D0*W(\br
++\tab{4}&14))+W(13)+(-0.5D0*W(12)))*Z(13)+((-0.5D0*W(13))+W(12)+(-0.5D0*W(1\br
++\tab{4}&1)))*Z(12)+((-0.5D0*W(12))+W(11)+(-0.5D0*W(10)))*Z(11)+((-0.5D0*W(\br
++\tab{4}&11))+W(10)+(-0.5D0*W(9)))*Z(10)+((-0.5D0*W(10))+W(9)+(-0.5D0*W(8))\br
++\tab{4}&)*Z(9)+((-0.5D0*W(9))+W(8)+(-0.5D0*W(7)))*Z(8)+((-0.5D0*W(8))+W(7)\br
++\tab{4}&+(-0.5D0*W(6)))*Z(7)+((-0.5D0*W(7))+W(6)+(-0.5D0*W(5)))*Z(6)+((-0.\br
++\tab{4}&5D0*W(6))+W(5)+(-0.5D0*W(4)))*Z(5)+((-0.5D0*W(5))+W(4)+(-0.5D0*W(3\br
++\tab{4}&)))*Z(4)+((-0.5D0*W(4))+W(3)+(-0.5D0*W(2)))*Z(3)+((-0.5D0*W(3))+W(\br
++\tab{4}&2)+(-0.5D0*W(1)))*Z(2)+((-0.5D0*W(2))+W(1))*Z(1)\br
++\tab{5}RETURN\br
++\tab{5}END
Asp27(name) : SIG == CODE 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
SIG ==> FortranMatrixCategory
CODE ==> 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
|