%%HP: T(3)A(D)F(.);
DIR
  DGMCALC
  \<<
    CASE DEPTH 1 <
      THEN 0
'Horizonte' STO 1000.
.05 BEEP 2000. .1
BEEP
"Stack ist leer!"
MSGBOX
      END DEPTH 1 ==
      THEN 1
'Horizonte' 2000. .1
BEEP 1000. .05 BEEP
2000. .1 BEEP
"Nur 1 Horizont
   vorhanden!
OK dr\252cken 
oder mit CANCEL
abbrechen!"
MSGBOX STO
      END DEPTH 1 >
      THEN 2
'Horizonte' STO
      END
    END
    IF Horizonte 1 \>=
    THEN 0. { SuPu
SuGu SuDu SuPo SuGo
SuDo Kubatur } STO
      \<< { SuDo SuDu
SuGo SuGo SuGu SuPo
SuPu LOESU Kubatur }
PURGE
      \>> 'LOESU' STO
    END
    IF Horizonte 2 ==
    THEN SWAP EVAL
      \<< 1
        \<< EVAL EVAL
PRS 'SuPo' STO+
'SuGo' STO+ 'SuDo'
STO+
        \>> DOSUBS
      \>> EVAL EVAL
      \<< 1
        \<< EVAL EVAL
PRS 'SuPu' STO+
'SuGu' STO+ 'SuDu'
STO+
        \>> DOSUBS
      \>> EVAL SuPo
SuPu - 'Kubatur' STO
SuGo SuGu
      IF \=/
      THEN 2000. .1
BEEP 1000. .05 BEEP
2000. .1 BEEP
"Grundfl\228chen 
  verschieden!"
MSGBOX
      END
    END
    IF Horizonte 1 ==
    THEN EVAL
      \<< 1
        \<< EVAL EVAL
PRS 'SuPo' STO+
'SuGo' STO+ 'SuDo'
STO+
        \>> DOSUBS
      \>> EVAL 2000. .1
BEEP 1000. .05 BEEP
2000. .1 BEEP
"Es wurde nur
  1 Horizont
   berechnet!
Siehe
SuDo SuGo SuPo"
MSGBOX
    END 'Horizonte'
PURGE
  \>>
  ERGDGM
  \<< RCLF 'Flagsave'
STO { -20. -20. -21.
-31. -95. } CF { -2.
-3. -22. -90. -103.
-105. } SF DEG RECT
DEC
    \<< { SuDo SuGo
SuPo SuDu SuGu SuPu
Kubatur } DUP VTYPE
SORT HEAD
      IF -1. ==
      THEN CLLCD
1000. .1 BEEP
"Variablen
        fehlen!"
MSGBOX
"     Werte fehlen!"
      ELSE
" Ergebnisse DGMCALC"
      END
    \>> EVAL CLLCD SWAP
DUP
    \<< EVAL
    \>> DOLIST SWAP
    \<< \->TAG
    \>> DOLIST 1.
CHOOSE DROP Flagsave
STOF 'Flagsave' PURGE
  \>>
  PRISM
  \<< \-> A B C
    \<< C B - A C - B A
- \-> a b c
      \<< a b CROSS DUP
'NV' STO ABS 2. /
'DFl' STO a ABS 'Da'
STO b ABS 'Db' STO c
ABS 'Dc' STO b c DOT
Db / Dc / NEG 'Dcos\Ga'
STO c a DOT Dc / Da /
NEG 'Dcos\Gb' STO a b
DOT Da / Db / NEG
'Dcos\Gg' STO A B + C +
3. / 'DSwV' STO NV V\->
SWAP DROP SWAP DROP
NV ABS / 'cos\Gm' STO
NV V\-> ROT SQ ROT SQ +
SWAP / NEG NV V\-> DROP
ROT \->V3 DUP ABS /
'FallV' STO
      \>> A V\-> DROP \->V2
B V\-> DROP \->V2 C V\->
DROP \->V2
    \>> \-> A B C
    \<< C B - A C - B A
- \-> a b c
      \<< a b CROSS ABS
