%%HP: T(3)A(D)F(,);
DIR
@ Taschenrechnerprogramme für den HP 49G, HP 49g+ und HP 50g
@ zur Berechnung eines digitalen Geländemodells (DGM).
@ Das Programmpaket ist im PDF-Dokument DGM.pdf beschrieben.
@ Autor: Otto Praxl
@ www.praxelius.de
@ Stand vom 22.06.2011
  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 Kubatur LOESU } 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
  \<< DUP "" + 'DrNr' STO EVAL EVAL \-> A B C
    \<< A 'VA' STO B 'VB' STO C 'VC' STO 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 VA VB VC DrNr LOE } PURGE
    \>> 'LOE' STO { LOE DrNr VA VB VC 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
    \<< { VA VB VC 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 Prisma " DrNr \->STR +
      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
  \>>
  Info
  \<< CLLCD "DGM:
 Digitales
   Gel\228nde-Modell
   nach REB 22.013
Stand vom 22.06.2011
 Autor: Otto Praxl
 www.praxelius.de" 2, DISP 0, WAIT DROP
  \>>
  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