axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / ASP30.spad

This file is indexed.

/usr/share/axiom-20170501/src/algebra/ASP30.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
132
133
134
135
136
137
138
139
140
)abbrev domain ASP30 Asp30
++ 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{Asp30} produces Fortran for Type 30 ASPs, needed for NAG routine
++f04qaf, for example:
++
++\tab{5}SUBROUTINE APROD(MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK)\br
++\tab{5}DOUBLE PRECISION X(N),Y(M),RWORK(LRWORK)\br
++\tab{5}INTEGER M,N,LIWORK,IFAIL,LRWORK,IWORK(LIWORK),MODE\br
++\tab{5}DOUBLE PRECISION A(5,5)\br
++\tab{5}EXTERNAL F06PAF\br
++\tab{5}A(1,1)=1.0D0\br
++\tab{5}A(1,2)=0.0D0\br
++\tab{5}A(1,3)=0.0D0\br
++\tab{5}A(1,4)=-1.0D0\br
++\tab{5}A(1,5)=0.0D0\br
++\tab{5}A(2,1)=0.0D0\br
++\tab{5}A(2,2)=1.0D0\br
++\tab{5}A(2,3)=0.0D0\br
++\tab{5}A(2,4)=0.0D0\br
++\tab{5}A(2,5)=-1.0D0\br
++\tab{5}A(3,1)=0.0D0\br
++\tab{5}A(3,2)=0.0D0\br
++\tab{5}A(3,3)=1.0D0\br
++\tab{5}A(3,4)=-1.0D0\br
++\tab{5}A(3,5)=0.0D0\br
++\tab{5}A(4,1)=-1.0D0\br
++\tab{5}A(4,2)=0.0D0\br
++\tab{5}A(4,3)=-1.0D0\br
++\tab{5}A(4,4)=4.0D0\br
++\tab{5}A(4,5)=-1.0D0\br
++\tab{5}A(5,1)=0.0D0\br
++\tab{5}A(5,2)=-1.0D0\br
++\tab{5}A(5,3)=0.0D0\br
++\tab{5}A(5,4)=-1.0D0\br
++\tab{5}A(5,5)=4.0D0\br
++\tab{5}IF(MODE.EQ.1)THEN\br
++\tab{7}CALL F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)\br
++\tab{5}ELSEIF(MODE.EQ.2)THEN\br
++\tab{7}CALL F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)\br
++\tab{5}ENDIF\br
++\tab{5}RETURN\br
++\tab{5}END

Asp30(name) : SIG == CODE 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

  SIG ==> FortranMatrixCategory 

  CODE ==> 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

APT Browse - Built by Thomas Orozco.