10  CLS:PRINT"CALCULO PORTICO SIMPLE BIARTICULADO CON DINTEL A DOS AGUAS (CALPOSI1) EA-95
20  PRINT"METODO ELASTICO (Acero A42b, åe=2600 kp/cmý, å*=2600/(1.33x1.0)=1950)
30  PRINT"A1CALPOR.DAS archivo entrada 15 datos, separados por espacios (V1,V2,H1,H2,H3,V3,V4,L,H,A,M,I,D,I1,I2), utilizando WINDOWS para ir cambiandolos
40  PRINT"A1CALPOR.RES archivo salida solucion momentos y perfiles
50  PRINT"Pulsar <TECLA) para ir visualizando los resultados de calculo
60  PRINT
70  OPTION BASE 1
71  DIM IP(30),I(30),PP(30),IBC(60),IDC(60),MBC(60),MBC1(60),MBC2(60),MBC3(60),MBC4(60),MDC(60),MDC1(60),MDC2(60),MDC3(60),MDC4(60),SBC(60),SDC(60)
72 CF=2600
73 KE=1.35
74 CS=CF/KE
80  'S$=S Datos por archivo, S1$=S Resultados por archivo, S2$=S Sin optimizar perfiles, S3$=Determinar perfil IPE
81  '4 Opciones: Datos por archivo/pantalla y comprobacion/calculo
82  GOSUB 400:'Dimensionado perfiles
85  PRINT
87  PRINT"RESULTADOS: sin optimizar perfiles portico (o con optimiz.) <S>i <>no:
88  PRINT"          : en archivo A1CALPOR.RES (o por pantalla)        <S>i <>no:
89  LOCATE CSRLIN-3,1:INPUT"DATOS     : en archivo A1CALPOR.DAS (o manuales)            <S>i <>no: ",S$:IF S$="S" OR S$="s" THEN S$="S" ELSE 200

100 'Datos por archivo
101 LOCATE CSRLIN-1,1:INPUT"Ruta y nombre archivo datos         <C:\BAS\A1CALPOR.DAS>: ",F$
110 IF F$="" THEN F$="C:\BAS\A1CALPOR.DAS":G$="C:\BAS\A1CALPOR.RES" ELSE G$=LEFT$(F$,LEN(F$)-3)+"RES"
120 PRINT"RESULTADOS en archivo " G$ " (o por pantalla)";:LOCATE,49:INPUT"<S>i <>no: ",S1$:IF S1$="S" OR S1$="s" THEN S1$="S"
130 OPEN F$ FOR INPUT AS 1
140 INPUT #1, V1,V2,H1,H2,H3,V3,V4,L,H,A,M,I,D,IP1,IP2:I$=STR$(I)
151 IF IP1=0 OR IP2=0 THEN IP1=180:IP2=180:S2$="S":GOTO 180
152 PRINT"Optimizar perfiles portico          ";:LOCATE,55:INPUT"<S>i <>no: ",S2$:IF S2$="S" OR S2$="s" THEN S2$="S"
155 IF S2$="S" THEN 180:'A calculo con optimizar perfiles portico

160 'Calculo datos archivo sin optimizar perfiles portico
161 GOSUB 500:'Listado datos archivo por pantalla
165 GOSUB 710:'Complemento listado por pantalla datos de archivo sin optimizar
166 GOSUB 800:'Calculo sin optimizar perfiles archivo
167 GOSUB 2650:'Resultados por pantalla sin optimizar
170 'IF S1$="S" THEN GOSUB 2930:'Impresion resultados en archivo
171 PRINT:INPUT"DATOS por archivo A1CALPOR.DAS (o manuales)     <S>i <>no: ",S$:IF S$="S" OR S$="s" THEN S$="S" ELSE CLOSE 1:GOTO 200
172 GOTO 140:'A siguientes datos archivo

180 'Calculo datos archivo con optimizar perfiles portico 
181 GOSUB 500:'Listado datos archivo por pantalla
182 GOSUB 750:PRINT:'Calculo con optimizar perfiles archivo
184 GOSUB 2600:'Resultados por pantalla con optimizar
185 'IF S1$="S" THEN GOSUB 2930:'Impresion resultados en archivo
186 PRINT:INPUT"DATOS por archivo A1CALPOR.DAS (o manuales)     <S>i <>no: ",S$:IF S$="S" OR S$="s" THEN S$="S" ELSE CLOSE 1:GOTO 200
188 GOTO 140:'A siguientes datos archivo

200 'Datos por teclado
202 PRINT"RESULTADOS: sin optimizar perfiles portico (o con optimiz.)";:LOCATE,61:INPUT"<S>i <>no: ",S2$:IF S2$="S" OR S2$="s" THEN S2$="S"
204 PRINT"          : en archivo A1CALPOR.RES (o por pantalla)";:LOCATE,61:INPUT"<S>i <>no: ",S1$:IF S1$="S" OR S1$="s" THEN S1$="S"
205 IF S1$="S" THEN G$="C:\BAS\A1CALPOR.RES"
211 IF IP1=0 OR IP2=0 THEN IP1=180:IP2=180:'S2$="S":GOTO 280
215 IF S2$<>"S" THEN 280:'A calculo co~ optimizar perfiles portico

