From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 11 Feb 2019 11:49:19 +0100
Subject: Add source files from Michael

---
 system/std.zusatz/1.7.3/src/complex | 133 ++++++++++++++++++++++++++++++++++++
 1 file changed, 133 insertions(+)
 create mode 100644 system/std.zusatz/1.7.3/src/complex

(limited to 'system/std.zusatz/1.7.3/src/complex')

diff --git a/system/std.zusatz/1.7.3/src/complex b/system/std.zusatz/1.7.3/src/complex
new file mode 100644
index 0000000..d62085b
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/complex
@@ -0,0 +1,133 @@
+ 
+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; 
+ 
+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; 
-- 
cgit v1.2.3