NLSL
cd2km.f90
Go to the documentation of this file.
1 c Version 1.6 8/12/94
2 c**********************************************************************
3 c =========================
4 c subroutine CD2KM
5 c =========================
6 c
7 c 2
8 c Calculate D (alpha,beta,gamma) as in "Angular Momentum"
9 c k,m
10 c by Brink and Satchler, p.24, 2nd ed., Clarendon Press,
11 c Oxford (1979).
12 c
13 c 2
14 c note : d2km(1,i+3,j+3)=real{ D (alpha,beta,gamma) }
15 c i,j
16 c
17 c 2
18 c d2km(2,i+3,j+3)=imag{ D (alpha,beta,gamma) }
19 c i,j
20 c
21 c written by DEB using original routines of DJS and GM
22 c
23 c Includes:
24 c rndoff.inc
25 c pidef.inc
26 c
27 c Uses:
28 c setcs.f (coded below)
29 c
30 c**********************************************************************
31 c
32  subroutine cd2km(d2km,alpha,beta,gamma)
33 c
34  use pidef
35  use rnddbl
36 c
37  implicit none
38  double precision alpha,beta,gamma,d2km(2,5,5)
39 c
40  double precision dsq32,dsq38,d,cb,sb,cb2,sb2,rd
41  integer i,j
42 c
43 c######################################################################
44 c
45  dsq32=dsqrt(3.0d0/2.0d0)
46  dsq38=dsqrt(3.0d0/8.0d0)
47 c
48  rd=beta*pi/180.0d0
49  cb=dcos(rd)
50  sb=dsin(rd)
51  cb2=cb*cb
52  sb2=sb*sb
53 c
54 c----------------------------------------------------------------------
55 c Set real parts of D2KM elements first
56 c----------------------------------------------------------------------
57  d2km(1,5,5)=0.25d0*(1.0d0+cb)*(1.0d0+cb)
58  d2km(1,1,1)=d2km(1,5,5)
59 c
60  d2km(1,5,4)=-0.5d0*sb*(1.0d0+cb)
61  d2km(1,4,5)=-d2km(1,5,4)
62  d2km(1,1,2)=-d2km(1,5,4)
63  d2km(1,2,1)=d2km(1,5,4)
64 c
65  d2km(1,5,3)=dsq38*sb2
66  d2km(1,3,5)=d2km(1,5,3)
67  d2km(1,1,3)=d2km(1,5,3)
68  d2km(1,3,1)=d2km(1,5,3)
69 c
70  d2km(1,5,2)=0.5d0*sb*(cb-1.0d0)
71  d2km(1,4,1)=d2km(1,5,2)
72  d2km(1,1,4)=-d2km(1,5,2)
73  d2km(1,2,5)=-d2km(1,5,2)
74 c
75  d2km(1,5,1)=(0.5d0*(1.0d0-cb))**2
76  d2km(1,1,5)=d2km(1,5,1)
77 c
78  d2km(1,4,4)=0.5d0*(2.0d0*cb-1.0d0)*(cb+1.0d0)
79  d2km(1,2,2)=d2km(1,4,4)
80 c
81  d2km(1,4,2)=0.5d0*(2.0d0*cb+1.0d0)*(1.0d0-cb)
82  d2km(1,2,4)=d2km(1,4,2)
83 c
84  d2km(1,4,3)=-dsq32*sb*cb
85  d2km(1,3,2)=d2km(1,4,3)
86  d2km(1,3,4)=-d2km(1,4,3)
87  d2km(1,2,3)=-d2km(1,4,3)
88 c
89  d2km(1,3,3)=0.5d0*(3.0d0*cb2-1.0d0)
90 c
91 c----------------------------------------------------------------------
92 c Set imaginary part of D2KM elements
93 c----------------------------------------------------------------------
94  if (dabs(alpha).gt.rndoff .or. dabs(gamma).gt.rndoff) then
95  do i=1,5
96  do j=1,5
97  d=(i-3)*alpha+(j-3)*gamma
98  rd=dmod(d,360.0d0)*pi/180.0d0
99  d2km(2,i,j)=-d2km(1,i,j)*dsin(rd)
100  d2km(1,i,j)=d2km(1,i,j)*dcos(rd)
101  end do
102  end do
103  else
104 c----------------------------------------------------------------------
105 c alpha, gamma zero: no imaginary elements
106 c----------------------------------------------------------------------
107  do i=1,5
108  do j=1,5
109  d2km(2,i,j)=0.0d0
110  end do
111  end do
112  end if
113 c
114  return
115  end
cd2km
subroutine cd2km(d2km, alpha, beta, gamma)
Definition: cd2km.f90:33
pidef::pi
double precision, parameter pi
Definition: pidef.f90:15
rnddbl::rndoff
double precision, parameter rndoff
Definition: rnddbl.f90:86
pidef
Definition: pidef.f90:12