NLSL: cfs.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

cfs.f90
Go to the documentation of this file.
1 c Version 1.3.2 5/1/92
2 c**********************************************************************
3 c
4 c (C)ontinued (F)raction (S)pectral calculation
5 c ===============================================
6 c
7 c This routine calculates a continued fraction of the form
8 c
9 c 1
10 c v(z) = ----------------
11 c a(1) - z - b(1)
12 c ----------------
13 c a(2) - z - b(2)
14 c ----------------
15 c a(3) - z - b(3)
16 c .
17 c .
18 c .
19 c - b(n-1)
20 c ----------
21 c a(n) - z
22 c
23 c
24 c Notes:
25 c 1) continued-fraction value OR its first derivative are returned
26 c in val for all nz values of z in a single call. Choice of first
27 c derivative is specified by setting ideriv .ne. 0
28 c 2) z is assumed to be a REAL number (not the general case)
29 c 3) A complex-valued diagonal shift w may be added to the a vector
30 c
31 c written 30-SEP-90 DJS
32 c modified 5-MAY-92 DEB for use with EPRLL/EPRCGL and EPRLF/EPRCGF
33 c
34 c The routine returns a spectrum calculated from both the absorption
35 c and dispersion parts of the spectrum using the given phase angle
36 c (in degrees)
37 c
38 c Code modified from CFVD program of D.J. Schneider,
39 c
40 c**********************************************************************
41 c
42 subroutine cfs(a,b,n,z0,dz,nz,w,ideriv,phs,val)
43 c
44 implicit none
45 c
46 integer ideriv,n,nz
47 double precision w,z,z0,dz,phs,val(nz)
48 double complex a(n),b(n),ephs
49 c
50 integer iz,k,ictr
51 double complex tv,td,s,x
52 c
53 double complex unity,ci
54 parameter(unity=(1.0d0,0.0d0),ci=(0.0d0,1.0d0))
55 c
56 double precision RADIAN
57 parameter(radian=0.174532925199433d-01)
58 c
59 c######################################################################
60 c
61 ephs=dcmplx( dcos(radian*phs), dsin(radian*phs) )
62 c
63 c -----------------------------------------------------------------
64 c Compute 0th derivative of continued fraction with respect to z
65 c -----------------------------------------------------------------
66 if (ideriv.eq.0) then
67 z=z0-dz
68 do iz=1,nz
69 z=z+dz
70 x=dcmplx(w,z)
71 s=unity/(a(n)+x)
72 tv=s*b(n-1)*b(n-1)
73 td=-tv*s
74 do k=n-1,2,-1
75 s=unity/(a(k)+x-tv)
76 tv=s*b(k-1)*b(k-1)
77 end do
78 s=unity/(a(1)+x-tv)
79 tv=s
80 val(iz)=dreal(ephs*tv)
81 end do
82 c
83 c -----------------------------------------------------------------
84 c Compute 1st derivative of continued fraction with respect to z
85 c -----------------------------------------------------------------
86 else
87 z=z0-dz
88 do iz=1,nz
89 z=z+dz
90 x=dcmplx(w,z)
91 s=unity/(a(n)+x)
92 tv=s*b(n-1)*b(n-1)
93 td=-tv*s
94 do k=n-1,2,-1
95 s=unity/(a(k)+x-tv)
96 tv=s*b(k-1)*b(k-1)
97 td=-tv*(unity-td)*s
98 end do
99 s=unity/(a(1)+x-tv)
100 tv=s
101 val(iz)=dreal( ephs*ci*tv*(unity-td)*s )
102 end do
103 end if
104 c
105 c -----------------------------------------------------------
106 c Special check to eliminate spikes near center of spectrum
107 c -----------------------------------------------------------
108 ictr=1.5d0-z0/dz
109 if(ictr .gt. 1 .and. ictr .lt. iz-1) then
110 if ( abs(val(ictr)-val(ictr-1))+abs(val(ictr)-val(ictr+1))
111 # .gt. 3.0d0*abs(val(ictr+1)-val(ictr-1)) )
112 # val(ictr)=0.5d0*(val(ictr+1)+val(ictr-1) )
113 end if
114 c
115 return
116 end
cfs
subroutine cfs(a, b, n, z0, dz, nz, w, ideriv, phs, val)
Definition: cfs.f90:43