%%HP: T(1)A(R)F(.);

"VIGAS POR HARDY CROSS
...V.1.4"
MSGBOX
"SI EXISTE EL DIRECTORIO TRABAJO BORRARLO"
MSGBOX STD 'TRABAJO' CRDIR
TRABAJO { MOM1 MOM2 MOM3 MOM4 }
'LISTA' STO
" ij SWAP GET SWAP TEMP SWAP
GET *
 "
OBJ 'COGT' STO
"
 2 * 2 - 
 " OBJ 'IZQ' STO
"
 2 * 1 - 
 " OBJ 'DER' STO
{ } 'TEMP2' STO { } 'TEMP1' STO
1. 'J' STO { } 'TEMP3' STO
"Nro. Nudos" "" INPUT OBJ 'NN'
STO
"Momentos Externos en los nudos
Ejm. para una viga con 5 nudos
y momento antihorario de 7 en
el nudo D seria [0 0 0 -7 0]"
"" INPUT OBJ 'Mext' STO
"FACTORES DE TRANSPORTE.HACIA  
 Para el mismo ejm de la viga,
y tomando todos biempotrados
seria 5 nud  4 tramos  
[0.5 0.5 0.5 0.5]"
"" INPUT OBJ 'fijD' STO
"FACTORES DE TRANSPORTE.HACIA  
 Para el mismo ejm de la viga,
y tomando todos biempotrados
seria 5 nud  4 tramos  
[0.5 0.5 0.5 0.5]"
"" INPUT OBJ 'fijI' STO
"H.CROSS VIGA ALTERNO" { { "ij"
"[ij i+1j]" } { "mij"
"[mij mi+1j]" } } { 1. 1. } { }
{ } INFORM DROP EVAL 'mij' STO
'ij' STO
"GDLs 
Q nudos son GDL? 
Para la misma viga con 5 nudos
para decir q A y E no son GDL 
y el resto si es: [0 1 1 1 0]
"
"" INPUT OBJ 'GDLs' STO 1. 'I'
STO
  WHILE I NN 1. + <
  REPEAT
    IF GDLs I GET 1. ==
    THEN "M" I + OBJ 'TEMP3' I
STO+
      IF J 1. ==
      THEN 'TEMP1' I STO+
      ELSE 'TEMP2' I STO+
      END 'J' -1. STO*
    END 'I' INCR DROP
  END DEPTH LIST 'ETIQUE' STO
1. 'I' STO { 8. } ij AXL SIZE +
0. CON 'PRINCIPAL' STO 1. 'I'
STO
  IF "Metodo" { { "Simultaneo"
1. } { "Alterno" 0. } } 1.
CHOOSE DROP
  THEN
    WHILE I 4. 
    REPEAT 1. 'K' STO TEMP3 0. *
'TEMP' STO
      WHILE K TEMP3 SIZE 
      REPEAT TEMP3 K GET 'J' STO
        IF J 1. ==
        THEN TEMP 1.
          IF I 1. ==
          THEN Mext 1. GET mij
1. GET -
          ELSE PRINCIPAL { } I
1. - 2. * + 1. + GET NEG
          END PUT 'TEMP' STO
PRINCIPAL { } I 2. * 1. - + 1. +
1. J COGT PUT 'PRINCIPAL' STO
PRINCIPAL { } I 2. * 2. - + 2. +
PRINCIPAL { } I 2. * 1. - + 1. +
GET fijD 1. GET * PUT
'PRINCIPAL' STO
        ELSE
          IF J NN ==
          THEN TEMP TEMP SIZE
            IF 1. I ==
            THEN Mext NN GET mij
NN IZQ GET -
            ELSE PRINCIPAL { } I
1. - 2. * + NN IZQ + GET NEG
            END PUT 'TEMP' STO
PRINCIPAL { } I 2. * 1. - + NN
IZQ + TEMP SIZE NN IZQ COGT PUT
'PRINCIPAL' STO PRINCIPAL { } I
2. * + NN 2. * 3. - + PRINCIPAL
{ } I 2. * 1. - + NN IZQ + GET
fijI NN 1. - GET * PUT
'PRINCIPAL' STO
          ELSE TEMP K
            IF I 1. ==
            THEN Mext J GET mij
J IZQ GET mij J DER GET + -
            ELSE PRINCIPAL { } I
1. - 2. * + J IZQ + GET
PRINCIPAL { } I 1. - 2. * + J
DER + GET + NEG
            END PUT 'TEMP' STO
PRINCIPAL { } I 2. * 1. - + J
IZQ + K J IZQ COGT PUT
'PRINCIPAL' STO PRINCIPAL { } I
2. * 1. - + J DER + K J DER
COGT PUT 'PRINCIPAL' STO
PRINCIPAL { } I 2. * + J 2. * 3.
- + PRINCIPAL { } I 2. * 1. - +
J 2. * 2. - + GET fijI J 1. -
GET * PUT 'PRINCIPAL' STO
PRINCIPAL { } I 2. * + J 2. * +
PRINCIPAL { } I 2. * 1. - + J 2.
* 1. - + GET fijD J GET * PUT
'PRINCIPAL' STO
          END
        END 'K' INCR DROP
      END TEMP ETIQUE TAG LISTA
I GET STO 'I' INCR DROP
    END
  ELSE
    WHILE I 4. 
    REPEAT 1. 'K' STO TEMP3 0. *