259 'Calculo datos teclado sin optimizar perfiles portico
260 GOSUB 600:'Entrada datos por pantalla
263 LOCATE CSRLIN-3,1
265 GOSUB 710:'Complemento listado por pantalla datos manuales sin optimizar
266 GOSUB 800:'Calculo sin optimizar perfiles archivo
267 GOSUB 2650:'Resultados por pantalla sin optimizar
270 'IF S1$="S" THEN GOSUB 2930:'Impresion resultados en archivo
271 PRINT:INPUT"DATOS por archivo A1CALPOR.DAS (o manuales)     <S>i <>no: ",S$:IF S$="S" OR S$="s" THEN S$="S" ELSE CLOSE 1:GOTO 200
272 CLS:GOTO 85:'A nuevos datos archivo

280 'Calculo datos teclado con resultados opt.perf.portico por pantalla
281 'GOSUB 500:'Listado datos archivo por pantalla
282 GOSUB 600:'Entrada datos por pantalla
283 GOSUB 750:PRINT:'Calculo co~ optimizar perfiles archivo
284 GOSUB 2600:'Resultados por pantalla con optimizar
285 'IF S1$="S" THEN GOSUB 2930:'Impresion resultados en archivo
286 'PRINT:INPUT"DATOS por archivo A1CALPOR.DAS (o manuales)     <S>i <>no: ",S$:IF S$="S" OR S$="s" THEN S$="S" ELSE CLOSE 1:GOTO 200
288 CLS:GOTO 85:'A siguientes datos pantalla/archivo

399 'Dimensionado perfiles
400 RESTORE
401 DATA 140,541,16.4,160,869.20,1,180,1320,18.8,200,1940,22.4,220,2770,26.2,240,3890,30.5,270,5790,36.1,300,8360,42.2,330,11770,49.1,360,16270,57.1,400,23130,66.3,450,33740,77.6,500,48200,90.7,550,67120,106,600,92080,122
402 DATA 749,159900,137,751,240300,196,1000,514700,270,1200,936200,355,1600,2370000,540,2000,4818000,724
403 FOR I=1 TO 19:'180-1 200-2 220-3 240-4 270-5 300-6 330-7 360-8 400-9 450-10 500-11 550-12 600-13 753-14 630-15
404 READ IP(I),I(I),PP(I)
405 NEXT I
406 RETURN

500 'Listado datos archivo por pantalla
501 CLS:PRINT"CALCULO PORTICO SIMPLE BIARTICULADO CON DINTEL A DOS AGUAS (CALPOSI1) EA-95
502 PRINT"Carga permanente cubierta (kg/m2)...... V1= " V1
505 PRINT"Sobrecarga nieve (kg/m2)............... V2= " V2
506 PRINT"Sobrecarga viento barlvento (kg/m2)... H1= " H1
510 PRINT"Sobrecarga viento sotavaeto (kg/m2).... H2= " H2
520 PRINT"Sobrecarga sismica sobre montante (kg). H3= 2x" H3
530 PRINT"Carga centrada rail puente grua (kg)... V3= 2x" V3
540 PRINT"Carga descentrada rail puente grua (kg) V4= 1x" V4
550 PRINT"Luz ejes montantes portico (m)......... l = " L
560 PRINT"Altura montantes portico (m)  ......... h = " H
570 PRINT"Altura apoyo viga carrilera (m)........ a = " A
580 PRINT"Separacion apoyo viga carrilera (m).... m = " M
590 PRINT"Pendiente faldones portico (%) ........ i = " VAL(I$)
591 PRINT"Separacion porticos (m) ............... d = " D
592 RETURN

