/usr/share/axiom-20170501/src/algebra/ASP8.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 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | )abbrev domain ASP8 Asp8
++ Author: Godfrey Nolan and Mike Dewar
++ Date Created: 11 February 1994
++ 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{Asp8} produces Fortran for Type 8 ASPs, needed for NAG routine
++ d02bbf. This ASP prints intermediate values of the computed solution of
++ an ODE and might look like:
++
++ \tab{5}SUBROUTINE OUTPUT(XSOL,Y,COUNT,M,N,RESULT,FORWRD)\br
++ \tab{5}DOUBLE PRECISION Y(N),RESULT(M,N),XSOL\br
++ \tab{5}INTEGER M,N,COUNT\br
++ \tab{5}LOGICAL FORWRD\br
++ \tab{5}DOUBLE PRECISION X02ALF,POINTS(8)\br
++ \tab{5}EXTERNAL X02ALF\br
++ \tab{5}INTEGER I\br
++ \tab{5}POINTS(1)=1.0D0\br
++ \tab{5}POINTS(2)=2.0D0\br
++ \tab{5}POINTS(3)=3.0D0\br
++ \tab{5}POINTS(4)=4.0D0\br
++ \tab{5}POINTS(5)=5.0D0\br
++ \tab{5}POINTS(6)=6.0D0\br
++ \tab{5}POINTS(7)=7.0D0\br
++ \tab{5}POINTS(8)=8.0D0\br
++ \tab{5}COUNT=COUNT+1\br
++ \tab{5}DO 25001 I=1,N\br
++ \tab{7} RESULT(COUNT,I)=Y(I)\br
++ 25001 CONTINUE\br
++ \tab{5}IF(COUNT.EQ.M)THEN\br
++ \tab{7}IF(FORWRD)THEN\br
++ \tab{9}XSOL=X02ALF()\br
++ \tab{7}ELSE\br
++ \tab{9}XSOL=-X02ALF()\br
++ \tab{7}ENDIF\br
++ \tab{5}ELSE\br
++ \tab{7} XSOL=POINTS(COUNT)\br
++ \tab{5}ENDIF\br
++ \tab{5}END
Asp8(name) : SIG == CODE 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)
SIG ==> FortranVectorCategory
CODE ==> 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)::%
|