blob: 7b4cf0dfed55ef2c0a08b86214f23383982197a9 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
real*8 function wavecalc(point,npt,c)
c******************************************************************************
c this routine returns the wavelength of a given channel number
c******************************************************************************
implicit real*8 (a-h,o-z)
real*4 point
real*8 c(9)
if (c(9) == 1.) go to 20
if (c(9) == 2.) go to 40
if (c(9) == 3.) go to 30
c*****no wavelength solution exists
if (c(1)==0. .or. c(2)==0.) then
wavecalc = point
c*****an ordinary polynomial solution
else
dn = point
wavecalc = c(1)+dn*(c(2)+dn*(c(3)+dn*(c(4)+
. dn*(c(5)+dn*c(6)))))
endif
return
c*****a Chebyshev polynomial solution
20 xpt = (2.*point-real(npt+1))/real(npt-1)
wavecalc = c(1) +
. c(2)*xpt +
. c(3)*(2.*xpt**2-1.) +
. c(4)*xpt*(4.*xpt**2-3.) +
. c(5)*(8.*xpt**4-8.*xpt**2+1.) +
. c(6)*xpt*(16.*xpt**4-20.*xpt**2+5.)
return
c*****a spline3 solution
30 s = (point-1.)/(real(npt)-1.)*c(8)
j = int(s)
a = real(j+1) - s
b = s - real(j)
z0 = a**3
z1 = 1. + 3.*a*(1.+a*b)
z2 = 1. + 3.*b*(1.+a*b)
z3 = b**3
wavecalc = c(j+1)*z0 + c(j+2)*z1 + c(j+3)*z2 + c(j+4)*z3
return
c*****a Legendre polynomial solution
40 xpt = (2.*point-real(npt+1))/real(npt-1)
wavecalc = c(1) + c(2)*xpt
return
end
|