600 'Listado datos manuales por pantalla
601 CLS:PRINT"CALCULO PORTICO SIMPLE BIARTICULADO CON DINTEL A DOS AGUAS (CALPOSI1) EA-95
602 V10=40:V20=50:H10=40:H20=20:L0=20.33:H0=5.85:I0=18.5:D0=6:IP10=360:IP20=240
603 PRINT"Carga permanente cubierta (kg/m2)...... V1=  " V10
604 PRINT"Sobrecarga nieve (kg/m2)............... V2=  " V20
605 PRINT"Sobrecarga viento barlovento (kg/m2)... H1=  " H10
606 PRINT"Sobrecarga viento sotavento (kg/m2).... H2=  " H20
611 PRINT"Sobrecarga sismica sobre montante (kg). H3= 2x " H30
612 PRINT"Carga centrada rail puente grua (kg)... V3= 2x " V30
613 PRINT"Carga descentrada rail puente grua (kg) V4= 1x " V40
614 PRINT"Luz ejes montantes portico (m)......... l =  " L0
615 PRINT"Altura montantes portico (m)  ......... h =  " H0
616 PRINT"Altura apoyo viga carrilera (m)........ a =  " A0
617 PRINT"Separacion apoyo viga carrilera (m).... m =  " M0
618 PRINT"Pendiente faldones portico (%) ........ i =  " I0
619 PRINT"Separacion porticos (m) ............... d =  " D0
620 IF S2$<>"S" THEN 630
623 PRINT"Perfil IPE montante (mm) ............. IP1=  " IP10
624 PRINT"Perfil IPE dintel (mm)  .............. IP2=  " IP20
630 LOCATE 1,1
631 PRINT"CALCULO PORTICO SIMPLE BIARTICULADO CON DINTEL A DOS AGUAS (CALPOSI1)
632 INPUT;"Carga permanente cubierta (kg/m2)...... V1= ";V1$
633 IF V1$="" THEN V1=V10:PRINT ELSE V1=VAL(V1$):PRINT"   "
635 INPUT;"Sobrecarga nieve (kg/m2)............... V2= ";V2$
636 IF V2$="" THEN V2=V20:PRINT ELSE V2=VAL(V2$):PRINT"   "
640 INPUT;"Sobrecarga viento barlovento (kg/m2)... H1= ";H1$
641 IF H1$="" THEN H1=H10:PRINT ELSE H1=VAL(H1$):PRINT"   "
645 INPUT;"Sobrecarga viento sotavento (kg/m2).... H2= ";H2$
646 IF H2$="" THEN H2=H20:PRINT ELSE H2=VAL(H2$):PRINT"   "
650 INPUT;"Sobrecarga sismica sobre montante (kg). H3= 2x";H3
651 IF H3=0 THEN H3=H30:PRINT ELSE PRINT"   "
652 INPUT;"Carga centrada rail puente grua (kg)... V3= 2x";V3
653 IF V3=0 THEN V3=V30:PRINT ELSE PRINT"   "
655 INPUT;"Carga descentrada rail puente grua (kg) V4= 1x";V4
656 IF V4=0 THEN V4=V40:PRINT ELSE PRINT"   "
658 INPUT;"Luz ejes montantes portico (m)......... l = ";L
659 IF L=0 THEN L=L0:PRINT ELSE PRINT"   "
660 INPUT;"Altura montantes portico (m)  ......... h = ";H
661 IF H=0 THEN H=H0:PRINT ELSE PRINT"   "
662 INPUT;"Altura apoyo viga carrilera (m)........ a = ";A
663 IF A=0 THEN A=A0:PRINT ELSE PRINT"   "
664 INPUT;"Separacion apoyo viga carrilera (m).... m = ";M
665 IF M=0 THEN M=M0:PRINT ELSE PRINT"   "
666 INPUT;"Pendiente faldones portico (%) ........ i = ";I$
667 IF I$="" THEN IN=I0:PRINT ELSE IN=VAL(I$):PRINT"   "
668 INPUT;"Separacion porticos (m) ............... d = ";D
669 IF D=0 THEN D=D0:PRINT ELSE PRINT"   "
670 IF S2$<>"S" THEN 690
672 INPUT;"Perfil IPE montante (cm4)............. IP1= ";IP1$
673 IF IP1$="" THEN IP1=IP10:PRINT ELSE IP1=VAL(IP1$):PRINT"   "
674 INPUT;"Perfil IPE dintel (cm4) .............. IP2= ";IP2$
675 IF IP2$="" THEN IP2=IP20:PRINT ELSE IP2=VAL(IP2$):PRINT"   "
690 RETURN

710 'Complemento listado por pantalla datos de archivo sin optimizar(I+cartelas)
712 FOR I=2 TO 15
713 IF IP1<IP(I) THEN IP1=IP(I-1):I1=I(I-1):PP1=PP(I-1):GOTO 715
714 NEXT I
715 FOR I=2 TO 15
716 IF IP2<IP(I) THEN IP2=IP(I-1):I2=I(I-1):PP2=PP(I-1):GOTO 719
717 NEXT I
719 I3=.4*I1+.45*I2+.15*(2*I2):I6=(I3-I2)
720 IF .66*I1<1940 THEN I1$="":KN10=KN1 ELSE I1$="/ 1.5":KN10=KN1/1.5
721 PRINT"Momento inercia montante (cm4)......... I1= " I1 I1$ TAB(60) "IPE=" IP1 "... 180"
722 PRINT"Momento inercia dintel (cm4) .......... I2= " I2 TAB(60) "IPE=" IP2 "+ cartelas"
723 KN1=FIX(2.2*H*PP1):KN2=FIX(1.1*L*PP2):KN3=FIX(1.1*L*(.2*PP1+.075*PP2))
725 PRINT"Peso montante+dintel+cartelas (kg)..... Q =" KN10 "+" KN2 "+" KN3 "=" KN10+KN2+KN3
726 RETURN

