10  CLS:PRINT"CALCULO PORTICO SIMPLE BIEMPOTRADO CON DINTEL A DOS AGUAS (CALPOSI2) 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"A2CALPOR.RES archivo salida solucion momentos y perfiles
50  PRINT"Pulsar <TECLA) para ir visualizando los resultados de calculo
60  PRINT
70  OPTION BASE 1
80  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)
81  'S$=S Datos por archivo, S1$=S Resultados por archivo, S2$=S Optimizar perfiles, S3$=Determinar perfil IPE
82  '4 Opciones: Datos por archivo/pantalla y comprobacion/calculo
83  GOSUB 400:'Dimensionado perfiles
85  PRINT:PRINT
87  PRINT"RESULTADOS: SIn optimizar perfiles portico (o con optimiz.) <S>i <>no:
88  PRINT"          : SI en archivo A2CALPOR.RES (o por pantalla)     <S>i <>no:
89  LOCATE CSRLIN-4,1
90  INPUT"DATOS     : SI en archivo A1CALPOR.DAS (o manuales)         <S>i <>no: ",S$:IF S$="S" OR S$="s" THEN S$="S" ELSE PRINT:GOTO 200

100 'Datos por archivo (S$=S)
101 INPUT"Ruta y nombre archivo datos                     <C:\BAS\A2CALPOR.DAS>: ",F$
110 IF F$="" THEN F$="C:\BAS\A2CALPOR.DAS":G$="C:\BAS\A2CALPOR.RES" ELSE G$=LEFT$(F$,LEN(F$)-3)+"RES"
120 PRINT"RESULTADOS en archivo " G$ " (o por pantalla)";:LOCATE,61: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,IN,D,IP1,IP2:I$=STR$(IN):I=IN
151 IF IP1=0 OR IP2=0 THEN IP1=180:IP2=180:S2$="S":GOTO 180
152 'PRINT"Optimizar perfiles portico          ";:LOCATE,49:INPUT"<S>i <>no: ",S2$:IF S2$="S" OR S2$="s" THEN S2$="S"
153 INPUT"          : SIn optimizar perfiles portico (o con optimiz.) <S>i <>no: ",S2$:IF S2$="S" OR S2$="s" THEN S2$="S"
154 'IF S2$="S" THEN 180:'A calculo con optimizar perfiles portico
155 IF S2$<>"S" THEN 180:'A calculo con optimizar perfiles portico

160 'Datos por archivo y sin optimizar perfiles portico (S$=S, S2$=S)
162 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 2900:'Resultados por pantalla sin optimizar
170 IF S1$="S" THEN I4=I1:IP4=IP1:I5=I2:IP5=IP2:GOSUB 3180:'Impresion resultados en archivo
171 PRINT:INPUT"DATOS por archivo A2CALPOR.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 'Datos por archivo con optimizar perfiles portico (S$=S, S2$<>S)
181 GOSUB 500:'Listado datos archivo por pantalla
182 GOSUB 750:PRINT:'Calculo con optimizar perfiles archivo
184 GOSUB 2850:'Resultados por pantalla con optimizar
185 IF S1$="S" THEN GOSUB 3180:'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 (S$<>S)
202 INPUT"RESULTADOS: SIn optimizar perfiles portico (o con optimiz.) <S>i <>no: ",S2$:IF S2$="S" OR S2$="s" THEN S2$="S"
204 INPUT"          : SI en archivo A2CALPOR.RES (o por pantalla)     <S>i <>no: ",S1$:IF S1$="S" OR S1$="s" THEN S1$="S"
205 IF S1$="S" THEN G$="C:\BAS\A2CALPOR.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 con optimizar perfiles portico

