gonum.org/v1/gonum@v0.15.1-0.20240517103525-f853624cb1bb/mathext/internal/amos/origcode_test.go (about) 1 // Copyright ©2016 The Gonum Authors. All rights reserved. 2 // Use of this source code is governed by a BSD-style 3 // license that can be found in the LICENSE file. 4 5 package amos 6 7 import ( 8 "math" 9 "math/cmplx" 10 ) 11 12 // These routines are the versions directly modified from the Fortran code. 13 // They are used to ensure that code style improvements do not change the 14 // code output. 15 16 func iabs(a int) int { 17 if a >= 0 { 18 return a 19 } 20 return -a 21 } 22 23 24 func zairyOrig(ZR, ZI float64, ID, KODE int) (AIR, AII float64, NZ, IERR int) { 25 // zairy is adapted from the original Netlib code by Donald Amos. 26 // http://www.netlib.no/netlib/amos/zairy.f 27 28 // Original comment: 29 /* 30 C***BEGIN PROLOGUE ZAIRY 31 C***DATE WRITTEN 830501 (YYMMDD) 32 C***REVISION DATE 890801 (YYMMDD) 33 C***CATEGORY NO. B5K 34 C***KEYWORDS AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD 35 C***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES 36 C***PURPOSE TO COMPUTE AIRY FUNCTIONS AI(Z) AND DAI(Z) FOR COMPLEX Z 37 C***DESCRIPTION 38 C 39 C ***A DOUBLE PRECISION ROUTINE*** 40 C ON KODE=1, ZAIRY COMPUTES THE COMPLEX AIRY FUNCTION AI(Z) OR 41 C ITS DERIVATIVE DAI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON 42 C KODE=2, A SCALING OPTION CEXP(ZTA)*AI(Z) OR CEXP(ZTA)* 43 C DAI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL DECAY IN 44 C -PI/3<ARG(Z)<PI/3 AND THE EXPONENTIAL GROWTH IN 45 C PI/3<ABS(ARG(Z))<PI WHERE ZTA=(2/3)*Z*CSQRT(Z). 46 C 47 C WHILE THE AIRY FUNCTIONS AI(Z) AND DAI(Z)/DZ ARE ANALYTIC IN 48 C THE WHOLE Z PLANE, THE CORRESPONDING SCALED FUNCTIONS DEFINED 49 C FOR KODE=2 HAVE A CUT ALONG THE NEGATIVE REAL AXIS. 50 C DEFINTIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF 51 C MATHEMATICAL FUNCTIONS (REF. 1). 52 C 53 C INPUT ZR,ZI ARE DOUBLE PRECISION 54 C ZR,ZI - Z=CMPLX(ZR,ZI) 55 C ID - ORDER OF DERIVATIVE, ID=0 OR ID=1 56 C KODE - A PARAMETER TO INDICATE THE SCALING OPTION 57 C KODE= 1 returnS 58 C AI=AI(Z) ON ID=0 OR 59 C AI=DAI(Z)/DZ ON ID=1 60 C = 2 returnS 61 C AI=CEXP(ZTA)*AI(Z) ON ID=0 OR 62 C AI=CEXP(ZTA)*DAI(Z)/DZ ON ID=1 WHERE 63 C ZTA=(2/3)*Z*CSQRT(Z) 64 C 65 C OUTPUT AIR,AII ARE DOUBLE PRECISION 66 C AIR,AII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND 67 C KODE 68 C NZ - UNDERFLOW INDICATOR 69 C NZ= 0 , NORMAL return 70 C NZ= 1 , AI=CMPLX(0.0E0,0.0E0) DUE TO UNDERFLOW IN 71 C -PI/3<ARG(Z)<PI/3 ON KODE=1 72 C IERR - ERROR FLAG 73 C IERR=0, NORMAL return - COMPUTATION COMPLETED 74 C IERR=1, INPUT ERROR - NO COMPUTATION 75 C IERR=2, OVERFLOW - NO COMPUTATION, REAL(ZTA) 76 C TOO LARGE ON KODE=1 77 C IERR=3, CABS(Z) LARGE - COMPUTATION COMPLETED 78 C LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION 79 C PRODUCE LESS THAN HALF OF MACHINE ACCURACY 80 C IERR=4, CABS(Z) TOO LARGE - NO COMPUTATION 81 C COMPLETE LOSS OF ACCURACY BY ARGUMENT 82 C REDUCTION 83 C IERR=5, ERROR - NO COMPUTATION, 84 C ALGORITHM TERMINATION CONDITION NOT MET 85 C 86 C***LONG DESCRIPTION 87 C 88 C AI AND DAI ARE COMPUTED FOR CABS(Z)>1.0 FROM THE K BESSEL 89 C FUNCTIONS BY 90 C 91 C AI(Z)=C*SQRT(Z)*K(1/3,ZTA) , DAI(Z)=-C*Z*K(2/3,ZTA) 92 C C=1.0/(PI*SQRT(3.0)) 93 C ZTA=(2/3)*Z**(3/2) 94 C 95 C WITH THE POWER SERIES FOR CABS(Z)<=1.0. 96 C 97 C IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- 98 C MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES 99 C OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF 100 C THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR), 101 C THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR 102 C FLAG IERR=3 IS TRIGGERED WHERE UR=dmax(dmach[4),1.0D-18) IS 103 C DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. 104 C ALSO, if THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN 105 C ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT 106 C FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE 107 C LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA 108 C MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, 109 C AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE 110 C PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE 111 C PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT- 112 C ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG- 113 C NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN 114 C DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN 115 C EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, 116 C NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE 117 C PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER 118 C MACHINES. 119 C 120 C THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX 121 C BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT 122 C ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- 123 C SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE 124 C ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), 125 C ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF 126 C CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY 127 C HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN 128 C ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY 129 C SEVERAL ORDERS OF MAGNITUDE. if ONE COMPONENT IS 10**K LARGER 130 C THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, 131 C 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS 132 C THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER 133 C COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY 134 C BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER 135 C COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE 136 C MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, 137 C THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, 138 C OR -PI/2+P. 139 C 140 C***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ 141 C AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF 142 C COMMERCE, 1955. 143 C 144 C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT 145 C AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 146 C 147 C A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX 148 C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- 149 C 1018, MAY, 1985 150 C 151 C A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX 152 C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS. 153 C MATH. SOFTWARE, 1986 154 */ 155 var AI, CONE, CSQ, CY, S1, S2, TRM1, TRM2, Z, ZTA, Z3 complex128 156 var AA, AD, AK, ALIM, ATRM, AZ, AZ3, BK, 157 CC, CK, COEF, CONEI, CONER, CSQI, CSQR, C1, C2, DIG, 158 DK, D1, D2, ELIM, FID, FNU, PTR, RL, R1M5, SFAC, STI, STR, 159 S1I, S1R, S2I, S2R, TOL, TRM1I, TRM1R, TRM2I, TRM2R, TTH, ZEROI, 160 ZEROR, ZTAI, ZTAR, Z3I, Z3R, ALAZ, BB float64 161 var IFLAG, K, K1, K2, MR, NN int 162 var tmp complex128 163 164 // Extra element for padding. 165 CYR := []float64{math.NaN(), 0} 166 CYI := []float64{math.NaN(), 0} 167 168 _ = AI 169 _ = CONE 170 _ = CSQ 171 _ = CY 172 _ = S1 173 _ = S2 174 _ = TRM1 175 _ = TRM2 176 _ = Z 177 _ = ZTA 178 _ = Z3 179 180 TTH = 6.66666666666666667e-01 181 C1 = 3.55028053887817240e-01 182 C2 = 2.58819403792806799e-01 183 COEF = 1.83776298473930683e-01 184 ZEROR = 0 185 ZEROI = 0 186 CONER = 1 187 CONEI = 0 188 189 NZ = 0 190 if ID < 0 || ID > 1 { 191 IERR = 1 192 } 193 if KODE < 1 || KODE > 2 { 194 IERR = 1 195 } 196 if IERR != 0 { 197 return 198 } 199 AZ = zabs(complex(ZR, ZI)) 200 TOL = dmax(dmach[4], 1.0e-18) 201 FID = float64(ID) 202 if AZ > 1.0e0 { 203 goto Seventy 204 } 205 206 // POWER SERIES FOR CABS(Z)<=1. 207 S1R = CONER 208 S1I = CONEI 209 S2R = CONER 210 S2I = CONEI 211 if AZ < TOL { 212 goto OneSeventy 213 } 214 AA = AZ * AZ 215 if AA < TOL/AZ { 216 goto Forty 217 } 218 TRM1R = CONER 219 TRM1I = CONEI 220 TRM2R = CONER 221 TRM2I = CONEI 222 ATRM = 1.0e0 223 STR = ZR*ZR - ZI*ZI 224 STI = ZR*ZI + ZI*ZR 225 Z3R = STR*ZR - STI*ZI 226 Z3I = STR*ZI + STI*ZR 227 AZ3 = AZ * AA 228 AK = 2.0e0 + FID 229 BK = 3.0e0 - FID - FID 230 CK = 4.0e0 - FID 231 DK = 3.0e0 + FID + FID 232 D1 = AK * DK 233 D2 = BK * CK 234 AD = dmin(D1, D2) 235 AK = 24.0e0 + 9.0e0*FID 236 BK = 30.0e0 - 9.0e0*FID 237 for K = 1; K <= 25; K++ { 238 STR = (TRM1R*Z3R - TRM1I*Z3I) / D1 239 TRM1I = (TRM1R*Z3I + TRM1I*Z3R) / D1 240 TRM1R = STR 241 S1R = S1R + TRM1R 242 S1I = S1I + TRM1I 243 STR = (TRM2R*Z3R - TRM2I*Z3I) / D2 244 TRM2I = (TRM2R*Z3I + TRM2I*Z3R) / D2 245 TRM2R = STR 246 S2R = S2R + TRM2R 247 S2I = S2I + TRM2I 248 ATRM = ATRM * AZ3 / AD 249 D1 = D1 + AK 250 D2 = D2 + BK 251 AD = dmin(D1, D2) 252 if ATRM < TOL*AD { 253 goto Forty 254 } 255 AK = AK + 18.0e0 256 BK = BK + 18.0e0 257 } 258 Forty: 259 if ID == 1 { 260 goto Fifty 261 } 262 AIR = S1R*C1 - C2*(ZR*S2R-ZI*S2I) 263 AII = S1I*C1 - C2*(ZR*S2I+ZI*S2R) 264 if KODE == 1 { 265 return 266 } 267 tmp = zsqrt(complex(ZR, ZI)) 268 STR = real(tmp) 269 STI = imag(tmp) 270 ZTAR = TTH * (ZR*STR - ZI*STI) 271 ZTAI = TTH * (ZR*STI + ZI*STR) 272 tmp = zexp(complex(ZTAR, ZTAI)) 273 STR = real(tmp) 274 STI = imag(tmp) 275 PTR = AIR*STR - AII*STI 276 AII = AIR*STI + AII*STR 277 AIR = PTR 278 return 279 280 Fifty: 281 AIR = -S2R * C2 282 AII = -S2I * C2 283 if AZ <= TOL { 284 goto Sixty 285 } 286 STR = ZR*S1R - ZI*S1I 287 STI = ZR*S1I + ZI*S1R 288 CC = C1 / (1.0e0 + FID) 289 AIR = AIR + CC*(STR*ZR-STI*ZI) 290 AII = AII + CC*(STR*ZI+STI*ZR) 291 292 Sixty: 293 if KODE == 1 { 294 return 295 } 296 tmp = zsqrt(complex(ZR, ZI)) 297 STR = real(tmp) 298 STI = imag(tmp) 299 ZTAR = TTH * (ZR*STR - ZI*STI) 300 ZTAI = TTH * (ZR*STI + ZI*STR) 301 tmp = zexp(complex(ZTAR, ZTAI)) 302 STR = real(tmp) 303 STI = imag(tmp) 304 PTR = STR*AIR - STI*AII 305 AII = STR*AII + STI*AIR 306 AIR = PTR 307 return 308 309 // CASE FOR CABS(Z)>1.0. 310 Seventy: 311 FNU = (1.0e0 + FID) / 3.0e0 312 313 /* 314 SET PARAMETERS RELATED TO MACHINE CONSTANTS. 315 TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0D-18. 316 ELIM IS THE APPROXIMATE EXPONENTIAL OVER-&&UNDERFLOW LIMIT. 317 EXP(-ELIM)<EXP(-ALIM)=EXP(-ELIM)/TOL AND 318 EXP(ELIM)>EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR 319 UNDERFLOW&&OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. 320 RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LA>=Z. 321 DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). 322 */ 323 K1 = imach[15] 324 K2 = imach[16] 325 R1M5 = dmach[5] 326 327 K = min(iabs(K1), iabs(K2)) 328 ELIM = 2.303e0 * (float64(K)*R1M5 - 3.0e0) 329 K1 = imach[14] - 1 330 AA = R1M5 * float64(K1) 331 DIG = dmin(AA, 18.0e0) 332 AA = AA * 2.303e0 333 ALIM = ELIM + dmax(-AA, -41.45e0) 334 RL = 1.2e0*DIG + 3.0e0 335 ALAZ = dlog(AZ) 336 337 // TEST FOR PROPER RANGE. 338 AA = 0.5e0 / TOL 339 BB = float64(float32(imach[9])) * 0.5e0 340 AA = dmin(AA, BB) 341 AA = math.Pow(AA, TTH) 342 if AZ > AA { 343 goto TwoSixty 344 } 345 AA = dsqrt(AA) 346 if AZ > AA { 347 IERR = 3 348 } 349 tmp = zsqrt(complex(ZR, ZI)) 350 CSQR = real(tmp) 351 CSQI = imag(tmp) 352 ZTAR = TTH * (ZR*CSQR - ZI*CSQI) 353 ZTAI = TTH * (ZR*CSQI + ZI*CSQR) 354 355 // RE(ZTA)<=0 WHEN RE(Z)<0, ESPECIALLY WHEN IM(Z) IS SMALL. 356 IFLAG = 0 357 SFAC = 1.0e0 358 AK = ZTAI 359 if ZR >= 0.0e0 { 360 goto Eighty 361 } 362 BK = ZTAR 363 CK = -dabs(BK) 364 ZTAR = CK 365 ZTAI = AK 366 367 Eighty: 368 if ZI != 0.0e0 { 369 goto Ninety 370 } 371 if ZR > 0.0e0 { 372 goto Ninety 373 } 374 ZTAR = 0.0e0 375 ZTAI = AK 376 Ninety: 377 AA = ZTAR 378 if AA >= 0.0e0 && ZR > 0.0e0 { 379 goto OneTen 380 } 381 if KODE == 2 { 382 goto OneHundred 383 } 384 385 // OVERFLOW TEST. 386 if AA > (-ALIM) { 387 goto OneHundred 388 } 389 AA = -AA + 0.25e0*ALAZ 390 IFLAG = 1 391 SFAC = TOL 392 if AA > ELIM { 393 goto TwoSeventy 394 } 395 396 OneHundred: 397 // CBKNU AND CACON return EXP(ZTA)*K(FNU,ZTA) ON KODE=2. 398 MR = 1 399 if ZI < 0.0e0 { 400 MR = -1 401 } 402 ZTAR, ZTAI, FNU, KODE, MR, _, CYR, CYI, NN, RL, TOL, ELIM, ALIM = zacaiOrig(ZTAR, ZTAI, FNU, KODE, MR, 1, CYR, CYI, NN, RL, TOL, ELIM, ALIM) 403 if NN < 0 { 404 goto TwoEighty 405 } 406 NZ = NZ + NN 407 goto OneThirty 408 409 OneTen: 410 if KODE == 2 { 411 goto OneTwenty 412 } 413 414 // UNDERFLOW TEST. 415 if AA < ALIM { 416 goto OneTwenty 417 } 418 AA = -AA - 0.25e0*ALAZ 419 IFLAG = 2 420 SFAC = 1.0e0 / TOL 421 if AA < (-ELIM) { 422 goto TwoTen 423 } 424 OneTwenty: 425 ZTAR, ZTAI, FNU, KODE, _, CYR, CYI, NZ, TOL, ELIM, ALIM = zbknuOrig(ZTAR, ZTAI, FNU, KODE, 1, CYR, CYI, NZ, TOL, ELIM, ALIM) 426 427 OneThirty: 428 S1R = CYR[1] * COEF 429 S1I = CYI[1] * COEF 430 if IFLAG != 0 { 431 goto OneFifty 432 } 433 if ID == 1 { 434 goto OneFourty 435 } 436 AIR = CSQR*S1R - CSQI*S1I 437 AII = CSQR*S1I + CSQI*S1R 438 return 439 OneFourty: 440 AIR = -(ZR*S1R - ZI*S1I) 441 AII = -(ZR*S1I + ZI*S1R) 442 return 443 OneFifty: 444 S1R = S1R * SFAC 445 S1I = S1I * SFAC 446 if ID == 1 { 447 goto OneSixty 448 } 449 STR = S1R*CSQR - S1I*CSQI 450 S1I = S1R*CSQI + S1I*CSQR 451 S1R = STR 452 AIR = S1R / SFAC 453 AII = S1I / SFAC 454 return 455 OneSixty: 456 STR = -(S1R*ZR - S1I*ZI) 457 S1I = -(S1R*ZI + S1I*ZR) 458 S1R = STR 459 AIR = S1R / SFAC 460 AII = S1I / SFAC 461 return 462 OneSeventy: 463 AA = 1.0e+3 * dmach[1] 464 S1R = ZEROR 465 S1I = ZEROI 466 if ID == 1 { 467 goto OneNinety 468 } 469 if AZ <= AA { 470 goto OneEighty 471 } 472 S1R = C2 * ZR 473 S1I = C2 * ZI 474 OneEighty: 475 AIR = C1 - S1R 476 AII = -S1I 477 return 478 OneNinety: 479 AIR = -C2 480 AII = 0.0e0 481 AA = dsqrt(AA) 482 if AZ <= AA { 483 goto TwoHundred 484 } 485 S1R = 0.5e0 * (ZR*ZR - ZI*ZI) 486 S1I = ZR * ZI 487 TwoHundred: 488 AIR = AIR + C1*S1R 489 AII = AII + C1*S1I 490 return 491 TwoTen: 492 NZ = 1 493 AIR = ZEROR 494 AII = ZEROI 495 return 496 TwoSeventy: 497 NZ = 0 498 IERR = 2 499 return 500 TwoEighty: 501 if NN == (-1) { 502 goto TwoSeventy 503 } 504 NZ = 0 505 IERR = 5 506 return 507 TwoSixty: 508 IERR = 4 509 NZ = 0 510 return 511 } 512 513 // sbknu computes the k bessel function in the right half z plane. 514 func zbknuOrig(ZR, ZI, FNU float64, KODE, N int, YR, YI []float64, NZ int, TOL, ELIM, ALIM float64) (ZRout, ZIout, FNUout float64, KODEout, Nout int, YRout, YIout []float64, NZout int, TOLout, ELIMout, ALIMout float64) { 515 /* Old dimension comment. 516 DIMENSION YR(N), YI(N), CC(8), CSSR(3), CSRR(3), BRY(3), CYR(2), 517 * CYI(2) 518 */ 519 520 // TODO(btracey): Find which of these are inputs/outputs/both and clean up 521 // the function call. 522 // YR and YI have length n (but n+1 with better indexing) 523 var AA, AK, ASCLE, A1, A2, BB, BK, CAZ, 524 CBI, CBR, CCHI, CCHR, CKI, CKR, COEFI, COEFR, CONEI, CONER, 525 CRSCR, CSCLR, CSHI, CSHR, CSI, CSR, CTWOR, 526 CZEROI, CZEROR, CZI, CZR, DNU, DNU2, DPI, ETEST, FC, FHS, 527 FI, FK, FKS, FMUI, FMUR, FPI, FR, G1, G2, HPI, PI, PR, PTI, 528 PTR, P1I, P1R, P2I, P2M, P2R, QI, QR, RAK, RCAZ, RTHPI, RZI, 529 RZR, R1, S, SMUI, SMUR, SPI, STI, STR, S1I, S1R, S2I, S2R, TM, 530 TTH, T1, T2, ELM, CELMR, ZDR, ZDI, AS, ALAS, HELIM float64 531 532 var I, IFLAG, INU, K, KFLAG, KK, KMAX, KODED, IDUM, J, IC, INUB, NW int 533 534 var tmp complex128 535 var CSSR, CSRR, BRY [4]float64 536 var CYR, CYI [3]float64 537 538 KMAX = 30 539 CZEROR = 0 540 CZEROI = 0 541 CONER = 1 542 CONEI = 0 543 CTWOR = 2 544 R1 = 2 545 546 DPI = 3.14159265358979324e0 547 RTHPI = 1.25331413731550025e0 548 SPI = 1.90985931710274403e0 549 HPI = 1.57079632679489662e0 550 FPI = 1.89769999331517738e0 551 TTH = 6.66666666666666666e-01 552 553 CC := [9]float64{math.NaN(), 5.77215664901532861e-01, -4.20026350340952355e-02, 554 -4.21977345555443367e-02, 7.21894324666309954e-03, 555 -2.15241674114950973e-04, -2.01348547807882387e-05, 556 1.13302723198169588e-06, 6.11609510448141582e-09} 557 558 CAZ = zabs(complex(ZR, ZI)) 559 CSCLR = 1.0e0 / TOL 560 CRSCR = TOL 561 CSSR[1] = CSCLR 562 CSSR[2] = 1.0e0 563 CSSR[3] = CRSCR 564 CSRR[1] = CRSCR 565 CSRR[2] = 1.0e0 566 CSRR[3] = CSCLR 567 BRY[1] = 1.0e+3 * dmach[1] / TOL 568 BRY[2] = 1.0e0 / BRY[1] 569 BRY[3] = dmach[2] 570 NZ = 0 571 IFLAG = 0 572 KODED = KODE 573 RCAZ = 1.0e0 / CAZ 574 STR = ZR * RCAZ 575 STI = -ZI * RCAZ 576 RZR = (STR + STR) * RCAZ 577 RZI = (STI + STI) * RCAZ 578 INU = int(float32(FNU + 0.5)) 579 DNU = FNU - float64(INU) 580 if dabs(DNU) == 0.5e0 { 581 goto OneTen 582 } 583 DNU2 = 0.0e0 584 if dabs(DNU) > TOL { 585 DNU2 = DNU * DNU 586 } 587 if CAZ > R1 { 588 goto OneTen 589 } 590 591 // SERIES FOR CABS(Z)<=R1. 592 FC = 1.0e0 593 tmp = zlog(complex(RZR, RZI)) 594 SMUR = real(tmp) 595 SMUI = imag(tmp) 596 FMUR = SMUR * DNU 597 FMUI = SMUI * DNU 598 FMUR, FMUI, CSHR, CSHI, CCHR, CCHI = zshchOrig(FMUR, FMUI, CSHR, CSHI, CCHR, CCHI) 599 if DNU == 0.0e0 { 600 goto Ten 601 } 602 FC = DNU * DPI 603 FC = FC / dsin(FC) 604 SMUR = CSHR / DNU 605 SMUI = CSHI / DNU 606 Ten: 607 A2 = 1.0e0 + DNU 608 609 // GAM(1-Z)*GAM(1+Z)=PI*Z/SIN(PI*Z), T1=1/GAM(1-DNU), T2=1/GAM(1+DNU). 610 T2 = dexp(-dgamln(A2, IDUM)) 611 T1 = 1.0e0 / (T2 * FC) 612 if dabs(DNU) > 0.1e0 { 613 goto Forty 614 } 615 616 // SERIES FOR F0 TO RESOLVE INDETERMINACY FOR SMALL ABS(DNU). 617 AK = 1.0e0 618 S = CC[1] 619 for K = 2; K <= 8; K++ { 620 AK = AK * DNU2 621 TM = CC[K] * AK 622 S = S + TM 623 if dabs(TM) < TOL { 624 goto Thirty 625 } 626 } 627 Thirty: 628 G1 = -S 629 goto Fifty 630 Forty: 631 G1 = (T1 - T2) / (DNU + DNU) 632 Fifty: 633 G2 = (T1 + T2) * 0.5e0 634 FR = FC * (CCHR*G1 + SMUR*G2) 635 FI = FC * (CCHI*G1 + SMUI*G2) 636 tmp = zexp(complex(FMUR, FMUI)) 637 STR = real(tmp) 638 STI = imag(tmp) 639 PR = 0.5e0 * STR / T2 640 PI = 0.5e0 * STI / T2 641 tmp = zdiv(complex(0.5, 0), complex(STR, STI)) 642 PTR = real(tmp) 643 PTI = imag(tmp) 644 QR = PTR / T1 645 QI = PTI / T1 646 S1R = FR 647 S1I = FI 648 S2R = PR 649 S2I = PI 650 AK = 1.0e0 651 A1 = 1.0e0 652 CKR = CONER 653 CKI = CONEI 654 BK = 1.0e0 - DNU2 655 if INU > 0 || N > 1 { 656 goto Eighty 657 } 658 659 // GENERATE K(FNU,Z), 0.0E0 <= FNU < 0.5E0 AND N=1. 660 if CAZ < TOL { 661 goto Seventy 662 } 663 tmp = zmlt(complex(ZR, ZI), complex(ZR, ZI)) 664 CZR = real(tmp) 665 CZI = imag(tmp) 666 CZR = 0.25e0 * CZR 667 CZI = 0.25e0 * CZI 668 T1 = 0.25e0 * CAZ * CAZ 669 Sixty: 670 FR = (FR*AK + PR + QR) / BK 671 FI = (FI*AK + PI + QI) / BK 672 STR = 1.0e0 / (AK - DNU) 673 PR = PR * STR 674 PI = PI * STR 675 STR = 1.0e0 / (AK + DNU) 676 QR = QR * STR 677 QI = QI * STR 678 STR = CKR*CZR - CKI*CZI 679 RAK = 1.0e0 / AK 680 CKI = (CKR*CZI + CKI*CZR) * RAK 681 CKR = STR * RAK 682 S1R = CKR*FR - CKI*FI + S1R 683 S1I = CKR*FI + CKI*FR + S1I 684 A1 = A1 * T1 * RAK 685 BK = BK + AK + AK + 1.0e0 686 AK = AK + 1.0e0 687 if A1 > TOL { 688 goto Sixty 689 } 690 Seventy: 691 YR[1] = S1R 692 YI[1] = S1I 693 if KODED == 1 { 694 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 695 } 696 tmp = zexp(complex(ZR, ZI)) 697 STR = real(tmp) 698 STI = imag(tmp) 699 tmp = zmlt(complex(S1R, S1I), complex(STR, STI)) 700 YR[1] = real(tmp) 701 YI[1] = imag(tmp) 702 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 703 704 // GENERATE K(DNU,Z) AND K(DNU+1,Z) FOR FORWARD RECURRENCE. 705 Eighty: 706 if CAZ < TOL { 707 goto OneHundred 708 } 709 tmp = zmlt(complex(ZR, ZI), complex(ZR, ZI)) 710 CZR = real(tmp) 711 CZI = imag(tmp) 712 CZR = 0.25e0 * CZR 713 CZI = 0.25e0 * CZI 714 T1 = 0.25e0 * CAZ * CAZ 715 Ninety: 716 FR = (FR*AK + PR + QR) / BK 717 FI = (FI*AK + PI + QI) / BK 718 STR = 1.0e0 / (AK - DNU) 719 PR = PR * STR 720 PI = PI * STR 721 STR = 1.0e0 / (AK + DNU) 722 QR = QR * STR 723 QI = QI * STR 724 STR = CKR*CZR - CKI*CZI 725 RAK = 1.0e0 / AK 726 CKI = (CKR*CZI + CKI*CZR) * RAK 727 CKR = STR * RAK 728 S1R = CKR*FR - CKI*FI + S1R 729 S1I = CKR*FI + CKI*FR + S1I 730 STR = PR - FR*AK 731 STI = PI - FI*AK 732 S2R = CKR*STR - CKI*STI + S2R 733 S2I = CKR*STI + CKI*STR + S2I 734 A1 = A1 * T1 * RAK 735 BK = BK + AK + AK + 1.0e0 736 AK = AK + 1.0e0 737 if A1 > TOL { 738 goto Ninety 739 } 740 OneHundred: 741 KFLAG = 2 742 A1 = FNU + 1.0e0 743 AK = A1 * dabs(SMUR) 744 if AK > ALIM { 745 KFLAG = 3 746 } 747 STR = CSSR[KFLAG] 748 P2R = S2R * STR 749 P2I = S2I * STR 750 tmp = zmlt(complex(P2R, P2I), complex(RZR, RZI)) 751 S2R = real(tmp) 752 S2I = imag(tmp) 753 S1R = S1R * STR 754 S1I = S1I * STR 755 if KODED == 1 { 756 goto TwoTen 757 } 758 tmp = zexp(complex(ZR, ZI)) 759 FR = real(tmp) 760 FI = imag(tmp) 761 tmp = zmlt(complex(S1R, S1I), complex(FR, FI)) 762 S1R = real(tmp) 763 S1I = imag(tmp) 764 tmp = zmlt(complex(S2R, S2I), complex(FR, FI)) 765 S2R = real(tmp) 766 S2I = imag(tmp) 767 goto TwoTen 768 769 // IFLAG=0 MEANS NO UNDERFLOW OCCURRED 770 // IFLAG=1 MEANS AN UNDERFLOW OCCURRED- COMPUTATION PROCEEDS WITH 771 // KODED=2 AND A TEST FOR ON SCALE VALUES IS MADE DURING FORWARD RECURSION 772 OneTen: 773 tmp = zsqrt(complex(ZR, ZI)) 774 STR = real(tmp) 775 STI = imag(tmp) 776 tmp = zdiv(complex(RTHPI, CZEROI), complex(STR, STI)) 777 COEFR = real(tmp) 778 COEFI = imag(tmp) 779 KFLAG = 2 780 if KODED == 2 { 781 goto OneTwenty 782 } 783 if ZR > ALIM { 784 goto TwoNinety 785 } 786 787 STR = dexp(-ZR) * CSSR[KFLAG] 788 STI = -STR * dsin(ZI) 789 STR = STR * dcos(ZI) 790 tmp = zmlt(complex(COEFR, COEFI), complex(STR, STI)) 791 COEFR = real(tmp) 792 COEFI = imag(tmp) 793 OneTwenty: 794 if dabs(DNU) == 0.5e0 { 795 goto ThreeHundred 796 } 797 // MILLER ALGORITHM FOR CABS(Z)>R1. 798 AK = dcos(DPI * DNU) 799 AK = dabs(AK) 800 if AK == CZEROR { 801 goto ThreeHundred 802 } 803 FHS = dabs(0.25e0 - DNU2) 804 if FHS == CZEROR { 805 goto ThreeHundred 806 } 807 808 // COMPUTE R2=F(E). if CABS(Z)>=R2, USE FORWARD RECURRENCE TO 809 // DETERMINE THE BACKWARD INDEX K. R2=F(E) IS A STRAIGHT LINE ON 810 // 12<=E<=60. E IS COMPUTED FROM 2**(-E)=B**(1-I1MACH(14))= 811 // TOL WHERE B IS THE BASE OF THE ARITHMETIC. 812 T1 = float64(imach[14] - 1) 813 T1 = T1 * dmach[5] * 3.321928094e0 814 T1 = dmax(T1, 12.0e0) 815 T1 = dmin(T1, 60.0e0) 816 T2 = TTH*T1 - 6.0e0 817 if ZR != 0.0e0 { 818 goto OneThirty 819 } 820 T1 = HPI 821 goto OneFourty 822 OneThirty: 823 T1 = datan(ZI / ZR) 824 T1 = dabs(T1) 825 OneFourty: 826 if T2 > CAZ { 827 goto OneSeventy 828 } 829 // FORWARD RECURRENCE LOOP WHEN CABS(Z)>=R2. 830 ETEST = AK / (DPI * CAZ * TOL) 831 FK = CONER 832 if ETEST < CONER { 833 goto OneEighty 834 } 835 FKS = CTWOR 836 CKR = CAZ + CAZ + CTWOR 837 P1R = CZEROR 838 P2R = CONER 839 for I = 1; I <= KMAX; I++ { 840 AK = FHS / FKS 841 CBR = CKR / (FK + CONER) 842 PTR = P2R 843 P2R = CBR*P2R - P1R*AK 844 P1R = PTR 845 CKR = CKR + CTWOR 846 FKS = FKS + FK + FK + CTWOR 847 FHS = FHS + FK + FK 848 FK = FK + CONER 849 STR = dabs(P2R) * FK 850 if ETEST < STR { 851 goto OneSixty 852 } 853 } 854 goto ThreeTen 855 OneSixty: 856 FK = FK + SPI*T1*dsqrt(T2/CAZ) 857 FHS = dabs(0.25 - DNU2) 858 goto OneEighty 859 OneSeventy: 860 // COMPUTE BACKWARD INDEX K FOR CABS(Z)<R2. 861 A2 = dsqrt(CAZ) 862 AK = FPI * AK / (TOL * dsqrt(A2)) 863 AA = 3.0e0 * T1 / (1.0e0 + CAZ) 864 BB = 14.7e0 * T1 / (28.0e0 + CAZ) 865 AK = (dlog(AK) + CAZ*dcos(AA)/(1.0e0+0.008e0*CAZ)) / dcos(BB) 866 FK = 0.12125e0*AK*AK/CAZ + 1.5e0 867 OneEighty: 868 // BACKWARD RECURRENCE LOOP FOR MILLER ALGORITHM. 869 K = int(float32(FK)) 870 FK = float64(K) 871 FKS = FK * FK 872 P1R = CZEROR 873 P1I = CZEROI 874 P2R = TOL 875 P2I = CZEROI 876 CSR = P2R 877 CSI = P2I 878 for I = 1; I <= K; I++ { 879 A1 = FKS - FK 880 AK = (FKS + FK) / (A1 + FHS) 881 RAK = 2.0e0 / (FK + CONER) 882 CBR = (FK + ZR) * RAK 883 CBI = ZI * RAK 884 PTR = P2R 885 PTI = P2I 886 P2R = (PTR*CBR - PTI*CBI - P1R) * AK 887 P2I = (PTI*CBR + PTR*CBI - P1I) * AK 888 P1R = PTR 889 P1I = PTI 890 CSR = CSR + P2R 891 CSI = CSI + P2I 892 FKS = A1 - FK + CONER 893 FK = FK - CONER 894 } 895 // COMPUTE (P2/CS)=(P2/CABS(CS))*(CONJG(CS)/CABS(CS)) FOR BETTER SCALING. 896 TM = zabs(complex(CSR, CSI)) 897 PTR = 1.0e0 / TM 898 S1R = P2R * PTR 899 S1I = P2I * PTR 900 CSR = CSR * PTR 901 CSI = -CSI * PTR 902 tmp = zmlt(complex(COEFR, COEFI), complex(S1R, S1I)) 903 STR = real(tmp) 904 STI = imag(tmp) 905 tmp = zmlt(complex(STR, STI), complex(CSR, CSI)) 906 S1R = real(tmp) 907 S1I = imag(tmp) 908 if INU > 0 || N > 1 { 909 goto TwoHundred 910 } 911 ZDR = ZR 912 ZDI = ZI 913 if IFLAG == 1 { 914 goto TwoSeventy 915 } 916 goto TwoFourty 917 TwoHundred: 918 // COMPUTE P1/P2=(P1/CABS(P2)*CONJG(P2)/CABS(P2) FOR SCALING. 919 TM = zabs(complex(P2R, P2I)) 920 PTR = 1.0e0 / TM 921 P1R = P1R * PTR 922 P1I = P1I * PTR 923 P2R = P2R * PTR 924 P2I = -P2I * PTR 925 tmp = zmlt(complex(P1R, P1I), complex(P2R, P2I)) 926 PTR = real(tmp) 927 PTI = imag(tmp) 928 STR = DNU + 0.5e0 - PTR 929 STI = -PTI 930 tmp = zdiv(complex(STR, STI), complex(ZR, ZI)) 931 STR = real(tmp) 932 STI = imag(tmp) 933 STR = STR + 1.0e0 934 tmp = zmlt(complex(STR, STI), complex(S1R, S1I)) 935 S2R = real(tmp) 936 S2I = imag(tmp) 937 938 // FORWARD RECURSION ON THE THREE TERM RECURSION WITH RELATION WITH 939 // SCALING NEAR EXPONENT EXTREMES ON KFLAG=1 OR KFLAG=3 940 TwoTen: 941 STR = DNU + 1.0e0 942 CKR = STR * RZR 943 CKI = STR * RZI 944 if N == 1 { 945 INU = INU - 1 946 } 947 if INU > 0 { 948 goto TwoTwenty 949 } 950 if N > 1 { 951 goto TwoFifteen 952 } 953 S1R = S2R 954 S1I = S2I 955 TwoFifteen: 956 ZDR = ZR 957 ZDI = ZI 958 if IFLAG == 1 { 959 goto TwoSeventy 960 } 961 goto TwoFourty 962 TwoTwenty: 963 INUB = 1 964 if IFLAG == 1 { 965 goto TwoSixtyOne 966 } 967 TwoTwentyFive: 968 P1R = CSRR[KFLAG] 969 ASCLE = BRY[KFLAG] 970 for I = INUB; I <= INU; I++ { 971 STR = S2R 972 STI = S2I 973 S2R = CKR*STR - CKI*STI + S1R 974 S2I = CKR*STI + CKI*STR + S1I 975 S1R = STR 976 S1I = STI 977 CKR = CKR + RZR 978 CKI = CKI + RZI 979 if KFLAG >= 3 { 980 continue 981 } 982 P2R = S2R * P1R 983 P2I = S2I * P1R 984 STR = dabs(P2R) 985 STI = dabs(P2I) 986 P2M = dmax(STR, STI) 987 if P2M <= ASCLE { 988 continue 989 } 990 KFLAG = KFLAG + 1 991 ASCLE = BRY[KFLAG] 992 S1R = S1R * P1R 993 S1I = S1I * P1R 994 S2R = P2R 995 S2I = P2I 996 STR = CSSR[KFLAG] 997 S1R = S1R * STR 998 S1I = S1I * STR 999 S2R = S2R * STR 1000 S2I = S2I * STR 1001 P1R = CSRR[KFLAG] 1002 } 1003 if N != 1 { 1004 goto TwoFourty 1005 } 1006 S1R = S2R 1007 S1I = S2I 1008 TwoFourty: 1009 STR = CSRR[KFLAG] 1010 YR[1] = S1R * STR 1011 YI[1] = S1I * STR 1012 if N == 1 { 1013 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 1014 } 1015 YR[2] = S2R * STR 1016 YI[2] = S2I * STR 1017 if N == 2 { 1018 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 1019 } 1020 KK = 2 1021 TwoFifty: 1022 KK = KK + 1 1023 if KK > N { 1024 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 1025 } 1026 P1R = CSRR[KFLAG] 1027 ASCLE = BRY[KFLAG] 1028 for I = KK; I <= N; I++ { 1029 P2R = S2R 1030 P2I = S2I 1031 S2R = CKR*P2R - CKI*P2I + S1R 1032 S2I = CKI*P2R + CKR*P2I + S1I 1033 S1R = P2R 1034 S1I = P2I 1035 CKR = CKR + RZR 1036 CKI = CKI + RZI 1037 P2R = S2R * P1R 1038 P2I = S2I * P1R 1039 YR[I] = P2R 1040 YI[I] = P2I 1041 if KFLAG >= 3 { 1042 continue 1043 } 1044 STR = dabs(P2R) 1045 STI = dabs(P2I) 1046 P2M = dmax(STR, STI) 1047 if P2M <= ASCLE { 1048 continue 1049 } 1050 KFLAG = KFLAG + 1 1051 ASCLE = BRY[KFLAG] 1052 S1R = S1R * P1R 1053 S1I = S1I * P1R 1054 S2R = P2R 1055 S2I = P2I 1056 STR = CSSR[KFLAG] 1057 S1R = S1R * STR 1058 S1I = S1I * STR 1059 S2R = S2R * STR 1060 S2I = S2I * STR 1061 P1R = CSRR[KFLAG] 1062 } 1063 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 1064 1065 // IFLAG=1 CASES, FORWARD RECURRENCE ON SCALED VALUES ON UNDERFLOW. 1066 TwoSixtyOne: 1067 HELIM = 0.5e0 * ELIM 1068 ELM = dexp(-ELIM) 1069 CELMR = ELM 1070 ASCLE = BRY[1] 1071 ZDR = ZR 1072 ZDI = ZI 1073 IC = -1 1074 J = 2 1075 for I = 1; I <= INU; I++ { 1076 STR = S2R 1077 STI = S2I 1078 S2R = STR*CKR - STI*CKI + S1R 1079 S2I = STI*CKR + STR*CKI + S1I 1080 S1R = STR 1081 S1I = STI 1082 CKR = CKR + RZR 1083 CKI = CKI + RZI 1084 AS = zabs(complex(S2R, S2I)) 1085 ALAS = dlog(AS) 1086 P2R = -ZDR + ALAS 1087 if P2R < (-ELIM) { 1088 goto TwoSixtyThree 1089 } 1090 tmp = zlog(complex(S2R, S2I)) 1091 STR = real(tmp) 1092 STI = imag(tmp) 1093 P2R = -ZDR + STR 1094 P2I = -ZDI + STI 1095 P2M = dexp(P2R) / TOL 1096 P1R = P2M * dcos(P2I) 1097 P1I = P2M * dsin(P2I) 1098 P1R, P1I, NW, ASCLE, TOL = zuchkOrig(P1R, P1I, NW, ASCLE, TOL) 1099 if NW != 0 { 1100 goto TwoSixtyThree 1101 } 1102 J = 3 - J 1103 CYR[J] = P1R 1104 CYI[J] = P1I 1105 if IC == (I - 1) { 1106 goto TwoSixtyFour 1107 } 1108 IC = I 1109 continue 1110 TwoSixtyThree: 1111 if ALAS < HELIM { 1112 continue 1113 } 1114 ZDR = ZDR - ELIM 1115 S1R = S1R * CELMR 1116 S1I = S1I * CELMR 1117 S2R = S2R * CELMR 1118 S2I = S2I * CELMR 1119 } 1120 if N != 1 { 1121 goto TwoSeventy 1122 } 1123 S1R = S2R 1124 S1I = S2I 1125 goto TwoSeventy 1126 TwoSixtyFour: 1127 KFLAG = 1 1128 INUB = I + 1 1129 S2R = CYR[J] 1130 S2I = CYI[J] 1131 J = 3 - J 1132 S1R = CYR[J] 1133 S1I = CYI[J] 1134 if INUB <= INU { 1135 goto TwoTwentyFive 1136 } 1137 if N != 1 { 1138 goto TwoFourty 1139 } 1140 S1R = S2R 1141 S1I = S2I 1142 goto TwoFourty 1143 TwoSeventy: 1144 YR[1] = S1R 1145 YI[1] = S1I 1146 if N == 1 { 1147 goto TwoEighty 1148 } 1149 YR[2] = S2R 1150 YI[2] = S2I 1151 TwoEighty: 1152 ASCLE = BRY[1] 1153 ZDR, ZDI, FNU, N, YR, YI, NZ, RZR, RZI, ASCLE, TOL, ELIM = zksclOrig(ZDR, ZDI, FNU, N, YR, YI, NZ, RZR, RZI, ASCLE, TOL, ELIM) 1154 INU = N - NZ 1155 if INU <= 0 { 1156 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 1157 } 1158 KK = NZ + 1 1159 S1R = YR[KK] 1160 S1I = YI[KK] 1161 YR[KK] = S1R * CSRR[1] 1162 YI[KK] = S1I * CSRR[1] 1163 if INU == 1 { 1164 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 1165 } 1166 KK = NZ + 2 1167 S2R = YR[KK] 1168 S2I = YI[KK] 1169 YR[KK] = S2R * CSRR[1] 1170 YI[KK] = S2I * CSRR[1] 1171 if INU == 2 { 1172 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 1173 } 1174 T2 = FNU + float64(float32(KK-1)) 1175 CKR = T2 * RZR 1176 CKI = T2 * RZI 1177 KFLAG = 1 1178 goto TwoFifty 1179 TwoNinety: 1180 1181 // SCALE BY dexp(Z), IFLAG = 1 CASES. 1182 1183 KODED = 2 1184 IFLAG = 1 1185 KFLAG = 2 1186 goto OneTwenty 1187 1188 // FNU=HALF ODD INTEGER CASE, DNU=-0.5 1189 ThreeHundred: 1190 S1R = COEFR 1191 S1I = COEFI 1192 S2R = COEFR 1193 S2I = COEFI 1194 goto TwoTen 1195 1196 ThreeTen: 1197 NZ = -2 1198 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 1199 } 1200 1201 // SET K FUNCTIONS TO ZERO ON UNDERFLOW, CONTINUE RECURRENCE 1202 // ON SCALED FUNCTIONS UNTIL TWO MEMBERS COME ON SCALE, THEN 1203 // return WITH MIN(NZ+2,N) VALUES SCALED BY 1/TOL. 1204 func zksclOrig(ZRR, ZRI, FNU float64, N int, YR, YI []float64, NZ int, RZR, RZI, ASCLE, TOL, ELIM float64) ( 1205 ZRRout, ZRIout, FNUout float64, Nout int, YRout, YIout []float64, NZout int, RZRout, RZIout, ASCLEout, TOLout, ELIMout float64) { 1206 var ACS, AS, CKI, CKR, CSI, CSR, FN, STR, S1I, S1R, S2I, 1207 S2R, ZEROI, ZEROR, ZDR, ZDI, CELMR, ELM, HELIM, ALAS float64 1208 1209 var I, IC, KK, NN, NW int 1210 var tmp complex128 1211 var CYR, CYI [3]float64 1212 // DIMENSION YR(N), YI(N), CYR(2), CYI(2) 1213 ZEROR = 0 1214 ZEROI = 0 1215 NZ = 0 1216 IC = 0 1217 NN = min(2, N) 1218 for I = 1; I <= NN; I++ { 1219 S1R = YR[I] 1220 S1I = YI[I] 1221 CYR[I] = S1R 1222 CYI[I] = S1I 1223 AS = zabs(complex(S1R, S1I)) 1224 ACS = -ZRR + dlog(AS) 1225 NZ = NZ + 1 1226 YR[I] = ZEROR 1227 YI[I] = ZEROI 1228 if ACS < (-ELIM) { 1229 continue 1230 } 1231 1232 tmp = zlog(complex(S1R, S1I)) 1233 CSR = real(tmp) 1234 CSI = imag(tmp) 1235 CSR = CSR - ZRR 1236 CSI = CSI - ZRI 1237 STR = dexp(CSR) / TOL 1238 CSR = STR * dcos(CSI) 1239 CSI = STR * dsin(CSI) 1240 CSR, CSI, NW, ASCLE, TOL = zuchkOrig(CSR, CSI, NW, ASCLE, TOL) 1241 if NW != 0 { 1242 continue 1243 } 1244 YR[I] = CSR 1245 YI[I] = CSI 1246 IC = I 1247 NZ = NZ - 1 1248 } 1249 if N == 1 { 1250 return ZRR, ZRI, FNU, N, YR, YI, NZ, RZR, RZI, ASCLE, TOL, ELIM 1251 } 1252 if IC > 1 { 1253 goto Twenty 1254 } 1255 YR[1] = ZEROR 1256 YI[1] = ZEROI 1257 NZ = 2 1258 Twenty: 1259 if N == 2 { 1260 return ZRR, ZRI, FNU, N, YR, YI, NZ, RZR, RZI, ASCLE, TOL, ELIM 1261 } 1262 if NZ == 0 { 1263 return ZRR, ZRI, FNU, N, YR, YI, NZ, RZR, RZI, ASCLE, TOL, ELIM 1264 } 1265 FN = FNU + 1.0e0 1266 CKR = FN * RZR 1267 CKI = FN * RZI 1268 S1R = CYR[1] 1269 S1I = CYI[1] 1270 S2R = CYR[2] 1271 S2I = CYI[2] 1272 HELIM = 0.5e0 * ELIM 1273 ELM = dexp(-ELIM) 1274 CELMR = ELM 1275 ZDR = ZRR 1276 ZDI = ZRI 1277 1278 // FIND TWO CONSECUTIVE Y VALUES ON SCALE. SCALE RECURRENCE IF 1279 // S2 GETS LARGER THAN EXP(ELIM/2) 1280 for I = 3; I <= N; I++ { 1281 KK = I 1282 CSR = S2R 1283 CSI = S2I 1284 S2R = CKR*CSR - CKI*CSI + S1R 1285 S2I = CKI*CSR + CKR*CSI + S1I 1286 S1R = CSR 1287 S1I = CSI 1288 CKR = CKR + RZR 1289 CKI = CKI + RZI 1290 AS = zabs(complex(S2R, S2I)) 1291 ALAS = dlog(AS) 1292 ACS = -ZDR + ALAS 1293 NZ = NZ + 1 1294 YR[I] = ZEROR 1295 YI[I] = ZEROI 1296 if ACS < (-ELIM) { 1297 goto TwentyFive 1298 } 1299 tmp = zlog(complex(S2R, S2I)) 1300 CSR = real(tmp) 1301 CSI = imag(tmp) 1302 CSR = CSR - ZDR 1303 CSI = CSI - ZDI 1304 STR = dexp(CSR) / TOL 1305 CSR = STR * dcos(CSI) 1306 CSI = STR * dsin(CSI) 1307 CSR, CSI, NW, ASCLE, TOL = zuchkOrig(CSR, CSI, NW, ASCLE, TOL) 1308 if NW != 0 { 1309 goto TwentyFive 1310 } 1311 YR[I] = CSR 1312 YI[I] = CSI 1313 NZ = NZ - 1 1314 if IC == KK-1 { 1315 goto Forty 1316 } 1317 IC = KK 1318 continue 1319 TwentyFive: 1320 if ALAS < HELIM { 1321 continue 1322 } 1323 ZDR = ZDR - ELIM 1324 S1R = S1R * CELMR 1325 S1I = S1I * CELMR 1326 S2R = S2R * CELMR 1327 S2I = S2I * CELMR 1328 } 1329 NZ = N 1330 if IC == N { 1331 NZ = N - 1 1332 } 1333 goto FourtyFive 1334 Forty: 1335 NZ = KK - 2 1336 FourtyFive: 1337 for I = 1; I <= NZ; I++ { 1338 YR[I] = ZEROR 1339 YI[I] = ZEROI 1340 } 1341 return ZRR, ZRI, FNU, N, YR, YI, NZ, RZR, RZI, ASCLE, TOL, ELIM 1342 } 1343 1344 // Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN 1345 // EXP(-ALIM)=ASCLE=1.0E+3*dmach[1)/TOL. THE TEST IS MADE TO SEE 1346 // if THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDERFLOW 1347 // WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED 1348 // if THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE 1349 // OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE 1350 // ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED. 1351 func zuchkOrig(YR, YI float64, NZ int, ASCLE, TOL float64) (YRout, YIout float64, NZout int, ASCLEout, TOLout float64) { 1352 var SS, ST, WR, WI float64 1353 NZ = 0 1354 WR = dabs(YR) 1355 WI = dabs(YI) 1356 ST = dmin(WR, WI) 1357 if ST > ASCLE { 1358 return YR, YI, NZ, ASCLE, TOL 1359 } 1360 SS = dmax(WR, WI) 1361 ST = ST / TOL 1362 if SS < ST { 1363 NZ = 1 1364 } 1365 return YR, YI, NZ, ASCLE, TOL 1366 } 1367 1368 // ZACAI APPLIES THE ANALYTIC CONTINUATION FORMULA 1369 // 1370 // K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) 1371 // MP=PI*MR*CMPLX(0.0,1.0) 1372 // 1373 // TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT 1374 // HALF Z PLANE FOR USE WITH ZAIRY WHERE FNU=1/3 OR 2/3 AND N=1. 1375 // ZACAI IS THE SAME AS ZACON WITH THE PARTS FOR LARGER ORDERS AND 1376 // RECURRENCE REMOVED. A RECURSIVE CALL TO ZACON CAN RESULT if ZACON 1377 // IS CALLED FROM ZAIRY. 1378 func zacaiOrig(ZR, ZI, FNU float64, KODE, MR, N int, YR, YI []float64, NZ int, RL, TOL, ELIM, ALIM float64) ( 1379 ZRout, ZIout, FNUout float64, KODEout, MRout, Nout int, YRout, YIout []float64, NZout int, RLout, TOLout, ELIMout, ALIMout float64) { 1380 var ARG, ASCLE, AZ, CSGNR, CSGNI, CSPNR, 1381 CSPNI, C1R, C1I, C2R, C2I, DFNU, FMR, PI, 1382 SGN, YY, ZNR, ZNI float64 1383 var INU, IUF, NN, NW int 1384 CYR := []float64{math.NaN(), 0, 0} 1385 CYI := []float64{math.NaN(), 0, 0} 1386 1387 PI = math.Pi 1388 NZ = 0 1389 ZNR = -ZR 1390 ZNI = -ZI 1391 AZ = zabs(complex(ZR, ZI)) 1392 NN = N 1393 DFNU = FNU + float64(float32(N-1)) 1394 if AZ <= 2.0e0 { 1395 goto Ten 1396 } 1397 if AZ*AZ*0.25 > DFNU+1.0e0 { 1398 goto Twenty 1399 } 1400 Ten: 1401 // POWER SERIES FOR THE I FUNCTION. 1402 ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, TOL, ELIM, ALIM = zseriOrig(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, TOL, ELIM, ALIM) 1403 goto Forty 1404 Twenty: 1405 if AZ < RL { 1406 goto Thirty 1407 } 1408 // ASYMPTOTIC EXPANSION FOR LARGE Z FOR THE I FUNCTION. 1409 ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, RL, TOL, ELIM, ALIM = zasyiOrig(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, RL, TOL, ELIM, ALIM) 1410 if NW < 0 { 1411 goto Eighty 1412 } 1413 goto Forty 1414 Thirty: 1415 // MILLER ALGORITHM NORMALIZED BY THE SERIES FOR THE I FUNCTION 1416 ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, TOL = zmlriOrig(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, TOL) 1417 if NW < 0 { 1418 goto Eighty 1419 } 1420 Forty: 1421 // ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION. 1422 ZNR, ZNI, FNU, KODE, _, CYR, CYI, NW, TOL, ELIM, ALIM = zbknuOrig(ZNR, ZNI, FNU, KODE, 1, CYR, CYI, NW, TOL, ELIM, ALIM) 1423 if NW != 0 { 1424 goto Eighty 1425 } 1426 FMR = float64(float32(MR)) 1427 SGN = -math.Copysign(PI, FMR) 1428 CSGNR = 0.0e0 1429 CSGNI = SGN 1430 if KODE == 1 { 1431 goto Fifty 1432 } 1433 YY = -ZNI 1434 CSGNR = -CSGNI * dsin(YY) 1435 CSGNI = CSGNI * dcos(YY) 1436 Fifty: 1437 // CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE 1438 // WHEN FNU IS LARGE 1439 INU = int(float32(FNU)) 1440 ARG = (FNU - float64(float32(INU))) * SGN 1441 CSPNR = dcos(ARG) 1442 CSPNI = dsin(ARG) 1443 if INU%2 == 0 { 1444 goto Sixty 1445 } 1446 CSPNR = -CSPNR 1447 CSPNI = -CSPNI 1448 Sixty: 1449 C1R = CYR[1] 1450 C1I = CYI[1] 1451 C2R = YR[1] 1452 C2I = YI[1] 1453 if KODE == 1 { 1454 goto Seventy 1455 } 1456 IUF = 0 1457 ASCLE = 1.0e+3 * dmach[1] / TOL 1458 ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF = zs1s2Orig(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF) 1459 NZ = NZ + NW 1460 Seventy: 1461 YR[1] = CSPNR*C1R - CSPNI*C1I + CSGNR*C2R - CSGNI*C2I 1462 YI[1] = CSPNR*C1I + CSPNI*C1R + CSGNR*C2I + CSGNI*C2R 1463 return ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, TOL, ELIM, ALIM 1464 Eighty: 1465 NZ = -1 1466 if NW == -2 { 1467 NZ = -2 1468 } 1469 return ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, TOL, ELIM, ALIM 1470 } 1471 1472 // ZASYI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z)>=0.0 BY 1473 // MEANS OF THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z) IN THE 1474 // REGION CABS(Z)>MAX(RL,FNU*FNU/2). NZ=0 IS A NORMAL return. 1475 // NZ<0 INDICATES AN OVERFLOW ON KODE=1. 1476 func zasyiOrig(ZR, ZI, FNU float64, KODE, N int, YR, YI []float64, NZ int, RL, TOL, ELIM, ALIM float64) ( 1477 ZRout, ZIout, FNUout float64, KODEout, Nout int, YRout, YIout []float64, NZout int, RLout, TOLout, ELIMout, ALIMout float64) { 1478 var AA, AEZ, AK, AK1I, AK1R, ARG, ARM, ATOL, 1479 AZ, BB, BK, CKI, CKR, CONEI, CONER, CS1I, CS1R, CS2I, CS2R, CZI, 1480 CZR, DFNU, DKI, DKR, DNU2, EZI, EZR, FDN, PI, P1I, 1481 P1R, RAZ, RTPI, RTR1, RZI, RZR, S, SGN, SQK, STI, STR, S2I, 1482 S2R, TZI, TZR, ZEROI, ZEROR float64 1483 1484 var I, IB, IL, INU, J, JL, K, KODED, M, NN int 1485 var tmp complex128 1486 1487 PI = math.Pi 1488 RTPI = 0.159154943091895336e0 1489 ZEROR = 0 1490 ZEROI = 0 1491 CONER = 1 1492 CONEI = 0 1493 1494 NZ = 0 1495 AZ = zabs(complex(ZR, ZI)) 1496 ARM = 1.0e3 * dmach[1] 1497 RTR1 = dsqrt(ARM) 1498 IL = min(2, N) 1499 DFNU = FNU + float64(float32(N-IL)) 1500 1501 // OVERFLOW TEST 1502 RAZ = 1.0e0 / AZ 1503 STR = ZR * RAZ 1504 STI = -ZI * RAZ 1505 AK1R = RTPI * STR * RAZ 1506 AK1I = RTPI * STI * RAZ 1507 tmp = zsqrt(complex(AK1R, AK1I)) 1508 AK1R = real(tmp) 1509 AK1I = imag(tmp) 1510 CZR = ZR 1511 CZI = ZI 1512 if KODE != 2 { 1513 goto Ten 1514 } 1515 CZR = ZEROR 1516 CZI = ZI 1517 Ten: 1518 if dabs(CZR) > ELIM { 1519 goto OneHundred 1520 } 1521 DNU2 = DFNU + DFNU 1522 KODED = 1 1523 if (dabs(CZR) > ALIM) && (N > 2) { 1524 goto Twenty 1525 } 1526 KODED = 0 1527 tmp = zexp(complex(CZR, CZI)) 1528 STR = real(tmp) 1529 STI = imag(tmp) 1530 tmp = zmlt(complex(AK1R, AK1I), complex(STR, STI)) 1531 AK1R = real(tmp) 1532 AK1I = imag(tmp) 1533 Twenty: 1534 FDN = 0.0e0 1535 if DNU2 > RTR1 { 1536 FDN = DNU2 * DNU2 1537 } 1538 EZR = ZR * 8.0e0 1539 EZI = ZI * 8.0e0 1540 1541 // WHEN Z IS IMAGINARY, THE ERROR TEST MUST BE MADE RELATIVE TO THE 1542 // FIRST RECIPROCAL POWER SINCE THIS IS THE LEADING TERM OF THE 1543 // EXPANSION FOR THE IMAGINARY PART. 1544 AEZ = 8.0e0 * AZ 1545 S = TOL / AEZ 1546 JL = int(float32(RL+RL)) + 2 1547 P1R = ZEROR 1548 P1I = ZEROI 1549 if ZI == 0.0e0 { 1550 goto Thirty 1551 } 1552 1553 // CALCULATE EXP(PI*(0.5+FNU+N-IL)*I) TO MINIMIZE LOSSES OF 1554 // SIGNIFICANCE WHEN FNU OR N IS LARGE 1555 INU = int(float32(FNU)) 1556 ARG = (FNU - float64(float32(INU))) * PI 1557 INU = INU + N - IL 1558 AK = -dsin(ARG) 1559 BK = dcos(ARG) 1560 if ZI < 0.0e0 { 1561 BK = -BK 1562 } 1563 P1R = AK 1564 P1I = BK 1565 if INU%2 == 0 { 1566 goto Thirty 1567 } 1568 P1R = -P1R 1569 P1I = -P1I 1570 Thirty: 1571 for K = 1; K <= IL; K++ { 1572 SQK = FDN - 1.0e0 1573 ATOL = S * dabs(SQK) 1574 SGN = 1.0e0 1575 CS1R = CONER 1576 CS1I = CONEI 1577 CS2R = CONER 1578 CS2I = CONEI 1579 CKR = CONER 1580 CKI = CONEI 1581 AK = 0.0e0 1582 AA = 1.0e0 1583 BB = AEZ 1584 DKR = EZR 1585 DKI = EZI 1586 // TODO(btracey): This loop is executed tens of thousands of times. Why? 1587 // is that really necessary? 1588 for J = 1; J <= JL; J++ { 1589 tmp = zdiv(complex(CKR, CKI), complex(DKR, DKI)) 1590 STR = real(tmp) 1591 STI = imag(tmp) 1592 CKR = STR * SQK 1593 CKI = STI * SQK 1594 CS2R = CS2R + CKR 1595 CS2I = CS2I + CKI 1596 SGN = -SGN 1597 CS1R = CS1R + CKR*SGN 1598 CS1I = CS1I + CKI*SGN 1599 DKR = DKR + EZR 1600 DKI = DKI + EZI 1601 AA = AA * dabs(SQK) / BB 1602 BB = BB + AEZ 1603 AK = AK + 8.0e0 1604 SQK = SQK - AK 1605 if AA <= ATOL { 1606 goto Fifty 1607 } 1608 } 1609 goto OneTen 1610 Fifty: 1611 S2R = CS1R 1612 S2I = CS1I 1613 if ZR+ZR >= ELIM { 1614 goto Sixty 1615 } 1616 TZR = ZR + ZR 1617 TZI = ZI + ZI 1618 tmp = zexp(complex(-TZR, -TZI)) 1619 STR = real(tmp) 1620 STI = imag(tmp) 1621 tmp = zmlt(complex(STR, STI), complex(P1R, P1I)) 1622 STR = real(tmp) 1623 STI = imag(tmp) 1624 tmp = zmlt(complex(STR, STI), complex(CS2R, CS2I)) 1625 STR = real(tmp) 1626 STI = imag(tmp) 1627 S2R = S2R + STR 1628 S2I = S2I + STI 1629 Sixty: 1630 FDN = FDN + 8.0e0*DFNU + 4.0e0 1631 P1R = -P1R 1632 P1I = -P1I 1633 M = N - IL + K 1634 YR[M] = S2R*AK1R - S2I*AK1I 1635 YI[M] = S2R*AK1I + S2I*AK1R 1636 } 1637 if N <= 2 { 1638 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM, ALIM 1639 } 1640 NN = N 1641 K = NN - 2 1642 AK = float64(float32(K)) 1643 STR = ZR * RAZ 1644 STI = -ZI * RAZ 1645 RZR = (STR + STR) * RAZ 1646 RZI = (STI + STI) * RAZ 1647 IB = 3 1648 for I = IB; I <= NN; I++ { 1649 YR[K] = (AK+FNU)*(RZR*YR[K+1]-RZI*YI[K+1]) + YR[K+2] 1650 YI[K] = (AK+FNU)*(RZR*YI[K+1]+RZI*YR[K+1]) + YI[K+2] 1651 AK = AK - 1.0e0 1652 K = K - 1 1653 } 1654 if KODED == 0 { 1655 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM, ALIM 1656 } 1657 tmp = zexp(complex(CZR, CZI)) 1658 CKR = real(tmp) 1659 CKI = imag(tmp) 1660 for I = 1; I <= NN; I++ { 1661 STR = YR[I]*CKR - YI[I]*CKI 1662 YI[I] = YR[I]*CKI + YI[I]*CKR 1663 YR[I] = STR 1664 } 1665 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM, ALIM 1666 OneHundred: 1667 NZ = -1 1668 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM, ALIM 1669 OneTen: 1670 NZ = -2 1671 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM, ALIM 1672 } 1673 1674 // ZMLRI COMPUTES THE I BESSEL FUNCTION FOR RE(Z)>=0.0 BY THE 1675 // MILLER ALGORITHM NORMALIZED BY A NEUMANN SERIES. 1676 func zmlriOrig(ZR, ZI, FNU float64, KODE, N int, YR, YI []float64, NZ int, TOL float64) ( 1677 ZRout, ZIout, FNUout float64, KODEout, Nout int, YRout, YIout []float64, NZout int, TOLout float64) { 1678 var ACK, AK, AP, AT, AZ, BK, CKI, CKR, CNORMI, 1679 CNORMR, CONEI, CONER, FKAP, FKK, FLAM, FNF, PTI, PTR, P1I, 1680 P1R, P2I, P2R, RAZ, RHO, RHO2, RZI, RZR, SCLE, STI, STR, SUMI, 1681 SUMR, TFNF, TST, ZEROI, ZEROR float64 1682 var I, IAZ, IDUM, IFNU, INU, ITIME, K, KK, KM, M int 1683 var tmp complex128 1684 ZEROR = 0 1685 ZEROI = 0 1686 CONER = 1 1687 CONEI = 0 1688 1689 SCLE = dmach[1] / TOL 1690 NZ = 0 1691 AZ = zabs(complex(ZR, ZI)) 1692 IAZ = int(float32(AZ)) 1693 IFNU = int(float32(FNU)) 1694 INU = IFNU + N - 1 1695 AT = float64(float32(IAZ)) + 1.0e0 1696 RAZ = 1.0e0 / AZ 1697 STR = ZR * RAZ 1698 STI = -ZI * RAZ 1699 CKR = STR * AT * RAZ 1700 CKI = STI * AT * RAZ 1701 RZR = (STR + STR) * RAZ 1702 RZI = (STI + STI) * RAZ 1703 P1R = ZEROR 1704 P1I = ZEROI 1705 P2R = CONER 1706 P2I = CONEI 1707 ACK = (AT + 1.0e0) * RAZ 1708 RHO = ACK + dsqrt(ACK*ACK-1.0e0) 1709 RHO2 = RHO * RHO 1710 TST = (RHO2 + RHO2) / ((RHO2 - 1.0e0) * (RHO - 1.0e0)) 1711 TST = TST / TOL 1712 1713 // COMPUTE RELATIVE TRUNCATION ERROR INDEX FOR SERIES. 1714 //fmt.Println("before loop", P2R, P2I, CKR, CKI, RZR, RZI, TST, AK) 1715 AK = AT 1716 for I = 1; I <= 80; I++ { 1717 PTR = P2R 1718 PTI = P2I 1719 P2R = P1R - (CKR*PTR - CKI*PTI) 1720 P2I = P1I - (CKI*PTR + CKR*PTI) 1721 P1R = PTR 1722 P1I = PTI 1723 CKR = CKR + RZR 1724 CKI = CKI + RZI 1725 AP = zabs(complex(P2R, P2I)) 1726 if AP > TST*AK*AK { 1727 goto Twenty 1728 } 1729 AK = AK + 1.0e0 1730 } 1731 goto OneTen 1732 Twenty: 1733 I = I + 1 1734 K = 0 1735 if INU < IAZ { 1736 goto Forty 1737 } 1738 // COMPUTE RELATIVE TRUNCATION ERROR FOR RATIOS. 1739 P1R = ZEROR 1740 P1I = ZEROI 1741 P2R = CONER 1742 P2I = CONEI 1743 AT = float64(float32(INU)) + 1.0e0 1744 STR = ZR * RAZ 1745 STI = -ZI * RAZ 1746 CKR = STR * AT * RAZ 1747 CKI = STI * AT * RAZ 1748 ACK = AT * RAZ 1749 TST = dsqrt(ACK / TOL) 1750 ITIME = 1 1751 for K = 1; K <= 80; K++ { 1752 PTR = P2R 1753 PTI = P2I 1754 P2R = P1R - (CKR*PTR - CKI*PTI) 1755 P2I = P1I - (CKR*PTI + CKI*PTR) 1756 P1R = PTR 1757 P1I = PTI 1758 CKR = CKR + RZR 1759 CKI = CKI + RZI 1760 AP = zabs(complex(P2R, P2I)) 1761 if AP < TST { 1762 continue 1763 } 1764 if ITIME == 2 { 1765 goto Forty 1766 } 1767 ACK = zabs(complex(CKR, CKI)) 1768 FLAM = ACK + dsqrt(ACK*ACK-1.0e0) 1769 FKAP = AP / zabs(complex(P1R, P1I)) 1770 RHO = dmin(FLAM, FKAP) 1771 TST = TST * dsqrt(RHO/(RHO*RHO-1.0e0)) 1772 ITIME = 2 1773 } 1774 goto OneTen 1775 Forty: 1776 // BACKWARD RECURRENCE AND SUM NORMALIZING RELATION. 1777 K = K + 1 1778 KK = max(I+IAZ, K+INU) 1779 FKK = float64(float32(KK)) 1780 P1R = ZEROR 1781 P1I = ZEROI 1782 1783 // SCALE P2 AND SUM BY SCLE. 1784 P2R = SCLE 1785 P2I = ZEROI 1786 FNF = FNU - float64(float32(IFNU)) 1787 TFNF = FNF + FNF 1788 BK = dgamln(FKK+TFNF+1.0e0, IDUM) - dgamln(FKK+1.0e0, IDUM) - dgamln(TFNF+1.0e0, IDUM) 1789 BK = dexp(BK) 1790 SUMR = ZEROR 1791 SUMI = ZEROI 1792 KM = KK - INU 1793 for I = 1; I <= KM; I++ { 1794 PTR = P2R 1795 PTI = P2I 1796 P2R = P1R + (FKK+FNF)*(RZR*PTR-RZI*PTI) 1797 P2I = P1I + (FKK+FNF)*(RZI*PTR+RZR*PTI) 1798 P1R = PTR 1799 P1I = PTI 1800 AK = 1.0e0 - TFNF/(FKK+TFNF) 1801 ACK = BK * AK 1802 SUMR = SUMR + (ACK+BK)*P1R 1803 SUMI = SUMI + (ACK+BK)*P1I 1804 BK = ACK 1805 FKK = FKK - 1.0e0 1806 } 1807 YR[N] = P2R 1808 YI[N] = P2I 1809 if N == 1 { 1810 goto Seventy 1811 } 1812 for I = 2; I <= N; I++ { 1813 PTR = P2R 1814 PTI = P2I 1815 P2R = P1R + (FKK+FNF)*(RZR*PTR-RZI*PTI) 1816 P2I = P1I + (FKK+FNF)*(RZI*PTR+RZR*PTI) 1817 P1R = PTR 1818 P1I = PTI 1819 AK = 1.0e0 - TFNF/(FKK+TFNF) 1820 ACK = BK * AK 1821 SUMR = SUMR + (ACK+BK)*P1R 1822 SUMI = SUMI + (ACK+BK)*P1I 1823 BK = ACK 1824 FKK = FKK - 1.0e0 1825 M = N - I + 1 1826 YR[M] = P2R 1827 YI[M] = P2I 1828 } 1829 Seventy: 1830 if IFNU <= 0 { 1831 goto Ninety 1832 } 1833 for I = 1; I <= IFNU; I++ { 1834 PTR = P2R 1835 PTI = P2I 1836 P2R = P1R + (FKK+FNF)*(RZR*PTR-RZI*PTI) 1837 P2I = P1I + (FKK+FNF)*(RZR*PTI+RZI*PTR) 1838 P1R = PTR 1839 P1I = PTI 1840 AK = 1.0e0 - TFNF/(FKK+TFNF) 1841 ACK = BK * AK 1842 SUMR = SUMR + (ACK+BK)*P1R 1843 SUMI = SUMI + (ACK+BK)*P1I 1844 BK = ACK 1845 FKK = FKK - 1.0e0 1846 } 1847 Ninety: 1848 PTR = ZR 1849 PTI = ZI 1850 if KODE == 2 { 1851 PTR = ZEROR 1852 } 1853 tmp = zlog(complex(RZR, RZI)) 1854 STR = real(tmp) 1855 STI = imag(tmp) 1856 P1R = -FNF*STR + PTR 1857 P1I = -FNF*STI + PTI 1858 AP = dgamln(1.0e0+FNF, IDUM) 1859 PTR = P1R - AP 1860 PTI = P1I 1861 1862 // THE DIVISION CEXP(PT)/(SUM+P2) IS ALTERED TO AVOID OVERFLOW 1863 // IN THE DENOMINATOR BY SQUARING LARGE QUANTITIES. 1864 P2R = P2R + SUMR 1865 P2I = P2I + SUMI 1866 AP = zabs(complex(P2R, P2I)) 1867 P1R = 1.0e0 / AP 1868 tmp = zexp(complex(PTR, PTI)) 1869 STR = real(tmp) 1870 STI = imag(tmp) 1871 CKR = STR * P1R 1872 CKI = STI * P1R 1873 PTR = P2R * P1R 1874 PTI = -P2I * P1R 1875 tmp = zmlt(complex(CKR, CKI), complex(PTR, PTI)) 1876 CNORMR = real(tmp) 1877 CNORMI = imag(tmp) 1878 for I = 1; I <= N; I++ { 1879 STR = YR[I]*CNORMR - YI[I]*CNORMI 1880 YI[I] = YR[I]*CNORMI + YI[I]*CNORMR 1881 YR[I] = STR 1882 } 1883 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL 1884 OneTen: 1885 NZ = -2 1886 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL 1887 } 1888 1889 // ZSERI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z)>=0.0 BY 1890 // MEANS OF THE POWER SERIES FOR LARGE CABS(Z) IN THE 1891 // REGION CABS(Z)<=2*SQRT(FNU+1). NZ=0 IS A NORMAL return. 1892 // NZ>0 MEANS THAT THE LAST NZ COMPONENTS WERE SET TO ZERO 1893 // DUE TO UNDERFLOW. NZ<0 MEANS UNDERFLOW OCCURRED, BUT THE 1894 // CONDITION CABS(Z)<=2*SQRT(FNU+1) WAS VIOLATED AND THE 1895 // COMPUTATION MUST BE COMPLETED IN ANOTHER ROUTINE WITH N=N-ABS(NZ). 1896 func zseriOrig(ZR, ZI, FNU float64, KODE, N int, YR, YI []float64, NZ int, TOL, ELIM, ALIM float64) ( 1897 ZRout, ZIout, FNUout float64, KODEout, Nout int, YRout, YIout []float64, NZout int, TOLout, ELIMout, ALIMout float64) { 1898 var AA, ACZ, AK, AK1I, AK1R, ARM, ASCLE, ATOL, 1899 AZ, CKI, CKR, COEFI, COEFR, CONEI, CONER, CRSCR, CZI, CZR, DFNU, 1900 FNUP, HZI, HZR, RAZ, RS, RTR1, RZI, RZR, S, SS, STI, 1901 STR, S1I, S1R, S2I, S2R, ZEROI, ZEROR float64 1902 var I, IB, IDUM, IFLAG, IL, K, L, M, NN, NW int 1903 var WR, WI [3]float64 1904 var tmp complex128 1905 1906 CONER = 1.0 1907 NZ = 0 1908 AZ = zabs(complex(ZR, ZI)) 1909 if AZ == 0.0e0 { 1910 goto OneSixty 1911 } 1912 // TODO(btracey) 1913 // The original fortran line is "ARM = 1.0D+3*D1MACH(1)". Evidently, in Fortran 1914 // this is interpreted as one to the power of +3*D1MACH(1). While it is possible 1915 // this was intentional, it seems unlikely. 1916 //ARM = 1.0E0 + 3*dmach[1] 1917 //math.Pow(1, 3*dmach[1]) 1918 ARM = 1000 * dmach[1] 1919 RTR1 = dsqrt(ARM) 1920 CRSCR = 1.0e0 1921 IFLAG = 0 1922 if AZ < ARM { 1923 goto OneFifty 1924 } 1925 HZR = 0.5e0 * ZR 1926 HZI = 0.5e0 * ZI 1927 CZR = ZEROR 1928 CZI = ZEROI 1929 if AZ <= RTR1 { 1930 goto Ten 1931 } 1932 tmp = zmlt(complex(HZR, HZI), complex(HZR, HZI)) 1933 CZR = real(tmp) 1934 CZI = imag(tmp) 1935 Ten: 1936 ACZ = zabs(complex(CZR, CZI)) 1937 NN = N 1938 tmp = zlog(complex(HZR, HZI)) 1939 CKR = real(tmp) 1940 CKI = imag(tmp) 1941 Twenty: 1942 DFNU = FNU + float64(float32(NN-1)) 1943 FNUP = DFNU + 1.0e0 1944 1945 // UNDERFLOW TEST. 1946 AK1R = CKR * DFNU 1947 AK1I = CKI * DFNU 1948 AK = dgamln(FNUP, IDUM) 1949 AK1R = AK1R - AK 1950 if KODE == 2 { 1951 AK1R = AK1R - ZR 1952 } 1953 if AK1R > (-ELIM) { 1954 goto Forty 1955 } 1956 Thirty: 1957 NZ = NZ + 1 1958 YR[NN] = ZEROR 1959 YI[NN] = ZEROI 1960 if ACZ > DFNU { 1961 goto OneNinety 1962 } 1963 NN = NN - 1 1964 if NN == 0 { 1965 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 1966 } 1967 goto Twenty 1968 Forty: 1969 if AK1R > (-ALIM) { 1970 goto Fifty 1971 } 1972 IFLAG = 1 1973 SS = 1.0e0 / TOL 1974 CRSCR = TOL 1975 ASCLE = ARM * SS 1976 Fifty: 1977 AA = dexp(AK1R) 1978 if IFLAG == 1 { 1979 AA = AA * SS 1980 } 1981 COEFR = AA * dcos(AK1I) 1982 COEFI = AA * dsin(AK1I) 1983 ATOL = TOL * ACZ / FNUP 1984 IL = min(2, NN) 1985 for I = 1; I <= IL; I++ { 1986 DFNU = FNU + float64(float32(NN-I)) 1987 FNUP = DFNU + 1.0e0 1988 S1R = CONER 1989 S1I = CONEI 1990 if ACZ < TOL*FNUP { 1991 goto Seventy 1992 } 1993 AK1R = CONER 1994 AK1I = CONEI 1995 AK = FNUP + 2.0e0 1996 S = FNUP 1997 AA = 2.0e0 1998 Sixty: 1999 RS = 1.0e0 / S 2000 STR = AK1R*CZR - AK1I*CZI 2001 STI = AK1R*CZI + AK1I*CZR 2002 AK1R = STR * RS 2003 AK1I = STI * RS 2004 S1R = S1R + AK1R 2005 S1I = S1I + AK1I 2006 S = S + AK 2007 AK = AK + 2.0e0 2008 AA = AA * ACZ * RS 2009 if AA > ATOL { 2010 goto Sixty 2011 } 2012 Seventy: 2013 S2R = S1R*COEFR - S1I*COEFI 2014 S2I = S1R*COEFI + S1I*COEFR 2015 WR[I] = S2R 2016 WI[I] = S2I 2017 if IFLAG == 0 { 2018 goto Eighty 2019 } 2020 S2R, S2I, NW, ASCLE, TOL = zuchkOrig(S2R, S2I, NW, ASCLE, TOL) 2021 if NW != 0 { 2022 goto Thirty 2023 } 2024 Eighty: 2025 M = NN - I + 1 2026 YR[M] = S2R * CRSCR 2027 YI[M] = S2I * CRSCR 2028 if I == IL { 2029 continue 2030 } 2031 tmp = zdiv(complex(COEFR, COEFI), complex(HZR, HZI)) 2032 STR = real(tmp) 2033 STI = imag(tmp) 2034 COEFR = STR * DFNU 2035 COEFI = STI * DFNU 2036 } 2037 if NN <= 2 { 2038 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 2039 } 2040 K = NN - 2 2041 AK = float64(float32(K)) 2042 RAZ = 1.0e0 / AZ 2043 STR = ZR * RAZ 2044 STI = -ZI * RAZ 2045 RZR = (STR + STR) * RAZ 2046 RZI = (STI + STI) * RAZ 2047 if IFLAG == 1 { 2048 goto OneTwenty 2049 } 2050 IB = 3 2051 OneHundred: 2052 for I = IB; I <= NN; I++ { 2053 YR[K] = (AK+FNU)*(RZR*YR[K+1]-RZI*YI[K+1]) + YR[K+2] 2054 YI[K] = (AK+FNU)*(RZR*YI[K+1]+RZI*YR[K+1]) + YI[K+2] 2055 AK = AK - 1.0e0 2056 K = K - 1 2057 } 2058 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 2059 2060 // RECUR BACKWARD WITH SCALED VALUES. 2061 OneTwenty: 2062 // EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION ABOVE THE 2063 // UNDERFLOW LIMIT = ASCLE = dmach[1)*SS*1.0D+3. 2064 S1R = WR[1] 2065 S1I = WI[1] 2066 S2R = WR[2] 2067 S2I = WI[2] 2068 for L = 3; L <= NN; L++ { 2069 CKR = S2R 2070 CKI = S2I 2071 S2R = S1R + (AK+FNU)*(RZR*CKR-RZI*CKI) 2072 S2I = S1I + (AK+FNU)*(RZR*CKI+RZI*CKR) 2073 S1R = CKR 2074 S1I = CKI 2075 CKR = S2R * CRSCR 2076 CKI = S2I * CRSCR 2077 YR[K] = CKR 2078 YI[K] = CKI 2079 AK = AK - 1.0e0 2080 K = K - 1 2081 if zabs(complex(CKR, CKI)) > ASCLE { 2082 goto OneFourty 2083 } 2084 } 2085 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 2086 OneFourty: 2087 IB = L + 1 2088 if IB > NN { 2089 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 2090 } 2091 goto OneHundred 2092 OneFifty: 2093 NZ = N 2094 if FNU == 0.0e0 { 2095 NZ = NZ - 1 2096 } 2097 OneSixty: 2098 YR[1] = ZEROR 2099 YI[1] = ZEROI 2100 if FNU != 0.0e0 { 2101 goto OneSeventy 2102 } 2103 YR[1] = CONER 2104 YI[1] = CONEI 2105 OneSeventy: 2106 if N == 1 { 2107 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 2108 } 2109 for I = 2; I <= N; I++ { 2110 YR[I] = ZEROR 2111 YI[I] = ZEROI 2112 } 2113 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 2114 2115 // return WITH NZ<0 if CABS(Z*Z/4)>FNU+N-NZ-1 COMPLETE 2116 // THE CALCULATION IN CBINU WITH N=N-IABS(NZ) 2117 2118 OneNinety: 2119 NZ = -NZ 2120 return ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM 2121 } 2122 2123 // ZS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE 2124 // ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON- 2125 // TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION. 2126 // ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF 2127 // MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER 2128 // OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE 2129 // PRECISION ABOVE THE UNDERFLOW LIMIT. 2130 func zs1s2Orig(ZRR, ZRI, S1R, S1I, S2R, S2I float64, NZ int, ASCLE, ALIM float64, IUF int) ( 2131 ZRRout, ZRIout, S1Rout, S1Iout, S2Rout, S2Iout float64, NZout int, ASCLEout, ALIMout float64, IUFout int) { 2132 var AA, ALN, AS1, AS2, C1I, C1R, S1DI, S1DR, ZEROI, ZEROR float64 2133 var tmp complex128 2134 2135 ZEROR = 0 2136 ZEROI = 0 2137 NZ = 0 2138 AS1 = zabs(complex(S1R, S1I)) 2139 AS2 = zabs(complex(S2R, S2I)) 2140 if S1R == 0.0e0 && S1I == 0.0e0 { 2141 goto Ten 2142 } 2143 if AS1 == 0.0e0 { 2144 goto Ten 2145 } 2146 ALN = -ZRR - ZRR + dlog(AS1) 2147 S1DR = S1R 2148 S1DI = S1I 2149 S1R = ZEROR 2150 S1I = ZEROI 2151 AS1 = ZEROR 2152 if ALN < (-ALIM) { 2153 goto Ten 2154 } 2155 tmp = zlog(complex(S1DR, S1DI)) 2156 C1R = real(tmp) 2157 C1I = imag(tmp) 2158 2159 C1R = C1R - ZRR - ZRR 2160 C1I = C1I - ZRI - ZRI 2161 tmp = zexp(complex(C1R, C1I)) 2162 S1R = real(tmp) 2163 S1I = imag(tmp) 2164 AS1 = zabs(complex(S1R, S1I)) 2165 IUF = IUF + 1 2166 Ten: 2167 AA = dmax(AS1, AS2) 2168 if AA > ASCLE { 2169 return ZRR, ZRI, S1R, S1I, S2R, S2I, NZ, ASCLE, ALIM, IUF 2170 } 2171 S1R = ZEROR 2172 S1I = ZEROI 2173 S2R = ZEROR 2174 S2I = ZEROI 2175 NZ = 1 2176 IUF = 0 2177 return ZRR, ZRI, S1R, S1I, S2R, S2I, NZ, ASCLE, ALIM, IUF 2178 } 2179 2180 // ZSHCH COMPUTES THE COMPLEX HYPERBOLIC FUNCTIONS CSH=SINH(X+iY) AND 2181 // CCH=COSH(X+I*Y), WHERE I**2=-1. 2182 // TODO(btracey): use cmplx.Sinh and cmplx.Cosh. 2183 func zshchOrig(ZR, ZI, CSHR, CSHI, CCHR, CCHI float64) (ZRout, ZIout, CSHRout, CSHIout, CCHRout, CCHIout float64) { 2184 var CH, CN, SH, SN float64 2185 SH = math.Sinh(ZR) 2186 CH = math.Cosh(ZR) 2187 SN = dsin(ZI) 2188 CN = dcos(ZI) 2189 CSHR = SH * CN 2190 CSHI = CH * SN 2191 CCHR = CH * CN 2192 CCHI = SH * SN 2193 return ZR, ZI, CSHR, CSHI, CCHR, CCHI 2194 } 2195 2196 func dmax(a, b float64) float64 { 2197 return math.Max(a, b) 2198 } 2199 2200 func dmin(a, b float64) float64 { 2201 return math.Min(a, b) 2202 } 2203 2204 func dabs(a float64) float64 { 2205 return math.Abs(a) 2206 } 2207 2208 func datan(a float64) float64 { 2209 return math.Atan(a) 2210 } 2211 2212 func dtan(a float64) float64 { 2213 return math.Tan(a) 2214 } 2215 2216 func dlog(a float64) float64 { 2217 return math.Log(a) 2218 } 2219 2220 func dsin(a float64) float64 { 2221 return math.Sin(a) 2222 } 2223 2224 func dcos(a float64) float64 { 2225 return math.Cos(a) 2226 } 2227 2228 func dexp(a float64) float64 { 2229 return math.Exp(a) 2230 } 2231 2232 func dsqrt(a float64) float64 { 2233 return math.Sqrt(a) 2234 } 2235 2236 func zmlt(a, b complex128) complex128 { 2237 return a * b 2238 } 2239 2240 func zdiv(a, b complex128) complex128 { 2241 return a / b 2242 } 2243 2244 func zabs(a complex128) float64 { 2245 return cmplx.Abs(a) 2246 } 2247 2248 func zsqrt(a complex128) complex128 { 2249 return cmplx.Sqrt(a) 2250 } 2251 2252 func zexp(a complex128) complex128 { 2253 return cmplx.Exp(a) 2254 } 2255 2256 func zlog(a complex128) complex128 { 2257 return cmplx.Log(a) 2258 } 2259 2260 // Zshch computes the hyperbolic sin and cosine of the input z. 2261 func Zshch(z complex128) (sinh, cosh complex128) { 2262 return cmplx.Sinh(z), cmplx.Cosh(z) 2263 }