750 'Calculo
751 PRINT "IP1(Mab) IP2(Mbc)" TAB(19) "IP4(Mdc) IP5(Med)" TAB(37) "IN1   IN2" TAB(49) "KG(kg)" TAB(60) "K=f(I1,I2,l,h)"
752 IPN1=0:IPN2=0:KN=0
760 FOR I=19 TO 1 STEP -1
770 IP1=IP(I):I1=I(I):PP1=PP(I)
780 FOR J=19 TO 1 STEP -1
790 IP2=IP(J):I2=I(J):PP2=PP(J)
800 I3=.4*I1+.45*I2+.15*(2*I2)
810 F=IN*L/200
820 S=SQR(F^2+L^2/4)
830 IF .66*I1<1940 THEN K=I3*H/(I1*S) ELSE K=I3*H/(.66*(I1+1450)*S)
840 KG1=2*H*PP1:KG2=2*S*PP2:KG3=.6*S*(PP1-PP2)+.15*S*PP2:KG=KG1+KG2+KG3:IF I=14 AND J=14 THEN KGN=KG
841 IF I=19 AND J=19 THEN KGN=KG:'Peso minimo inicial
850 IF KG>KGN AND S2$<>"S" THEN 2410:'Peso superior al minimo
851 IF Z=0 THEN IF IP1<IPN1 AND IP2<IPN2 THEN IF S2$<>"S" THEN RETURN