260 'Calculo datos teclado con resultados sin opt.perf.portico por pantalla (S$<>S, S2$=S)
261 'LOCATE CSRLIN-3,1
262 GOSUB 600:'Entrada datos por pantalla
263 LOCATE CSRLIN-3,1:'Datos de perfiles sin optimizar por pantalla
265 GOSUB 710:'Complemento listado por pantalla datos manuales sin optimizar
266 GOSUB 800:'Calculo sin optimizar perfiles archivo
267 GOSUB 2900:'Resultados por pantalla sin optimizar
270 IF S1$="S" THEN GOSUB 3180:'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 'GOTO 100:'A nuevos datos archivo
278 CLS:GOTO 85:'A siguientes datos pantalla/archivo

280 'Calculo datos teclado con resultados opt.perf.portico por pantalla (S$<>S, S2$<>S)
282 GOSUB 600:'Entrada datos por pantalla
283 GOSUB 750:PRINT:'Calculo con optimizar perfiles archivo
284 GOSUB 2850:'Resultados por pantalla con optimizar
288 CLS:GOTO 85:'A siguientes datos pantalla/archivo

400 'Dimensionado perfiles
401 RESTORE
402 DATA 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,753,159900,137,630,224000,270
403 FOR I=1 TO 15:'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
502 PRINT"Carga permanente cubierta (kg/m2)...... V1= " V1
505 PRINT"Sobrecarga nieve (kg/m2)............... V2= " V2
506 PRINT"Sobrecarga viento barlovento (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 'Entrada datos manuales por pantalla
601 CLS
602 V10=40:V20=50:H10=40:H20=20:L0=20.33:H0=5.85:I0=18.5:D0=6:IP10=300: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 (cm4)............. IP1=  " IP10
624 PRINT"Perfil IPE dintel (cm4) .............. IP2=  " IP20
630 LOCATE 1,1
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
712 FOR X=2 TO 15
713 IF IP1<IP(X) THEN IP1=IP(X-1):I1=I(X-1):PP1=PP(X-1):GOTO 715 ELSE IF IP1=IP(X) THEN I1=I(X):PP1=PP(X):GOTO 715
714 NEXT X
715 FOR X=2 TO 15
716 IF IP2<IP(X) THEN IP2=IP(X-1):I2=I(X-1):PP2=PP(X-1):GOTO 719 ELSE IF IP2=IP(X) THEN I2=I(X):PP2=PP(X):GOTO 719
717 NEXT X
719 I3=.4*I1+.45*I2+.15*(2*I2):I6=FIX(I3-I2)
720 PRINT"Momento inercia montante (cm4)......... I1= " I1 TAB(60) "IPE=" IP1
721 PRINT"Momento inercia dintel (cm4) .......... I2= " I2 TAB(60) "IPE=" IP2 "+ cartelas"
722 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 =" KN1 "+" KN2 "+" KN3 "=" KN1+KN2+KN3
726 RETURN

