1 | ! **************************************************************
|
---|
2 | !
|
---|
3 | ! This file contains the subroutines: difang,addang
|
---|
4 | !
|
---|
5 | ! Copyright 2003 Frank Eisenmenger, U.H.E. Hansmann,
|
---|
6 | ! Shura Hayryan, Chin-Ku
|
---|
7 | ! Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann,
|
---|
8 | ! Jan H. Meinke, Sandipan Mohanty
|
---|
9 | !
|
---|
10 | ! **************************************************************
|
---|
11 |
|
---|
12 | real*8 function difang(a1,a2)
|
---|
13 |
|
---|
14 | ! ......................................................
|
---|
15 | ! PURPOSE: difang = a2 - a1 with: -pi < difang <= pi
|
---|
16 | !
|
---|
17 | ! INPUT: a1,a2-two angles [rad.]
|
---|
18 | !
|
---|
19 | ! CALLS: none
|
---|
20 | !
|
---|
21 | ! ......................................................
|
---|
22 |
|
---|
23 | implicit none
|
---|
24 | double precision pi, pi2, d, a2, a1
|
---|
25 | parameter (pi=3.141592653589793d0,
|
---|
26 | & pi2=2.d0*pi)
|
---|
27 |
|
---|
28 | d=mod((a2-a1),pi2)
|
---|
29 | if (abs(d).le.pi) then
|
---|
30 | difang=d
|
---|
31 | else
|
---|
32 | difang=d-sign(pi2,d)
|
---|
33 | endif
|
---|
34 |
|
---|
35 | return
|
---|
36 | end
|
---|
37 | ! *********************************
|
---|
38 | real*8 function addang(a1,a2)
|
---|
39 |
|
---|
40 | ! ......................................................
|
---|
41 | ! PURPOSE: addang = a1 + a2 with: -pi < addang <= pi
|
---|
42 | !
|
---|
43 | ! INPUT: a1,a2-two angles [rad.]
|
---|
44 | !
|
---|
45 | ! CALLS: none
|
---|
46 | !
|
---|
47 | ! ......................................................
|
---|
48 |
|
---|
49 | implicit none
|
---|
50 | double precision pi, pi2, d, a1, a2
|
---|
51 |
|
---|
52 | parameter (pi=3.141592653589793d0,
|
---|
53 | & pi2=2.d0*pi)
|
---|
54 |
|
---|
55 | d=mod((a1+a2),pi2)
|
---|
56 | if (abs(d).le.pi) then
|
---|
57 | addang=d
|
---|
58 | else
|
---|
59 | addang=d-sign(pi2,d)
|
---|
60 | endif
|
---|
61 |
|
---|
62 | return
|
---|
63 | end
|
---|
64 |
|
---|