860 'Carga vertical uniforme
870 P1=(V1+V2)*D
880 VA1=.5*P1*L
890 VE1=VA1
900 U=H^2*(3+K)+F*(3*H+F)
910 HA1=(P1*L^2/32)*(8*H+5*F)/U
920 HE1=HA1
930 MB1=-HA1*H
940 MD1=MB1
950 MC1=P1*L^2/8-(F+H)*HA1
960 MPA1=-HA1*A
970 MPB1=MPA1
980 MPE1=MPA1
990 MPD1=MPA1
1000 FOR X=1 TO FIX(L/2)
1010 MBC1(X)=P1*X*(L-X)/2-HA1*(H+2*F*X/L)
1020 MDC1(X)=MBC1(X)
1030 NEXT X
1040 XCM1=L/2-(2*F*HA1)/(L*P1)
1050 MCM1=VA1*XCM1-(HA1*(H+2*XCM1*F/L))-P1*XCM1^2/2
1060 XC01=XCM1-SQR(XCM1^2-4*HA1*H/(P1*2))
1070 P1=P1*L
1080 'Carga unitaria viento montante y dintel barlovento 
1090 'P2=H1*D
1100 VA2=-H^2/(2*L)
1110 VA2=VA2-F*(F+2*H)/(2*L)
1120 VE2=-VA2
1130 HE2=H^2*(H*(5*K+12)+6*F)/(16*U)
1140 HE21=F*(8*H^2*(K+3)+5*F*(F+4*H))/(16*U)
1150 HE2=HE2+HE21
1160 HA21=-F+HE21
1170 HA2=-H-F+HE2
1180 MD2=-H^3*(H*(5*K+12)+6*F)/(16*U)
1190 MC2=H^2/4+(F+H)*MD2/H
1200 MB2=H^2/2+MD2
1210 MD2=MD2-HE21*H
1220 MC2=MC2-F^2*(4*H^2*(K+2)+F*(5*H+F))/(16*U)
1230 MB2=MB2+HA21*H
1240 MPA2=-HA2*A-A^2/2
1250 MPB2=MPA2
1260 MPE2=-HE2*A
1270 MPD2=MPE2
1280 'Suma acciones H1 barlovento y H2 sotavento
1290 P2=H1*D
1300 P22=H2*D
1310 HE22=-HA2
1320 MD22=-MB2
1330 MPE22=-MPA2:MPD22=-MPB2
1340 VA2=VA2*(P2+P22)
1350 VE2=-VA2
1360 HA2=HA2*P2-HE2*P22
1370 HE2=HE2*P2+HE22*P22
1380 'MA2=MA2*P2-ME2*P22
1390 MPA2=MPA2*P2-MPE2*P22:MPB2=MPB2*P2-MPD2*P22
1400 MB2=MB2*P2-MD2*P22
1410 MC2=MC2*(P2-P22)
1420 'ME2=ME2*P2+ME22*P22
1430 MD2=MD2*P2+MD22*P22
1440 MPE2=MPE2*P2+MPE22*P22:MPD2=MPD2*P2+MPD22*P22
1450 'carga seismo
1460 P2=(P2+P22)*(H+F)+2*H3
1470 VA23=-H3*H/L
1480 VE23=-VA23
1490 HE23=H3*H*(2*K*H+6*H+3*F)/(4*U)
1500 HA23=-H3+HE23
1510 MD23=-HE23*H
1520 MB23=-HA23*H
1530 MPA23=-HA23*A
1540 MPB23=MPA23
1550 MC23=(H3*H/4)-HE23*(F+H)
1560 MPD23=A*MD23/H
1570 MPE23=MPD23
1580 VA2=VA2+VA23-VE23
1590 VE2=VE2+VE23-VA23
1600 HA2=HA2+HA23-HE23
1610 HE2=HE2+HE23-HA23
1620 MB2=MB2+MB23-MD23
1630 MPA2=MPA2+MPA23-MPE23
1640 MPB2=MPB2+MPB23-MPD23
1650 MD2=MD2+MD23-MB23
1660 MPE2=MPE2+MPE23-MPA23
1670 MPD2=MPD2+MPD23-MPB23
1680 FOR X=1 TO FIX(L/2)
1690 MBC2(X)=MB2+X*(MC2-MB2)*2/L
1700 MDC2(X)=MD2+X*(MC2-MD2)*2/L
1710 NEXT X
1720 'Puente grua centrado
1730 P3=V3
1740 VA3=P3
1750 VE3=VA3
1760 HA3=3*P3*M*(K*(H^2-A^2)+H*(2*H+F))/(2*H*U)
1770 HE3=HA3
1780 MB3=P3*M-HA3*H
1790 MD3=MB3
1800 MC3=P3*M-HA3*(H+F)
1810 MPA3=-HA3*A
1820 MPE3=MPA3
1830 MPB3=P3*M-HA3*A
1840 MPD3=MPB3
1850 FOR X=1 TO FIX(L/2)
1860 MBC3(X)=MB3+X*(MC3-MB3)*2/L
1870 MDC3(X)=MD3+X*(MC3-MD3)*2/L
1880 NEXT X
1890 P4=V4
1900 VA4=P4*(L-M)/L
1910 VE4=P4-VA4
1920 VE4=VA4
1930 HA4=3*P4*M*(K*(H^2-A^2)+H*(2*H+F))/(4*H*U)
1940 HE4=HA4
1950 MB4=P4*M-HA4*H
1960 MD4=-HE4*H
1970 MC4=P4*M/2-(F+H)*HA4
1980 MPA4=-HA4*A
1990 MPB4=P4*M-HA4*A
2000 MPE4=-HE4*A
2010 MPD4=MPE4
2020 FOR X=1 TO FIX(L/2)
2030 MBC4(X)=MB4+X*(MC4-MB4)*2/L
2040 MDC4(X)=MD4+X*(MC4-MD4)*2/L
2050 NEXT X
2060 'Envolventes cargas
2070 VA=VA1+VA2+VA3+VA4
2080 VE=VE1+VE2+VE3+VE4
2090 HA=HA1+HA2+HA3+HA4
2100 HE=HE1+HE2+HE3+HE4
2101 'Envolvents momentos y calculo secciones perfiles
2110 MB=MB1+MB2+MB3+MB4:MM=ABS(MB):N=HA:GOSUB 2460
2120 IB=IP:SB=S:I4=IX:IP4=IP
2130 MC=MC1+MC2+MC3+MC4:MM=ABS(MC):N=HA:GOSUB 2460
2140 IC=IP:SC=S
2150 MD=MD1+MD2+MD3+MD4:MM=ABS(MD):N=HA:GOSUB 2460
2160 ID=IP:SD=S:IF I4<IX THEN I4=IX:IP4=IP
2170 MPA=MPA1+MPA2+MPA3+MPA4:MM=ABS(MPA):N=VA:GOSUB 2460
2180 IPA=IP:SPA=S
2190 MPB=MPB1+MPB2+MPB3+MPB4:MM=ABS(MPB):N=VA:GOSUB 2460
2200 IPB=IP:SPB=S
2210 MPD=MPD1+MPD2+MPD3+MPD4:MM=ABS(MPD):N=VD:GOSUB 2460
2220 IPD=IP:SPD=S
2230 MPE=MPE1+MPE2+MPE3+MPE4:MM=ABS(MPE):N=VD:GOSUB 2460
2240 IPE=IP:SPE=S
2250 I5=0
2260 FOR X=1 TO FIX(L/2)
2270 MBC(X)=MBC1(X)+MBC2(X)+MBC3(X)+MBC4(X):MM=ABS(MBC(X)):N=HA:GOSUB 2460
2280 IBC(X)=IP:SBC(X)=S:IF X>=.15*L AND X<=.425*L THEN IF I5<IX THEN I5=IX:IP5=IP
2290 NEXT X
2300 FOR X=1 TO FIX(L/2)
2310 MDC(X)=MDC1(X)+MDC2(X)+MDC3(X)+MDC4(X):MM=ABS(MDC(X)):N=HD:GOSUB 2460
2320 IDC(X)=IP:SDC(X)=S:IF X>=.15*L AND X<=.425*L THEN IF I5<IX THEN I5=IX:IP5=IP
2330 NEXT X
2331 IF S2$="S" THEN RETURN:'No se optimizan perfiles
2332 'Eleccion perfiles maximos (los de I4 e I5 mayores del dintel a partir de 1 m)
2333 'IF Z=0 AND S2$<>"S" THEN IF I1=200 AND I2=100 THEN Z=1:I1=I5:I2=I4:GOTO 800 ELSE 2600
2340 IF Z=1 THEN RETURN:'Fin ultima pasada definitiva y dimensionado cartelas
2341 LOCATE ,1:PRINT IP1 TAB(10) IP2 TAB(19) IP5 TAB(28) IP4;:LOCATE ,1:'Podria finalizar la comprobaci¢n de los perfiles inferiores
2345 'Comprobaci¢n de si I1,I2 coinciden con I5,I4 y adem s se haorran kg
2350 'IF KGP<>KGN THEN LOCATE CSRLIN+1,1:PRINT IP1 IP2;:LOCATE CSRLIN-1,1:'Podria finalizar la comprobaci¢n de los perfiles inferiores
2370 'IF IP1>=IP4 AND IP2>=IP5 THEN KGP=KG ELSE KGP=0
2380 'IF KGP>0 AND KGP<=KGN THEN KGN=KGP:IN1=I4:IN2=I5:KN1=FIX(KG1):KN2=FIX(KG2):KN3=FIX(KG3)
2390 'IF IP1=IP4 AND IP2=IP5 THEN KN=KGN:IPN1=IP4:IPN2=IP5 ELSE KN=0
2400 'IF KGP=KGN THEN PRINT IP1 IP2 TAB(19) IP4 IP5 TAB(33) IN1 IN2 TAB(48) KG TAB(60) USING" #.####";K;:LOCATE ,1
2401 IF IP1=IP4 AND IP2=IP5 THEN IF KG<KGN THEN IPN1=IP4:IPN2=IP5:KGN=KG:IN1=I4:IN2=I5:KN1=FIX(KG1):KN2=FIX(KG2):KN3=FIX(KG3)
2402 IF IP1=IP4 AND IP2=IP5 THEN PRINT IP1 TAB(10) IP2 TAB(19) IP5 TAB(28) IP4 TAB(35) IN1 IN2 TAB(50) FIX(KG) TAB(60) USING" #.####";K
2410 NEXT J
2420 NEXT I

