|
identification division.
program-id. kreis8.
* von Rüdiger Nicolovius
* zu den platonischen und archimedischen Polyedern
* Programm KRESI8.F
author. "JD".
date-written. 16.2.2009.
date-compiled.
data division.
working-storage section.
* implicit
77 i pic S9(4) comp.
77 aaa pic S9(4)V9(4) comp-2.
77 bbb pic S9(4)V9(4) comp-2.
77 ccc pic S9(4)V9(4) comp-2.
77 ddd pic S9(4)V9(4) comp-2.
77 rrr pic S9(4)V9(4) comp-2.
77 f1 pic S9(4)V9(4) comp-2.
77 f2 pic S9(4)V9(4) comp-2.
77 f3 pic S9(4)V9(4) comp-2.
*
77 pp1 pic S9(4)V9(4) comp-2 occurs 3.
77 pp2 pic S9(4)V9(4) comp-2 occurs 3.
77 pp3 pic S9(4)V9(4) comp-2 occurs 3.
77 ppm pic S9(4)V9(4) comp-2 occurs 3.
*
77 nullf pic S9(4)V9(4) comp-2 value 0.0E0.
77 eins pic S9(4)V9(4) comp-2 value 1.0E0.
77 zwei pic S9(4)V9(4) comp-2 value 2.0E0.
77 eps pic S9(4)V9(4) comp-2 value 1.0E-15.
linkage section.
77 p1 pic S9(4)V9(4) comp-2 occurs 3.
77 p2 pic S9(4)V9(4) comp-2 occurs 3.
77 p3 pic S9(4)V9(4) comp-2 occurs 3.
77 pm pic S9(4)V9(4) comp-2 occurs 3.
77 rad pic S9(4)V9(4) comp-2 occurs 3.
*
77 idim pic S9(4) comp.
77 iflag pic S9(4) comp.
procedure division using idim p1 p2 p3 pm rad iflag.
move 0 to iflag
move p1(1) to pp1(1)
move p2(1) to pp3(1)
move p3(1) to pp3(1)
move p1(2) to pp1(2)
move p2(2) to pp2(2)
move p3(2) to pp3(2)
if idim < 2 or idim > 3 then
move 1 to iflag
stop run
end-if
if idim = 2 then
move nullf to pp1(3)
move nullf to pp2(3)
move nullf to pp3(3)
else
move p1(3) to pp1(3)
move p2(3) to pp2(3)
move p3(3) to pp3(3)
end-if
move nullf to aaa bbb ccc.
*
move 1 to i
loop10.
if i>3 goto continue10.
compute aaa=aaa+(pp2(i)-pp1(i))**2.
compute bbb=bbb+(pp3(i)-pp1(i))*(pp2(i)-pp1(i)).
compute ccc=ccc+(pp3(i)-pp1(i))**2.
add 1 to i.
goto loop10.
continue10.
compute ddd=aaa*ccc- bbb*2.
if function abs(ddd) <= eps*(aaa*+2+ccc**2) then
move 2 to iflag
stop run
end-if
compute ddd=zwei*ddd
compute f1=bbb*(aaa+ccc-zwei*bbb)/ddd
compute f2=ccc*(aaa-bbb)/ddd
compute f3=aaa*(ccc-bbb)/ddd
move nullf to rrr.
move 1 to i
loop20.
if i>3 goto continue20.
compute ppm(i)=f1*pp1(i)+f2*pp2(i)+f3*pp3(i).
compute rrr=rrr+(ppm(i)-pp1(i))**2
add 1 to i.
goto loop20.
continue20.
move ppm(1) to pm(1)
move ppm(2)to pm(2).
if idim = 3 move ppm(3) to pm(3).
move function sqrt(rrr) to rad.
end program kreis8.
¤ Dauer der Verarbeitung: 0.18 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
