home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 01 / bemess.inc < prev    next >
Encoding:
Text File  |  1986-11-25  |  15.5 KB  |  362 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*                          Modul:  bemess.inc                              *)
  3. (*--------------------------------------------------------------------------*)
  4. (*   Ermittelt das erforderliche Traegheitsmoment und das erforderliche
  5.      Widerstandsmoment des Stahlprofils das verwendet werden soll.          *)
  6.  
  7. PROCEDURE StahlBemessung;
  8.  
  9.   CONST Emodul   = 2.1E8;                              (* E-Modul von Stahl *)
  10.         SigmaMax : ARRAY [1..2] OF REAL = (14.0,21.0);
  11.                  (* maximale Spannungen fuer St-37 und St-52 im Lastfall H  *)
  12.  
  13.   VAR erfI,                             (* erforderliches Traegheitsmoment  *)
  14.       erfW,                             (* erforderliches Widerstandsmoment *)
  15.       DeltaSoll    : REAL;                       (* zulaessige Durchbiegung *)
  16.       d,Stahlguete : INTEGER;
  17.  
  18.   (*------------------------------------------------------------------------*)
  19.  
  20.   PROCEDURE Eingabe (VAR delta : REAL; VAR n,Guete : INTEGER);
  21.  
  22.     BEGIN
  23.       CLRSCR;
  24.       REPEAT
  25.         GOTOXY (1,1); WRITE('Eingabe der Stahlguete 1 = St-37   2 = St-52 : ');
  26.         READLN (Guete);
  27.       UNTIL Guete IN [1,2];
  28.       WRITELN ('Begrenzung der maximalen Durchbiegung auf l/x');
  29.       WRITE ('Eingabe x : '); READLN (n);
  30.       delta := Feldlaenge / n;
  31.     END; (* eingabe *)
  32.  
  33.   (*------------------------------------------------------------------------*)
  34.   (*   Berechnet die maximale Durchbiegung des Traegers mit Hilfe des
  35.        MOHR'schen Satzes.                                                   *)
  36.  
  37.   FUNCTION Durchbiegung : REAL;
  38.  
  39.     VAR deltaH,                                         (* Intervallgroesse *)
  40.         Momentenflaeche,                     (* Groesse der Momentenflaeche *)
  41.         Haelfte,                             (* Haelfte der Momentenflaeche *)
  42.         step,                                               (* Schrittweite *)
  43.         MomAufA,  (* Groesse der linken Auflagerkraft aus Momentenbelastung *)
  44.         Resultort,            (* Ort der Resultierenden der Momentenflaeche *)
  45.         Summe,dummy : REAL;
  46.         i           : INTEGER;
  47.  
  48.     (*----------------------------------------------------------------------*)
  49.     (*   Numerische Intergration der Momentenflaeche mit Hilfe der
  50.          SIMPSON'schen Regel                                                *)
  51.  
  52.     FUNCTION Simpson (Ort,dH : REAL) : REAL;
  53.  
  54.       VAR Moment1,Moment2,Moment3,Q : REAL;
  55.  
  56.       BEGIN
  57.         Schnittkraft (Ort,Moment1,Q);                (* Berechnung von drei *)
  58.         Schnittkraft (Ort+dH,Moment2,Q);             (*                     *)
  59.         Schnittkraft (Ort+2*dH,Moment3,Q);           (* Stuetzordinaten     *)
  60.         Simpson := dH/3 *
  61.                   (Moment1 + 4*Moment2 + Moment3);    (* SIMPSON'sche Regel *)
  62.       END; (* simpson *)
  63.  
  64.  
  65.     BEGIN (* Durchbiegung *)
  66.       Momentenflaeche := 0; Haelfte := 0;
  67.       deltaH := Feldlaenge / 20;              (* Festlegung der Genauigkeit *)
  68.       FOR i:=0 TO 9 DO                   (* Integration der Momentenflaeche *)
  69.         Momentenflaeche := Momentenflaeche + Simpson(2*i*deltaH,deltaH);
  70.       dummy := Feldlaenge / 2; step := 1;
  71.       REPEAT         (* Suche nach dem Ort der Resultierenden der M-flaeche *)
  72.         deltaH := dummy / 10; Haelfte := 0;
  73.         FOR i:=0 TO 4 DO Haelfte := Haelfte + Simpson(2*i*deltaH,deltaH);
  74.         IF Haelfte>Momentenflaeche/2 THEN BEGIN
  75.           dummy := dummy - step;
  76.           step := step/10;
  77.         END; (* if *)
  78.         dummy := dummy + step;                     (* bis ausreichende Ge-  *)
  79.       UNTIL ABS(Haelfte-Momentenflaeche/2) < 0.01; (* nauigkeit erreicht ist*)
  80.       Resultort := ROUND(dummy*100)/100;    (* runde auf zwei Stellen genau *)
  81.       MomAufA := (Feldlaenge-Resultort)/Feldlaenge * Momentenflaeche;
  82.       Summe := MomAufA * Resultort; deltaH := Resultort / 10;
  83.       FOR i:=0 TO 4 DO
  84.         Summe := Summe - Simpson(2*i*deltaH,deltaH)
  85.                  *(Resultort-(2*i+1)*deltaH);
  86.       Durchbiegung := Summe;
  87.     END; (* durchbiegung *)
  88.  
  89. (*--------------------------------------------------------------------------*)
  90.  
  91.   PROCEDURE Ausgabe;
  92.  
  93.     BEGIN
  94.       CLRSCR;
  95.       WRITELN ('Bemessung als Stahltraeger');
  96.       WRITELN ('==========================');
  97.       WRITELN;
  98.       WRITE ('Stahlguete : St-');
  99.       CASE Stahlguete OF
  100.         1 : WRITELN ('37');
  101.         2 : WRITELN ('52');
  102.       END; (* case *)
  103.       WRITELN ('erforderliches Traegheitsmoment    = ',erfI:7:0,' cm4');
  104.       WRITELN ('bei einer maximalen Duchbiegung von l /',d:4,' = ',
  105.                 DeltaSoll*100:5:2,' cm');
  106.       WRITELN ('erforderliches Widerstandsmoment   = ',erfW:7:0,' cm3');
  107.       WRITELN ('bei einer maximalen Spannung Sigma = ',
  108.                 SigmaMax [Stahlguete]:5:2,' kN/cm2');
  109.     END; (* ausgabe *)
  110.  
  111.  
  112.   BEGIN (* stahlbemessung *)
  113.     Eingabe (Deltasoll,d,Stahlguete);
  114.     erfI := Durchbiegung / Emodul / DeltaSoll * 1E8; (* Einheit : [cm4] *)
  115.     erfW := Maxmoment * 100 / SigmaMax [Stahlguete]; (* Einheit : [cm3] *)
  116.     Ausgabe;
  117.   END; (* stahlbemessung *)
  118.  
  119. (*--------------------------------------------------------------------------*)
  120. (*   Ermittelt bei Vorgabe einer Teilung die notwendigen Laengs- und Schub-
  121.      bewehrungen, und gibt sie als Stahlflaechen aus.                       *)
  122.  
  123. PROCEDURE BetonBemessung;
  124.  
  125.   TYPE BetonArt  = (B15,B25,B35,B45,B55);           (* erlaubte Betongueten *)
  126.        Error     = (M,Q,ok);          (* moegliche Fehler bei der Bemessung *)
  127.        Test      = SET OF Error;                (* zur Abfangung der Fehler *)
  128.        String3   = STRING[3];
  129.  
  130.   VAR Betonguete      : BetonArt;
  131.       Erfolg1,Erfolg2 : Error;
  132.       Kontrolle       : Test;
  133.       Schubbereich    : String3;
  134.       nochnicht       : BOOLEAN;
  135.       Hoehe,                                      (* Hoehe des Querschnitts *)
  136.       statHoehe,                        (* statische Hoehe des Querschnitts *)
  137.       Breite,                                    (* Breite des Querschnitts *)
  138.       vorhKz,vorhKs,                            (* Hilfswerte zur Bemessung *)
  139.       AsM,                              (* Stahlflaeche der Laengsbewehrung *)
  140.       AsQ,                                (* Stahlflaeche der Querbewehrung *)
  141.       step,                               (* Schrittweite bei der Bemessung *)
  142.       maxTau,                                   (* vorhandene Schubspannung *)
  143.       Tau,      (* entsprechend dem Schubbereich abgeminderte Schubspannung *)
  144.       Moment,Querkraft,                                (* Schnittreaktionen *)
  145.       Ort,                                                 (* Bemessungsort *)
  146.       Abstand         : REAL;
  147.       i,Teilung       : INTEGER;
  148.  
  149.   (*------------------------------------------------------------------------*)
  150.  
  151.   PROCEDURE Eingabe;
  152.  
  153.     VAR help : INTEGER;
  154.  
  155.     BEGIN
  156.       REPEAT
  157.         WRITE ('Wahl der Betonguete : 1=B15,2=B25,..,5=B55 : ');
  158.         READLN (help);
  159.       UNTIL help IN [1..5];
  160.       Betonguete := BetonArt (help);
  161.       WRITELN;
  162.       WRITE  ('Rechteckquerschnitt :      Eingabe der Hoehe [cm] : ');
  163.       READLN (Hoehe);
  164.       WRITE  ('                              und der Breite [cm] : ');
  165.       READLN (Breite);
  166.       WRITE  ('Abstand der Bewehrungsachse vom unteren Rand [cm] : ');
  167.       READLN (Abstand);
  168.       statHoehe := Hoehe - Abstand;
  169.       WRITELN;
  170.       WRITE  ('Teilung : ');
  171.       READLN (Teilung);
  172.     END; (* eingabe *)
  173.  
  174.   (*------------------------------------------------------------------------*)
  175.   (*   Ermittelt die Beiwerte Ks und Kz fuer die Laengsbewehrung            *)
  176.  
  177.   PROCEDURE BemessungM (Moment : REAL; VAR Ks,Kz : REAL; VAR Fehler : Error);
  178.  
  179.     CONST                                         (* Tabelle der Kh - Werte *)
  180.           KhTAB : ARRAY[1..5,1..13] OF REAL =
  181.        ( (9.09,5.49,4.14,3.33,2.98,2.75,2.60,2.51,2.46,2.40,2.34,2.28,2.22),
  182.          (7.04,4.25,3.21,2.58,2.31,2.13,2.01,1.94,1.90,1.86,1.81,1.77,1.72),
  183.          (6.14,3.71,2.80,2.25,2.01,1.86,1.75,1.69,1.66,1.62,1.58,1.54,1.50),
  184.          (5.67,3.43,2.58,2.08,1.86,1.72,1.62,1.56,1.53,1.50,1.46,1.42,1.38),
  185.          (5.38,3.25,2.45,1.97,1.76,1.63,1.54,1.48,1.45,1.42,1.38,1.35,1.31) );
  186.                                                   (* Tabelle der Ks - Werte *)
  187.           KsTAB : ARRAY[1..13] OF REAL =
  188.          (3.6,3.7,3.8,3.9,4.0,4.1,4.1,4.2,4.2,4.3,4.4,4.4,4.5);
  189.                                                   (* Tabelle der Kz - Werte *)
  190.           KzTAB : ARRAY[1..13] OF REAL =
  191.          (0.97,0.95,0.93,0.90,0.88,0.87,0.85,0.84,0.83,0.82,0.81,0.79,0.78);
  192.  
  193.     VAR vorhKh : REAL;                             (* berechneter Kh - Wert *)
  194.         i      : INTEGER;                                        (* Zaehler *)
  195.  
  196.     BEGIN
  197.       Fehler := ok; Ks := 0; Kz := 1;
  198.       vorhKh := statHoehe / SQRT (Moment / Breite * 100);    (* berechne Kh *)
  199.       IF vorhKh < KhTAB [ORD(Betonguete),13] THEN
  200.         Fehler := M                    (* wenn zu gross dann erkenne Fehler *)
  201.       ELSE BEGIN
  202.         FOR i:=1 TO 12 DO IF vorhKh < KhTAB [ORD(Betonguete),i] THEN BEGIN
  203.           Ks := KsTAB [i+1];                 (* sonst ermittle zugehoerigen *)
  204.           Kz := KzTAB [i+1];                 (* Ks- und Kz-Wert             *)
  205.         END; (* for *)
  206.       END; (* else *)
  207.     END; (* bemessungm *)
  208.  
  209.  (*-------------------------------------------------------------------------*)
  210.  (*    Ermittelt die Schubspannung, den Schubbereich und die abgeminderte
  211.        Schubspannung, aus der die notwendige Schubbewehrung berechnet wird. *)
  212.  
  213.  PROCEDURE BemessungQ (Querkraft,Kz : REAL; VAR mT,T    : REAL;
  214.                                              VAR Bereich : string3;
  215.                                              VAR Fehler  : Error);
  216.  
  217.     CONST                              (* Tabellen der Schubbereichsgrenzen *)
  218.           T012 : ARRAY [1..5] OF REAL = (0.050,0.075,0.100,0.110,0.125);
  219.           T02  : ARRAY [1..5] OF REAL = (0.120,0.180,0.240,0.270,0.300);
  220.           T03  : ARRAY [1..5] OF REAL = (0.200,0.300,0.400,0.450,0.500);
  221.  
  222.     BEGIN
  223.       Fehler := ok;
  224.       IF mT > T03 [ORD(Betonguete)] THEN
  225.         Fehler := Q;                                      (* erkenne Fehler *)
  226.       mT := Querkraft / Breite / Kz / statHoehe;  (* berechne Schubspannung *)
  227.       IF mT <= T012 [ORD(Betonguete)] THEN BEGIN         (* Schubbreich I   *)
  228.         Bereich := 'I';
  229.         T := 0.4 * mT;
  230.       END; (* if *)
  231.       IF (T012 [ORD(Betonguete)] < mT)
  232.       AND (mT <= T02 [ORD(Betonguete)]) THEN BEGIN       (* Schubbreich II  *)
  233.         Bereich := 'II';
  234.         T := mT*mT/T02[ORD(Betonguete)];
  235.         IF T < 0.4*mT THEN
  236.           T := 0.4*mT;
  237.       END; (* if *)
  238.       IF (T02 [ORD(Betonguete)] < mT)
  239.       AND (mT <= T03 [ORD(Betonguete)]) THEN BEGIN       (* Schubbreich III *)
  240.         Bereich := 'III';
  241.         T := mT;
  242.       END; (* if *)
  243.     END; (* bemessungq *)
  244.  
  245.  
  246.   (*------------------------------------------------------------------------*)
  247.  
  248.   PROCEDURE Ausdruck (Fehler1,Fehler2 : Error);
  249.  
  250.     BEGIN
  251.       IF i=0 THEN BEGIN
  252.         CLRSCR;
  253.         WRITELN ('Bemessung als Stahlbetontraeger');
  254.         WRITELN ('===============================');
  255.         WRITELN;
  256.         WRITELN ('Materialgueten :          Stahl: BSt 500 S');
  257.         WRITELN ('                          Beton: B ',CHR(ORD(Betonguete)+48)
  258.                   ,'5');
  259.         WRITELN ('Querschnittswerte         d/b/h: ',Hoehe:6:2,'/',Breite:6:2,
  260.                   '/',statHoehe:6:2,' cm');
  261.         WRITELN;
  262.         WRITELN ('  x      Moment As-unten    Querkraft   tau 0 Schub- ',
  263.                  '   tau As-Buegel');
  264.         WRITELN ('  m         kNm      cm2           kN   MN/m2 bereich',
  265.                  ' MN/m2     cm2/m');
  266.         WRITELN;
  267.       END; (* if *)
  268.       IF (Fehler1 = ok) AND (Fehler2 = ok) THEN
  269.         WRITELN (Ort:5:2,Moment:10:2,AsM:9:2,Querkraft:13:2,10*maxTau:8:3,
  270.                      Schubbereich:5,10*Tau:9:3,AsQ:10:2);
  271.       IF Fehler1 = M THEN
  272.         WRITELN (Ort:5:2,Moment:10:2,'  *******',Querkraft:13:2,'  *********',
  273.                  '*********************');
  274.       IF Fehler2 = Q THEN
  275.         WRITELN (Ort:5:2,Moment:10:2,AsM:9:2,Querkraft:13:2,'  *************',
  276.                  '*****************');
  277.     END; (* ausdruck *)
  278.  
  279.  
  280.   BEGIN (* betonbemessung *)
  281.     CLRSCR;
  282.     REPEAT
  283.       Eingabe;
  284.       Kontrolle := [];                                    (* loesche Fehler *)
  285.       step := Feldlaenge / Teilung;                (* berechne Schrittweite *)
  286.       nochnicht := TRUE;
  287.       FOR i:=0 TO Teilung+1 DO BEGIN
  288.         Ort := i * step;                          (* berechne Bemessungsort *)
  289.         IF (Ort > OrtMaxMoment) AND nochnicht THEN BEGIN
  290.                      (* bemesse auch fuer die Stelle des maximalen Momentes *)
  291.           nochnicht := FALSE;
  292.           i := i - 1;
  293.           Ort := OrtMaxmoment;
  294.         END; (* if *)
  295.         Schnittkraft (Ort,Moment,Querkraft);            (* berechne M und Q *)
  296.         IF Moment <= 0 THEN BEGIN     (* fange Fall: Moment kleiner Null ab *)
  297.           AsM := 0; vorhKz := 1;
  298.         END (* then *)
  299.         ELSE BEGIN                                  (* sonst bemesse Moment *)
  300.           BemessungM (Moment,vorhKs,vorhKz,Erfolg1);
  301.           AsM := vorhKs * Moment / statHoehe;
  302.           Kontrolle := Kontrolle + [Erfolg1];
  303.         END; (* else *)
  304.         BemessungQ (ABS(Querkraft),vorhKz,maxTau,Tau,Schubbereich,Erfolg2);
  305.         AsQ := 1.4 * maxTau * Breite;
  306.         Kontrolle := Kontrolle + [Erfolg2];
  307.         Ausdruck (Erfolg1,Erfolg2);
  308.       END; (* for *)
  309.       IF M IN Kontrolle THEN BEGIN       (* Fehler in der Momentenbemessung *)
  310.         LOWVIDEO;
  311.         WRITELN ('Bei  der Momentenbemessung ist ein Fehler  aufgetreten.');
  312.         WRITELN ('Die Materialwerte und / oder die Querschnittswerte sind');
  313.         WRITELN ('unterdimensioniert.                                    ');
  314.         WRITELN ('Bitte fuer eine erneute Berechnung neue Werte eingeben.');
  315.       END; (* if *)
  316.       IF Q IN Kontrolle THEN BEGIN      (* Fehler in der Querkraftbemessung *)
  317.         LOWVIDEO;
  318.         WRITELN ('Bei der Querkraftbemessunung ist ein Fehler aufgetreten.');
  319.         WRITELN ('Die Materialwerte  und / oder die Querschnittswerte sind');
  320.         WRITELN ('unterdimensioniert.                                     ');
  321.         WRITELN ('Bitte fuer eine erneute Berechnung  neue Werte eingeben.');
  322.       END; (* if *)
  323.       NORMVIDEO;
  324.     UNTIL Kontrolle = [ok];         (* Ende, wenn kein Fehler mehr vorliegt *)
  325.   END; (* betonbemessung *)
  326.  
  327.   (**************************************************************************)
  328.   (*                       Wahl der Art der Bemessung                       *)
  329.  
  330.   PROCEDURE Bemessung;
  331.  
  332.   VAR Wahl : CHAR;
  333.  
  334.   BEGIN
  335.     WRITELN;
  336.     WRITELN ('Bemessung als :  S - Stahltraeger');
  337.     WRITELN ('                 B - Stahlbetontraeger');
  338.     WRITELN ('                 X - keine Bemessung');
  339.     WRITELN;
  340.     WRITE ('    Ihre Wahl :');
  341.     REPEAT
  342.       GOTOXY(18,9); READ (Wahl);
  343.     UNTIL Wahl IN ['s','S','b','B','x','X'];
  344.     CASE Wahl OF
  345.       's','S' : StahlBemessung;
  346.       'b','B' : BetonBemessung;
  347.     END; (* case *)
  348.   END; (* bemessung *)
  349.  
  350. (*--------------------------------------------------------------------------*)
  351.  
  352. PROCEDURE Ausgabe;
  353.  
  354.   BEGIN
  355.     CLRSCR;
  356.     WRITELN ('Auflager A (links)  = ',Auflagerlinks:8:2,' kN');
  357.     WRITELN ('Auflager B (rechts) = ',Auflagerrechts:8:2,' kN');
  358.     WRITELN ('maximales Moment    = ',MaxMoment:8:2,' kNm ',
  359.              ' bei x = ',OrtMaxMoment:5:2,' m');
  360.   END; (* ausgabe *)
  361.  
  362.