%%HP: T(1)A(D)F(.);
DIR
  
     UPDIR
    
  INICIOS
     DEG STD
INDIC.2 PARTIDA
    
  CONDENSA
     INDIC.2
CONDEN
    
  ESFUE
     INDIC.2 ESF
UPDIR { L } PURGE
UPDIR
    
  MODIF
     INDIC.2 SIGA
UPDIR
    
  VER
     INDIC.2 1 NS
      FOR I "TAD."
I STR + OBJ KC BI
* BI TRN SWAP *
"Contribucin de Kc "
I + PROMPT CLEAR KC
"Kc " I + PROMPT
UPDIR
      NEXT CLEAR
UPDIR
    
  INDIC.2
    DIR
       Code
      INICIO.COPIA
         "TAD."
SWAP + OBJ 'TAD'
STO TAD CRDIR TAD
STD CLLCD
"Subestructura( "
H STR + " ):
" +
"Ingrese: Barras - G.L."
+ { 0 } INPUT OBJ
'G' STO 'B' STO
"Subestructura( "
H STR + " ):
" +
"Ingrese lista: Largo"
+ { 0 } INPUT OBJ
B LIST 'LARG' STO
"Subestructura( "
H STR + " ):
" +
"Ingrese Lista: Angulo"
+ { 0 } INPUT OBJ
B LIST 'ANGU' STO
"Ingrese lista: AE"
{ 0 } INPUT OBJ B
LIST 'AE' STO
"Ingrese lista: EI"
{ 0 } INPUT OBJ B
LIST 'EI' STO 1 B
          FOR I
"  v   v  BARRA:"
I STR + { "{" }
INPUT OBJ "B" I
STR + OBJ STO
          NEXT
"DESEA CAMBIAR[S/N]"
"N" INPUT OBJ
          IF 'S'
SAME
          THEN
REVIS
          END
        
      ST
[[ 229.18118467 9.40766550527 ]
 [ 9.40766550527 96.1672473868 ]]
      DIVM
         'GB' STO
KI SIZE OBJ DROP
DROP 'GT' STO
          IF 'GB<GT
' EVAL
          THEN GT
GB - 'GI' STO GB
DUP 2 LIST 0 CON
'KBB' STO GI DUP 2
LIST 0 CON 'KII'
STO GI GB 2 LIST 0
CON 'KIB' STO 1 GT
1 'C' STO
            FOR I C
GT
              FOR J
IF '(IGI)AND(JGI)
' EVAL
THEN 'KI(I,J)' EVAL
DUP 'KII(I,J)' STO
'KII(J,I)' STO
ELSE
  IF '(IGI)AND(J>
GI)' EVAL
  THEN 'KI(I,J)'
EVAL 'KIB(I,J-GI)'
STO
  ELSE 'KI(I,J)'
EVAL DUP 'KBB(I-GI,
J-GI)' STO 'KBB(J-
GI,I-GI)' STO
  END
END
              NEXT
C 1 + 'C' STO
            NEXT
          ELSE 0
'KII' STO 0 'KIB'
STO KI 'KBB' STO
          END
        
      CAL.K
         1 B
          FOR K
LARG K GET AE K GET
EI K GET  L a e
             ANGU
K GET DUP SIN SWAP
COS a L / 12 e * L
3 ^ / 6 e * L 2 ^ /
4 e * L / 2 e * L /
 s c A B C D E
               c 2
^ A * s 2 ^ B * + s
c * A B - * s C * s
2 ^ A * c 2 ^ B * +
c C *  F G H I J
 6 IDN 0 * { 1 2 }
G PUTI H NEG PUTI F
NEG PUTI G NEG PUTI
H NEG PUT { 2 3 } J
PUTI G NEG PUTI I
NEG PUTI J PUT { 3
4 } H PUTI J NEG
PUTI E PUT { 4 5 }
G PUTI H PUT { 5 6
} J NEG PUT DUP TRN
+ { 1 1 } F PUT { 2
2 } I PUT { 3 3 } D
PUT { 4 4 } F PUT {
5 5 } I PUT { 6 6 }
D PUT

              
             "'K"