750 'Calculo (I1=perfil montante, I2=perfil dintel, I3=Perfil virtual dintel, I4=Perfil calculo montante, I5=Perfil calculo dintel
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:'Tanteo a partir de los maximos e ir reduciendo 
760 FOR I=15 TO 1 STEP -1
770 IP1=IP(I):I1=I(I):PP1=PP(I)
780 FOR J=15 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):'S=.005*L*SQR(L^2+10000)
830 K=I3*H/(I1*S)
840 KG1=2*H*PP1:KG2=2*S*PP2:KG3=.6*S*(PP1-PP2)+.15*S*PP2:KG=KG1+KG2+KG3
841 IF I=15 AND J=15 THEN KGN=KG
850 'IF KG>KGN AND S2$<>"S" THEN 2640
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=(K*H+F)^2+4*K*(H^2+H*F+F^2)
910 HA1=(P1*L^2/8)*(K*(4*H+5*F)+F)/U
920 HE1=HA1
930 MA1=(P1*L^2/48)*(K*H*(8*H+15*F)+F*(6*H-F))/U
940 ME1=MA1
950 MB1=MA1-HA1*H
960 MD1=MB1
970 MC1=P1*L^2/8+MA1-HA1*(H+F)
980 MPA1=MA1-HA1*A
990 MPB1=MPA1
1000 MPE1=MPA1
1010 MPD1=MPA1
1020 FOR X=1 TO FIX(L/2)
1030 MBC1(X)=MA1+VA1*X-HA1*(H+2*X*F/L)-.5*P1*X^2
1040 MDC1(X)=MBC1(X)
1050 NEXT X
1060 'XCM1=L/2-2*F*HA1/(L*P1)
1070 'MCM1=MA1+VA1*XCM1-HA1*(H+2*XCM1*F/L)-P1*XCM1^2/2
1080 'XC01=XCM1-SQR(XCM1^2+4*(MA1-HA1*H)/(P1*2))
1090 'P1=P1*L
1100 'Carga unitaria viento montante y dintel barlovento
1110 'P2=H1*D
1120 VA2=-H^2*K/(2*L*(3*K+1))
1130 VA2=VA2-3*F*(4*K*(F+H)+F)/(8*L*(3*K+1))
1140 VE2=-VA2
1150 HE2=H^2*(K^2*H+K*(2*F+3*H))/(4*U)
1160 HE21=F*(2*K*H^2*(K+4)+F*(10*K*H+5*K*F+F))/(4*U)
1170 HE2=HE2+HE21
1180 HA2=-H-F+HE2
1190 S=(K*H^2*(K+6)+K*F*(15*H+16*F)+6*F^2)/U
1200 T=6*(2*K+1)/(3*K+1)
1210 SS=F*(K*H*(9*F+4*H)+F*(6*H+F))/U
1220 TT=3*(4*H*(3*K+2)+F)/(2*(3*K+1))
1230 MA2=-(H^2*(S+T)+F*(SS+TT))/24
1240 MPA2=MA2-HA2*A-A^2/2
1250 MPB2=MPA2
1260 MB2=MA2-HA2*H-H^2/2
1270 ME2=(H^2*(-S+T)+F*(-SS+TT))/24
1280 MC2=ME2-HE2*(F+H)+VE2*L/2
1290 MD2=ME2-HE2*H
1300 MPE2=ME2-HE2*A
1310 MPD2=MPE2
1320 'Suma acciones H1 barlovento y H2 sotavento
1330 P2=H1*D
1340 P22=H2*D
1350 HE22=-HA2
1360 ME22=-MA2:MPE22=-MPA2
1370 MD22=-MB2:MPD22=-MPB2
1380 VA2=VA2*(P2+P22)
1390 VE2=-VA2
1400 HA2=HA2*P2-HE2*P22
1410 HE2=HE2*P2+HE22*P22
1420 MA2=MA2*P2-ME2*P22
1430 MPA2=MPA2*P2-MPE2*P22:MPB2=MPB2*P2-MPD2*P22
1440 MB2=MB2*P2-MD2*P22
1450 MC2=MC2*(P2-P22)
1460 ME2=ME2*P2+ME22*P22
1470 MD2=MD2*P2+MD22*P22
1480 MPE2=MPE2*P2+MPE22*P22:MPD2=MPD2*P2+MPD22*P22
1490 'Carga seismo
1500 P2=(P2+P22)*(H+F)+2*H3
1510 VA23=-H3*H*3*K/(L*(6*K+2))
1520 VE23=-VA23
1530 HE23=H3*K*H*(K*H+4*H+3*F)/(2*U)
1540 HA23=-H3+HE23
1550 SSS=F*(K*H+2*K*F+F)/U
1560 TTT=((3*K+2)+F)/(2*(3*K+1))
1570 MA23=-H3*H*(SSS+TTT)/2
1580 MPA23=MA23-HA23*A
1590 MPB23=MPA23
1600 MB23=MA23-HA23*H
1610 ME23=H3*H*(-SSS+TTT)/2
1620 MC23=ME23-HE23*(F+H)+VE23*L/2
1630 MD23=ME23-HE23*H
1640 MPE23=ME23-HE23*A
1650 MPD23=MPE23
1660 VA2=VA2+VA23-VE23
1670 VE2=VE2+VE23-VA23
1680 HA2=HA2+HA23-HE23
1690 HE2=HE2+HE23-HA23
1700 MA2=MA2+MA23-ME23
1710 MB2=MB2+MB23-MD23
1720 MPA2=MPA2+MPA23-MPE23
1730 MPB2=MPB2+MPB23-MPD23
1740 ME2=ME2+ME23-MA23
1750 MD2=MD2+MD23-MB23
1760 MPE2=MPE2+MPE23-MPA23
1770 MPD2=MPD2+MPD23-MPB23
1780 FOR X=1 TO FIX(L/2)
1790 MBC2(X)=MB2+X*(MC2-MB2)*2/L
1800 MDC2(X)=MD2+X*(MC2-MD2)*2/L
1810 NEXT X
1820 'Puente grua centrado
1830 P3=V3
1840 VA3=P3
1850 VE3=VA3
1860 B=H-A
1870 HA3=6*P3*M*K*(H*(H+F+K*B)-B*(F+B+K*B))/(H*U)
1880 HE3=HA3
1890 V=(-F^2*H+K*H^2*(2*H+3*F+2*K*B)-K*B*F*(6*H+3*B+4*F)-3*K*B^2*H*(K+2))/U
1900 MA3=P3*M*V/H
1910 ME3=MA3
1920 MB3=MA3-HA3*H+P3*M
1930 MD3=MB3
1940 MC3=MA3-HA3*(H+F)+P3*M
1950 MPA3=MA3-HA3*A
1960 MPE3=MPA3
1970 MPB3=MA3-HA3*A+P3*M
1980 MPD3=MPB3
1990 FOR X=1 TO FIX(L/2)
2000 MBC3(X)=MB3+X*(MC3-MB3)*2/L
2010 MDC3(X)=MD3+X*(MC3-MD3)*2/L
2020 NEXT X
2030 P3=2*P3
2040 'Puente grua descentrado
2050 P4=V4
2060 VE4=P4*M*3*K*A/(L*H*(1+3*K))
2070 VA4=P4-VE4
2080 HA4=3*P4*M*K*(H*(H+F+K*B)-B*(F+B+K*B))/(H*U)
2090 HE4=HA4
2100 W=(H+3*K*B)/(1+3*K)
2110 'V=(-F^2*H+K*H^2*(2*H+3*F+2*K*B)-K*B*F*(6*H+3*B+4*F)+3*K*B^2*H*(K+2))/U
2120 MA4=P4*M*(V-W)/(2*H)
2130 ME4=P4*M*(V+W)/(2*H)
2140 MB4=MA4-HA4*H+P4*M
2150 MD4=ME4-HE4*H
2160 MC4=ME4-HE4*(H+F)+VE4*L/2
2170 MPA4=MA4-HA4*A
2180 MPB4=MA4-HA4*A+P4*M
2190 MPE4=ME4-HE4*A
2200 MPD4=MPE4
2210 FOR X=1 TO FIX(L/2)
2220 MBC4(X)=MB4+X*(MC4-MB4)*2/L
2230 MDC4(X)=MD4+X*(MC4-MD4)*2/L
2240 NEXT X
2250 'Envolventes cargas
2260 VA=VA1+VA2+VA3+VA4
2270 VE=VE1+VE2+VE3+VE4
2280 HA=HA1+HA2+HA3+HA4
2290 HE=HE1+HE2+HE3+HE4
2295 'Envolvents momentos y calculo secciones perfiles
2300 MA=MA1+MA2+MA3+MA4:MM=ABS(MA):N=VA:GOSUB 2690
2310 IA=IP:SA=S:I4=IX:IP4=IP
2320 MB=MB1+MB2+MB3+MB4:MM=ABS(MB):N=HA:GOSUB 2690
2330 IB=IP:SB=S:IF I4<IX THEN I4=IX:IP4=IP
2340 MC=MC1+MC2+MC3+MC4:MM=ABS(MC):N=HA:GOSUB 2690
2350 IC=IP:SC=S
2360 MD=MD1+MD2+MD3+MD4:MM=ABS(MD):N=HA:GOSUB 2690
2370 ID=IP:SD=S:IF I4<IX THEN I4=IX:IP4=IP
2380 ME=ME1+ME2+ME3+ME4:MM=ABS(ME):N=VE:GOSUB 2690
2390 IE=IP:SE=S:IF I4<IX THEN I4=IX:IP4=IP
2400 MPA=MPA1+MPA2+MPA3+MPA4:MM=ABS(MPA):N=VA:GOSUB 2690
2410 IPA=IP:SPA=S
2420 MPB=MPB1+MPB2+MPB3+MPB4:MM=ABS(MPB):N=VA:GOSUB 2690
2430 IPB=IP:SPB=S
2440 MPD=MPD1+MPD2+MPD3+MPD4:MM=ABS(MPD):N=VE:GOSUB 2690
2450 IPD=IP:SPD=S
2460 MPE=MPE1+MPE2+MPE3+MPE4:MM=ABS(MPE):N=VE:GOSUB 2690
2470 IPE=IP:SPE=S
2480 I5=0
2490 FOR X=1 TO FIX(L/2)
2500 MBC(X)=MBC1(X)+MBC2(X)+MBC3(X)+MBC4(X):MM=ABS(MBC(X)):N=HA:GOSUB 2690
2510 IBC(X)=IP:SBC(X)=S:IF X>=.15*L AND X<=.425*L THEN IF I5<IX THEN I5=IX:IP5=IP
2520 NEXT X
2530 FOR X=1 TO FIX(L/2)
2540 MDC(X)=MDC1(X)+MDC2(X)+MDC3(X)+MDC4(X):MM=ABS(MDC(X)):N=HE:GOSUB 2690
2550 IDC(X)=IP:SDC(X)=S:IF X>=.15*L AND X<=.425*L THEN IF I5<IX THEN I5=IX:IP5=IP
2560 NEXT X
2561 IF S2$="S" THEN RETURN:'No se optimizan perfiles
2562 'IF S2$<>"S" THEN RETURN:'No se optimizan perfiles
2570 IF Z=1 THEN RETURN:'Fin ultima pasada definitiva y dimensionado cartelas
2571 'Eleccion perfiles maximos (los de I4 de montante e I5 por debajo los mayores del dintel mayores)
2581 LOCATE ,1:PRINT IP1 TAB(10) IP2 TAB(19) IP5 TAB(28) IP4;:LOCATE ,1:'Podria finalizar la comprobaci¢n de los perfiles inferiores
2600 'Comprobaci¢n de si I1,I2 coinciden con I4,I5 (ente .15 a .425 L) y adem s se ahorran kg
2611 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)
2631 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
2639 IF S2$="S" THEN RETURN
2640 'IF S2$<>"S" THEN RETURN
2641 NEXT J
2650 NEXT I

