'********************************************** '* COMPLEX CALCULATOR * '* ------------------------------------------ * '* Ref.: "Mathematiques en Turbo-Pascal By * '* M. Ducamp and A. Reverchon (vol 2), * '* Eyrolles, Paris, 1988" [BIBLI 05]. * '* ------------------------------------------ * '* SAMPLE RUN: * '* * '* Calculate: sqrt((5-i)*Ln(3+2i)) * '* * '* Enter operation: xa Real part: 5 * '* Imaginary part: -1 * '* Enter operation: sto0 * '* Enter operation: xa Real part: 3 * '* Imaginary part: 2 * '* Enter operation: sto1 * '* Enter operation: ln * '* Enter operation: sto2 * '* Enter operation: '*' * '* Enter operation: sto3 * '* Enter operation: sqr * '* Enter operation: sto4 * '* * '* (result is: 2.6640487 + i 0.3110939) * '* * '* Basic version by J-P Moreau, Paris. * '* (www.jpmoreau.fr) * '********************************************** ' The screen should look like that: ' COMPLEX NUMBERS CALCULATOR IN INVERSE POLISH NOTATION ' ------------------------------------------------------------------- ' ALGEBRAIC FORM POLAR FORM ' T 0.0000000 ' Z 0.0000000 ' Y 0.0000000 ' X 2.6640487 + i 0.3110939 2.6821511 EXP+i 0.1162483 ' ------------------------------------------------------------------- ' M0 5.0000000 - i 1.0000000 5.0990195 EXP-i 0.1973956 ' M1 3.0000000 + i 2.0000000 3.6055513 EXP+i 0.5880026 ' M2 1.2824747 + i 0.5880026 1.4108467 EXP+i 0.4298922 ' M3 7.0003760 + i 1.6575383 7.1939348 EXP+i 0.2324967 ' M4 2.6640487 + i 0.3110939 2.6821511 EXP+i 0.1162483 ' M5 0.0000000 ' M6 0.0000000 ' M7 0.0000000 ' M8 0.0000000 ' M9 0.0000000 ' ------------------------------------------------------------------- ' + - * / 1/X X^2 SQR ^ EXP LN ' SIN COS TAN SH CH TH ARCSIN ARCCOS ARCTAN ARGCH ' ARGSH ARGTH XA XP CLX CLS CLM STOx RCLx Q ' ------------------------------------------------------------------- ' Enter operation: ' ' ' Command explanations: ' XA: enter a complex number x+iy, by giving x and y. ' XP: enter a complex number r*exp(i*t), by giving r and t. ' CLX: stack register X is set to 0 and stack is shifted downwards. ' This allows to correct an input mistake. ' CLS: All four stack registers are set to 0. ' STOx: x from 0 to 9. stores X content in memory number x. ' RCLx: x from 0 to 9, recalls content of memory x in X register. ' The stack is previously shifted upwards. ' CLM: All ten memories are set to 0. ' Q: Quit program. '---------------------------------------------------------------------- defdbl a-h,o-z defint i,n dim stack1(1:4),stack2(1:4),stack3(1:4),stack4(1:4) dim xmemory0(1:4),xmemory1(1:4),xmemory2(1:4),xmemory3(1:4) dim xmemory4(1:4),xmemory5(1:4),xmemory6(1:4),xmemory7(1:4) dim xmemory8(1:4),xmemory9(1:4) 'a complex number z is represented as a table with 4 locations: ' z(1), z(2) for algebraic form x+iy ' z(3), z(4) for polar form r*exp(i*t) dim x(1:4),xx(1:4),yy(1:4),zz(1:4) 'complex numbers PI=3.1415926535 Iresult=0 'after an elementary operation, Iresult=1 'if operation is successful. for i=1 to 4 stack1(i)=0: stack2(i)=0 'set stack to zero stack3(i)=0: stack4(i)=0 next for i=1 to 4 xmemory0(i)=0: xmemory1(i)=0 'set memory to zero xmemory2(i)=0: xmemory3(i)=0 xmemory4(i)=0: xmemory5(i)=0 xmemory6(i)=0: xmemory7(i)=0 xmemory8(i)=0: xmemory9(i)=0 next gosub 700 'call InitDisplay 'initial display 10 input " Enter operation: ", Cmd\$ 'main loop 'enter command if Cmd\$<>"q" then gosub 900 'execute command gosub 700 'display result end if if Cmd\$<>"q" then goto 10 END 'of main program '*************************************************** 500 'Subroutine DownStack(n) if n<1 then n=1 end if for j=n to 3 if j=1 then for i=1 to 4 stack2(i)=stack1(i) next end if if j=2 then for i=1 to 4 stack3(i)=stack2(i) next end if if j=3 then for i=1 to 4 stack4(i)=stack3(i) next end if next j for i=1 to 4 stack4(i)=0 next i return 600 'Subroutine UpStack for j=4 to 2 step -1 if j=4 then for i=1 to 4 stack4(i)=stack3(i) next i end if if j=3 then for i=1 to 4 stack3(i)=stack2(i) next i end if if j=2 then for i=1 to 4 stack2(i)=stack1(i) next i end if next j for i=1 to 4 stack1(i)=0 next i return 700 'Subroutine InitDisplay print print " COMPLEX NUMBERS CALCULATOR IN INVERSE POLISH NOTATION " print "---------------------------------------------------------------" print " ALGEBRAIC FORM POLAR FORM " print " T"; for i=1 to 4 zz(i)=stack4(i) next gosub 1000 print " Z"; for i=1 to 4 zz(i)=stack3(i) next gosub 1000 print " Y"; for i=1 to 4 zz(i)=stack2(i) next gosub 1000 print " X"; for i=1 to 4 zz(i)=stack1(i) next gosub 1000 print "---------------------------------------------------------------" print " M0"; for i=1 to 4 zz(i)=xmemory0(i) next gosub 1000 print " M1"; for i=1 to 4 zz(i)=xmemory1(i) next gosub 1000 print " M2"; for i=1 to 4 zz(i)=xmemory2(i) next gosub 1000 print " M3"; for i=1 to 4 zz(i)=xmemory3(i) next gosub 1000 print " M4"; for i=1 to 4 zz(i)=xmemory4(i) next gosub 1000 print " M5"; for i=1 to 4 zz(i)=xmemory5(i) next gosub 1000 print " M6"; for i=1 to 4 zz(i)=xmemory6(i) next gosub 1000 print " M7"; for i=1 to 4 zz(i)=xmemory7(i) next gosub 1000 print " M8"; for i=1 to 4 zz(i)=xmemory8(i) next gosub 1000 print " M9"; for i=1 to 4 zz(i)=xmemory9(i) next gosub 1000 print "---------------------------------------------------------------" print " + - * / 1/X X^2 SQR ^ EXP LN " print " SIN COS TAN SH CH TH ARCSIN ARCCOS ARCTAN ARGCH " print " ARGSH ARGTH XA XP CLX CLS CLM STOx RCLx Q " print "---------------------------------------------------------------" return 'return number of memory (0 to 9) 800 'subroutine num(c,i) if c\$="0" then ii=0 end if if c\$="1" then ii=1 end if if c\$="2" then ii=2 end if if c\$="3" then ii=3 end if if c\$="4" then ii=4 end if if c\$="5" then ii=5 end if if c\$="6" then ii=6 end if if c\$="7" then ii=7 end if if c\$="8" then ii=8 end if if c\$="9" then ii=9 end if return 'execute command Cmd\$ 900 if Cmd\$="xa" then gosub 600 'call UpStack input " Real part Imaginary part: ", zz(1), zz(2) gosub 1300 'call RectPol(zz) for i=1 to 4 stack1(i)=zz(i) next i return end if if Cmd\$="xp" then gosub 600 'call UpStack input " Modulus Argument: ", zz(3), zz(4) gosub 1400 'call PolRect(zz) for i=1 to 4 stack1(i)=zz(i) next i return end if if Cmd\$="clx" then n=1:gosub 500 'call DownStack(1) return end if if Cmd\$="cls" then for i=1 to 4 stack1(i)=0 : stack2(i)=0 stack3(i)=0 : stack4(i)=0 next i return end if if Cmd\$="clm" then for i=1 to 4 xmemory0(i)=0 : xmemory1(i)=0 : xmemory2(i)=0 xmemory3(i)=0 : xmemory4(i)=0 : xmemory5(i)=0 xmemory6(i)=0 : xmemory7(i)=0 : xmemory8(i)=0 xmemory9(i)=0 next i return end if if Left\$(Cmd\$,3)="sto" then c\$=Right\$(Cmd\$,1): gosub 800 if ii>-1 and ii<10 then for i=1 to 4 if ii=0 then xmemory0(i)=stack1(i) end if if ii=1 then xmemory1(i)=stack1(i) end if if ii=2 then xmemory2(i)=stack1(i) end if if ii=3 then xmemory3(i)=stack1(i) end if if ii=4 then xmemory4(i)=stack1(i) end if if ii=5 then xmemory5(i)=stack1(i) end if if ii=6 then xmemory6(i)=stack1(i) end if if ii=7 then xmemory7(i)=stack1(i) end if if ii=8 then xmemory8(i)=stack1(i) end if if ii=9 then xmemory9(i)=stack1(i) end if next i end if return end if if Left\$(Cmd\$,3)="rcl" then c\$=Right\$(Cmd\$,1): gosub 800 if ii>-1 and ii<10 then for i=1 to 4 if ii=0 then stack1(i)=xmemory0(i) end if if ii=1 then stack1(i)=xmemory1(i) end if if ii=2 then stack1(i)=xmemory2(i) end if if ii=3 then stack1(i)=xmemory3(i) end if if ii=4 then stack1(i)=xmemory4(i) end if if ii=5 then stack1(i)=xmemory5(i) end if if ii=6 then stack1(i)=xmemory6(i) end if if ii=7 then stack1(i)=xmemory7(i) end if if ii=8 then stack1(i)=xmemory8(i) end if if ii=9 then stack1(i)=xmemory9(i) end if next i end if return end if if Cmd\$="+" then for i=1 to 4 xx(i)=stack2(i) yy(i)=stack1(i) next i gosub 1500 'zz=xx+yy for i=1 to 4 stack1(i)=zz(i) next i if Iresult=1 then n=2: gosub 500 'call DownStack(2) return end if end if if Cmd\$="-" then for i=1 to 4 xx(i)=stack2(i) yy(i)=stack1(i) next i gosub 1600 'zz=xx-yy for i=1 to 4 stack1(i)=zz(i) next i if Iresult=1 then n=2: gosub 500 'call DownStack(2) return end if end if if Cmd\$="*" then for i=1 to 4 xx(i)=stack2(i) yy(i)=stack1(i) next i gosub 1700 'zz=xx*yy for i=1 to 4 stack1(i)=zz(i) next i if Iresult=1 then n=2: gosub 500 'call DownStack(2) return end if end if if Cmd\$="/" then for i=1 to 4 xx(i)=stack2(i) yy(i)=stack1(i) next i gosub 1800 'zz=xx/yy for i=1 to 4 stack1(i)=zz(i) next i if Iresult=1 then n=2: gosub 500 'call DownStack(2) return end if end if if Cmd\$="^" then for i=1 to 4 xx(i)=stack2(i) yy(i)=stack1(i) next i gosub 2400 'zz=xx^yy for i=1 to 4 stack1(i)=zz(i) next i if Iresult=1 then n=2: gosub 500 'call DownStack(2) return end if end if if Cmd\$="exp" then for i=1 to 4 xx(i)=stack1(i) next i gosub 1900 'zz=Exp(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="ln" then for i=1 to 4 xx(i)=stack1(i) next i gosub 2000 'zz=Ln(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="1/x" then for i=1 to 4 xx(i)=stack1(i) next i gosub 2300 'zz=1/xx if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="x^2" then for i=1 to 4 xx(i)=stack1(i) next i gosub 2100 'zz=xx*xx if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="sqr" then for i=1 to 4 xx(i)=stack1(i) next i gosub 2200 'zz=sqr(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="sin" then for i=1 to 4 xx(i)=stack1(i) next i gosub 2700 'zz=sin(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="cos" then for i=1 to 4 xx(i)=stack1(i) next i gosub 2800 'zz=cos(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="tan" then for i=1 to 4 xx(i)=stack1(i) next i gosub 2900 'zz=tan(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="sh" then for i=1 to 4 xx(i)=stack1(i) next i gosub 2500 'zz=sh(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="ch" then for i=1 to 4 xx(i)=stack1(i) next i gosub 2600 'zz=ch(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="th" then for i=1 to 4 xx(i)=stack1(i) next i gosub 3000 'zz=th(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="arcsin" then for i=1 to 4 xx(i)=stack1(i) next i gosub 3100 'zz=arcsin(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="arccos" then for i=1 to 4 xx(i)=stack1(i) next i gosub 3200 'zz=arccos(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="arctan" then for i=1 to 4 xx(i)=stack1(i) next i gosub 3300 'zz=arctan(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="argsh" then for i=1 to 4 xx(i)=stack1(i) next i gosub 3400 'zz=argsh(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="argch" then for i=1 to 4 xx(i)=stack1(i) next i gosub 3500 'zz=argch(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if if Cmd\$="argth" then for i=1 to 4 xx(i)=stack1(i) next i gosub 3600 'zz=argth(xx) if Iresult=1 then for i=1 to 4 stack1(i)=zz(i) next i return end if end if return 'Display complex number zz (algebraic form + polar form) 1000 print using " ####.######"; zz(1); if zz(2)<>0 then if zz(2)>0 then print " +"; else print " -"; end if print using " i ####.######"; abs(zz(2)); else print " "; end if if zz(3)<>0 then print using " ####.######"; zz(3); else print " "; end if if zz(4)<>0 then print " EXP"; if zz(4)>0 then print " +"; else print " -"; end if print using " i ####.######"; abs(zz(4)) else print " " end if return 'copy zz in xx 1200 for i=1 to 4 xx(i)=zz(i) next return 'rectangular to polar conversion 1300 zz(3)=sqr(zz(1)*zz(1)+zz(2)*zz(2)) if zz(1)=0 then if zz(2)>0 then zz(4)=PI/2 else if zz(2)<0 then zz(4)=-PI/2 else zz(4)=0 end if end if else zz(4)=ATN(zz(2)/zz(1)) if zz(1)<0 then if zz(2)>=0 then zz(4)=zz(4)+PI else zz(4)=zz(4)-PI end if end if end if return 'polar to rectangular conversion 1400 if zz(4)>PI then zz(4)=zz(4)-2*PI end if if zz(4)<-PI then zz(4)=zz(4)+2*PI end if zz(1)=zz(3)*cos(zz(4)): zz(2)=zz(3)*sin(zz(4)) return 'add two complex numbers (zz=xx+yy) 1500 zz(1)=xx(1)+yy(1) zz(2)=xx(2)+yy(2) gosub 1300 'call RectPol(zz) Iresult=1 return 'subtract two complex numbers (zz=xx-yy) 1600 zz(1)=xx(1)-yy(1) zz(2)=xx(2)-yy(2) gosub 1300 'call RectPol(zz) Iresult=1 return 'multiply two complex numbers (zz=xx*yy) 1700 zz(3)=xx(3)*yy(3) zz(4)=xx(4)+yy(4) gosub 1400 'call PolRect(zz) Iresult=1 return 'divide two complex numbers (zz=xx/yy) 'if modulus r of yy=0, Iresult=0 (no operation is done) 1800 if yy(3)=0 then Iresult=0 return else zz(3)=xx(3)/yy(3) zz(4)=xx(4)-yy(4) gosub 1400 'call PolRect(zz) Iresult=1 return end if 'compute exp(z) (zz=exp(xx)) 1900 zz(1)=exp(xx(1))*cos(xx(2)) zz(2)=exp(xx(1))*sin(xx(2)) gosub 1300 'call RectPol(zz) Iresult=1 return 'compute Ln(z) (zz=Ln(xx)) 'if modulus r of xx<=0, Iresult=0 (no operation is done) 2000 if xx(3)<=0 then Iresult=0 return else zz(1)=log(xx(3)) zz(2)=xx(4) gosub 1300 'call RectPol(zz) Iresult=1 return end if 'compute z^2 (zz=xx*xx) 2100 zz(1)=xx(1)*xx(1)-xx(2)*xx(2) zz(2)=2*xx(1)*xx(2) gosub 1300 'call RectPol(zz) Iresult=1 return 'compute SQRT(Z) (zz=sqrt(xx)) 2200 zz(1)=sqr(xx(3))*cos(xx(4)/2) zz(2)=sqr(xx(3))*sin(xx(4)/2) gosub 1300 'call RectPol(zz) Iresult=1 return 'compute 1/z (zz=1/xx) 'if modulus r of xx=0, Iresult=0 (no operation is done) 2300 if xx(3)=0 then Iresult=0 return else zz(3)=1 / xx(3) zz(4)= -xx(3) gosub 1400 'call PolRect(zz) Iresult=1 return end if 'compute X^Y (zz=xx^yy) 'if modulus r of xx<=0, Iresult=0 (no operation is done) 2400 Iresult=0 gosub 2000 'zz=ZLn(xx) if Iresult=1 then gosub 1200 'copy zz in xx gosub 1700 'zz=xx*yy if Iresult=1 then gosub 1200 gosub 1900 'zz=exp(xx) end if end if return 'compute Sh(Z) (zz=Sh(xx)) 2500 zz(1)=(exp(xx(1))*cos(xx(2)) - exp(-xx(1))*cos(-xx(2)))/2 zz(2)=(exp(xx(1))*sin(xx(2)) - exp(-xx(1))*sin(-xx(2)))/2 gosub 1300 'call RectPol(zz) Iresult=1 return 'compute Ch(Z) (zz=Ch(xx)) 2600 zz(1)=(exp(xx(1))*cos(xx(2)) + exp(-xx(1))*cos(-xx(2)))/2 zz(2)=(exp(xx(1))*sin(xx(2)) + exp(-xx(1))*sin(-xx(2)))/2 gosub 1300 'call RectPol(zz) Iresult=1 return 'compute sin(Z) (zz=sin(xx)) 2700 zz(1)= (exp(-xx(2))*sin(xx(1)) - exp(xx(2))*sin(-xx(1)))/2 zz(2)=-(exp(-xx(2))*cos(xx(1)) - exp(xx(2))*cos(-xx(1)))/2 gosub 1300 'call RectPol(zz) Iresult=1 return 'compute cos(Z) (zz=cos(xx)) 2800 zz(1)=(exp(xx(2))*cos(xx(1)) + exp(xx(2))*cos(-xx(1)))/2 zz(2)=(exp(xx(2))*sin(xx(1)) + exp(xx(2))*sin(-xx(1)))/2 gosub 1300 'call RectPol(zz) Iresult=1 return 'compute Tan(Z) zz=tan(xx) 'if cos(xx)=0 then Iresult=0 (no operation is done) 2900 Iresult=0 gosub 2700 'zz=Zsin(xx) put in z3 for i=1 to 4 z3(i)=zz(i) next if Iresult=1 then gosub 2800 'zz=Zcos(xx) put in z4 for i=1 to 4 z4(i)=zz(i) next if Iresult=1 then for i=1 to 4 xx(i)=z3(i) : yy(i)=z4(i) next gosub 1800 'zz=xx/yy end if end if return 'compute Th(Z) (zz=th(xx)) 'if ch(xx)=0 then Iresult=0 (no operation is done) 3000 Iresult=0 gosub 2500 'zz=Zsh(xx) put in z3 for i=1 to 4 z3(i)=zz(i) next if Iresult=1 then gosub 2600 'zz=Zch(xx) put in z4 for i=1 to 4 z4(i)=zz(i) next if Iresult=1 then for i=1 to 4 xx(i)=z3(i) : yy(i)=z4(i) next gosub 1800 'zz=xx/yy end if end if return 'compuite Arcsin(z) (zz=arcsin(xx)) 3100 for i=1 to 4 'save xx in x x(i)=xx(i) next zz(1)=1-xx(1)*xx(1)+xx(2)*xx(2) zz(2)=-2*xx(1)*xx(2) gosub 1300 'call RectPol(zz) gosub 1200 'xx=zz gosub 2200 'zz=Zsqrt(xx) if Iresult=0 then return end if zz(1)=zz(1)-x(2) 'use initial value of xx zz(2)=zz(2)+x(1) gosub 1300 'call RectPol(zz) gosub 1200 'xx=zz gosub 2000 'zz=Ln(xx) if Iresult=0 then return end if temp=zz(1) zz(1)=zz(2) zz(2)=-temp gosub 1300 'call RectPol(zz) Iresult=1 return 'compute Arccos(z) (zz=arccos(xx)) 3200 for i=1 to 4 'save xx in x x(i)=xx(i) next zz(1)=1-xx(1)*xx(1)+xx(2)*xx(2) zz(2)=-2*xx(1)*xx(2) gosub 1300 'call RectPol(zz) gosub 1200 'xx=zz gosub 2200 'zz=Zsqrt(xx) if Iresult=0 then return end if temp=zz(1) zz(1)=x(1)-zz(2) 'use initial value of xx zz(2)=temp+x(2) gosub 1300 'call RectPol(zz) gosub 1200 'xx=zz gosub 2000 'zz=Ln(xx) if Iresult=0 then return end if temp=zz(1) zz(1)=zz(2) zz(2)=-temp gosub 1300 'call RectPol(zz) Iresult=1 return 'compute Arctan(z) (zz=arctan(xx)) 3300 for i=1 to 4 'save xx in x x(i)=xx(i) next z2(1)=-xx(1) z2(2)=1-xx(2) z3(1)=xx(1) z3(2)=1+xx(2) for i=1 to 4 zz(i)=z2(i) next i gosub 1300 'call RectPol(zz) for i=1 to 4 z2(i)=zz(i) next i for i=1 to 4 zz(i)=z3(i) next i gosub 1300 'call RectPol(zz) for i=1 to 4 z3(i)=zz(i) next i for i=1 to 4 xx(i)=z2(i) yy(i)=z3(i) next i gosub 1800 'zz=xx/yy if Iresult=0 then return end if gosub 1200 'xx=zz gosub 2000 'zz=Ln(xx) if Iresult=0 then return end if temp=zz(1) zz(1)=zz(2)/2 zz(2)=-temp/2 gosub 1300 'call RectPol(zz) Iresult=1 return 'compute Argsh(z) (zz=argsh(xx)) 3400 for i=1 to 4 x(i)=xx(i) next i zz(1)=1+xx(1)*xx(1)-xx(2)*xx(2) zz(2)=2*xx(1)*xx(2) gosub 1300 'call RectPol(zz) gosub 1200 'xx=zz gosub 2200 'zz=sqrt(xx) if Iresult=0 then return end if zz(1)=zz(1)+x(1) zz(2)=zz(2)+x(2) gosub 1300 'call RectPol(zz) gosub 1200 'xx=zz gosub 2000 'zz=Ln(xx) if Iresult=0 then return end if Iresult=1 return 'compute Argch(z) (zz=argch(xx)) 3500 for i=1 to 4 x(i)=xx(i) next i zz(1)=-1+xx(1)*xx(1)-xx(2)*xx(2) zz(2)=2*xx(1)*xx(2) gosub 1300 'call RectPol(zz) gosub 1200 'xx=zz gosub 2200 'zz=sqrt(xx) if Iresulr=0 then return end if zz(1)=zz(1)+x(1) 'use initial value of xx zz(2)=zz(2)+x(2) gosub 1300 'call RectPol(zz) gosub 1200 'xx=zz gosub 2000 'zz=Ln(xx) if Iresult=0 then return end if Iresult=1 return 'compute Argth(z) (zz=argth(xx)) 3600 for i=1 to 4 'save xx in x x(i)=xx(i) next z2(1)=1+xx(1) z2(2)=xx(2) z3(1)=1-xx(1) z3(2)=-xx(2) for i=1 to 4 zz(i)=z2(i) next i gosub 1300 'call RectPol(zz) for i=1 to 4 z2(i)=zz(i) next i for i=1 to 4 zz(i)=z3(i) next i gosub 1300 'call RectPol(zz) for i=1 to 4 z3(i)=zz(i) next i for i=1 to 4 xx(i)=z2(i) yy(i)=z3(i) next i gosub 1800 'zz=xx/yy if Iresult=0 then return end if gosub 1200 'xx=zz gosub 2000 'zz=Ln(xx) if Iresult=0 then return end if zz(1)=zz(1)/2 zz(2)=zz(2)/2 gosub 1300 'call RectPol(zz) Iresult=1 return 'end of file ucomplex.bas