system/std.zusatz/1.8.7/src/complex

Raw file
Back to index

  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
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;