/usr/share/axiom-20170501/src/algebra/ASP34.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 105 106 107 | )abbrev domain ASP34 Asp34
++ Author: Mike Dewar and Godfrey Nolan and Themos Tsikas
++ 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{Asp34} produces Fortran for Type 34 ASPs, needed for NAG routine
++f04mbf, for example:
++
++\tab{5}SUBROUTINE MSOLVE(IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK)\br
++\tab{5}DOUBLE PRECISION RWORK(LRWORK),X(N),Y(N)\br
++\tab{5}INTEGER I,J,N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK)\br
++\tab{5}DOUBLE PRECISION W1(3),W2(3),MS(3,3)\br
++\tab{5}IFLAG=-1\br
++\tab{5}MS(1,1)=2.0D0\br
++\tab{5}MS(1,2)=1.0D0\br
++\tab{5}MS(1,3)=0.0D0\br
++\tab{5}MS(2,1)=1.0D0\br
++\tab{5}MS(2,2)=2.0D0\br
++\tab{5}MS(2,3)=1.0D0\br
++\tab{5}MS(3,1)=0.0D0\br
++\tab{5}MS(3,2)=1.0D0\br
++\tab{5}MS(3,3)=2.0D0\br
++\tab{5}CALL F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)\br
++\tab{5}IFLAG=-IFLAG\br
++\tab{5}RETURN\br
++\tab{5}END
Asp34(name) : SIG == CODE 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))
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
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
|