Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: kreis8.cob Sprache: Cobol

Original von: verschiedene^©

       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.0 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

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.