Mercurial > hg > octave-lyh

annotate libcruft/amos/zbunk.f @ 7500:2df882e69f13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
use QR decomposition and normalization for polyfit; normalization for polyval
author Ben Abbott <bpabbott@mac.com>
date Tue, 19 Feb 2008 07:28:40 -0500
parents 8b0cb8f79fdc
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
3217
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
1 SUBROUTINE ZBUNK(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM,
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
2 * ALIM)
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
3 C***BEGIN PROLOGUE ZBUNK
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
4 C***REFER TO ZBESK,ZBESH
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
5 C
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
6 C ZBUNK COMPUTES THE K BESSEL FUNCTION FOR FNU.GT.FNUL.
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
7 C ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR K(FNU,Z)
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
8 C IN ZUNK1 AND THE EXPANSION FOR H(2,FNU,Z) IN ZUNK2
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
9 C
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
10 C***ROUTINES CALLED ZUNK1,ZUNK2
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
11 C***END PROLOGUE ZBUNK
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
12 C COMPLEX Y,Z
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
13 DOUBLE PRECISION ALIM, AX, AY, ELIM, FNU, TOL, YI, YR, ZI, ZR
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
14 INTEGER KODE, MR, N, NZ
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
15 DIMENSION YR(N), YI(N)
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
16 NZ = 0
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
17 AX = DABS(ZR)*1.7321D0
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
18 AY = DABS(ZI)
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
19 IF (AY.GT.AX) GO TO 10
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
20 C-----------------------------------------------------------------------
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
21 C ASYMPTOTIC EXPANSION FOR K(FNU,Z) FOR LARGE FNU APPLIED IN
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
22 C -PI/3.LE.ARG(Z).LE.PI/3
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
23 C-----------------------------------------------------------------------
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
24 CALL ZUNK1(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, ALIM)
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
25 GO TO 20
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
26 10 CONTINUE
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
27 C-----------------------------------------------------------------------
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
28 C ASYMPTOTIC EXPANSION FOR H(2,FNU,Z*EXP(M*HPI)) FOR LARGE FNU
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
29 C APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
30 C AND HPI=PI/2
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
31 C-----------------------------------------------------------------------
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
32 CALL ZUNK2(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, ALIM)
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
33 20 CONTINUE
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
34 RETURN
8b0cb8f79fdc [project @ 1998-11-11 23:32:20 by jwe]
jwe
parents:
diff changeset
35 END