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

This file is indexed.

/usr/share/axiom-20170501/src/algebra/ASP49.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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
)abbrev domain ASP49 Asp49
++ Author: Mike Dewar, Grant Keady and Godfrey Nolan
++ Date Created: Mar 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{Asp49} produces Fortran for Type 49 ASPs, needed for NAG routines
++e04dgf, e04ucf, for example:
++
++\tab{5}SUBROUTINE OBJFUN(MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER)\br
++\tab{5}DOUBLE PRECISION X(N),OBJF,OBJGRD(N),USER(*)\br
++\tab{5}INTEGER N,IUSER(*),MODE,NSTATE\br
++\tab{5}OBJF=X(4)*X(9)+((-1.0D0*X(5))+X(3))*X(8)+((-1.0D0*X(3))+X(1))*X(7)\br
++\tab{4}&+(-1.0D0*X(2)*X(6))\br
++\tab{5}OBJGRD(1)=X(7)\br
++\tab{5}OBJGRD(2)=-1.0D0*X(6)\br
++\tab{5}OBJGRD(3)=X(8)+(-1.0D0*X(7))\br
++\tab{5}OBJGRD(4)=X(9)\br
++\tab{5}OBJGRD(5)=-1.0D0*X(8)\br
++\tab{5}OBJGRD(6)=-1.0D0*X(2)\br
++\tab{5}OBJGRD(7)=(-1.0D0*X(3))+X(1)\br
++\tab{5}OBJGRD(8)=(-1.0D0*X(5))+X(3)\br
++\tab{5}OBJGRD(9)=X(4)\br
++\tab{5}RETURN\br
++\tab{5}END

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

  SIG ==> FortranFunctionCategory with

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

  CODE ==> 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)::$

APT Browse - Built by Thomas Orozco.