2430 'Calculo con perfiles optimizados (ultima pasada con z=1)
2440 Z=1:I1=IN1:I2=IN2:RETURN

2450 'Calculo de tensiones y dimensionado perfil
2460 N=ABS(N)
2465 S=N/16.4+100*MM/73:IF S<1950 THEN IP=140:IX=541:RETURN
2466 S=N/20.1+100*MM/109:IF S<1950 THEN IP=160:IX=869:RETURN

2470 S=N/23.9+100*MM/146:IF S<1950 THEN IP=180:IX=1320:RETURN
2480 S=N/28.5+100*MM/194:IF S<1950 THEN IP=200:IX=1940:RETURN
2490 S=N/33.4+100*MM/252:IF S<1950 THEN IP=220:IX=2770:RETURN
2500 S=N/39.1+100*MM/324:IF S<1950 THEN IP=240:IX=3890:RETURN
2510 S=N/45.9+100*MM/429:IF S<1950 THEN IP=270:IX=5790:RETURN
2520 S=N/53.8+100*MM/557:IF S<1950 THEN IP=300:IX=8360:RETURN
2530 S=N/62.6+100*MM/713:IF S<1950 THEN IP=330:IX=11770:RETURN
2540 S=N/72.7+100*MM/904:IF S<1950 THEN IP=360:IX=16270:RETURN
2550 S=N/84.5+100*MM/1160:IF S<1950 THEN IP=400:IX=23130:RETURN
2560 S=N/98.8+100*MM/1500:IF S<1950 THEN IP=450:IX=33740!:RETURN
2570 S=N/116+100*MM/1930:IF S<1950 THEN IP=500:IX=48200!:RETURN
2580 S=N/134+100*MM/2440:IF S<1950 THEN IP=550:IX=57120!:RETURN
2590 S=N/156+100*MM/3070:IF S<1950 THEN IP=600:IX=92080!:RETURN
2591 S=N/174+100*MM/4240:IF S<1950 THEN IP=749:IX=159900!:RETURN
2592 S=N/250+100*MM/8240:IF S<1950 THEN IP=751:IX=240300!:RETURN
2593 S=N/344+100*MM/10290:IF S<1950 THEN IP=1000:IX=514700!:RETURN
2594 S=N/453+100*MM/15600:IF S<1950 THEN IP=1200:IX=936200!:RETURN
2595 S=N/688+100*MM/29600:IF S<1950 THEN IP=1600:IX=2370000!:RETURN ELSE S=N/923+100*MM/48180:IP=2000:IX=4818000!:RETURN

