00001 C
00002 C
00003 C Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved.
00004 C
00005 C This program is free software; you can redistribute it and/or modify it
00006 C under the terms of version 2 of the GNU General Public License as
00007 C published by the Free Software Foundation.
00008 C
00009 C This program is distributed in the hope that it would be useful, but
00010 C WITHOUT ANY WARRANTY; without even the implied warranty of
00011 C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
00012 C
00013 C Further, this software is distributed without any warranty that it is
00014 C free of the rightful claim of any third person regarding infringement
00015 C or the like. Any license provided herein, whether implied or
00016 C otherwise, applies only to this software file. Patent licenses, if
00017 C any, provided herein do not apply to combinations of this program with
00018 C other software, or any other product whatsoever.
00019 C
00020 C You should have received a copy of the GNU General Public License along
00021 C with this program; if not, write the Free Software Foundation, Inc., 59
00022 C Temple Place - Suite 330, Boston MA 02111-1307, USA.
00023 C
00024 C Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00025 C Mountain View, CA 94043, or:
00026 C
00027 C http://www.sgi.com
00028 C
00029 C For further information regarding this notice, see:
00030 C
00031 C http://oss.sgi.com/projects/GenInfo/NoticeExplan
00032 C
00033 C
00034
00035 program gencray
00036
00037 call gen_strtoh
00038 call gen_strtod
00039 c call gen_strtold
00040
00041 call gen_alog
00042 call gen_exp
00043 call gen_sqrt
00044
00045 call gen_cabs
00046
00047 call gen_itoi
00048 call gen_rtoi
00049 call gen_rtor
00050
00051 c call gen_dlog
00052 c call gen_dexp
00053 c call gen_dsqrt
00054
00055 c call gen_dtoi
00056 c call gen_dtor
00057 c call gen_dtod
00058
00059 call gen_clog
00060 call gen_cexp
00061 call gen_csqrt
00062
00063 call gen_ctoi
00064 call gen_ctor
00065 call gen_ctoc
00066
00067 call gen_cdlog
00068 call gen_cdexp
00069 call gen_cdsqrt
00070
00071 call gen_cdabs
00072
00073 call gen_cdtoi
00074 call gen_cdtocd
00075
00076 call gen_hlog
00077 call gen_hexp
00078 call gen_hsqrt
00079 call gen_htoi
00080
00081 call gen_modi
00082 call gen_modj
00083 call gen_modf
00084 call gen_mods
00085
00086 call gen_selrk
00087
00088 stop
00089
00090 end
00091
00092 subroutine gen_strtoh
00093
00094 write(6,"(""STRTOF(0.0) 00000000"")")
00095 write(6,"(""STRTOF(1.0) 3F800000"")")
00096 write(6,"(""STRTOF(-1.0) BF800000"")")
00097 write(6,"(""STRTOF(2.00) 40000000"")")
00098 write(6,"(""STRTOF(3.00) 40400000"")")
00099 write(6,"(""STRTOF(-3.50) C0600000"")")
00100 write(6,"(""STRTOF(3.625) 40680000"")")
00101 write(6,"(""STRTOF(1.E-40) 00000002"")")
00102 write(6,"(""STRTOF(1.E+40) 00000001"")")
00103
00104 return
00105 end
00106
00107 subroutine gen_strtod
00108
00109 character*22 num
00110
00111 write(6,"(""STRTOD(.0)"",1(1x,z16.16))") .0
00112 write(6,"(""STRTOD(0.)"",1(1x,z16.16))") 0.
00113 write(6,"(""STRTOD(0E0)"",1(1x,z16.16))") 0.0
00114 write(6,"(""STRTOD(0.0E0)"",1(1x,z16.16))") 0.0
00115 write(6,"(""STRTOD(0.0E1)"",1(1x,z16.16))") 0.0
00116 write(6,"(""STRTOD(0E-1)"",1(1x,z16.16))") 0.0
00117 write(6,"(""STRTOD(-0E+2)"",1(1x,z16.16))") -0E+2
00118 write(6,"(""STRTOD(1.00)"",1(1x,z16.16))") 1.00
00119 write(6,"(""STRTOD(1.0E0)"",1(1x,z16.16))") 1.00
00120 write(6,"(""STRTOD(0.1E1)"",1(1x,z16.16))") 1.00
00121 write(6,"(""STRTOD(1.0E+0)"",1(1x,z16.16))") 1.00
00122 write(6,"(""STRTOD(1.0E-0)"",1(1x,z16.16))") 1.00
00123 write(6,"(""STRTOD(1E0)"",1(1x,z16.16))") 1.00
00124 write(6,"(""STRTOD(0.99999999999999)"",1(1x,z16.16))")
00125 . 0.99999999999999
00126 write(6,"(""STRTOD(0.999999999999995)"",1(1x,z16.16))")
00127 . 0.999999999999995
00128 write(6,"(""STRTOD(0.999999999999999)"",1(1x,z16.16))")
00129 . 0.999999999999999
00130 write(6,"(""STRTOD(0.9999999999999999)"",1(1x,z16.16))")
00131 . 0.9999999999999999
00132 write(6,"(""STRTOD(0.99999999999999999)"",1(1x,z16.16))")
00133 . 0.99999999999999999
00134 write(6,"(""STRTOD(1.23)"",1(1x,z16.16))") 1.23
00135 write(6,"(""STRTOD(8.3E0)"",1(1x,z16.16))") 8.3E0
00136 write(6,"(""STRTOD(5.1E-0)"",1(1x,z16.16))") 5.1E-0
00137 write(6,"(""STRTOD(2.2E+0)"",1(1x,z16.16))") 2.2E+0
00138 write(6,"(""STRTOD(0.0000456E+7)"",1(1x,z16.16))") 0.0000456E+7
00139 write(6,"(""STRTOD(0.0000001E-5)"",1(1x,z16.16))") 0.0000001E-5
00140 write(6,"(""STRTOD(-7.18923E+21)"",1(1x,z16.16))") -7.18923e+21
00141
00142 do i=1,50
00143 x=(ranf()-0.5)*(i+0.1)**84.7
00144 if(abs(x).ge.1.e99 .or. abs(x).lt.1.e-99) then
00145 write(num,"(e22.14e3)") x
00146 read(num,"(e22.14e3)") x
00147 write(6,"(""STRTOD("",a22,"")"",1(1x,z16.16))") num,x
00148 else
00149 write(num,"(e22.15)") x
00150 read(num,"(e22.15)") x
00151 write(6,"(""STRTOD("",a22,"")"",1(1x,z16.16))") num,x
00152 endif
00153 enddo
00154
00155 do i=1,50
00156 x=(ranf()-0.5)*i*10000
00157 if(abs(x).ge.100000.0) then
00158 write(num,"(f21.13)") x
00159 read(num,"(f21.13)") x
00160 write(6,"(""STRTOD("",a21,"")"",1(1x,z16.16))") num,x
00161 else
00162 x = x*0.01
00163 if(abs(x).ge.100.0) then
00164 write(num,"(f7.1)") x
00165 read(num,"(f7.1)") x
00166 write(6,"(""STRTOD("",a7,"")"",1(1x,z16.16))") num,x
00167 else
00168 write(num,"(f7.3)") x
00169 read(num,"(f7.3)") x
00170 write(6,"(""STRTOD("",a7,"")"",1(1x,z16.16))") num,x
00171 endif
00172 endif
00173 enddo
00174
00175 write(6,"(""STRTOD(1E-309)"",1(1x,z16.16))") 2
00176 write(6,"(""STRTOD(1E+309)"",1(1x,z16.16))") 1
00177
00178 return
00179 end
00180
00181 subroutine gen_strtold
00182
00183 character*37 num
00184
00185 double precision x
00186 complex cx
00187 equivalence(cx,x)
00188
00189 x = 0.0D0
00190 write(6,"(""STRTOLD(0.)"",2(1x,z16.16))") cx
00191 write(6,"(""STRTOLD(.0)"",2(1x,z16.16))") cx
00192 write(6,"(""STRTOLD(0E0)"",2(1x,z16.16))") cx
00193 write(6,"(""STRTOLD(0.0E0)"",2(1x,z16.16))") cx
00194 write(6,"(""STRTOLD(0.0E1)"",2(1x,z16.16))") cx
00195 write(6,"(""STRTOLD(0E-1)"",2(1x,z16.16))") cx
00196 write(6,"(""STRTOLD(-0E+2)"",2(1x,z16.16))") cx
00197 x = 1.0D0
00198 write(6,"(""STRTOLD(1.00)"",2(1x,z16.16))") cx
00199 write(6,"(""STRTOLD(0.1E1)"",2(1x,z16.16))") cx
00200 write(6,"(""STRTOLD(1.0E0)"",2(1x,z16.16))") cx
00201 write(6,"(""STRTOLD(1.0E+0)"",2(1x,z16.16))") cx
00202 write(6,"(""STRTOLD(1.0E-0)"",2(1x,z16.16))") cx
00203 write(6,"(""STRTOLD(1E0)"",2(1x,z16.16))") cx
00204 x = 1.875D0
00205 write(6,"(""STRTOLD(1.875)"",2(1x,z16.16))") cx
00206 x = 0.99999999999999D0
00207 write(6,"(""STRTOLD(0.99999999999999)"",2(1x,z16.16))") cx
00208 x = 0.999999999999994D0
00209 write(6,"(""STRTOLD(0.999999999999994)"",2(1x,z16.16))") cx
00210 x = 0.999999999999999D0
00211 write(6,"(""STRTOLD(0.999999999999999)"",2(1x,z16.16))") cx
00212 x = 0.9999999999999999D0
00213 write(6,"(""STRTOLD(0.9999999999999999)"",2(1x,z16.16))") cx
00214 x = 0.999999999999999999D0
00215 write(6,"(""STRTOLD(0.999999999999999999)"",2(1x,z16.16))") cx
00216 x = 1.23D0
00217 write(6,"(""STRTOLD(1.23)"",2(1x,z16.16))") cx
00218 x = -7.18923D+21
00219 write(6,"(""STRTOLD(-7.18923E+21)"",2(1x,z16.16))") cx
00220
00221 do i=1,100
00222 x=(ranf()-0.5D0)*(i+0.1D0)**87.123
00223 if(dabs(x).ge.1.0D99 .or. dabs(x).lt.1.0D-99) then
00224 write(num,"(d37.28e3)") x
00225 read(num,"(d37.28e3)") x
00226 write(6,"(""STRTOLD("",a37,"")"",2(1x,z16.16))") num,cx
00227 else
00228 write(num,"(d37.29)") x
00229 read(num,"(d37.29)") x
00230 write(6,"(""STRTOLD("",a37,"")"",2(1x,z16.16))") num,cx
00231 endif
00232 enddo
00233
00234 write(6,"(""STRTOLD(1E-309)"",2(1x,z16.16))") 2,0
00235 write(6,"(""STRTOLD(1E+309)"",2(1x,z16.16))") 1,0
00236
00237 return
00238 end
00239
00240 subroutine gen_alog
00241
00242 x = 1.0e308
00243 do while(x .gt. 0)
00244 z = ALOG(x)
00245 write(6,"(""ALOG(R)"",2(1x,z16.16))") x,z
00246 x = z
00247 enddo
00248
00249 do i=1,100
00250 x = RANF()
00251 if(x .gt. 0.1) then
00252 if(x .lt. 0.2) then
00253 x = x * 10.0
00254 else if(x .lt. 0.3) then
00255 x = x * 1.e2
00256 else if(x .lt. 0.4) then
00257 x = x * 1.e4
00258 else if(x .lt. 0.5) then
00259 x = x * 1.e8
00260 else if(x .lt. 0.6) then
00261 x = x * 1.e16
00262 else if(x .lt. 0.7) then
00263 x = x * 1.e32
00264 else if(x .lt. 0.8) then
00265 x = x * 1.e64
00266 else if(x .lt. 0.9) then
00267 x = x * 1.e128
00268 else
00269 x = x * 1.e256
00270 endif
00271 endif
00272 z = ALOG(x)
00273 write(6,"(""ALOG(R)"",2(1x,z16.16))") x,z
00274 enddo
00275
00276 write(6,"(""ALOG(R)"",2(1x,z16.16))") -1.0,x'0000000000000004'
00277 return
00278 end
00279
00280 subroutine gen_exp
00281
00282 x = 1.0e-307
00283 do while(x .lt. 1.e4)
00284 z = EXP(x)
00285 write(6,"(""EXP(R)"",2(1x,z16.16))") x,z
00286 x = z
00287 enddo
00288
00289 x = 0.01
00290 do while(x .lt. 1.e4)
00291 z = EXP(x)
00292 write(6,"(""EXP(R)"",2(1x,z16.16))") x,z
00293 x = z
00294 enddo
00295
00296 x = -1.0
00297 do while(abs(x) .lt. 1.e4)
00298 z = EXP(x)
00299 write(6,"(""EXP(R)"",2(1x,z16.16))") x,z
00300 x = -1.0/z
00301 enddo
00302
00303 do i=1,100
00304 x = (RANF()-0.5)*1000.0
00305 z = EXP(x)
00306 write(6,"(""EXP(R)"",2(1x,z16.16))") x,z
00307 enddo
00308
00309 write(6,"(""EXP(R)"",2(1x,z16.16))") 1.e5,x'0000000000000004'
00310 return
00311 end
00312
00313 subroutine gen_sqrt
00314
00315 z = 1.0e308
00316 x = 0.
00317 do while(x .ne. z)
00318 x = z
00319 z = SQRT(x)
00320 write(6,"(""SQRT(R)"",2(1x,z16.16))") x,z
00321 enddo
00322
00323 z = 1.0e-307
00324 x = 0.
00325 do while(x .ne. z)
00326 x = z
00327 z = SQRT(x)
00328 write(6,"(""SQRT(R)"",2(1x,z16.16))") x,z
00329 enddo
00330
00331 write(6,"(""SQRT(R)"",2(1x,z16.16))") -1.0,x'0000000000000004'
00332 return
00333 end
00334
00335 subroutine gen_cabs
00336
00337 complex x
00338 real rcabs
00339
00340 x = (0.,0.)
00341 z = rcabs(x)
00342 write(6,"(""CABS(C)"",3(1x,z16.16))") x,z
00343
00344 x = (-1.,0.)
00345 z = rcabs(x)
00346 write(6,"(""CABS(C)"",3(1x,z16.16))") x,z
00347
00348 x = (0.,-1.)
00349 z = rcabs(x)
00350 write(6,"(""CABS(C)"",3(1x,z16.16))") x,z
00351
00352 x = (0.1,0.2)
00353 z = rcabs(x)
00354 write(6,"(""CABS(C)"",3(1x,z16.16))") x,z
00355
00356 x = (-0.1,-0.2)
00357 z = rcabs(x)
00358 write(6,"(""CABS(C)"",3(1x,z16.16))") x,z
00359
00360 x = (-0.2,-0.1)
00361 z = rcabs(x)
00362 write(6,"(""CABS(C)"",3(1x,z16.16))") x,z
00363
00364 do i=1,100
00365 x = cmplx((ranf()-.5)*10.0**(i+.5),(ranf()-.5)*10.0**(i+.5))
00366 z = CABS(x)
00367 write(6,"(""CABS(C)"",3(1x,z16.16))") x,z
00368 enddo
00369
00370 x = (1.e300,-1.e300)
00371 z = rcabs(x)
00372 write(6,"(""CABS(C)"",3(1x,z16.16))") x,z
00373
00374 return
00375 end
00376 real function rcabs(c)
00377 complex c
00378 rcabs=cabs(c)
00379 return
00380 end
00381
00382 subroutine gen_itoi
00383
00384 integer x,y,z
00385
00386 x = 2
00387 y = -2
00388 do while(y .le. 64)
00389 z = itoi(x,y)
00390 write(6,"(""ITOI(I,I)"",3(1x,z16.16))") x,y,z
00391 y = y+1
00392 enddo
00393
00394 x = -3
00395 y = 5
00396 do while(x .ne. 0)
00397 z = itoi(x,y)
00398 write(6,"(""ITOI(I,I)"",3(1x,z16.16))") x,y,z
00399 y = x
00400 x = z
00401 enddo
00402
00403 x=0
00404 y=3000
00405 write(6,"(""ITOI(I,I)"",3(1x,z16.16))") x,y,itoi(x,y)
00406 x=1
00407 y=3000
00408 write(6,"(""ITOI(I,I)"",3(1x,z16.16))") x,y,itoi(x,y)
00409 x=2
00410 y=64
00411 write(6,"(""ITOI(I,I)"",3(1x,z16.16))") x,y,itoi(x,y)
00412 x=2
00413 y=0
00414 write(6,"(""ITOI(I,I)"",3(1x,z16.16))") x,y,itoi(x,y)
00415 x=2
00416 y=-1
00417 write(6,"(""ITOI(I,I)"",3(1x,z16.16))") x,y,itoi(x,y)
00418
00419 write(6,"(""ITOI(I,I)"",3(1x,z16.16))") 0,-1,0
00420 return
00421 end
00422 integer function itoi(i,j)
00423 itoi=i**j
00424 return
00425 end
00426
00427 subroutine gen_rtoi
00428
00429 integer y
00430
00431 x = 0.5
00432 y = 1
00433 do while(x .gt. 0.0)
00434 z = x**y
00435 write(6,"(""RTOI(R,I)"",3(1x,z16.16))") x,y,z
00436 x = z
00437 y = y+1
00438 enddo
00439
00440 do i=1,100
00441 x = (RANF()-0.5)*100.0
00442 y = (RANF()-0.5)*100.0
00443 z = x**y
00444 write(6,"(""RTOI(R,I)"",3(1x,z16.16))") x,y,z
00445 enddo
00446
00447 x = 0.
00448 y = 300
00449 write(6,"(""RTOI(R,I)"",3(1x,z16.16))") x,y,rtoi(x,y)
00450 x = 1.
00451 y = 300
00452 write(6,"(""RTOI(R,I)"",3(1x,z16.16))") x,y,rtoi(x,y)
00453 x = 2.
00454 y = 64
00455 write(6,"(""RTOI(R,I)"",3(1x,z16.16))") x,y,rtoi(x,y)
00456
00457 write(6,"(""RTOI(R,I)"",3(1x,z16.16))") 1.e100,100,1
00458 write(6,"(""RTOI(R,I)"",3(1x,z16.16))") 0,-1,4
00459 return
00460 end
00461 real function rtoi(r,i)
00462 rtoi=r**i
00463 return
00464 end
00465
00466 subroutine gen_rtor
00467
00468 x = 0.5
00469 y = 1.0
00470 do while(x .gt. 0.0)
00471 z = x**y
00472 write(6,"(""RTOR(R,R)"",3(1x,z16.16))") x,y,z
00473 x = z
00474 y = y + RANF()*2.0
00475 enddo
00476
00477 do i=1,100
00478 x = RANF()*100.0
00479 y = (RANF()-0.5)*100.0
00480 z = x**y
00481 write(6,"(""RTOR(R,R)"",3(1x,z16.16))") x,y,z
00482 enddo
00483
00484 x = 0.
00485 y = 300.
00486 write(6,"(""RTOR(R,R)"",3(1x,z16.16))") x,y,rtor(x,y)
00487 x = 1.
00488 y = 300.
00489 write(6,"(""RTOR(R,R)"",3(1x,z16.16))") x,y,rtor(x,y)
00490 x = 2.
00491 y = 64.
00492 write(6,"(""RTOR(R,R)"",3(1x,z16.16))") x,y,rtor(x,y)
00493
00494 write(6,"(""RTOR(R,R)"",3(1x,z16.16))") 1.e100,100.,
00495 . x'7ff0000000000000'
00496 write(6,"(""RTOR(R,R)"",3(1x,z16.16))") 0,-1.0,
00497 . x'7ff0000000000000'
00498 return
00499 end
00500 real function rtor(r,p)
00501 rtor=r**p
00502 return
00503 end
00504
00505 subroutine gen_dlog
00506
00507 double precision x,z
00508 complex cx,cz
00509 equivalence(cx,x),(cz,z)
00510
00511 x = 1.0e308
00512 do while(x .gt. 0)
00513 z = DLOG(x)
00514 write(6,"(""DLOG(D)"",4(1x,z16.16))") cx,cz
00515 x = z
00516 enddo
00517
00518 do i=1,100
00519 x = RANF()
00520 if(x .gt. 0.1) then
00521 if(x .lt. 0.2) then
00522 x = x * 10.0
00523 else if(x .lt. 0.3) then
00524 x = x * 1.e2
00525 else if(x .lt. 0.4) then
00526 x = x * 1.e4
00527 else if(x .lt. 0.5) then
00528 x = x * 1.e8
00529 else if(x .lt. 0.6) then
00530 x = x * 1.e16
00531 else if(x .lt. 0.7) then
00532 x = x * 1.e32
00533 else if(x .lt. 0.8) then
00534 x = x * 1.e64
00535 else if(x .lt. 0.9) then
00536 x = x * 1.e128
00537 else
00538 x = x * 1.e256
00539 endif
00540 endif
00541 z = DLOG(x)
00542 write(6,"(""DLOG(D)"",4(1x,z16.16))") cx,cz
00543 enddo
00544
00545 write(6,"(""DLOG(D)"",4(1x,z16.16))") -1.0,0,
00546 . x'7fffffffffffffff',x'7fffffffffffffff'
00547
00548 return
00549 end
00550
00551 subroutine gen_dexp
00552
00553 double precision x,z
00554 complex cx,cz
00555 equivalence(cx,x),(cz,z)
00556
00557 x = 1.0e-307
00558 do while(x .lt. 1.e4)
00559 z = DEXP(x)
00560 write(6,"(""DEXP(D)"",4(1x,z16.16))") cx,cz
00561 x = z
00562 enddo
00563
00564 x = 0.01
00565 do while(x .lt. 1.e4)
00566 z = DEXP(x)
00567 write(6,"(""DEXP(D)"",4(1x,z16.16))") cx,cz
00568 x = z
00569 enddo
00570
00571 x = -1.0
00572 do while(abs(x) .lt. 1.e4)
00573 z = DEXP(x)
00574 write(6,"(""DEXP(D)"",4(1x,z16.16))") cx,cz
00575 x = -1.0/z
00576 enddo
00577
00578 do i=1,100
00579 x = (RANF()-0.5)*1000.0
00580 z = DEXP(x)
00581 write(6,"(""DEXP(D)"",4(1x,z16.16))") cx,cz
00582 enddo
00583
00584 write(6,"(""DEXP(D)"",4(1x,z16.16))") 1.e5,0,
00585 . x'7fffffffffffffff',x'7fffffffffffffff'
00586
00587 return
00588 end
00589
00590 subroutine gen_dsqrt
00591
00592 double precision x,z
00593 complex cx,cz
00594 equivalence(cx,x),(cz,z)
00595
00596 z = 1.0e308
00597 x = 0.
00598 do while(x .ne. z)
00599 x = z
00600 z = DSQRT(x)
00601 write(6,"(""DSQRT(D)"",4(1x,z16.16))") cx,cz
00602 enddo
00603
00604 z = 1.0e-307
00605 x = 0.
00606 do while(x .ne. z)
00607 x = z
00608 z = DSQRT(x)
00609 write(6,"(""DSQRT(D)"",4(1x,z16.16))") cx,cz
00610 enddo
00611
00612 write(6,"(""DSQRT(D)"",4(1x,z16.16))") -1.0,0,
00613 . x'7fffffffffffffff',x'7fffffffffffffff'
00614 return
00615 end
00616
00617 subroutine gen_dtoi
00618
00619 double precision x,z
00620 double precision dtoi
00621 complex cx,cz
00622 equivalence(cx,x),(cz,z)
00623 integer y
00624
00625 x = 0.5
00626 y = 1
00627 do while(x .gt. 0.0)
00628 z = x**y
00629 write(6,"(""DTOI(D,I)"",5(1x,z16.16))") cx,y,cz
00630 x = z
00631 y = y+1
00632 enddo
00633
00634 do i=1,100
00635 x = (RANF()-0.5)*100.0
00636 y = (RANF()-0.5)*100.0
00637 z = x**y
00638 write(6,"(""DTOI(D,I)"",5(1x,z16.16))") cx,y,cz
00639 enddo
00640
00641 x=0.
00642 y=300
00643 z=dtoi(x,y)
00644 write(6,"(""DTOI(D,I)"",5(1x,z16.16))") cx,y,cz
00645 x=1.
00646 y=300
00647 z=dtoi(x,y)
00648 write(6,"(""DTOI(D,I)"",5(1x,z16.16))") cx,y,cz
00649 x=2.
00650 y=64
00651 z=dtoi(x,y)
00652 write(6,"(""DTOI(D,I)"",5(1x,z16.16))") cx,y,cz
00653
00654 write(6,"(""DTOI(D,I)"",5(1x,z16.16))") 1.e100,0,100,1,0
00655 write(6,"(""DTOI(D,I)"",5(1x,z16.16))") 0,0,-1,
00656 . x'7fffffffffffffff',x'7fffffffffffffff'
00657
00658 return
00659 end
00660 double precision function dtoi(d,i)
00661 double precision d
00662 dtoi=d**i
00663 return
00664 end
00665
00666 subroutine gen_dtor
00667
00668 double precision x,z
00669 double precision dtor
00670 complex cx,cz
00671 equivalence(cx,x),(cz,z)
00672
00673 x = 0.5
00674 y = 1.0
00675 do while(x .gt. 0.0)
00676 z = x**y
00677 write(6,"(""DTOR(D,R)"",5(1x,z16.16))") cx,y,cz
00678 x = z
00679 y = y + RANF()*2.0
00680 enddo
00681
00682 do i=1,100
00683 x = RANF()*100.0
00684 y = (RANF()-0.5)*100.0
00685 z = x**y
00686 write(6,"(""DTOR(D,R)"",5(1x,z16.16))") cx,y,cz
00687 enddo
00688
00689 x=0.
00690 y=300.
00691 z=dtor(x,y)
00692 write(6,"(""DTOR(D,R)"",5(1x,z16.16))") cx,y,cz
00693 x=1.
00694 y=300.
00695 z=dtor(x,y)
00696 write(6,"(""DTOR(D,R)"",5(1x,z16.16))") cx,y,cz
00697 x=2.
00698 y=64.
00699 z=dtor(x,y)
00700 write(6,"(""DTOR(D,R)"",5(1x,z16.16))") cx,y,cz
00701
00702 write(6,"(""DTOR(D,R)"",5(1x,z16.16))") 1.e100,0,100.,
00703 . x'7fffffffffffffff',x'7fffffffffffffff'
00704 write(6,"(""DTOR(D,R)"",5(1x,z16.16))") 0,0,-1.0,
00705 . x'7fffffffffffffff',x'7fffffffffffffff'
00706
00707 return
00708 end
00709 double precision function dtor(d,r)
00710 double precision d
00711 dtor=d**r
00712 return
00713 end
00714
00715 subroutine gen_dtod
00716
00717 double precision x,y,z
00718 double precision dtod
00719 complex cx,cy,cz
00720 equivalence(cx,x),(cy,y),(cz,z)
00721
00722 x = 0.5
00723 y = 1.0
00724 do while(x .gt. 0.0)
00725 z = x**y
00726 write(6,"(""DTOD(D,D)"",6(1x,z16.16))") cx,cy,cz
00727 x = z
00728 y = y + RANF()*2.0
00729 enddo
00730
00731 do i=1,100
00732 x = RANF()*100.0
00733 y = (RANF()-0.5)*100.0
00734 z = x**y
00735 write(6,"(""DTOD(D,D)"",6(1x,z16.16))") cx,cy,cz
00736 enddo
00737
00738 x=0.
00739 y=300.
00740 z=dtod(x,y)
00741 write(6,"(""DTOD(D,D)"",6(1x,z16.16))") cx,cy,cz
00742 x=1.
00743 y=300.
00744 z=dtod(x,y)
00745 write(6,"(""DTOD(D,D)"",6(1x,z16.16))") cx,cy,cz
00746 x=2.
00747 y=64.
00748 z=dtod(x,y)
00749 write(6,"(""DTOD(D,D)"",6(1x,z16.16))") cx,cy,cz
00750
00751 write(6,"(""DTOD(D,D)"",6(1x,z16.16))") 1.e100,0,100.,0,
00752 . x'7fffffffffffffff',x'7fffffffffffffff'
00753 write(6,"(""DTOD(D,D)"",6(1x,z16.16))") 0,0,-1.0,0,
00754 . x'7fffffffffffffff',x'7fffffffffffffff'
00755
00756 return
00757 end
00758 double precision function dtod(d,dp)
00759 double precision d,dp
00760 dtod=d**dp
00761 return
00762 end
00763
00764 subroutine gen_clog
00765
00766 complex x,z
00767
00768 x = (1.0e308,1.0e308)
00769 do while(real(x) .gt. 0)
00770 z = CLOG(x)
00771 write(6,"(""CLOG(C)"",4(1x,z16.16))") x,z
00772 x = z
00773 enddo
00774
00775 do i=1,100
00776 x = cmplx(RANF()-0.5,RANF()-0.5)
00777 if(real(x) .gt. 0.1) then
00778 if(real(x) .lt. 0.2) then
00779 x = x * 10.0
00780 else if(real(x) .lt. 0.3) then
00781 x = x * 1.e2
00782 else if(real(x) .lt. 0.4) then
00783 x = x * 1.e4
00784 else if(real(x) .lt. 0.5) then
00785 x = x * 1.e8
00786 else if(real(x) .lt. 0.6) then
00787 x = x * 1.e16
00788 else if(real(x) .lt. 0.7) then
00789 x = x * 1.e32
00790 else if(real(x) .lt. 0.8) then
00791 x = x * 1.e64
00792 else if(real(x) .lt. 0.9) then
00793 x = x * 1.e128
00794 else
00795 x = x * 1.e256
00796 endif
00797 endif
00798 z = CLOG(x)
00799 write(6,"(""CLOG(C)"",4(1x,z16.16))") x,z
00800 enddo
00801
00802 write(6,"(""CLOG(C)"",4(1x,z16.16))") 0,0,
00803 . x'0000000000000004',x'0000000000000000'
00804
00805 return
00806 end
00807
00808 subroutine gen_cexp
00809
00810 complex x,z
00811
00812 x = (1.0e-307,1.0e-307)
00813 do while(abs(real(x)) .lt. 1.e4)
00814 z = CEXP(x)
00815 write(6,"(""CEXP(C)"",4(1x,z16.16))") x,z
00816 x = z
00817 enddo
00818
00819 x = (0.01,0.5)
00820 do while(abs(real(x)) .lt. 1.e4)
00821 z = CEXP(x)
00822 write(6,"(""CEXP(C)"",4(1x,z16.16))") x,z
00823 x = z
00824 enddo
00825
00826 x = (-1.0,-10.3)
00827 do while(cabs(x) .lt. 1.e4)
00828 z = CEXP(x)
00829 write(6,"(""CEXP(C)"",4(1x,z16.16))") x,z
00830 if(cabs(z) .gt. 1.e-5) then
00831 x = -1.0/z
00832 else
00833 x = 1.e5
00834 endif
00835 enddo
00836
00837 do i=1,100
00838 x = cmplx((RANF()-0.5)*1000.0,(RANF()-0.5)*100.0)
00839 z = CEXP(x)
00840 write(6,"(""CEXP(C)"",4(1x,z16.16))") x,z
00841 enddo
00842
00843 write(6,"(""CEXP(C)"",4(1x,z16.16))") 1.e5,0,4,0
00844
00845 return
00846 end
00847
00848 subroutine gen_csqrt
00849
00850 complex x,z
00851
00852 z = (1.0e307,-1.0e307)
00853 x = 0.
00854 do while(real(x) .ne. real(z))
00855 x = z
00856 z = CSQRT(x)
00857 write(6,"(""CSQRT(C)"",4(1x,z16.16))") x,z
00858 enddo
00859
00860 z = (1.0e-307,1.0e-307)
00861 x = 0.
00862 do while(real(x) .ne. real(z))
00863 x = z
00864 z = CSQRT(x)
00865 write(6,"(""CSQRT(C)"",4(1x,z16.16))") x,z
00866 enddo
00867
00868 do i=1,100
00869 x = cmplx((RANF()-0.5)*10000.0,(RANF()-0.5)*100.0)
00870 z = CSQRT(x)
00871 write(6,"(""CSQRT(C)"",4(1x,z16.16))") x,z
00872 enddo
00873
00874 return
00875
00876 end
00877
00878 subroutine gen_ctoi
00879
00880 complex x,z
00881 complex ctoi
00882 integer y
00883
00884 x = (0.5,0.1)
00885 y = 1
00886 do while(real(x) .gt. 0.0)
00887 z = x**y
00888 write(6,"(""CTOI(C,I)"",5(1x,z16.16))") x,y,z
00889 x = z
00890 y = y+1
00891 enddo
00892
00893 do i=1,100
00894 x = cmplx((RANF()-0.5)*100.0,(RANF()-0.5)*1000.0)
00895 y = (RANF()-0.5)*100.0
00896 z = x**y
00897 write(6,"(""CTOI(C,I)"",5(1x,z16.16))") x,y,z
00898 enddo
00899
00900 x=(0.,0.)
00901 y=300
00902 z=ctoi(x,y)
00903 write(6,"(""CTOI(C,I)"",5(1x,z16.16))") x,y,z
00904 x=(1.,1.)
00905 y=300
00906 z=ctoi(x,y)
00907 write(6,"(""CTOI(C,I)"",5(1x,z16.16))") x,y,z
00908 x=(2.,2.)
00909 y=64
00910 z=ctoi(x,y)
00911 write(6,"(""CTOI(C,I)"",5(1x,z16.16))") x,y,z
00912
00913 write(6,"(""CTOI(C,I)"",5(1x,z16.16))") 1.e100,0,100,1,0
00914 write(6,"(""CTOI(C,I)"",5(1x,z16.16))") 0,0,-1,0,0
00915
00916 return
00917 end
00918 complex function ctoi(c,i)
00919 complex c
00920 ctoi=c**i
00921 return
00922 end
00923
00924 subroutine gen_ctor
00925
00926 complex x,z
00927 complex ctor
00928
00929 x = (0.5,0.7)
00930 y = 1.0
00931 do while(real(x) .gt. 0.0)
00932 z = x**y
00933 write(6,"(""CTOR(C,R)"",5(1x,z16.16))") x,y,z
00934 x = z
00935 y = y + RANF()*2.0
00936 enddo
00937
00938 do i=1,100
00939 x = cmplx((0.5-RANF())*100.0,(0.5-RANF())*1000.0)
00940 y = (RANF()-0.5)*100.0
00941 z = x**y
00942 write(6,"(""CTOR(C,R)"",5(1x,z16.16))") x,y,z
00943 enddo
00944
00945 x=(0.,0.)
00946 y=300.
00947 z=ctor(x,y)
00948 write(6,"(""CTOR(C,R)"",5(1x,z16.16))") x,y,z
00949 x=(1.,1.)
00950 y=300.
00951 z=ctor(x,y)
00952 write(6,"(""CTOR(C,R)"",5(1x,z16.16))") x,y,z
00953 x=(2.,2.)
00954 y=64.
00955 z=ctor(x,y)
00956 write(6,"(""CTOR(C,R)"",5(1x,z16.16))") x,y,z
00957
00958 write(6,"(""CTOR(C,R)"",5(1x,z16.16))") 1.e100,0,100.,4,0
00959 write(6,"(""CTOR(C,R)"",5(1x,z16.16))") 0,0,0,
00960 . x'7fffffffffffffff',x'7fffffffffffffff'
00961
00962 return
00963 end
00964 complex function ctor(c,r)
00965 complex c
00966 ctor=c**r
00967 return
00968 end
00969
00970 subroutine gen_ctoc
00971
00972 complex x,y,z
00973 complex ctoc
00974
00975 x = (0.5,-2.7)
00976 y = (1.0,1.0)
00977 do while(abs(real(x)) .lt. 1.e10)
00978 z = x**y
00979 write(6,"(""CTOC(C,C)"",6(1x,z16.16))") x,y,z
00980 x = z
00981 y = y + cmplx(RANF()*2.0,(0.5-RANF())*10.0)
00982 enddo
00983
00984 do i=1,100
00985 x = cmplx((RANF()-0.5)*100.0,(RANF()-0.5)*17.1)
00986 y = cmplx((RANF()-0.5)*3.9,(RANF()-0.5)*51.1)
00987 z = x**y
00988 write(6,"(""CTOC(C,C)"",6(1x,z16.16))") x,y,z
00989 enddo
00990
00991 x=(0.,0.)
00992 y=(300.,300.)
00993 z=ctoc(x,y)
00994 write(6,"(""CTOC(C,C)"",6(1x,z16.16))") x,y,z
00995 x=(1.,1.)
00996 y=(300.,300.)
00997 z=ctoc(x,y)
00998 write(6,"(""CTOC(C,C)"",6(1x,z16.16))") x,y,z
00999 x=(2.,2.)
01000 y=(64.,64.)
01001 z=ctoc(x,y)
01002 write(6,"(""CTOC(C,C)"",6(1x,z16.16))") x,y,z
01003
01004 write(6,"(""CTOC(C,C)"",6(1x,z16.16))") 1.e100,0,100.,0,4,0
01005 write(6,"(""CTOC(C,C)"",6(1x,z16.16))") 0,0,0,0,
01006 . x'7fffffffffffffff',x'7fffffffffffffff'
01007
01008 return
01009 end
01010 complex function ctoc(c,cp)
01011 complex c,cp
01012 ctoc=c**cp
01013 return
01014 end
01015
01016 subroutine gen_cdlog
01017 c
01018 c complex(16) x,z
01019 c double precision rx,rz,ix,iz
01020 c complex crx,crz,cix,ciz
01021 c equivalence(crx,rx),(crz,rz)
01022 c equivalence(cix,ix),(ciz,iz)
01023 c
01024 c complex(16) dreal,dimag
01025 c
01026 c x = cmplx(1.0e307,1.0e307)
01027 c do while(real(x) .gt. 0)
01028 c z = CDLOG(x)
01029 c rx = dreal(x)
01030 c ix = dimag(x)
01031 c rz = dreal(z)
01032 c iz = dimag(z)
01033 c write(6,"(""CDLOG(CD)"",8(1x,z16.16))") crx,cix,crz,ciz
01034 c x = z
01035 c enddo
01036 c
01037 c do i=1,100
01038 c x = cmplx(RANF()-0.5,RANF()-0.5)
01039 c if(real(x) .gt. 0.1) then
01040 c if(real(x) .lt. 0.2) then
01041 c x = x * 10.0
01042 c else if(real(x) .lt. 0.3) then
01043 c x = x * 1.e2
01044 c else if(real(x) .lt. 0.4) then
01045 c x = x * 1.e4
01046 c else if(real(x) .lt. 0.5) then
01047 c x = x * 1.e8
01048 c else if(real(x) .lt. 0.6) then
01049 c x = x * 1.e16
01050 c else if(real(x) .lt. 0.7) then
01051 c x = x * 1.e32
01052 c else if(real(x) .lt. 0.8) then
01053 c x = x * 1.e64
01054 c else if(real(x) .lt. 0.9) then
01055 c x = x * 1.e128
01056 c else
01057 c x = x * 1.e256
01058 c endif
01059 c endif
01060 c z = CDLOG(x)
01061 c rx = dreal(x)
01062 c ix = dimag(x)
01063 c rz = dreal(z)
01064 c iz = dimag(z)
01065 c write(6,"(""CDLOG(CD)"",8(1x,z16.16))") crx,cix,crz,ciz
01066 c enddo
01067 c
01068 c write(6,"(""CDLOG(CD)"",8(1x,z16.16))") 0,0,0,0,4,0,0,0
01069 c
01070 return
01071 end
01072
01073 subroutine gen_cdexp
01074 c
01075 c complex(16) x,z
01076 c double precision rx,rz,ix,iz
01077 c complex crx,crz,cix,ciz
01078 c equivalence(crx,rx),(crz,rz)
01079 c equivalence(cix,ix),(ciz,iz)
01080 c
01081 c complex(16) dreal,dimag
01082 c
01083 c x = cmplx(1.0e-307,1.0e-307)
01084 c do while(abs(real(x)) .lt. 1.e4)
01085 c z = CDEXP(x)
01086 c rx = dreal(x)
01087 c ix = dimag(x)
01088 c rz = dreal(z)
01089 c iz = dimag(z)
01090 c write(6,"(""CDEXP(CD)"",8(1x,z16.16))") crx,cix,crz,ciz
01091 c x = z
01092 c enddo
01093 c
01094 c x = cmplx(0.01,0.5)
01095 c do while(abs(real(x)) .lt. 1.e4)
01096 c z = CDEXP(x)
01097 c rx = dreal(x)
01098 c ix = dimag(x)
01099 c rz = dreal(z)
01100 c iz = dimag(z)
01101 c write(6,"(""CDEXP(CD)"",8(1x,z16.16))") crx,cix,crz,ciz
01102 c x = z
01103 c enddo
01104 c
01105 c x = cmplx(-1.0,-10.3)
01106 c do while(cdabs(x) .lt. 1.e4)
01107 c z = CDEXP(x)
01108 c rx = dreal(x)
01109 c ix = dimag(x)
01110 c rz = dreal(z)
01111 c iz = dimag(z)
01112 c write(6,"(""CDEXP(CD)"",8(1x,z16.16))") crx,cix,crz,ciz
01113 c if(cdabs(z) .gt. 1.e-5) then
01114 c x = -1.0/z
01115 c else
01116 c x = 1.e5
01117 c endif
01118 c enddo
01119 c
01120 c do i=1,100
01121 c x = cmplx((RANF()-0.5)*1000.0,(RANF()-0.5)*100.0)
01122 c z = CDEXP(x)
01123 c rx = dreal(x)
01124 c ix = dimag(x)
01125 c rz = dreal(z)
01126 c iz = dimag(z)
01127 c write(6,"(""CDEXP(CD)"",8(1x,z16.16))") crx,cix,crz,ciz
01128 c enddo
01129 c
01130 c write(6,"(""CDEXP(CD)"",8(1x,z16.16))") 1.e5,0,0,0,4,0,0,0
01131 c
01132 return
01133 end
01134
01135 subroutine gen_cdsqrt
01136 c
01137 c complex(16) x,z
01138 c double precision rx,rz,ix,iz
01139 c complex crx,crz,cix,ciz
01140 c equivalence(crx,rx),(crz,rz)
01141 c equivalence(cix,ix),(ciz,iz)
01142 c
01143 c complex(16) dreal,dimag
01144 c
01145 c z = cmplx(1.0e307,-1.0e307)
01146 c x = 0.
01147 c do while(real(x) .ne. real(z))
01148 c x = z
01149 c z = CDSQRT(x)
01150 c rx = dreal(x)
01151 c ix = dimag(x)
01152 c rz = dreal(z)
01153 c iz = dimag(z)
01154 c write(6,"(""CDSQRT(CD)"",8(1x,z16.16))") crx,cix,crz,ciz
01155 c enddo
01156 c
01157 c z = cmplx(1.0e-307,1.0e-307)
01158 c x = 0.
01159 c do while(real(x) .ne. real(z))
01160 c x = z
01161 c z = CDSQRT(x)
01162 c rx = dreal(x)
01163 c ix = dimag(x)
01164 c rz = dreal(z)
01165 c iz = dimag(z)
01166 c write(6,"(""CDSQRT(CD)"",8(1x,z16.16))") crx,cix,crz,ciz
01167 c enddo
01168 c
01169 c do i=1,100
01170 c x = cmplx((RANF()-0.5)*10000.0,(RANF()-0.5)*100.0)
01171 c z = CDSQRT(x)
01172 c rx = dreal(x)
01173 c ix = dimag(x)
01174 c rz = dreal(z)
01175 c iz = dimag(z)
01176 c write(6,"(""CDSQRT(CD)"",8(1x,z16.16))") crx,cix,crz,ciz
01177 c enddo
01178 c
01179 return
01180 end
01181
01182 subroutine gen_cdabs
01183 c
01184 c complex(16) x,cmplx
01185 c double precision z,rx,ix
01186 c complex crx,cix,cz
01187 c equivalence(crx,rx),(cix,ix),(cz,z)
01188 c
01189 c x = (0.,0.)
01190 c z = CDABS(x)
01191 c rx = dreal(x)
01192 c ix = dimag(x)
01193 c write(6,"(""CDABS(CD)"",6(1x,z16.16))") crx,cix,cz
01194 c
01195 c x = (-1.,0.)
01196 c z = CDABS(x)
01197 c rx = dreal(x)
01198 c ix = dimag(x)
01199 c write(6,"(""CDABS(CD)"",6(1x,z16.16))") crx,cix,cz
01200 c
01201 c x = (0.,-1.)
01202 c z = CDABS(x)
01203 c rx = dreal(x)
01204 c ix = dimag(x)
01205 c write(6,"(""CDABS(CD)"",6(1x,z16.16))") crx,cix,cz
01206 c
01207 c x = (0.1,0.2)
01208 c z = CDABS(x)
01209 c rx = dreal(x)
01210 c ix = dimag(x)
01211 c write(6,"(""CDABS(CD)"",6(1x,z16.16))") crx,cix,cz
01212 c
01213 c x = (-0.1,-0.2)
01214 c z = CDABS(x)
01215 c rx = dreal(x)
01216 c ix = dimag(x)
01217 c write(6,"(""CDABS(CD)"",6(1x,z16.16))") crx,cix,cz
01218 c
01219 c x = (-0.2,-0.1)
01220 c z = CDABS(x)
01221 c rx = dreal(x)
01222 c ix = dimag(x)
01223 c write(6,"(""CDABS(CD)"",6(1x,z16.16))") crx,cix,cz
01224 c
01225 c do i=1,100
01226 c x = cmplx((ranf()-.5)*10.0**(i+.5),(ranf()-.5)*10.0**(i+.5))
01227 c z = CDABS(x)
01228 c rx = dreal(x)
01229 c ix = dimag(x)
01230 c write(6,"(""CDABS(CD)"",6(1x,z16.16))") crx,cix,cz
01231 c enddo
01232 c
01233 c x = (1.e300,-1.e300)
01234 c z = CDABS(x)
01235 c rx = dreal(x)
01236 c ix = dimag(x)
01237 c write(6,"(""CDABS(CD)"",6(1x,z16.16))") crx,cix,cz
01238 c
01239 return
01240 end
01241
01242 subroutine gen_cdtoi
01243 c
01244 c complex(16) x,z,CDTOI
01245 c double precision rx,rz,ix,iz
01246 c complex crx,crz,cix,ciz
01247 c equivalence(crx,rx),(crz,rz)
01248 c equivalence(cix,ix),(ciz,iz)
01249 c integer y
01250 c double precision dreal,dimag
01251 c
01252 c x = (0.5,0.1)
01253 c y = 1
01254 c do while(real(x) .gt. 0.0)
01255 c z = CDTOI(x,y)
01256 c rx = dreal(x)
01257 c ix = dimag(x)
01258 c rz = dreal(z)
01259 c iz = dimag(z)
01260 c write(6,"(""CDTOI(CD,I)"",9(1x,z16.16))") crx,cix,y,crz,ciz
01261 c x = z
01262 c y = y+1
01263 c enddo
01264 c
01265 c do i=1,100
01266 c x = cmplx((RANF()-0.5)*100.0,(RANF()-0.5)*1000.0)
01267 c y = (RANF()-0.5)*100.0
01268 c z = CDTOI(x,y)
01269 c rx = dreal(x)
01270 c ix = dimag(x)
01271 c rz = dreal(z)
01272 c iz = dimag(z)
01273 c write(6,"(""CDTOI(CD,I)"",9(1x,z16.16))") crx,cix,y,crz,ciz
01274 c enddo
01275 c
01276 c x=(0.,0.)
01277 c y=300
01278 c z=CDTOI(x,y)
01279 c rx = dreal(x)
01280 c ix = dimag(x)
01281 c rz = dreal(z)
01282 c iz = dimag(z)
01283 c write(6,"(""CDTOI(CD,I)"",9(1x,z16.16))") crx,cix,y,crz,ciz
01284 c x=(1.,1.)
01285 c y=300
01286 c z=CDTOI(x,y)
01287 c rx = dreal(x)
01288 c ix = dimag(x)
01289 c rz = dreal(z)
01290 c iz = dimag(z)
01291 c write(6,"(""CDTOI(CD,I)"",9(1x,z16.16))") crx,cix,y,crz,ciz
01292 c x=(2.,2.)
01293 c y=64
01294 c z=CDTOI(x,y)
01295 c rx = dreal(x)
01296 c ix = dimag(x)
01297 c rz = dreal(z)
01298 c iz = dimag(z)
01299 c write(6,"(""CDTOI(CD,I)"",9(1x,z16.16))") crx,cix,y,crz,ciz
01300 c
01301 c write(6,"(""CDTOI(CD,I)"",9(1x,z16.16))") 1e100,0,0,0,90,1,0,0,0
01302 c write(6,"(""CDTOI(CD,I)"",9(1x,z16.16))") 0,0,0,0,-1,4,0,0,0
01303 c
01304 return
01305 end
01306
01307 subroutine gen_cdtocd
01308 c
01309 c complex(16) x,y,z,CDTOCD
01310 c double precision rx,ry,rz,ix,iy,iz
01311 c complex crx,cry,crz,cix,ciy,ciz
01312 c equivalence(crx,rx),(cry,ry),(crz,rz)
01313 c equivalence(cix,ix),(ciy,iy),(ciz,iz)
01314 c double precision dreal,dimag
01315 c
01316 c x = (0.5,0.1)
01317 c y = (1.0,1.0)
01318 c do while(real(x) .gt. 0.0)
01319 c z = CDTOCD(x,y)
01320 c rx = dreal(x)
01321 c ix = dimag(x)
01322 c ry = dreal(y)
01323 c iy = dimag(y)
01324 c rz = dreal(z)
01325 c iz = dimag(z)
01326 c write(6,"(""CDTOCD(CD,CD)"",12(1x,z16.16))")
01327 c . crx,cix,cry,ciy,crz,ciz
01328 c x = z
01329 c y = y+(1.0,-1.0)
01330 c enddo
01331 c
01332 c do i=1,100
01333 c x = cmplx((RANF()-0.5)*100.0,(RANF()-0.5)*1000.0)
01334 c y = cmplx((RANF()-0.25)*10.0,(RANF()-0.75)*100.0)
01335 c z = CDTOCD(x,y)
01336 c rx = dreal(x)
01337 c ix = dimag(x)
01338 c ry = dreal(y)
01339 c iy = dimag(y)
01340 c rz = dreal(z)
01341 c iz = dimag(z)
01342 c write(6,"(""CDTOCD(CD,CD)"",12(1x,z16.16))")
01343 c . crx,cix,cry,ciy,crz,ciz
01344 c enddo
01345 c
01346 c x=(0.,0.)
01347 c y=(300.,-300.)
01348 c z=CDTOCD(x,y)
01349 c rx = dreal(x)
01350 c ix = dimag(x)
01351 c ry = dreal(y)
01352 c iy = dimag(y)
01353 c rz = dreal(z)
01354 c iz = dimag(z)
01355 c write(6,"(""CDTOCD(CD,CD)"",12(1x,z16.16))")
01356 c . crx,cix,cry,ciy,crz,ciz
01357 c x=(1.,1.)
01358 c y=(300.,-300.)
01359 c z=CDTOCD(x,y)
01360 c rx = dreal(x)
01361 c ix = dimag(x)
01362 c ry = dreal(y)
01363 c iy = dimag(y)
01364 c rz = dreal(z)
01365 c iz = dimag(z)
01366 c write(6,"(""CDTOCD(CD,CD)"",12(1x,z16.16))")
01367 c . crx,cix,cry,ciy,crz,ciz
01368 c x=(2.,2.)
01369 c y=(64.,-64.)
01370 c z=CDTOCD(x,y)
01371 c rx = dreal(x)
01372 c ix = dimag(x)
01373 c ry = dreal(y)
01374 c iy = dimag(y)
01375 c rz = dreal(z)
01376 c iz = dimag(z)
01377 c write(6,"(""CDTOCD(CD,CD)"",12(1x,z16.16))")
01378 c . crx,cix,cry,ciy,crz,ciz
01379 c
01380 c write(6,"(""CDTOCD(CD,CD)"",12(1x,z16.16))")
01381 c . 1e100,0,1.0,0,99.0,0,-99.0,0,4,0,0,0
01382 c x=(0.,0.)
01383 c y=(-1.0,-1.0)
01384 c z=CDTOCD(x,y)
01385 c rx = dreal(x)
01386 c ix = dimag(x)
01387 c ry = dreal(y)
01388 c iy = dimag(y)
01389 c rz = dreal(z)
01390 c iz = dimag(z)
01391 c write(6,"(""CDTOCD(CD,CD)"",12(1x,z16.16))")
01392 c . crx,cix,cry,ciy,crz,ciz
01393 c
01394 return
01395 end
01396
01397 subroutine gen_hlog
01398
01399 real(4) x,z
01400 integer(4) iz
01401
01402 x = 1.0e38
01403 do while(x .gt. 0)
01404 z = LOG(x)
01405 call hwrite2("(""HLOG(H)"",2(1x,z8.8))",x,z)
01406 x = z
01407 enddo
01408
01409 do i=1,100
01410 x = RANF()
01411 if(x .gt. 0.1) then
01412 if(x .lt. 0.2) then
01413 x = x * 10.0
01414 else if(x .lt. 0.3) then
01415 x = x * 1.e2
01416 else if(x .lt. 0.4) then
01417 x = x * 1.e4
01418 else if(x .lt. 0.5) then
01419 x = x * 1.e8
01420 else if(x .lt. 0.6) then
01421 x = x * 1.e16
01422 else
01423 x = x * 1.e32
01424 endif
01425 endif
01426 z = LOG(x)
01427 call hwrite2("(""HLOG(H)"",2(1x,z8.8))",x,z)
01428 enddo
01429
01430 x=-1.0
01431 iz=x'00000004'
01432 call hwrite2("(""HLOG(H)"",2(1x,z8.8))",x,iz)
01433 return
01434 end
01435 subroutine hwrite2(fmt,x,z)
01436 integer(4) x,z
01437 character*(*) fmt
01438 ix=and(x,x'ffffffff')
01439 iz=and(z,x'ffffffff')
01440 write(6,fmt) ix,iz
01441 return
01442 end
01443
01444 subroutine gen_hexp
01445
01446 real(4) x,z
01447 integer(4) iz
01448
01449 x = 1.0e-38
01450 do while(x .lt. 88.2)
01451 z = EXP(x)
01452 call hwrite2("(""HEXP(H)"",2(1x,z8.8))",x,z)
01453 x = z
01454 enddo
01455
01456 x = 0.01
01457 do while(x .lt. 88.2)
01458 z = EXP(x)
01459 call hwrite2("(""HEXP(H)"",2(1x,z8.8))",x,z)
01460 x = z
01461 enddo
01462
01463 x = -1.0
01464 do while(abs(x) .lt. 88.2)
01465 z = EXP(x)
01466 call hwrite2("(""HEXP(H)"",2(1x,z8.8))",x,z)
01467 x = -1.0/z
01468 enddo
01469
01470 do i=1,100
01471 x = (RANF()-0.5)*100.0
01472 z = EXP(x)
01473 call hwrite2("(""HEXP(H)"",2(1x,z8.8))",x,z)
01474 enddo
01475
01476 x=1.e5
01477 iz=x'00000004'
01478 call hwrite2("(""HEXP(H)"",2(1x,z8.8))",x,iz)
01479 return
01480 end
01481
01482 subroutine gen_hsqrt
01483
01484 real(4) x,z
01485 integer(4) iz
01486
01487 z = 1.0e38
01488 x = 0.
01489 do while(x .ne. z)
01490 x = z
01491 z = SQRT(x)
01492 call hwrite2("(""HSQRT(H)"",2(1x,z8.8))",x,z)
01493 enddo
01494
01495 z = 1.0e-38
01496 x = 0.
01497 do while(x .ne. z)
01498 x = z
01499 z = SQRT(x)
01500 call hwrite2("(""HSQRT(H)"",2(1x,z8.8))",x,z)
01501 enddo
01502
01503 x=-1.0
01504 iz=x'00000004'
01505 call hwrite2("(""HSQRT(H)"",2(1x,z8.8))",x,iz)
01506 return
01507 end
01508
01509 subroutine gen_htoi
01510
01511 real(4) x,z
01512 integer(4) y,iz
01513
01514 x=1.0
01515 y=511
01516 call hwrite3("(""HTOI(H,I)"",3(1x,z8.8))",x,y,x)
01517 x=2.0
01518 y=62
01519 iz=x'5e800000'
01520 call hwrite3("(""HTOI(H,I)"",3(1x,z8.8))",x,y,iz)
01521 return
01522 end
01523 subroutine hwrite3(fmt,x,y,z)
01524 integer(4) x,y,z
01525 character*(*) fmt
01526 ix=and(x,x'ffffffff')
01527 iy=and(y,x'ffffffff')
01528 iz=and(z,x'ffffffff')
01529 write(6,fmt) ix,iy,iz
01530 return
01531 end
01532
01533 subroutine gen_modi
01534 integer*4 modi,i,m
01535
01536 i=-1
01537 m=1
01538 call hwrite3("(""MODULOI(I,I)"",3(1x,z8.8))",
01539 . i,m,modi(i,m))
01540 i=1
01541 m=-1
01542 call hwrite3("(""MODULOI(I,I)"",3(1x,z8.8))",
01543 . i,m,modi(i,m))
01544 i=0
01545 m=1
01546 call hwrite3("(""MODULOI(I,I)"",3(1x,z8.8))",
01547 . i,m,modi(i,m))
01548 i=1
01549 m=0
01550 call hwrite3("(""MODULOI(I,I)"",3(1x,z8.8))",
01551 . i,m,modi(i,m))
01552 do i=1,100,10
01553 do j=1,3
01554 m=2*i*ranf()+j
01555 call hwrite3("(""MODULOI(I,I)"",3(1x,z8.8))",
01556 . i,m,modi(i,m))
01557 enddo
01558 enddo
01559
01560 return
01561 end
01562 integer*4 function modi(i,m)
01563 integer*4 i,m
01564 modi=modulo(i,m)
01565 return
01566 end
01567
01568 subroutine gen_modj
01569 integer*8 modj,i,m
01570
01571 write(6,"(""MODULOJ(I,I)"",3(1x,z16.16))")
01572 . -1,1,modj(-1,1)
01573 write(6,"(""MODULOJ(I,I)"",3(1x,z16.16))")
01574 . 1,-1,modj(1,-1)
01575 write(6,"(""MODULOJ(I,I)"",3(1x,z16.16))")
01576 . 0,1,modj(0,1)
01577 write(6,"(""MODULOJ(I,I)"",3(1x,z16.16))")
01578 . 1,0,modj(1,0)
01579 do i=1,100,10
01580 do j=1,3
01581 m=2*i*ranf()+j
01582 write(6,"(""MODULOJ(I,I)"",3(1x,z16.16))")
01583 . i,m,modj(i,m)
01584 enddo
01585 enddo
01586
01587 return
01588 end
01589 integer*8 function modj(i,m)
01590 integer*8 i,m
01591 modj=modulo(i,m)
01592 return
01593 end
01594
01595 subroutine gen_modf
01596 real*4 modf,x,y
01597
01598 x=-1.0
01599 y=1.0
01600 call hwrite3("(""MODULOF(H,H)"",3(1x,z8.8))",
01601 . x,y,modf(x,y))
01602 x=1.0
01603 y=-1.0
01604 call hwrite3("(""MODULOF(H,H)"",3(1x,z8.8))",
01605 . x,y,modf(x,y))
01606 x=0.0
01607 y=1.0
01608 call hwrite3("(""MODULOF(H,H)"",3(1x,z8.8))",
01609 . x,y,modf(x,y))
01610 x=1.0
01611 y=0.0
01612 call hwrite3("(""MODULOF(H,H)"",3(1x,z8.8))",
01613 . x,y,modf(x,y))
01614 do i=1,100
01615 x=(ranf()-0.5)*100
01616 y=(ranf()-0.5)*50
01617 call hwrite3("(""MODULOF(H,H)"",3(1x,z8.8))",
01618 . x,y,modf(x,y))
01619 enddo
01620
01621 return
01622 end
01623 real*4 function modf(x,y)
01624 real*4 x,y
01625 modf=modulo(x,y)
01626 return
01627 end
01628
01629 subroutine gen_mods
01630 real*8 mods,x,y
01631
01632 write(6,"(""MODULOS(R,R)"",3(1x,z16.16))")
01633 . -1.,1.,mods(-1.,1.)
01634 write(6,"(""MODULOS(R,R)"",3(1x,z16.16))")
01635 . 1.,-1.,mods(1.,-1.)
01636 write(6,"(""MODULOS(R,R)"",3(1x,z16.16))")
01637 . 0,1.,mods(0,1.)
01638 write(6,"(""MODULOS(R,R)"",3(1x,z16.16))")
01639 . 1.,0,mods(1.,0)
01640 do i=1,100
01641 x=(ranf()-0.5)*100
01642 y=(ranf()-0.5)*50
01643 write(6,"(""MODULOS(R,R)"",3(1x,z16.16))")
01644 . x,y,mods(x,y)
01645 enddo
01646
01647 return
01648 end
01649 real*8 function mods(x,y)
01650 real*8 x,y
01651 mods=modulo(x,y)
01652 return
01653 end
01654
01655 subroutine gen_selrk
01656 integer p,r,k
01657 p=-1
01658 do while(p.lt.50)
01659 r=-1
01660 do while(r.lt.10000)
01661 if(p.lt.0 .and. r.lt.0) then
01662 k=selected_real_kind(-p)
01663 elseif(p.lt.0) then
01664 k=selected_real_kind(R=r)
01665 elseif(r.lt.0) then
01666 k=selected_real_kind(p)
01667 else
01668 k=selected_real_kind(p,r)
01669 endif
01670 write(6,"(""SELREALK(I,I)"",3(1x,z16.16))")
01671 . p,r,k
01672 if(r.le.0) then
01673 r=r+1
01674 else
01675 r=r*20
01676 endif
01677 enddo
01678 if(p.le.0) then
01679 p=p+1
01680 else
01681 p=p*2
01682 endif
01683 enddo
01684 return
01685 end
01686
01687 c USMID = "\n%Z%%M% %I% %G% %U%\n";
01688 c rcsid = "$Id: sim_mpp_gen.f,v 1.1.1.1 2005/10/21 19:00:00 marcel Exp $";
