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