10  COM X[103,22],M[19,19],U[19,19],Q[20],V[20],P[78]
30  COM M$[60],N$[72]
40  COM N,K,N8,K8,N9,K9,Q9,Q7,Q5,Q4,Q3,Q2,Q1
45  COM I3,I4,U9,X$[20]
50  REM:2NOV73
52  REM:>PSORT
60  DIM W[16],H[300],C[16]
61  DIM A$[12],C$[12],R$[6]
62  IF Q[1]#0 THEN 70
64  CHAIN "$IDA29",210
70  MAT H=ZER
80  MAT W=ZER
90  MAT C=ZER
100  IF K9-1 >= 4 THEN 500
110  PRINT "CAN'T USE PSOR IF IDA DIM. HAVE LESS THAN 4 COLUMNS."
120  GOTO 9998
500  GOTO Q9 OF 510,520,540
510  PRINT "* GIVE VARIABLE NAME OR COLUMN NUMBER FOR THE "
520  PRINT "  VARIABLE TO BE SORTED : ";
530  GOTO 550
540  PRINT "* VARIABLE : ";
550  ENTER 30,Q8,C$
560  PRINT 
570  IF Q8>0 THEN 600
580  GOSUB 4000
590  GOTO 540
600  GOSUB 4500
610  I9=Z9
620  IF I9=0 THEN 580
670  PRINT "* ACCOMPANYING VARIABLE :";
680  ENTER 30,Q8,C$
690  PRINT 
700  IF Q8>0 THEN 730
702  PRINT "THE ACCOMPANYING VARIABLE WILL BE ARRANGED IN THE"
704  PRINT "SAME ORDER AS THE SORTED VARIABLE IN THE SORTED ORDER."
705  PRINT "WANT LIST OF VAR. IN DATA MATRIX ";
706  INPUT C$
707  IF C$[1,1]#"Y" THEN 670
710  GOSUB 4000
720  GOTO 670
730  GOSUB 4500
740  I8=Z9
750  IF I8=0 THEN 710
760  GOTO Q9 OF 770,780,800
770  PRINT "* GIVE COLUMN NAME OR COLUMN NUMBER FOR "
780  PRINT "  COLUMN RECEIVING SORTED OBSERVATIONS : ";
790  GOTO 810
800  PRINT "* RECEIVING COLUMN : ";
810  ENTER 30,Q8,C$
820  PRINT 
830  IF Q8>0 THEN 900
835  GOSUB 840
836  GOTO 800
840  PRINT "AFTER THE COLUMN IS SORTED IN ASCENDING ORDER, WHICH COLUMN"
850  PRINT "IN THE DATA MATRIX DO YOU WANT  TO REPLACE WITH IT? IT CAN BE"
860  PRINT  USING 865;I9,I8
865  IMAGE "ANY COL. NO. IN THE ACTIVE MATRIX EXCEPT COLS.",3D," AND",3D
870  PRINT  USING 875;K+1
875  IMAGE "OR IT CAN BE COLUMN",3D
880  PRINT 
890  RETURN 
900  GOSUB 4500
910  J9=Z9
912  IF J9=I9 THEN 915
913  IF J9=I8 THEN 915
914  GOTO 920
915  PRINT "COL. NUMBER IMPROPER.  PLEASE RE-ENTER"
916  PRINT  USING 865;I9,I8
917  PRINT  USING 875;K+1
918  GOTO 800
920  IF J9=0 OR J9>K+1 THEN 950
930  IF J9=K+1 THEN 1070
940  GOTO 990
950  PRINT "YOU HAVE SPECIFIED AN INVALID COLUMN, PLEASE SELECT A"
960  PRINT "DIFFERENT COLUMN LESS THAN OR EQUAL TO ";K+1
970  PRINT 
980  GOTO 800
990  PRINT "REQUEST WILL DESTROY OLD DATA IN RECEIVING COLUMN."
1000  PRINT "WANT TO PROCEED ?";
1020  ENTER 60,Q8,R$
1030  IF Q8<0 THEN 840
1040  PRINT 
1050  IF R$[1,1]="Y" THEN 1075
1060  GOTO 800
1070  K=K+1
1075  GOSUB 3000
1080  N0=0
1090  FOR I=Q4 TO N
1100  IF X[I,K9+2]=0 THEN 1130
1110  N0=N0+1
1120  H[N0]=I
1130  NEXT I
1140  GOTO Q9 OF 1150,1160,1180
1150  PRINT "* GIVE COLUMN NAME OR COLUMN NMBER FOR "
1160  PRINT "  COLUMN RECEIVING ACCOMPANYING OBSERVATIONS : ";
1170  GOTO 1190
1180  PRINT "* RECEIVING COL. FOR SORTED ACCOMP. VAR. :";
1190  ENTER 30,Q8,C$
1200  PRINT 
1210  IF Q8>0 THEN 1290
1220  PRINT "IN WHICH COLUMN DO YOU WANT TO PLACE THE (SORTED)"
1230  PRINT "ACCOMPANYING VARIABLE ?  YOU MAY PLACE IT IN"
1240  GOSUB 860
1280  GOTO 1180
1290  GOSUB 4500
1300  J8=Z9
1301  IF J8=J9 THEN 1305
1302  IF J8=I9 THEN 1305
1303  IF J8=I8 THEN 1305
1304  GOTO 1310
1305  PRINT "COL. NUMBER IMPROPER.  PLEASE RE-ENTER"
1306  PRINT  USING 1307;(K+1),I9,I8,J9
1307  IMAGE "A NUMBER LESS THAN OR EQUAL TO",3D," BUT NOT",3D,3D," OR",3D
1308  GOTO 1180
1310  IF J8=0 OR J8>K+1 THEN 1340
1320  IF J8=K+1 THEN 1460
1330  GOTO 1380
1340  PRINT "YOU HAVE SPECIFIED AN INVALID COLUMN, PLEASE SELECT A"
1350  PRINT "DIFFERENT COLUMN LESS THAN OR EQUAL TO ";K+1
1360  PRINT 
1370  GOTO 1180
1380  PRINT "REQUEST WILL DESTROY OLD DATA IN RECEIVING COLUMN."
1390  PRINT "WANT TO PROCEED ?";
1410  ENTER 60,Q8,R$
1420  IF Q8<0 THEN 1220
1430  PRINT 
1440  IF R$[1,1]="Y" THEN 1465
1450  GOTO 1180
1460  K=K+1
1465  GOSUB 3000
1530  GOSUB 6000
1540  Q[3]=1
1550  I7=I9
1560  J7=J9
1570  FOR J=1 TO 2
1580  FOR I=1 TO 3
1590  X[N9+I,J7]=X[N9+I,I7]
1600  NEXT I
1610  I7=I8
1620  J7=J8
1630  NEXT J
1640  N5=0
1650  FOR I=Q4 TO N
1660  IF X[I,K9+2]=0 THEN 1700
1670  N5=N5+1
1680  X[I,J9]=X[H[N5],I9]
1690  X[I,J8]=X[H[N5],I8]
1700  NEXT I
1710  GOTO 9998
3000  IF Q3#1 THEN 3080
3010  PRINT LIN(1);"NAME OF NEW VARIABLE = ";
3020  INPUT C$
3030  IF Z9>10 THEN 3060
3040  M$[6*Z9-5,6*Z9]=C$[1,6]
3050  GOTO 3080
3060  N$[6*Z9-65,6*Z9-60]=C$[1,6]
3080  RETURN 
4000  IF Q3=1 THEN 4100
4010  PRINT LIN(1),"FOR YOUR REFERENCE :"
4040  PRINT LIN(1),"COLUMN  1ST OBSERVATION"
4045  PRINT 
4050  FOR J=1 TO K
4060  PRINT  USING "2X,DD,6X,D.5DE";J,X[Q4,J]
4070  NEXT J
4080  GOTO 4185
4100  PRINT LIN(1),"THESE ARE THE VARIABLES IN THE DATA MATRIX :"
4110  PRINT "COLUMN   NAME"
4115  PRINT 
4120  FOR J=1 TO K
4130  REM
4140  PRINT  USING 4150;J,M$[6*J-5,6*J]
4150  IMAGE 2X,DD,4X,6A
4160  GOTO 4180
4170  PRINT  USING 4150;J,N$[6*(J-10)-5,6*(J-10)]
4180  NEXT J
4185  PRINT 
4190  RETURN 
4500  FOR I=1 TO 10
4510  IF M$[6*I-5,6*I]=C$[1,6] THEN 4730
4520  NEXT I
4530  FOR I=1 TO 11
4540  IF N$[6*I-5,6*I]=C$[1,6] THEN 4750
4550  NEXT I
4560  RESTORE 
4670  FOR I=1 TO 20
4680  READ A$
4690  IF A$=C$ THEN 4730
4700  NEXT I
4710  Z9=0
4720  GOTO 4760
4730  Z9=I
4740  GOTO 4760
4750  Z9=10+I
4760  RETURN 
6000  I=1
6001  M1=1
6003  J=N0
6005  IF I >= J THEN 6070
6010  K1=I
6011  I2=(J+I)/2
6012  T=H[I2]
6013  IF X[H[I],I9] <= X[T,I9] THEN 6020
6014  H[I2]=H[I]
6015  H[I]=T
6016  T=H[I2]
6020  L1=J
6021  IF X[H[J],I9] >= X[T,I9] THEN 6040
6022  H[I2]=H[J]
6023  H[J]=T
6024  T=H[I2]
6025  IF X[H[I],I9] <= X[T,I9] THEN 6040
6026  H[I2]=H[I]
6027  H[I]=T
6028  T=H[I2]
6029  GOTO 6040
6030  H[L1]=H[K1]
6031  H[K1]=T1
6040  L1=L1-1
6041  IF X[H[L1],I9]>X[T,I9] THEN 6040
6042  T1=H[L1]
6050  K1=K1+1
6051  IF X[H[K1],I9]<X[T,I9] THEN 6050
6052  IF K1 <= L1 THEN 6030
6053  IF (L1-I) <= (J-K1) THEN 6060
6054  W[M1]=I
6055  C[M1]=L1
6056  I=K1
6057  M1=M1+1
6058  GOTO 6080
6060  W[M1]=K1
6061  C[M1]=J
6062  J=L1
6063  M1=M1+1
6064  GOTO 6080
6070  M1=M1-1
6071  IF M1=0 THEN 6100
6072  I=W[M1]
6073  J=C[M1]
6080  IF (J-I) >= 11 THEN 6010
6082  IF I=1 THEN 6005
6083  I=I-1
6090  I=I+1
6091  IF I=J THEN 6070
6092  T=H[I+1]
6093  IF X[H[I],I9] <= X[T,I9] THEN 6090
6094  K1=I
6095  H[K1+1]=H[K1]
6096  K1=K1-1
6097  IF X[T,I9]<X[H[K1],I9] THEN 6095
6098  H[K1+1]=T
6099  GOTO 6090
6100  RETURN 
9000  DATA "1","2","3","4","5","6","7","8","9","10","11","12"
9010  DATA "13","14","15","16","17","18","19","20","21"
9998  CHAIN "$IDA",150
9999  END 