2660 'Calculo con perfiles optimizados (ultima pasada con z=1)
2670 Z=1:I1=IN1:I2=IN2:GOTO 800

2680 'Calculo de tensiones y dimensionado perfil
2690 N=ABS(N)
2700 S=N/20.1+100*MM/109:IF S<1950 THEN IP=160:IX=869:RETURN 
2710 S=N/23.9+100*MM/146:IF S<1950 THEN IP=180:IX=1320:RETURN 
2720 S=N/28.5+100*MM/194:IF S<1950 THEN IP=200:IX=1940:RETURN 
2730 S=N/33.4+100*MM/252:IF S<1950 THEN IP=220:IX=2770:RETURN 
2740 S=N/39.1+100*MM/324:IF S<1950 THEN IP=240:IX=3890:RETURN 
2750 S=N/45.9+100*MM/429:IF S<1950 THEN IP=270:IX=5790:RETURN 
2760 S=N/53.8+100*MM/557:IF S<1950 THEN IP=300:IX=8360:RETURN 
2770 S=N/62.6+100*MM/713:IF S<1950 THEN IP=330:IX=11770:RETURN
2780 S=N/72.7+100*MM/904:IF S<1950 THEN IP=360:IX=16270:RETURN
2790 S=N/84.5+100*MM/1160:IF S<1950 THEN IP=400:IX=23130:RETURN 
2800 S=N/98.8+100*MM/1500:IF S<1950 THEN IP=450:IX=33740!:RETURN
2810 S=N/116+100*MM/1930:IF S<1950 THEN IP=500:IX=48200!:RETURN
2820 'S=N/134+.9*100*MM/2440:IF S<1950 THEN IP=550:IX=57120!:RETURN ELSE S=N/156+100*MM/3070:IP=600:IX=92080!:RETURN
2830 S=N/134+100*MM/2440:IF S<1950 THEN IP=550:IX=57120!:RETURN
2840 S=N/156+100*MM/3070:IF S<1950 THEN IP=600:IX=92080!:RETURN
2841 S=N/174+100*MM/4240:IF S<1950 THEN IP=753:IX=159900!:RETURN
2842 S=N/250+100*MM/6240:IF S<1950 THEN IP=770:IX=240300!:RETURN ELSE S=N/344+100*MM/7110:IP=630:IX=224000!:RETURN

