1** Copyright (c) 1989, NVIDIA CORPORATION. All rights reserved. 2** 3** Licensed under the Apache License, Version 2.0 (the "License"); 4** you may not use this file except in compliance with the License. 5** You may obtain a copy of the License at 6** 7** http://www.apache.org/licenses/LICENSE-2.0 8** 9** Unless required by applicable law or agreed to in writing, software 10** distributed under the License is distributed on an "AS IS" BASIS, 11** WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12** See the License for the specific language governing permissions and 13** limitations under the License. 14 15* Exponentiation operator (**) - exponentiation of integer, 16* real, d.p., or complex values to an integer power, 17* including constant folding. 18 19 implicit double precision (d), complex(c) 20 parameter(n = 34) 21 integer rslts(n), expect(n), iexpect(12) 22 real rrslts(13:18), rexpect(13:18) 23 double precision drslts(4), dexpect(4) 24 complex crslts(4), cexpect(4) 25 26 equivalence (expect, iexpect), (expect(13), rexpect), 27 + (expect(19), dexpect), (expect(27), cexpect) 28 equivalence (rslts(13), rrslts(13)), (rslts(19), drslts), 29 + (rslts(27), crslts) 30 31 parameter(ip1 = 138 ** 1, ip2 = -4 ** 2, ip3 = 5**0, 32 + ip4 = -5**3, ip5 = 1 ** 20, ip6 = 1**(-3), 33 + ip7 = 2 ** (-1), ip8=5**(-2), ip9=2**3**2 ) 34 35 parameter(xp1 = 2.0 ** 2, xp2 = 4.0 ** (-1), xp3 = -3.0 ** 3, 36 + xp4 = 2.3 ** 1, xp5 = 2.0 ** (-2) ) 37 38 parameter(dp1 = 2.0D0 ** 3, dp2 = 2.3d45**0, dp3=(-2.0d0)**(-2)) 39 40 parameter(cp1 = (2.0, 0.0) ** 3, cp2 = (2.3, 2.3) ** 1, 41 + cp3 = (2.3, 2.3) ** 0, cp4 = (1.0, 1.0) ** 2 ) 42 43c ----------- tests 1 - 12: integer ** integer 44 45 data iexpect / ip1, ip2, ip2, ip3, ip4, ip5, 46 + ip6, ip7, ip8, ip9, ip9, 125 / 47 48 data i138, i4, i2, i3, i5, i20, in3, i1, in2, in1 / 49 + 138, 4, 2, 3, 5, 20, -3, 1, -2, -1 / 50 51 rslts(1) = i138 ** i1 52 rslts(2) = - (i4 ** i2) 53 rslts(3) = - i4 ** i2 54 rslts(4) = i5 ** (i2 / i3) 55 rslts(5) = - i5 ** (i2 + i1) 56 rslts(6) = i1 ** i20 57 rslts(7) = i1 ** (in3) 58 rslts(8) = (i1 * i2) ** (-i1) 59 rslts(9) = 5 ** (in2) 60 rslts(10) = (-in2) ** if(3) ** 2 61 rslts(11) = i2 ** (i3 ** i2) 62 rslts(12) = if(5) ** 3 63 64c ------------ tests 13 - 18: real ** integer 65 66 data rexpect / xp1, xp2, xp3, xp4, xp5, 9.0 / 67 68 data x3, x23, x2 / 3.0, 2.3, 2.0 / 69 70 rrslts(13) = 4.0 71 rrslts(14) = 4.0 ** in1 72 rrslts(15) = -x3**3 73 rrslts(16) = x23 ** (i2 - 1) 74 rrslts(17) = x2 ** (- i2) 75 rrslts(18) = xf( -x3 ) ** 2 76 77c ------------- tests 19 - 26: double ** integer 78 79 data dexpect / dp1, dp2, dp3, 4.0D0 / 80 81 data d2 / 2.0d0 / 82 83 drslts(1) = d2 ** i3 84 drslts(2) = 2.3D45 ** (i2 - i1 - i1) 85 drslts(3) = (-d2) ** (-i2) 86 drslts(4) = d2 ** 2 87 88c -------------- tests 27 - 34: complex ** integer 89 90 data cexpect / cp1, cp2, cp3, cp4 / 91 92 data c2, c23, cn1_1 / 93 + (2.0, 0.0), (2.3, 2.3), (-1.0, 1.0) / 94 95 crslts(1) = c2 ** i3 96 crslts(2) = (2.3, 2.3) ** (i2 - i1) 97 crslts(3) = c23 ** 0 98 crslts(4) = (c2 + cn1_1) ** 2 99 100c --------------- check results: 101 102 call check(rslts, expect, n) 103 end 104 105 106 integer function if(i) 107 common /comif/ ii 108 data ii /0/ 109 if (ii .gt. 1) stop "'if' called too often" 110 ii = ii + 1 111 if = i 112 end 113 114 real function xf(x) 115 common /comxf/ ii 116 data ii /0/ 117 if (ii .gt. 1) stop "'xf' called too often" 118 ii = ii + 1 119 xf = x 120 end 121