summaryrefslogtreecommitdiff
path: root/system/std.zusatz/1.8.7/src/complex
diff options
context:
space:
mode:
Diffstat (limited to 'system/std.zusatz/1.8.7/src/complex')
-rw-r--r--system/std.zusatz/1.8.7/src/complex115
1 files changed, 115 insertions, 0 deletions
diff --git a/system/std.zusatz/1.8.7/src/complex b/system/std.zusatz/1.8.7/src/complex
new file mode 100644
index 0000000..e2139d0
--- /dev/null
+++ b/system/std.zusatz/1.8.7/src/complex
@@ -0,0 +1,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;
+