2850 'Listado resultados con optimizar por pantalla
2860 I3=.4*I4+.45*I5+.15*(2*I5):I6=FIX(I3-I5)
2870 PRINT"Calculo momento inercia montante (cm4). I1=" I4 TAB(61) "IPE=" IP4
2880 PRINT"Calculo momento inercia dintel (cm4) .. I2=" I5 "+" I6 TAB(61) "IPE=" IP5 "+ cartelas"
2890 PRINT"Peso montante+dintel+cartelas (kg)..... Q =" KN1 "+" KN2 "+" KN3 "=" KN1+KN2+KN3

2900 'Listado resultados sin optimizar por pantalla
2901 PRINT"RESULTADOS: Gravitat. Vien./Sei. Grua centr. Grua later.  Total   IPE  e(kp/cm2)";
2910 PRINT"  P";TAB(10);"=";:PRINT USING"##########";P1*L,P2,P3,P4
2920 PRINT" VA";TAB(10);"=";:PRINT USING"##########";VA1,VA2,VA3,VA4,VA
2930 PRINT" HA";TAB(10);"=";:PRINT USING"##########";HA1,HA2,HA3,HA4,HA
2940 PRINT" MA";TAB(10);"=";:PRINT USING"##########";MA1,MA2,MA3,MA4,MA,IA,SA
2950 PRINT" MPA";TAB(10);"=";:PRINT USING"##########";MPA1,MPA2,MPA3,MPA4,MPA,IPA,SPA
2960 PRINT" MPB";TAB(10);"=";:PRINT USING"##########";MPB1,MPB2,MPB3,MPB4,MPB,IPB,SPB
2970 PRINT" MB"TAB(10);"=";:PRINT USING"##########";MB1,MB2,MB3,MB4,MB,IB,SB
2971 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))
2972 'IF ABS(MA)>ABS(ME) THEN ESP=ABS(MA/((IP4+150)/1000)) ELSE ESP=ABS(ME/((IP4+150)/1000))

