← Back to branch summary

~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/signal/snell.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
routines/signal/snell.f
 
1
C/MEMBR ADD NAME=SNELL,SSI=0
 
2
      subroutine snell(dsn2,du, dk, dq)
 
3
c!purpose
 
4
c calculation of the jacobi's elliptic function sn(u,k)
 
5
c
 
6
c external calculation of the parameter necessary
 
7
c dk = k($k)
 
8
c dq = exp(-pi*k'/k) ... (jacobi's nome)
 
9
c!
 
10
c
 
11
      double precision dpi, domi
 
12
      double precision de, dz, dpi2, dq, dm, du, dk, dc, dqq, dh, dq1,
 
13
     *    dq2
 
14
c
 
15
      domi=2.0d+0*dlamch('p')
 
16
      dpi=4.0d+0*atan(1.0d+0)
 
17
c
 
18
      data de, dz /1.0d+0,2.0d+0/
 
19
c
 
20
      dpi2 = dpi/dz
 
21
      if (abs(dq).ge.de) go to 30
 
22
c
 
23
      dm = dpi2*du/dk
 
24
      dc = dz*dm
 
25
      dc =  cos(dc)
 
26
c
 
27
      dm =  sin(dm)*dk/dpi2
 
28
      dqq = dq*dq
 
29
      dq1 = dq
 
30
      dq2 = dqq
 
31
c
 
32
      do 10 i=1,100
 
33
        dh = (de-dq1)/(de-dq2)
 
34
        dh = dh*dh
 
35
        dh = dh*(de-dz*dq2*dc+dq2*dq2)
 
36
        dh = dh/(de-dz*dq1*dc+dq1*dq1)
 
37
        dm = dm*dh
 
38
c
 
39
        dh = abs(de-dh)
 
40
        if (dh.lt.domi) go to 20
 
41
c
 
42
        dq1 = dq1*dqq
 
43
        dq2 = dq2*dqq
 
44
  10  continue
 
45
c
 
46
      go to 30
 
47
c
 
48
  20  dsn2 = dm
 
49
      return
 
50
c
 
51
  30  dsn2 = 0.0d+0
 
52
      return
 
53
      end