Arithmetic-geometric mean: Difference between revisions

(J: Arbitrary precision)
Line 9:
Demonstrate the function by calculating:
:<math>\mathrm{agm}(1,1/\sqrt{2})</math>
 
=={{header|360 Assembly}}==
For maximum compatibility, this program uses only the basic instruction set.
<lang 360asm>
AGM CSECT
USING AGM,R13
SAVEAREA B STM-SAVEAREA(R15)
DC 17F'0'
DC CL8'AGM'
STM STM R14,R12,12(R13)
ST R13,4(R15)
ST R15,8(R13)
LR R13,R15
ZAP A,K a=1
ZAP PWL8,K
MP PWL8,K
DP PWL8,=P'2'
ZAP PWL8,PWL8(7)
BAL R14,SQRT
ZAP G,PWL8 g=sqrt(1/2)
WHILE1 EQU * while a!=g
ZAP PWL8,A
SP PWL8,G
CP PWL8,=P'0' (a-g)!=0
BE EWHILE1
ZAP PWL8,A
AP PWL8,G
DP PWL8,=P'2'
ZAP AN,PWL8(7) an=(a+g)/2
ZAP PWL8,A
MP PWL8,G
BAL R14,SQRT
ZAP G,PWL8 g=sqrt(a*g)
ZAP A,AN a=an
B WHILE1
EWHILE1 EQU *
ZAP PWL8,A
UNPK ZWL16,PWL8
MVC CWL16,ZWL16
OI CWL16+15,X'F0'
MVI CWL16,C'+'
CP PWL8,=P'0'
BNM *+8
MVI CWL16,C'-'
MVC CWL80+0(15),CWL16
MVC CWL80+9(1),=C'.' /k (15-6=9)
XPRNT CWL80,80 display a
L R13,4(0,R13)
LM R14,R12,12(R13)
XR R15,R15
BR R14
DS 0F
K DC PL8'1000000' 10^6
A DS PL8
G DS PL8
AN DS PL8
* ****** SQRT *******************
SQRT CNOP 0,4 function sqrt(x)
ZAP X,PWL8
ZAP X0,=P'0' x0=0
ZAP X1,=P'1' x1=1
WHILE2 EQU * while x0!=x1
ZAP PWL8,X0
SP PWL8,X1
CP PWL8,=P'0' (x0-x1)!=0
BE EWHILE2
ZAP X0,X1 x0=x1
ZAP PWL16,X
DP PWL16,X1
ZAP XW,PWL16(8) xw=x/x1
ZAP PWL8,X1
AP PWL8,XW
DP PWL8,=P'2'
ZAP PWL8,PWL8(7)
ZAP X2,PWL8 x2=(x1+xw)/2
ZAP X1,X2 x1=x2
B WHILE2
EWHILE2 EQU *
ZAP PWL8,X1 return x1
BR R14
DS 0F
X DS PL8
X0 DS PL8
X1 DS PL8
X2 DS PL8
XW DS PL8
* end SQRT
PWL8 DC PL8'0'
PWL16 DC PL16'0'
CWL80 DC CL80' '
CWL16 DS CL16
ZWL16 DS ZL16
LTORG
YREGS
END AGM
</lang>
{{out}}
<pre>
+00000000.84721
</pre>
 
 
 
=={{header|Ada}}==
1,392

edits