2980 IF S1$="S" THEN GOSUB 3190:'Impresion resultados
2990 IF INKEY$="" THEN 2990
3000 FOR X=1 TO FIX(L/2)
3010 PRINT"MBC(";X;")";TAB(10);"=";:PRINT USING"##########";MBC1(X),MBC2(X),MBC3(X),MBC4(X),MBC(X),IBC(X),SBC(X)
3020 NEXT X
3030 PRINT" MC";TAB(10);"=";:PRINT USING"##########";MC1,MC2,MC3,MC4,MC,IC,SC
3040 IF INKEY$="" THEN 3040
3050 FOR X=FIX(L/2) TO 1 STEP -1
3060 PRINT"MDC(";X;")";TAB(10);"=";:PRINT USING"##########";MDC1(X),MDC2(X),MDC3(X),MDC4(X),MDC(X),IDC(X),SDC(X)
3070 NEXT X
3080 IF INKEY$="" THEN 3080
3090 PRINT" MD";TAB(10);"=";:PRINT USING"##########";MD1,MD2,MD3,MD4,MD,ID,SD
3100 PRINT" MPD";TAB(10);"=";:PRINT USING"##########";MPD1,MPD2,MPD3,MPD4,MPD,IPD,SPD
3110 PRINT" MPE";TAB(10);"=";:PRINT USING"##########";MPE1,MPE2,MPE3,MPE4,MPE,IPE,SPE
3120 PRINT" ME";TAB(10);"=";:PRINT USING"##########";ME1,ME2,ME3,ME4,ME,IE,SE
3130 PRINT" HE";TAB(10);"=";:PRINT USING"##########";HE1,HE2,HE3,HE4,HE
3139 PRINT" VE";TAB(10);"=";:PRINT USING"##########";VE1,VE2,VE3,VE4,VE
3140 PRINT"TOR.DINT.";TAB(10);"=" TAB(55) TOR TAB(63) "6+2 x" FIX(TOR/600+1)/10 "t"