K STR + OBJ STO K
'CI' STO CALE
          NEXT { G
G } 0 CON 1 B
          FOR W { 6
G } 0 CON "B" W +
OBJ 'BR' STO 1 6
            FOR X
BR X GET DUP
              IF 0
==
              THEN
DROP
              ELSE
X SWAP 2 LIST 1
PUT
              END
            NEXT
DUP DUP "'T1." W +
OBJ STO TRN SWAP
"K" W + OBJ SWAP *
* +
          NEXT 'K'
STO
        
      BOR
         "TAD." L
+ OBJ S1
          IF 'S1'
SAME
          THEN 0
DROP
          ELSE 1 B
            FOR J
UPDIR "S" J + OBJ
"TAD." L + OBJ
PURGE
            NEXT
          END
        
      PARTIDA
         CLLCD
"
  Borrando  archivos
      anteriores

  Espere por favor..."
1 DISP 1 NS
          FOR I
UPDIR "TAD." I +
OBJ INDIC.2 1
LIST PGDIR
          NEXT
SUBE.
        
      SIGA
        
"SUBEST. N" ""
INPUT OBJ 'I' STO
"TAD." I + OBJ T
          IF 'T'
SAME
          THEN { BI
} ORDER
          ELSE { T
BI } ORDER
          END
"DESEA CAMBIAR[S/N]"
"N" INPUT OBJ
          IF 'S'
SAME
          THEN
REVIS
          END CAL.K
RESUL SOB "TAD." I
+ OBJ UPDIR { I }
PURGE
        
      ESF
         PETO RAQ
        
      CONDEN
         CLEAR ST
'KI' STO
"INGRESA A CUANTOS GL
DESEA CONDENSAR"
"" INPUT OBJ DIVM
KBB KIB TRN KII INV
KIB * * - { KII KIB
KI KBB GB C GT KBI
GI } PURGE
        
      ABC TAD.1
      CAC
         PATH OBJ
DROP 'ABC' UPDIR
STO CLEAR ABC "d1"
"" INPUT OBJ 'D1'
STO "d2" "" INPUT
OBJ 'D2' STO 6 IDN
'' STO ANGU CI GET
'' STO D1  SIN *
NEG '(1,3)' STO D1
 COS * '(2,3)'
STO D2  SIN * '(4
,6)' STO D2  COS *
NEG '(5,6)' STO
"K" CI + OBJ  * 
TRN SWAP * "K" CI +
UPDIR OBJ ABC STO
        
      CALE
        
"CACHO RIGIDO(" CI
+ ")[S/N]" + "N"
INPUT OBJ
          IF 'S'
SAME
          THEN CAC
{   CI } PURGE
          END
        
      SOB
        
"Ingrese la Matriz B"
I + PROMPT 'BI' STO
BI SIZE 1 GET DIVM
          IF KII 0

          THEN KBB
KIB TRN KII INV KIB
* * - 'KC' STO
          ELSE KBB
'KC' STO
          END BI
TRN KC BI * * 'SI'
STO UPDIR 1 NS
          FOR P
"TAD." P + OBJ SI
UPDIR
            IF P 1
==
            THEN
'ST' STO
            ELSE ST
+ 'ST' STO
            END
          NEXT
        
      TAD TAD.1
      SUBE.
        
"INGRESE NUMERO DE
 SUBESTRUCTURAS"
"" INPUT OBJ 'NS'
STO 1 NS
          FOR H H
INICIO
"
      Trabajando
 
  Espere por favor..."
1 DISP CAL.K RESUL
"Subestructura:( "
H STR + " ):" +
"
Ingrese la Matriz "
+ H + PROMPT 'BI'
STO BI SIZE 1 GET
DIVM
            IF KII
0 
            THEN
