1 REM TACKER:  jovan (Jovan Trujillo)
2 REM DATE:    09-Aug-16 16:40:51
3 REM CHECKED: TurboBasic
100 REM			*** PROGRAM PJFRAME ***
105 REM 	AUTHOR:
110 REM			    DAVID K. BROWN
112 REM		 DEPARTMENT OF MECHANICAL ENGINEERING
113 REM 	        UNIVERSITY OF GLASGOW
120 REM 		         SCOTLAND
125 REM		
130 REM				March 2015
135 REM			    (VERSION 3/10/15)
140 REM		** THE PROGRAM WILL ANALYSE PLANE
141 REM		   FRAME/TRUSS PROBLEMS WITH UP TO
142 REM		   40 NODES AND 40 MEMBERS.	  		**
145 REM 	
146 REM 	** LOADING IS APPLIED THROUGH COORDINATE
147 REM		   NODAL FORCES AND 4 TYPES OF DISPLACEMENT
148 REM 	   BOUNDARY CONDITIONS ARE ALLOWED. **
149 REM
150 REM		** DATA INPUT IS FROM THE USER VIA THE KEYBOARD
151 REM		   (IN RESPONSE TO PROMPTS APPEARING ON THE SCREEN). **
153 REM
155 REM     ** OUTPUT IS SEND DIRECT TO THE PRINTER AND CONSISTS OF:
156 REM			NODAL DISPLACEMENTS AND FORCES;
157 REM 		MEMBER FORCES, STRESSES AND ELONGATIONS.   		 **
160 REM
170 REM
220 PN$ = "PJFRAME"
225 GOSUB 50140 : REM CLEARSCREEN
230 MX = 40 : REM MAX # OF MEMBERS
240 NX = 40 : REM MAX # OF NODES
245 NF = 2*NX : REM MAX # OF DEGREES OF FREEDOM
260 DIM NI(MX),NJ(MX),A(MX),E(MX)
270 DIM P(NF),PO(NF+2)
280 DIM X(NX),Y(NX),KODE(NX)
290 DIM KS(NF,NF),KH(NF,NF)
300 DIM PH(NF),F(NF),SP$(NX)
310 IR = 0
320 FOR I = 1 TO NF : PO(I) = 0 : P(I) = 0 : PH(I) = 0 : F(I) = 0 : NEXT I
330 FOR I = 1 TO NF
340 FOR J = 1 TO NF
350 KH(I,J) = 0 : KS(I,J) = 0
360 NEXT J
370 NEXT I
380 IF IR = 1 THEN 600
390 REM		** DATA IS NOW REQUESTED
400 TM$ = "TOO MANY " : MA$ = " MAXIMUM ALLOWED = "
410 PRINT "HOW MANY MEMBERS IN THE STRUCTURE "; : INPUT NM
420 IF NM > MX THEN PRINT TM$;"MEMBERS,";MA$;MX : GOTO 410
430 PRINT "HOW MANY NODES "; : INPUT NN
440 IF NN > NX THEN PRINT TM$;"NODES,";MA$;NX : GOTO 430
450 PRINT : PRINT
460 PRINT "      NODAL DATA IS REQUIRED" : PRINT
470 PRINT "     NODE NUMBER  "; : INPUT I
480 IF I < 1 OR I > NN THEN PRINT "INVALID NODE NUMBER " : GOTO 470
490 PRINT "TYPE IN KODE (SEE SHEET) "; : INPUT KODE(I)
500 IF KODE(I) < 1 OR KODE(I) > 4 THEN PRINT "INVALID KODE " : GOTO 490
510 PRINT "X,Y COORDS OF NODE";I;"  "; : INPUT X(I),Y(I)
520 PRINT
530 PRINT "APPLIED X,Y FORCES "
540 PRINT "     AT NODE";I;"  ";
550 INPUT PO(2*I-1),PO(2*I) : PRINT
560 PRINT "ANY MORE NODES OR CORRECTIONS [Y/N] ";
570 INPUT AN$ : L1$ = LEFT$(AN$,1)
580 IF L1$ = "Y" OR L1$ = "y" THEN GOTO 470
590 IF L1$ <> "N" AND L1$ <> "n" THEN GOTO 560
600 PRINT "DO YOU WISH A PRINT-OUT OF THE NODAL DATA [Y/N] ";
610 INPUT AN$ : L1$ = LEFT$(AN$,1)
620 IF L1$ = "N" OR L1$ = "n" THEN GOTO 800
630 IF L1$ <> "Y" AND L1$ <> "y" THEN GOTO 600
640 GOSUB 60120 : REM OPEN PRINTER CHANNEL
650 P$ = "          ****   PROGRAM " + PN$ + "     ****"
660 GOSUB 60000 : IP = 2 : GOSUB 60060
670 P$ = " N KODE    X           Y"
680 P$ = " " + P$
690 P$ = P$ + "          PX          PY" : GOSUB 60000
700 FW = 12 : NS = 3
710 FOR I = 1 TO NN
720 XA = I : GOSUB 30000 : P$ = XA$
730 XA = KODE(I) : GOSUB 30000 : P$ = P$ + XA$
740 XS = X(I) : GOSUB 10040 : P$ = P$ + XS$
750 XS = Y(I) : GOSUB 10040 : P$ = P$ + XS$
760 XS = PO(2*I - 1) : GOSUB 10040 : P$ = P$ + XS$
770 XS = PO(2*I) : GOSUB 10040 : P$ = P$ + XS$ : GOSUB 60000
780 NEXT I
790 GOSUB 60130 : REM CLOSE PRINTER CHANNEL
800 PRINT "DO YOU WISH TO CORRECT THE DATA [Y/N] ";
810 INPUT AN$ : L1$ = LEFT$(AN$,1)
820 IF L1$ = "Y" OR L1$ = "y" THEN GOTO 460
830 IF L1$ <> "N" AND L1$ <> "n" THEN GOTO 800
840 IF IR = 1 THEN GOTO 970
850 N = 2*NN
860 GOSUB 50140
870 PRINT "        MEMBER DATA IS REQUIRED"
880 PRINT : PRINT : PRINT "INPUT THE MEMBER #,& THE I,J OF ITS END NODES";
890 INPUT L, NI(L), NJ(L)
900 IF L < 1 OR L > NM THEN PRINT "INVALID MEMBER NUMBER" : GOTO 880
910 PRINT "INPUT THE AREA AND ELASTIC MODULUS OF THE MEMBER ";
920 INPUT A(L), E(L)
930 PRINT : PRINT "ANY MORE MEMBERS OR CORRECTIONS [Y/N] ";
940 INPUT AN$ : L1$=LEFT$(AN$,1)
950 IF L1$ = "Y" OR L1$ = "y" THEN GOTO 880
960 IF L1$ <> "N" AND L1$ <> "n" THEN GOTO 930
970 PRINT "DO YOU WISH A PRINT-OUT OF MEMBER DATA [Y/N] ";
980 INPUT AN$ : L1$ = LEFT$(AN$,1)
990 IF L1$ = "N" OR L1$ = "n" THEN GOTO 1120
1000 IF L1$ <> "Y" AND L1$ <> "y" THEN GOTO 970
1010 GOSUB 60120 : REM OPEN PRINTER CHANNEL
1020 GOSUB 60040
1030 P$ = "  M  NI  NJ  AREA        E" : GOSUB 60000
1040 FOR L = 1 TO NM
1050 XA = L : GOSUB 30000 : P$ = XA$ + " "
1060 XA = NI(L) : GOSUB 30000 : P$ = P$ + XA$ + "  "
1070 XA = NJ(L) : GOSUB 30000 : P$ = P$ + XA$ + "  "
1080 XS = A(L) : GOSUB 10000 : P$ = P$ + XS$
1090 XS = E(L) : GOSUB 10000 : P$ = P$ + XS$ : GOSUB 60000
1100 NEXT L
1110 GOSUB 60130 : REM CLOSE PRINTER CHANNEL
1120 PRINT "DO YOU WISH TO CORRECT THE DATA [Y/N]  ";
1130 INPUT AN$ : L1$ = LEFT$(AN$,1)
1140 IF L1$ = "Y" OR L1$ = "y" THEN GOTO 880
1150 IF L1$ <> "N" AND L1$ <> "n" THEN GOTO 1120
1160 GOSUB 50140 : PRINT " PROGRAM " + PN$ + " IS NOW RUNNING ....."
1170 FOR I = 1 TO 5 : PRINT : NEXT I
1180 REM ** SCAN THROUGH ALL MEMBERS DETERMINING
1190 REM    ALL THEIR STIFFNESS COEFFICIENTS AND
1200 REM    LODGING THEM IN THE UNCONDENSED
1210 REM    GLOBAL STIFFNESS MATRIX [KS].        **
1220 REM
1230 L1 = 0
1240 L = 0
1250 L = L + 1
1260 II = NI(L)
1270 JJ = NJ(L)
1280 K = 2*NJ(L)
1290 M = 2*NI(L)
1300 GOTO 3390
1310 Z = -1
1320 J = 1
1330 ON J GOTO 1440,1370,1400,1340,1500
1340 Z = 1
1350 K = 2*NJ(L)
1360 GOTO 1440
1370 Z = 1
1380 K = 2*NI(L)
1390 GOTO 1440
1400 Z = -1
1410 M = 2*NJ(L)
1420 REM ** LOCATE STIFFNESS COEFFICIENTS
1430 REM    INTO STIFFNESS MATRIX.
1440 KS(K-1,M-1)=KS(K-1,M-1)+Z*CL*CL*E(L)*A(L)/DL
1450 KS(K-1,M)=KS(K-1,M)+Z*CM*CL*E(L)*A(L)/DL
1460 KS(K,M-1)=KS(K,M-1)+Z*CM*CL*E(L)*A(L)/DL
1470 KS(K,M) = KS(K,M) + Z*CM*CM*E(L)*A(L)/DL
1480 J = J + 1
1490 GOTO 1330
1500 IF L - NM >= 0 THEN GOTO 1540
1510 IF L - NM < 0 THEN GOTO 1250
1520 REM **  HOLD UNCONDENSED LOAD VECTOR [P] IN [PH],
1530 REM     HOLD UNCONDENSED STIFFNESS MATRIX [KS] IN [KH]. **
1540 FOR I = 1 TO N
1550 P(I) = PO(I)
1560 PH(I) = P(I)
1570 NEXT I
1580 FOR I = 1 TO N
1590 FOR J = 1 TO N
1600 KH(I,J) = KS(I,J)
1610 NEXT J
1620 NEXT I
1630 REM ** USING KODE AT EACH NODE,
1640 REM    PROGRESSIVELY CONDENSE THE
1650 REM    STIFFNESS MATRIX [KS] AND HOLD
1660 REM    FINALLY IN [KS]; SIMILARLY
1670 REM    CONDENSE [P] INTO [P].         **
1680 MZ = 1
1690 FOR IJ = 1 TO NN : REM&987654321 THIS LOOP ENDS AT REM&123456789
1700 ON KODE(IJ) GOTO 2030,1890,1750,1720
1710 PRINT "KODE(";IJ;") WRONG" : GOTO 3640
1720 MZ = MZ + 2
1730 GOTO 2140
1740 REM
1750 FOR I = MZ TO N
1760 P(I) = P(I+1)
1770 FOR J = 1 TO N
1780 KS(I,J) = KS(I+1,J)
1790 NEXT J
1800 NEXT I
1810 FOR J = MZ TO N
1820 FOR I = 1 TO N
1830 KS(I,J) = KS(I,J+1)
1840 NEXT I
1850 NEXT J
1860 MZ = MZ + 1
1870 GOTO 2140
1880 REM
1890 FOR I = MZ TO N
1900 P(I+1) = P(I+2)
1910 FOR J = 1 TO N
1920 KS(I+1,J) = KS(I+2,J)
1930 NEXT J
1940 NEXT I
1950 FOR J = MZ TO N
1960 FOR I = 1 TO N
1970 KS(I,J+1) = KS(I,J+2)
1980 NEXT I
1990 NEXT J
2000 MZ = MZ + 1
2010 GOTO 2140
2020 REM
2030 FOR I = MZ TO N
2040 P(I) = P(I+2)
2050 FOR J = 1 TO N
2060 KS(I,J) = KS(I+2,J)
2070 NEXT J
2080 NEXT I
2090 FOR J = MZ TO N
2100 FOR I = 1 TO N
2110 KS(I,J) = KS(I,J+2)
2120 NEXT I
2130 NEXT J
2140 NEXT IJ : REM&123456789  THIS LOOP STARTS AT REM&987654321
2150 MZ = MZ - 1
2160 M = MZ
2170 GOSUB 60120 : REM OPEN PRINTER
2180 GOSUB 60040
2190 P$ =  "" : MQ = MZ
2200 IF MQ > 6 THEN MQ = 6 : P$ = "TOP LEFT 6X6 CORNER OF THE "
2210 P$ = P$ + "CONDENSED STIFFNESS MATRIX" : GOSUB 60000
2220 FW = 12 : NS = 4 : REM * DON'T INCREASE FW! **
2230 FOR I = 1 TO MQ : P$ = ""
2240 FOR J = 1 TO MQ
2250 XS = KS(I,J) : GOSUB 10040 : P$ = P$ + XS$
2260 NEXT J : GOSUB 60000 : GOSUB 60040
2270 NEXT I
2280 FW = 12 : NS = 4
2290 P$ = "    CONDENSED LOAD VECTOR" : GOSUB 60000
2300 FOR I = 1 TO MZ
2310 XS = P(I) : GOSUB 10000 : P$ = "        " + XS$ : GOSUB 60000
2320 NEXT I
2330 GOSUB 60130 : REM CLOSE PRINTER
2340 PRINT "    DO YOU WISH THE PROGRAM TO CONTINUE [Y/N]  ";
2350 INPUT AN$ : L1$ = LEFT$(AN$,1)
2360 IF L1$ = "N" OR L1$ = "n" THEN GOTO 3640
2370 IF L1$ <> "Y" AND L1$ <> "y" THEN GOTO 2340
2380 REM ** SOLUTION OF EQUATIONS NOW BEGINS
2390 REM    BY GAUSSIAN ELIMINATION          **
2400 M1 = M - 1
2410 FOR I = 1 TO M1
2420 L = I + 1
2430 FOR J = L TO M
2440 IF KS(J,I) = 0 THEN GOTO 2490
2450 FOR K = L TO M
2460 KS(J,K) = KS(J,K) - KS(I,K)*KS(J,I)/KS(I,I)
2470 NEXT K
2480 P(J) = P(J) - P(I)*KS(J,I)/KS(I,I)
2490 NEXT J
2500 NEXT I
2510 P(M) = P(M)/KS(M,M)
2520 FOR I = 1 TO M1
2530 K = M - I
2540 L = K + 1
2550 FOR J = L TO M
2560 P(K) = P(K) - P(J)*KS(K,J)
2570 NEXT J
2580 P(K) = P(K)/KS(K,K)
2590 NEXT I
2600 REM **  THE VECTOR OF UNKNOWN DISPLACEMENTS
2610 REM     IS HELD IN [P].                    **
2620 GOSUB 60120
2630 GOSUB 60040
2640 P$ = "    VECTOR OF UNKNOWN DISPLACEMENTS" : GOSUB 60000
2650 FW = 12 : NS = 4
2660 FOR I = 1 TO MZ
2670 XS = P(I) : GOSUB 10040 : P$ = "        " + XS$ : GOSUB 60000
2680 NEXT I
2690 REM **  EXPAND VECTOR [P] INTO [PH] BY
2700 REM     INCORPORATING BOUNDARY DISPLACEMENT VALUES **
2710 MS = 0
2720 MA = 0
2730 FOR IJ = 1 TO NN
2740 IF KODE(IJ) <> 4 THEN GOTO 2800
2750 MS = MS + 2
2760 MA = MA + 2
2770 PH(MS - 1) = P(MA - 1)
2780 PH(MS) = P(MA)
2790 GOTO 2950
2800 IF KODE(IJ) <> 3 GOTO 2860
2810 MS = MS + 2
2820 MA = MA + 1
2830 PH(MS - 1) = 0
2840 PH(MS) = P(MA)
2850 GOTO 2950
2860 IF KODE(IJ) <> 2 THEN GOTO 2920
2870 MS = MS + 2
2880 MA = MA + 1
2890 PH(MS-1) = P(MA)
2900 PH(MS)=0
2910 GOTO 2950
2920 MS = MS + 2
2930 PH(MS-1) = 0
2940 PH(MS) = 0
2950 NEXT IJ
2960 GOSUB 60040
2970 P$ = "VECTOR OF ALL NODAL DISPLACEMENTS" : GOSUB 60000
2980 P$ = "  N        UX             VY" : GOSUB 60000
2990 FW = 15 : NS = 4
3000 FOR I = 1 TO NN
3010 XS = PH(2*I - 1) : GOSUB 10040 : P$ = XS$
3020 XS = PH(2*I) : GOSUB 10040 : P$ = P$ + XS$
3030 XS = I : GOSUB 30000 : P$ = XA$ + P$ : GOSUB 60000
3040 NEXT I
3050 REM **  CALCULATE FOR EACH MEMBER:
3060 REM       MEMBER ELONGATION,
3070 REM       FORCES AND STRESSES.     **
3080 L1 = 1
3090 I = 0
3100 GOSUB 60040
3110 P$ = " M	ELON	FORCE	STRESS"
3120 P$ = " " + P$ : GOSUB 60000
3130 I = I + 1
3140 J2 = 2*NJ(I)
3150 I2 = 2*NI(I)
3160 II = I2/2
3170 JJ = J2/2
3180 DU = PH(J2-1)-PH(I2-1)
3190 DV = PH(J2)-PH(I2)
3200 GOTO 3390
3210 REM **  ELONGATION CALCULATED BY COMBINING
3220 REM     NETT COORDINATE DISPLACEMENTS OF
3230 REM     ONE END RELATIVE TO THE OTHER.     **
3240 EL = DU*CL + DV*CM
3250 REM **  FORCE CALCULATED FROM STRESS/STRAIN
3260 REM     RELATION AND ELONGATION.           **
3270 REM THEN STRESS = FORCE/AREA.
3280 FC = EL*E(I)*A(I)/DL
3290 RS = FC/A(I)
3300 FW = 15 : NS = 4
3310 XS = EL : GOSUB 10040 : P$ = XS$
3320 XS = FC : GOSUB 10040 : P$ = P$ + XS$
3330 XS = RS : GOSUB 10040 : P$ = P$ + XS$
3340 XA = I : GOSUB 30000 : P$ = XA$ + P$ : GOSUB 60000
3350 IF I - NM < 0 GOTO 3130
3360 IF I - NM >= 0 GOTO 3500
3370 REM ** DETERMINE MEMBER LENGTHS DL AND
3380 REM     DIRECTION COSINES CL, CM..        **
3390 DX = X(JJ) - X(II)
3400 DY = Y(JJ) - Y(II)
3410 DL = SQR(DX*DX+DY*DY)
3420 CL = DX/DL
3430 CM = DY/DL
3440 IF L1 = 0 GOTO 1310
3450 GOTO 3240
3460 REM **  MULTIPLY UNCONDENSED STIFFNESS
3470 REM     MATRIX [KH] BY THE EXPANDED
3480 REM     (UNCONDENSED) DISPLACEMENT VECTOR [PH]
3490 REM     TO FIND ALL NODAL FORCES              **
3500 FOR I = 1 TO N
3510 FOR J = 1 TO N
3520 F(I) = KH(I,J)*PH(J) + F(I)
3530 NEXT J
3540 NEXT I
3550 GOSUB 60040
3560 P$ = "NODE        FX        FY" : GOSUB 60000
3570 FW = 15 : NS = 4
3580 FOR I = 1 TO NN
3590 XA = I : GOSUB 30000 : P$ = XA$ + "  "
3600 XS = F(2*I-1) : GOSUB 10040 : P$ = P$ + XS$
3610 XS = F(2*I) : GOSUB 10040 : P$ = P$ + XS$ : GOSUB 60000
3620 NEXT I
3630 GOSUB 60130 : REM CLOSE PRINTER
3640 FOR I = 1 TO 3 : PRINT : NEXT I
3650 PRINT "             DO YOU WISH TO RERUN THE PROGRAM USING"
3660 PRINT "              THE SAME # OF NODES AND MEMBERS BUT"
3670 PRINT "               WITH DIFFERENT DATA FOR THE NODES"
3680 PRINT "                    AND/OR MEMBERS? [Y/N]   ";
3690 INPUT AN$ : L1$=LEFT$(AN$,1)
3700 IF L1$ = "Y" OR L1$ = "y" THEN IR = 1 : GOTO 330
3710 IF L1$ <> "N" AND L1$ <> "n" THEN GOTO 3640
3720 GOSUB 60120 : IP = 3 : GOSUB 60060
3730 P$ = "**** END OF RUN OF PROGRAM " + PN$ + " ****" : GOSUB 60000
3740 IP = 5 : GOSUB 60060 : GOSUB 60130
3750 FOR I = 1 TO 5 : PRINT : NEXT I
3760 PRINT "************ SOLUTION COMPLETED *************"
3770 END
10000 REM 			FORMATTING AND INPUT/OUTPUT
10004 REM				SUBROUTINES BY
10008 REM				D.A. PIRIE
10012 REM		DEPARTMENT OF AEROSPACE ENGINEERING
10016 REM		UNIVERSITY OF GLASGOW
10020 REM		SCOTLAND
10024 REM		MAY 1989
10028 REM
10032 REM **  FORMAT NUMERICAL OUTPUT IN SCIENTIFIC NOTATION **
10036 FW = 12 : NS = 4 : REM DEFAULT VALUES
10040 WE = 1E-30 : REM ANYTHING SMALLER TAKEN AS ZERO
10050 XA = XS : GOSUB 30010 : XS$ = XA$
10060 KE = 0 : KE$ = "" : BL$ = "        " : B0$ = "00000000"
10070 F5 = FW - NS - 5 : N3 = NS + 3 : Z$ = "0." : AX = ABS(XS)
10080 IF AX < WE THEN XS$ = LEFT$(BL$,F5) + Z$ + LEFT$(BL$,N3) : GOTO 10130
10090 LX = LEN(XS$) : L3 = LX - 3 : XA = XS
10100 IF LX > 5 THEN IF MID$(XS$,L3,1) = "E" THEN GOSUB 10400
10110 IF ABS(XS) < 1 OR ABS(XS) >= 10 THEN GOSUB 10240
10120 GOSUB 10140
10130 RETURN
10140 REM FORM OUTPUT$
10150 GOSUB 10200
10160 IF ABS(XS) >= 10 THEN GOSUB 10240
10170 GOSUB 10280
10180 GOSUB 10330
10190 RETURN
10200 REM ROUNDOFF MANTISSA
10210 XR = 5 : FOR I5 = 1 TO NS : XR = XR/10 : NEXT I5
10220 XS = XS + XR*SGN(XS)
10230 RETURN
10240 REM NORMALISE MANTISSA
10250 IF ABS(XS) < 1 THEN XS = XS*10 : KE = KE - 1 : GOTO 10250
10260 IF ABS(XS) >= 10 THEN XS = XS/10 : KE = KE + 1 : GOTO 10260
10270 RETURN
10280 REM FORM EXPONENT%
10290 S$ = "+" : IF KE < 0 THEN S$ = "-"
10300 XA = KE : GOSUB 30010 : KE$ = XA$
10310 KE$ = S$ + RIGHT$("0" + MID$(KE$,2),2)
10320 RETURN
10330 REM FORM(MANTISSA + EXPONENT)$
10340 XA = XS : GOSUB 30010 : XS$ = XA$
10350 X1$ = LEFT$(XS$,NS + 2)
10360 XS$ = X1$:IF LEN(X1$)<NS+2 THEN XS$ = X1$ + LEFT$(B0$,NS+2-LEN(X1$))
10370 IF XS = INT(XS) THEN XS$ = X1$ + "." + LEFT$(B0$,NS-1)
10380 XS$ = LEFT$(BL$,FW-NS-6) + XS$ + "E" + KE$
10390 RETURN
10400 REM
10410 KE = VAL(RIGHT$(XS$,3)): XS = VAL(LEFT$(XS$,LEN(XS$) - 4)) : RETURN
10420 REM
20000 REM **  FORMAT NUMERICAL OUTPUT    **
20010 REM
20020 REM
20030 FW = 12 : NS = 3 : REM DEFAULT VALUES
20040 BL$ = "                  "
20050 IF FW - NS < 7 THEN PRINT "FIELD WIDTH TOO SMALL OR TOO MANY SIGFIGS"
20060 XE$="    " : XA = XS : GOSUB 30010 : XS$ = XA$
20070 IF ABS(XS) >= 10^(8-NS) THEN XX = XS : GOTO 20090
20080 GOSUB 20210
20090 IF LEN(XS$)> 5 THEN IF MID$(XS$,LEN(XS$) - 3, 1) = "E" THEN GOSUB 20190
20100 XA = XX : GOSUB 30010 : XX$ = XA$
20110 FOR J5 = 1 TO LEN(XX$)
20120 IF MID$(XX$,J5,1) = "." THEN DP = J5 : GOTO 20140
20130 NEXT J5 : DP = LEN(XX$) + 1 : XX$ = XX$ + "."
20140 XX$ = XX$ + "0000000" : XS$ = LEFT$(XX$,DP+NS) + XE$
20150 LX = LEN(XS$):IF LX >= FW THEN XS$ = " " + LEFT$(XS$,FW+1) : GOTO 20170
20160 XS$ = LEFT$(BL$,FW-LX)+XS$
20170 RETURN
20180 REM SEPARATE MANTISSA, EXPONENTS
20190 XE$ = RIGHT$(XS$,4) : XS=VAL(LEFT$(XS$,LEN(XS$) - 4))
20200 GOSUB 20210 : RETURN
20210 REM ROUND-OFF TO NS DECIMAL PLACES
20220 XX = XS + .5*SGN(XS)/10^NS : RETURN
30000 GOSUB 30010 : GOSUB 30060 : RETURN
30010 REM * FIX FOR BASIC(EG APPLE) WHICH STRIP LEADING BLANK FROM
30020 REM   STR$(NON-NEGATIVE NUMBER) *
30030 XA$ = STR$(XA) : X1$ = LEFT$(XA$,1)
30040 IF X1$ <> " " AND X1$ <> "-" THEN XA$ = " " + XA$
30050 RETURN
30060 REM * RIGHT-JUSTIFY INTEGERS <= 99
30070 XA$ = RIGHT$(" " + XA$, 3)
30080 RETURN
30090 REM *********************************************
50000 REM ** THE FOLLOWING STATEMENTS
50010 REM ** ARE SPECIFIC TO MS-DOS
50020 REM        TURBO BASIC                         **
50030 PRINT P$ : RETURN : REM ** PRINTLINE ON OUTPUTFILE **
50040 PRINT , : RETURN : REM ** 1 NEWLINE ON OUTPUTFILE **
50050 REM
50060 FOR KP = 1 TO IP : REM DO IP
50070 PRINT , : REM NEWLINES
50080 NEXT KP : REM ON
50090 RETURN : REM OUTPUT FILE *
50100 GOSUB 50000 : GOSUB 50040 : RETURN : REM PRINTLINE + NEWLINE
50110 REM OPEN PN$ + ".IN" FOR INPUT AS #2 : RETURN : REM ** OPEN INFILE **
50120 REM OPEN PN$ + ".OUT" FOR OUTPUT AS #3 : RETURN : REM ** OPEN OUTFILE **
50130 REM CLOSE #2, #3 : RETURN : REM CLOSE INFILE & OUTFILE
50140 CLS : RETURN : REM CLEARSCREEN
60000 REM
60010 REM
60030 PRINT P$ : RETURN : REM ** PRINTLINE ON PRINTER **
60040 PRINT : RETURN : REM ** 1 NEWLINE ON PRINTER **
60050 REM
60060 FOR KP = 1 TO IP : REM DO IP
60070 PRINT : REM NEWLINES
60080 NEXT KP : REM ON
60090 RETURN : REM PRINTER *
60100 REM
60110 REM
60120 REM OPEN "LPT1:" AS #1 : RETURN : REM OPEN PRINTER
60130 REM CLOSE #1 : RETURN : REM CLOSE PRINTER