3141 'PRINT"PLE.APOY.";TAB(10);"=" TAB(62) IP4/2+200 "x" IP4+200 "x 16 mm"
3142 'NUM=2:DIA$="22 (5,4 t)":GOSUB 3143:GOTO 3150:',7854*1,89^2*1950=5,4:'3,03*2600/3^(1/3)=5,4
3143 'IF ESP>10978 THEN NUM=3 ELSE RETURN
3144 'IF ESP>16467 THEN NUM=2:DIA$="30 (10,1 t)" ELSE RETURN:',7854*2,57^2*1950=10,1:'5,61*2600/3^(1/3)=10,1
3145 'IF ESP>20240 THEN NUM=3 ELSE RETURN
3146 'IF ESP>30360 THEN NUM=4 ELSE RETURN
3147 'IF ESP>40480 THEN DIA$="33 (12,6 t)" ELSE RETURN
3148 'IF ESP>50480 THEN NUM=6 ELSE RETURN
3149 'IF ESP>75720 THEN DIA$="36 (14,8 t)":RETURN
3150 'PRINT"ESP.APOY.";TAB(10);"=" TAB(55) FIX(ESP) TAB(62) STR$(NUM) "+2 x o" DIA$

3152 PRINT"PARA CONTINUAR PULSAR <ENTER> TERMINAR PULSAR <T>";
3160 IN$=INKEY$:IF IN$="" THEN 3160 ELSE IF IN$="T" OR IN$="t" THEN SYSTEM
3170 Z=0:'PRINT:IF S1$="S" THEN GOSUB 3190:GOTO 140 ELSE 140
3171 RETURN

