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

This file is indexed.

/usr/share/axiom-20170501/src/algebra/ASP10.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
)abbrev domain ASP10 Asp10
++ Author: Mike Dewar and Godfrey Nolan
++ Date Created: Mar 1993
++ Date Last Updated: 18 March 1994, 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{ASP10} produces Fortran for Type 10 ASPs, needed for NAG routine 
++ d02kef. This ASP computes the values of a set of functions, for example: 
++
++ \tab{5}SUBROUTINE COEFFN(P,Q,DQDL,X,ELAM,JINT)\br
++ \tab{5}DOUBLE PRECISION ELAM,P,Q,X,DQDL\br
++ \tab{5}INTEGER JINT\br
++ \tab{5}P=1.0D0\br
++ \tab{5}Q=((-1.0D0*X**3)+ELAM*X*X-2.0D0)/(X*X)\br
++ \tab{5}DQDL=1.0D0\br
++ \tab{5}RETURN\br
++ \tab{5}END

Asp10(name) : SIG == CODE where
  name : Symbol

  FST  ==> FortranScalarType
  FT   ==> FortranType
  SYMTAB ==> SymbolTable
  EXF ==> Expression Float
  RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode))
  FEXPR ==> FortranExpression(['JINT,'X,'ELAM],[],MFLOAT)
  MFLOAT ==> MachineFloat
  FRAC   ==> Fraction
  POLY   ==> Polynomial
  EXPR   ==> Expression
  INT    ==> Integer
  FLOAT  ==> Float
  VEC    ==> Vector
  VF2    ==> VectorFunctions2

  SIG ==> FortranVectorFunctionCategory with

    coerce : Vector FEXPR -> %
      ++coerce(f) takes objects from the appropriate instantiation of
      ++\spadtype{FortranExpression} and turns them into an ASP.

  CODE ==> add

    real : FST := "real"::FST

    syms : SYMTAB := empty()$SYMTAB

    declare!(P,fortranReal()$FT,syms)$SYMTAB

    declare!(Q,fortranReal()$FT,syms)$SYMTAB

    declare!(DQDL,fortranReal()$FT,syms)$SYMTAB

    declare!(X,fortranReal()$FT,syms)$SYMTAB

    declare!(ELAM,fortranReal()$FT,syms)$SYMTAB

    declare!(JINT,fortranInteger()$FT,syms)$SYMTAB

    Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"),
                          [P,Q,DQDL,X,ELAM,JINT],syms)

    retract(u:VEC FRAC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC FRAC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=_
         map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC EXPR FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY INT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    retract(u:VEC POLY FLOAT):$ ==
      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
      v::$

    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
      v case "failed" => "failed"
      (v::VEC FEXPR)::$

    coerce(c:FortranCode):% == coerce(c)$Rep

    coerce(r:RSFC):% == coerce(r)$Rep

    coerce(c:List FortranCode):% == coerce(c)$Rep

    -- To help the poor old compiler!
    localAssign(s:Symbol,u:Expression MFLOAT):FortranCode == 
      assign(s,u)$FortranCode

    coerce(u:Vector FEXPR):% ==
      import Vector FEXPR
      not (#u = 3) => error "Incorrect Dimension For Vector"
      ([localAssign(P,elt(u,1)::Expression MFLOAT),_
        localAssign(Q,elt(u,2)::Expression MFLOAT),_
        localAssign(DQDL,elt(u,3)::Expression MFLOAT),_
        returns()$FortranCode ]$List(FortranCode))::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.