2600 'Listado resultados con optimizar por pantalla
2611 I3=FIX(.4*I4+.45*I5+.15*(2*I5)):I6=(I3-I5)
2615 IF .66*I1<1940 THEN I1$="":KN10=KN1 ELSE I1$="/ 1.5":KN10=KN1/1.5
2620 PRINT"Calculo momento inercia montante (cm4). I1=" I4 I1$ TAB(60) "IPE=" IP4 "... 180"
2621 'LOCATE 17,1:PRINT"Calculo momento inercia montante (cm4). I1=" I4 TAB(60) "IPE=" IP4
2630 PRINT"Calculo momento inercia dintel (cm4) .. I2=" I5 "+" I6 TAB(60) "IPE=" IP5 "+ cartelas"
2640 PRINT"Peso montante+dintel+cartelas (kg)..... Q =" KN10 "+" KN2 "+" KN3 "=" KN10+KN2+KN3

2650 'Listado resultados sin optimizar por pantalla
2651 PRINT"RESULTADOS: Gravitat. Vien./Sei. Grua centr. Grua later.  Total   IPE  å(kp/cm2)";
2660 PRINT"  P";TAB(10);"=";:PRINT USING"##########";P1,P2,P3,P4
2670 PRINT" VA";TAB(10);"=";:PRINT USING"##########";VA1,VA2,VA3,VA4,VA
2680 PRINT" HA";TAB(10);"=";:PRINT USING"##########";HA1,HA2,HA3,HA4,HA
2690 PRINT" MA";TAB(10);"=";:PRINT USING"##########";MA1,MA2,MA3,MA4,MA
2700 PRINT" MPA";TAB(10);"=";:PRINT USING"##########";MPA1,MPA2,MPA3,MPA4,MPA,IPA,SPA
2710 PRINT" MPB";TAB(10);"=";:PRINT USING"##########";MPB1,MPB2,MPB3,MPB4,MPB,IPB,SPB
2720 PRINT" MB";TAB(10);"=";:PRINT USING"##########";MB1,MB2,MB3,MB4,MB,IB,SB
2721 IF ABS(MB)>ABS(MD) THEN TOR=FIX(ABS(MB)/((IP4+0.5*IP5)/1000)) ELSE TOR=FIX(ABS(MD)/((IP4+0.5*IP5)/1000))

2730 IF S1$="S" THEN GOSUB 2940:'Impresion resultados en archivo
2740 IF INKEY$="" THEN 2740
2750 FOR X=1 TO FIX(L/2)
2760 PRINT"MBC(";X;")";TAB(10);"=";:PRINT USING"##########";MBC1(X),MBC2(X),MBC3(X),MBC4(X),MBC(X),IBC(X),SBC(X)
2770 NEXT X
2780 PRINT" MC";TAB(10);"=";:PRINT USING"##########";MC1,MC2,MC3,MC4,MC,IC,SC
2790 IF INKEY$="" THEN 2790
2800 FOR X=FIX(L/2) TO 1 STEP -1
2810 PRINT"MDC(";X;")";TAB(10);"=";:PRINT USING"##########";MDC1(X),MDC2(X),MDC3(X),MDC4(X),MDC(X),IDC(X),SDC(X)
2820 NEXT X
2830 IF INKEY$="" THEN 2830
2840 PRINT" MD";TAB(10);"=";:PRINT USING"##########";MD1,MD2,MD3,MD4,MD,ID,SD
2850 PRINT" MPD";TAB(10);"=";:PRINT USING"##########";MPD1,MPD2,MPD3,MPD4,MPD,IPD,SPD
2860 PRINT" MPE";TAB(10);"=";:PRINT USING"##########";MPE1,MPE2,MPE3,MPE4,MPE,IPE,SPE
2870 PRINT" ME";TAB(10);"=";:PRINT USING"##########";ME1,ME2,ME3,ME4,ME
2880 PRINT" HE";TAB(10);"=";:PRINT USING"##########";HE1,HE2,HE3,HE4,HE
2890 PRINT" VE";TAB(10);"=";:PRINT USING"##########";VE1,VE2,VE3,VE4,VE
2891 PRINT"TOR.DINT.";TAB(10);"=" TAB(55) TOR TAB(63) "6+2 x" FIX(TOR/600+1)/10 " t"
2892 'PRINT"PLE.APOY.";TAB(10);"=" TAB(62) IP4/2+200 "x" IP4+200 "x 16 mm"

2900 PRINT"PARA TERMINAR PULSAR <T>";
2910 IN$=INKEY$:IF IN$="" THEN 2910 ELSE IF IN$="T" OR IN$="t" THEN SYSTEM
2920 Z=0:'PRINT:GOTO 140:'A nuevo calculo por archivo
2921 RETURN