3180 'Impresion resultados en archivo
3190 OPEN G$ FOR APPEND AS 2
3200 PRINT #2,"CALCULO PORTICO SIMPLE BIEMPOTRADO CON DINTEL A DOS AGUAS (CALPOR2)
3210 PRINT #2,"METODO ELASTICO (Acero A42b, åe=2600 kp/cmý, å*=2600/(1.33x1.0)=1950)
3220 PRINT #2,"Carga permanente cubierta (kg/m2)...... V1= " V1
3230 PRINT #2,"Sobrecarga nieve (kg/m2)............... V2= " V2
3240 PRINT #2,"Sobrecarga viento barlovento (kg/m2)... H1= " H1
3250 PRINT #2,"Sobrecarga viento sotavento (kg/m2).... H2= " H2
3260 PRINT #2,"Sobrecarga sismica sobre montante (kg). H3= 2x" H3
3270 PRINT #2,"Carga centrada rail puente grua (kg)..  V3= 2x" V3
3280 PRINT #2,"Carga descentrada rail puente grua (kg) V4= 1x" V4
3290 PRINT #2,"Luz ejes montantes portico (m)......... l = " L
3300 PRINT #2,"Altura montantes portico (m)  ......... h = " H
3310 PRINT #2,"Altura apoyo viga carrilera (m)........ a = " A
3320 PRINT #2,"Separacion apoyo viga carrilera (m).... m = " M
3330 PRINT #2,"Pendiente faldones portico (%) ........ i = " VAL(I$)
3340 PRINT #2,"Separacion porticos (m) ............... d = " D
3350 'IF S2$="S" THEN PRINT #2,"Momento inercia montante (cm4)......... I1= " I1
3360 'IF S2$="S" THEN PRINT #2,"Momento inercia dintel (cm4) .......... I2= " I2
3370 PRINT #2,"Momento inercia montante (cm4) ........ I1=" I4 TAB(61) "IPE=" IP4
3380 PRINT #2,"Momento inercia dintel (cm4) .......... I2=" I5 "+" I6 TAB(61) "IPE=" IP5 "+ cartelas"
3390 IF S2$<>"S" THEN PRINT #2,"Peso montante+dintel+cartelas (kg)..... Q =" KN1 "+" KN2 "+" KN3 "=" KN1+KN2+KN3
3400 PRINT #2,"RESULTADOS: Gravitat. Vien./Sis. Grua cent. Grua lat. Total     IPE   å(kp/cm2)"
3410 PRINT #2,"  P";TAB(13);"=";:PRINT #2, USING"#########";P1*L,P2,P3,P4
3420 PRINT #2," VA";TAB(13);"=";:PRINT #2, USING"#########";VA1,VA2,VA3,VA4,VA
3430 PRINT #2," HA";TAB(13);"=";:PRINT #2, USING"#########";HA1,HA2,HA3,HA4,HA
3440 PRINT #2," MA";TAB(13);"=";:PRINT #2, USING"#########";MA1,MA2,MA3,MA4,MA,IA,SA
3450 PRINT #2," MPA";TAB(13);"=";:PRINT #2, USING"#########";MPA1,MPA2,MPA3,MPA4,MPA,IPA,SPA
3460 PRINT #2," MPB";TAB(13);"=";:PRINT #2, USING"#########";MPB1,MPB2,MPB3,MPB4,MPB,IPB,SPB
3470 PRINT #2," MB";TAB(13);"=";:PRINT #2, USING"#########";MB1,MB2,MB3,MB4,MB,IB,SB
3480 FOR X=1 TO FIX(L/2)
3490 PRINT #2,"MBC(";X;")";TAB(13);"=";:PRINT #2, USING"#########";MBC1(X),MBC2(X),MBC3(X),MBC4(X),MBC(X),IBC(X),SBC(X)
3500 NEXT X
3510 PRINT #2," MC";TAB(13);"=";:PRINT #2, USING"#########";MC1,MC2,MC3,MC4,MC,IC,SC
3520 FOR X=FIX(L/2) TO 1 STEP -1
3530 PRINT #2,"MDC(";X;")";TAB(13);"=";:PRINT #2, USING"#########";MDC1(X),MDC2(X),MDC3(X),MDC4(X),MDC(X),IDC(X),SDC(X)
3540 NEXT X
3550 PRINT #2," MD";TAB(13);"=";:PRINT #2, USING"#########";MD1,MD2,MD3,MD4,MD,ID,SD
3560 PRINT #2," MPD";TAB(13);"=";:PRINT #2, USING"#########";MPD1,MPD2,MPD3,MPD4,MPD,IPD,SPD
3570 PRINT #2," MPE";TAB(13);"=";:PRINT #2, USING"#########";MPE1,MPE2,MPE3,MPE4,MPE,IPE,SPE
3580 PRINT #2," ME";TAB(13);"=";:PRINT #2, USING"#########";ME1,ME2,ME3,ME4,ME,IE,SE
3590 PRINT #2," HE";TAB(13);"=";:PRINT #2, USING"#########";HE1,HE2,HE3,HE4,HE
3600 PRINT #2," VE";TAB(13);"=";:PRINT #2, USING"#########";VE1,VE2,VE3,VE4,VE
3610 CLOSE 2
3620 RETURN