'TEMP' STO
      WHILE K TEMP1 SIZE 
      REPEAT TEMP1 K GET 'J' STO
        IF J 1. ==
        THEN TEMP 1.
          IF I 1. ==
          THEN Mext 1. GET mij
1. GET -
          ELSE PRINCIPAL { } I
1. - 2. * + 1. + GET NEG
          END PUT 'TEMP' STO
PRINCIPAL { } I 2. * 1. - + 1. +
1. J COGT PUT 'PRINCIPAL' STO
PRINCIPAL { } I 2. * 1. - + 2. +
PRINCIPAL { } I 2. * 1. - + 1. +
GET fijD 1. GET * PUT
'PRINCIPAL' STO
        ELSE
          IF J NN ==
          THEN TEMP TEMP SIZE
            IF 1. I ==
            THEN Mext NN GET mij
NN IZQ GET -
            ELSE PRINCIPAL { } I
1. - 2. * + NN IZQ + GET NEG
            END PUT 'TEMP' STO
PRINCIPAL { } I 2. * 1. - + NN
IZQ + TEMP SIZE NN IZQ COGT PUT
'PRINCIPAL' STO PRINCIPAL { } I
2. * 1. - + NN 2. * 3. - +
PRINCIPAL { } I 2. * 1. - + NN
IZQ + GET fijI NN 1. - GET * PUT
'PRINCIPAL' STO
          ELSE TEMP K 2. * 1. -
            IF I 1. ==
            THEN Mext J GET mij
J IZQ GET mij J DER GET + -
            ELSE PRINCIPAL { } I
1. - 2. * + J IZQ + GET
PRINCIPAL { } I 1. - 2. * + J
DER + GET + NEG
            END PUT 'TEMP' STO
PRINCIPAL { } I 2. * 1. - + J
IZQ + K 2. * 1. - J IZQ COGT
PUT 'PRINCIPAL' STO PRINCIPAL {
} I 2. * 1. - + J DER + K 2. *
1. - J DER COGT PUT 'PRINCIPAL'
STO PRINCIPAL { } I 2. * 1. - +
J 2. * 3. - + PRINCIPAL { } I 2.
* 1. - + J 2. * 2. - + GET fijI
J 1. - GET * PUT 'PRINCIPAL' STO
PRINCIPAL { } I 2. * 1. - + J 2.
* + PRINCIPAL { } I 2. * 1. - +
J 2. * 1. - + GET fijD J GET *
PUT 'PRINCIPAL' STO
          END
        END 'K' INCR DROP
      END 1. 'K' STO
      WHILE K TEMP2 SIZE 
      REPEAT TEMP2 K GET 'J' STO
        IF J NN ==
        THEN CLEAR TEMP TEMP
SIZE
          IF 1. I ==
          THEN Mext NN GET mij
NN IZQ GET PRINCIPAL { } 1. + NN
IZQ + GET + -
          ELSE PRINCIPAL { } I
2. * 1. - + NN IZQ + GET NEG
          END PUT 'TEMP' STO
PRINCIPAL { } I 2. * + NN IZQ +
TEMP SIZE NN IZQ COGT PUT
'PRINCIPAL' STO PRINCIPAL { } I
2. * + NN 2. * 3. - + PRINCIPAL
{ } I 2. * + NN IZQ + GET fijI
NN 1. - GET * PUT 'PRINCIPAL'
STO
        ELSE TEMP K 2. *
          IF I 1. ==
          THEN Mext J GET mij J
9. 'PRUEBA' STO IZQ GET mij J
DER GET + PRINCIPAL { } I 2. *
1. - + J IZQ + GET + PRINCIPAL {
} I 2. * 1. - + J DER + GET + -
          ELSE PRINCIPAL { } I
2. * 1. - + J IZQ + GET
PRINCIPAL { } I 2. * 1. - + J
DER + GET + NEG
          END PUT 'TEMP' STO
PRINCIPAL { } I 2. * + J IZQ + K
2. * J IZQ COGT PUT 'PRINCIPAL'
STO PRINCIPAL { } I 2. * + J DER
+ K 2. * J DER COGT PUT
'PRINCIPAL' STO PRINCIPAL { } I
2. * + J 2. * 3. - + PRINCIPAL {
} I 2. * + J 2. * 2. - + GET
fijI J 1. - GET * PUT
'PRINCIPAL' STO PRINCIPAL { } I
2. * + J 2. * + PRINCIPAL { } I
2. * + J 2. * 1. - + GET fijD J
GET * PUT 'PRINCIPAL' STO
        END 'K' INCR DROP
      END TEMP ETIQUE TAG LISTA
I GET STO 'I' INCR DROP
    END
  END LISTA ETIQUE mij MOM1 MOM2
MOM3 MOM4 PRINCIPAL UPDIR
RESULTADOS 'PRINCIPAL' STO
'MOM4' STO 'MOM3' STO 'MOM2' STO
'MOM1' STO 'mij' STO 'ETIQUE'
STO 'LISTA' STO PRINCIPAL ROW
DROP + + + + + + + mij + 'MOM'
STO 'mij' PURGE LISTA EVAL ADD
ADD ADD ETIQUE TAG 'MDES' STO
'ETIQUE' PURGE 'LISTA' PURGE
UPDIR TRABAJO CLVAR UPDIR
'TRABAJO' PGDIR 3. FIX
"AUTOR:ROBERTO BARRENECHEA MAIL:ROBERTO10102000@YAHOO.COM"
MSGBOX