2930 'Impresion resultados en archivo
2940 OPEN G$ FOR APPEND AS 2
2950 PRINT #2,"CALCULO PORTICO SIMPLE BIARTICULADO CON DINTEL A DOS AGUAS (CALPOR1)
2960 PRINT #2,"METODO ELASTICO (Acero A42b, åe=2600 kp/cmý, å*=2600/(1.33x1.0)=1950)
2970 PRINT #2,"Carga permanente cubierta (kg/m2)...... V1= " V1
2980 PRINT #2,"Sobrecarga nieve (kg/m2)............... V2= " V2
2990 PRINT #2,"Sobrecarga viento barlovento (kg/m2)... H1= " H1
3000 PRINT #2,"Sobrecarga viento sotavento (kg/m2).... H2= " H2
3010 PRINT #2,"Sobrecarga sismica sobre montante (kg). H3= 2x" H3
3020 PRINT #2,"Carga centrada rail puente grua (kg)..  V3= 2x" V3
3030 PRINT #2,"Carga descentrada rail puente grua (kg) V4= 1x" V4
3040 PRINT #2,"Luz ejes montantes portico (m)......... l = " L
3050 PRINT #2,"Altura montantes portico (m)  ......... h = " H
3060 PRINT #2,"Altura apoyo viga carrilera (m)........ a = " A
3070 PRINT #2,"Separacion apoyo viga carrilera (m).... m = " M
3080 PRINT #2,"Pendiente faldones portico (%) ........ i = " VAL(I$)
3090 PRINT #2,"Separacion porticos (m) ............... d = " D
3100 IF S2$="S" THEN PRINT #2,"Momento inercia montante (cm4)......... I1= " I1 "... 180"
3110 IF S2$="S" THEN PRINT #2,"Momento inercia dintel (cm4) .......... I2= " I2
3115 IF .66*I1<1940 THEN I1$="":KN10=KN1 ELSE I1$="/ 1.5":KN10=KN1/1.5
3120 PRINT #2,"Momento inercia montante (cm4)......... I1=" I4 I1$ TAB(60) "IPE=" IP4
3130 PRINT #2,"Momento inercia dintel (cm4) .......... I2=" I5 "+" I6 TAB(60) "IPE=" IP5 "+ cartelas"
3140 IF S2$<>"S" THEN PRINT #2,"Peso montante+dintel+cartelas (kg)..... Q =" KN10 "+" KN2 "+" KN3 "=" KN10+KN2+KN3
3150 PRINT #2,"RESULTADOS: Gravitat. Vien./Sis. Grua cent. Grua lat. Total     IPE   å(kp/cm2)"
3160 PRINT #2,"  P";TAB(13);"=";:PRINT #2, USING"#########";P1,P2,P3,P4
3170 PRINT #2," VA";TAB(13);"=";:PRINT #2, USING"#########";VA1,VA2,VA3,VA4,VA
3180 PRINT #2," HA";TAB(13);"=";:PRINT #2, USING"#########";HA1,HA2,HA3,HA4,HA
3190 PRINT #2," MA";TAB(13);"=";:PRINT #2, USING"#########";MA1,MA2,MA3,MA4,MA
3200 PRINT #2," MPA";TAB(13);"=";:PRINT #2, USING"#########";MPA1,MPA2,MPA3,MPA4,MPA,IPA,SPA
3210 PRINT #2," MPB";TAB(13);"=";:PRINT #2, USING"#########";MPB1,MPB2,MPB3,MPB4,MPB,IPB,SPB
3220 PRINT #2," MB";TAB(13);"=";:PRINT #2, USING"#########";MB1,MB2,MB3,MB4,MB,IB,SB
3230 FOR X=1 TO FIX(L/2)
3240 PRINT #2,"MBC(";X;")";TAB(13);"=";:PRINT #2, USING"#########";MBC1(X),MBC2(X),MBC3(X),MBC4(X),MBC(X),IBC(X),SBC(X)
3250 NEXT X
3260 PRINT #2," MC";TAB(13);"=";:PRINT #2, USING"#########";MC1,MC2,MC3,MC4,MC,IC,SC
3270 FOR X=FIX(L/2) TO 1 STEP -1
3280 PRINT #2,"MDC(";X;")";TAB(13);"=";:PRINT #2, USING"#########";MDC1(X),MDC2(X),MDC3(X),MDC4(X),MDC(X),IDC(X),SDC(X)
3290 NEXT X
3300 PRINT #2," MD";TAB(13);"=";:PRINT #2, USING"#########";MD1,MD2,MD3,MD4,MD,ID,SD
3310 PRINT #2," MPD";TAB(13);"=";:PRINT #2, USING"#########";MPD1,MPD2,MPD3,MPD4,MPD,IPD,SPD
3320 PRINT #2," MPE";TAB(13);"=";:PRINT #2, USING"#########";MPE1,MPE2,MPE3,MPE4,MPE,IPE,SPE
3330 PRINT #2," ME";TAB(13);"=";:PRINT #2, USING"#########";ME1,ME2,ME3,ME4,ME
3340 PRINT #2," HE";TAB(13);"=";:PRINT #2, USING"#########";HE1,HE2,HE3,HE4,HE
3350 PRINT #2," VE";TAB(13);"=";:PRINT #2, USING"#########";VE1,VE2,VE3,VE4,VE
3351 PRINT #2," TOR.DINT.";TAB(10);"=" TAB(55) TOR TAB(63) "6+2 x" FIX(TOR/600+1)/10 " t"
3360 CLOSE 2
3370 RETURN