KBB KIB TRN KII INV
KIB * * - 'KC' STO
            ELSE
KBB 'KC' STO
            END BI
TRN KC BI * * 'SI'
STO UPDIR
          NEXT 1 NS
          FOR P
"TAD." P + OBJ SI
UPDIR
            IF P 1
==
            THEN
'ST' STO
            ELSE ST
+ 'ST' STO
            END
          NEXT
        
      REVIS
        
"QUE DESEA CAMBIAR

{AE EI LARG ANGU B Rr}"
PATH OBJ 'LS'
UPDIR STO 'TAD' STO
1 LS 1 -
          FOR I
DROP
          NEXT { LS
} PURGE "" INPUT
OBJ DUP
          IF 'Rr'
SAME
          THEN Rr
TAD SWAP EVAL HALT
SWAP STO
"SIGUE CAMB.[S/N]"
"N" INPUT OBJ
            IF 'S'
SAME
            THEN
REVIS
            END
          ELSE DUP
TAD EVAL "CAMBIE"
SWAP STR INPUT
OBJ SWAP STO
"SIGUE CAMBIANDO
[S / N]"
"N" INPUT OBJ
            IF 'S'
SAME
            THEN
REVIS
            END
          END
        
      INICIO
         "TAD."
SWAP + OBJ 'TAD'
STO TAD CRDIR TAD
STD CLLCD
"Subestructura( "
H STR + " ):
" +
"Ingrese: Barras - G.L."
+ { 0 } INPUT OBJ
'G' STO 'B' STO
"SUB-ESTRUCTURA :( "
H STR + " ):" + {
"LARGE:" "ANGLE:"
"AE:" "EI:" } { 1 5
} { } { 0 0 0 0 }
INFORM DROP OBJ
DROP 'EI' STO 'AE'
STO 'ANGU' STO
'LARG' STO 1 B
          FOR I
"Subestructura: ( "
H STR + "):
" +
"  v   v  BARRA:"
I STR + + { "{" }
INPUT OBJ "B" I
STR + OBJ STO
          NEXT
"DESEA CAMBIAR [S/N]"
"N" INPUT OBJ
          IF 'S'
SAME
          THEN
REVIS
          END
        
      RESUL
        
"Tiene Matriz T (S / N)"
"N" INPUT OBJ
          IF 'N'
SAME
          THEN K
'KI' STO
          ELSE
CASO1
          END
        
      CASO1
        
"Ingrese T" PROMPT
'T' STO T TRN K T *
* 'KI' STO
        
      NS 1
      PETO
        DIR
          
             UPDIR
            
          RAQ
            
"N SUBEST. A LA
CUAL DESEA CALCULAR 
EL ESFUERZO"
"" INPUT OBJ UPDIR
'L' STO BOR
"INPUT ? {U} Fzas c/r
a los G.B.T.Indeptes."
PROMPT "TAD." L +
OBJ ST INV SWAP *
'U' STO BI U * 'rB'
STO
              IF
KII 0 
              THEN
KII INV KIB * rB *
NEG 'rI' STO rB rI
1 ROW+
              ELSE
rB
              END T
              IF
'T' SAME
              THEN
'R' STO
              ELSE
T SWAP * 'R' STO
              END
UPDIR PETO CAD01
            
          CAD01
             UPDIR
"TAD." L + OBJ R
OBJ OBJ DROP DROP
1
              FOR I
"R" I STR + OBJ
STO -1
              STEP
1 B
              FOR I
"K" I STR + OBJ
"B" I STR + OBJ
'BR' STO 1 6
FOR J
  IF BR J GET DUP 0

  THEN "R" SWAP
STR + OBJ
  ELSE DROP 0
  END
NEXT { 6 1 } ARRY
* "S" I STR + OBJ
STO
              NEXT
{ R1 R2 R3 BR R4 R5
R6 R7 R8 R9 R10 BR
} PURGE
            
        END
    END
END
