summaryrefslogtreecommitdiff
path: root/system/std.zusatz/1.8.7/src/complex
blob: e2139d07741df03484a4e4f093fe3061b0108d36 (plain)
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 
PACKET complex DEFINES COMPLEX,:=,complex zero,complex one,complex i, 
                       complex,realpart,imagpart,CONJ,+,-,*,/,=,<>, 
                       put,get, ABS, sqrt, phi, dphi :
 
TYPE COMPLEX = STRUCT(REAL re,im); 
COMPLEX PROC complex zero: COMPLEX :(0.0,0.0). END PROC complex zero; 
COMPLEX PROC complex one : COMPLEX :(1.0,0.0). END PROC complex one; 
COMPLEX PROC complex i   : COMPLEX :(0.0,1.0). END PROC complex i; 
 
OP := (COMPLEX VAR dest, COMPLEX CONST source) :
 
  CONCR (dest) := CONCR (source)
 
ENDOP := ;
 
COMPLEX PROC complex(REAL CONST re,im): 
   COMPLEX :(re,im). 
END PROC complex; 
 
REAL PROC realpart(COMPLEX CONST number): 
           number.re. 
END PROC realpart; 
 
REAL PROC imagpart(COMPLEX CONST number): 
           number.im. 
END PROC imagpart ;
 
COMPLEX OP CONJ(COMPLEX CONST number): 
   COMPLEX :( number.re,- number.im). 
END OP CONJ; 
 
BOOL OP =(COMPLEX CONST a,b): 
   IF   a.re=b.re 
   THEN a.im=b.im 
   ELSE FALSE 
   FI. 
END OP =; 
 
BOOL OP <>(COMPLEX CONST a,b): 
   IF   a.re=b.re 
   THEN a.im<>b.im 
   ELSE TRUE 
   FI. 
END OP <>; 
 
COMPLEX OP +(COMPLEX CONST a,b): 
   COMPLEX :(a.re+b.re,a.im+b.im). 
END OP +; 
 
COMPLEX OP -(COMPLEX CONST a,b): 
   COMPLEX :(a.re-b.re,a.im-b.im). 
END OP -; 
 
COMPLEX OP *(COMPLEX CONST a,b): 
   REAL VAR re of a::a.re,im of a ::a.im, 
            re of b::b.re,im of b ::b.im; 
   COMPLEX :(re of a*re of b- im of a *im of b, 
             re of a*im of b+ im of a*re of b). 
END OP *; 
 
COMPLEX OP /(COMPLEX CONST a,b): 
   REAL VAR re of a::a.re,im of a::a.im, 
            re of b::b.re,im of b::b.im; 
   REAL VAR sqare sum of re and im ::b.re*b.re+b.im*b.im; 
   COMPLEX :( (re of a * re of b + im of a * im of b)/sqare sum of re and im,
              (im of a *re of b - re of a*im of b)/sqare sum of re and im). 
END OP /; 
 
PROC get(COMPLEX VAR a): 
   REAL VAR realpart,imagpart; 
   get(realpart);get(imagpart); 
   a:= COMPLEX :(realpart,imagpart); 
END PROC get; 
 
PROC put(COMPLEX CONST a): 
   put(a.re);put(" ");put(a.im); 
END PROC put; 
 
REAL PROC dphi(COMPLEX CONST x): 
 IF   imagpart(x)=0.0 THEN reell
 ELIF realpart(x)=0.0 THEN imag 
 ELIF realpart(x)>0.0 THEN realpositiv 
 ELSE realnegativ 
 FI. 
reell: IF sign(realpart(x)) < 0 THEN 180.0 ELSE 0.0 FI. 
imag: IF imagpart(x)>0.0 THEN 90.0 ELSE 270.0 FI. 
realpositiv:IF imagpart(x)>0.0 THEN arctand(realpart(x)/imagpart(x)) 
                               ELSE
arctand(realpart(x)/imagpart(x))+360.0 FI. 
realnegativ: arctand(realpart(x)/imagpart(x))+180.0. 
END PROC dphi; 
 
REAL PROC phi(COMPLEX CONST x): 
dphi(x)*3.141592653689793/180.0. 
END PROC phi; 
 
COMPLEX PROC sqrt(COMPLEX CONST x): 
IF x=complex zero THEN x 
ELIF realpart(x)<0.0 THEN 
complex(imagpart(x)/(2.0*real(sign(imagpart(x)))
        *sqrt((ABSx-realpart(x))/2.0)), 
        real(sign(imagpart(x)))*sqrt((ABS x-realpart(x))/2.0)) 
ELSE complex(sqrt((ABS x+realpart(x))/2.0), 
     imagpart(x)/(2.0*sqrt((ABS x+realpart(x))/2.0)))
FI. 
 
END PROC sqrt; 
 
REAL OP ABS(COMPLEX CONST x): 
 sqrt(realpart(x)*realpart(x)+imagpart(x)*imagpart(x)). 
END OP ABS; 
 
END PACKET complex;