2. / 'GFl' STO a ABS
'Ga' STO b ABS 'Gb'
STO c ABS 'Gc' STO b
c DOT Gb / Gc / NEG
'Gcos\Ga' STO c a DOT
Gc / Ga / NEG 'Gcos\Gb'
STO a b DOT Ga / Gb /
NEG 'Gcos\Gg' STO A B +
C + 3. / V\-> 0. \->V3
'GSwV' STO
      \>>
    \>> DSwV V\-> SWAP
DROP SWAP DROP 'hm'
STO GFl hm * 'PVol'
STO
    \<< { PVol hm GSwV
Gcos\Gg Gcos\Gb Gcos\Ga Gc
Gb Ga GFl FallV cos\Gm
DSwV Dcos\Gg Dcos\Gb
Dcos\Ga Dc Db Da DFl NV
LOE } PURGE
    \>> 'LOE' STO { LOE
DFl Da Db Dc Dcos\Ga
Dcos\Gb Dcos\Gg NV FallV
cos\Gm DSwV GFl Ga Gb
Gc Gcos\Ga Gcos\Gb Gcos\Gg
GSwV hm PVol } ORDER
  \>>
  ERGPR
  \<< RCLF 'Flagsave'
STO { -20. -20. -21.
-31. -95. } CF { -2.
-3. -22. -90. -103.
-105. } SF DEG RECT
DEC
    \<< { DFl Da Db Dc
Dcos\Ga Dcos\Gb Dcos\Gg NV
FallV cos\Gm DSwV GFl
Ga Gb Gc Gcos\Ga Gcos\Gb
Gcos\Gg GSwV hm PVol }
DUP VTYPE SORT HEAD
      IF -1. ==
      THEN CLLCD
1000. .1 BEEP
"Variablen
        fehlen!"
MSGBOX
"     Werte fehlen!"
      ELSE
" Ergebnisse Prismatoid"
      END
    \>> EVAL CLLCD SWAP
DUP
    \<< EVAL
    \>> DOLIST SWAP
    \<< \->TAG
    \>> DOLIST 1.
CHOOSE DROP Flagsave
STOF 'Flagsave' PURGE
  \>>
  PRS
  \<< \-> A B C
    \<< C B - A C - \-> a
b
      \<< a b CROSS ABS
2. / A B + C + 3. /
V\-> 'hm' STO DROP DROP
      \>> A V\-> DROP \->V2
B V\-> DROP \->V2 C V\->
DROP \->V2
    \>> \-> A B C
    \<< C B - A C - \-> a
b
      \<< a b CROSS ABS
2. / DUP
      \>>
    \>> hm * 'hm' PURGE
  \>>
  H01 { D01 D02 D03
D04 D05 D06 D07 D08
D09 D10 D11 }
  H02 { D12 D13 D14
D15 D16 D17 D18 D19 }
  H03 { D20 D21 D22
D23 D24 }
  D01 { P01 P02 P04 }
  D02 { P01 P04 P05 }
  D03 { P02 P03 P04 }
  D04 { P04 P03 P07 }
  D05 { P04 P06 P05 }
  D06 { P03 P08 P07 }
  D07 { P04 P07 P06 }
  D08 { P05 P06 P10 }
  D09 { P09 P10 P06 }
  D10 { P06 P07 P09 }
  D11 { P07 P08 P09 }
  D12 { P01 P02 P12 }
  D13 { P02 P03 P12 }
  D14 { P01 P12 P05 }
  D15 { P13 P03 P08 }
  D16 { P13 P08 P09 }
  D17 { P11 P13 P09 }
  D18 { P11 P09 P10 }
  D19 { P05 P11 P10 }
  D20 { P01 P02 P05 }
  D21 { P02 P03 P05 }
  D22 { P03 P08 P09 }
  D23 { P05 P03 P09 }
  D24 { P05 P09 P10 }
  P01 [ 2. 17. 6.3 ]
  P02 [ 2. 1. 5.2 ]
  P03 [ 6. 1. 4.5 ]
  P04 [ 11. 9. 9.1 ]
  P05 [ 6. 17. 4.9 ]
  P06 [ 19. 13. 7.3 ]
  P07 [ 20. 6. 6. ]
  P08 [ 25. 1. 1.2 ]
  P09 [ 25. 9. 1. ]
  P10 [ 25. 17. 1.2 ]
  P11 [ 6. 15. 2. ]
  P12 [ 6. 9. 4. ]
  P13 [ 6. 3. 2. ]
END