1! Lawrence University Department of Chemistry Appleton, Wisconsin 54911 (414) 739-3681, Ext. 456 2! Program name, version, date, authorship: SPPLT, Version 1A, 14-Dec-74 (Main program for SPPLT) Written by Stephen L. Holmgren, class of 1973, and maintained by Dr. James S. Evans, Department of Chemistry, Lawrence University. 3! Purpose of program: SPPLT prepares contour plots of hybrid atomic orbitals with specified contour levels, effective nuclear charge, amounts of 2s and 2p character, and geometric operations (scaling, translation, rotation). 4! Included are subroutines for several plotting devices: Tektronix 4010 graphics terminal; TSP-212 plotter system; Hewlett-Packard 7200A/7202A graphic plotter. 5! Language and operating system: SPPLT, written in BASIC-PLUS, uses virtual core files and several non-privileged SYS functions, and runs in 8K under RSTS Versions 05-21 and 05B-24 (PDP-11/45). 6! Availability: SPPLT is a non-proprietary program product of Lawrence University. It is distributed at cost for educational use, on the condition that it not be sold, rented, or leased for profit. 8! Further documentation: User's guide: 3 pages of run instructions and operational features for students who will use SPPLT for class assignments. 9! Programmer's guide: discussion of algorithms and instructions for system implementation. Literature reference: S. L. Holmgren and J. S. Evans, Journal of Chemical Education, vol. 51, pp. 189-191 (1974). 10! Disclaimer: Neither the author of this program nor Lawrence University assumes any liability, expressed or implied, with respect to the correctness or performance of this program. 50 PRINT : PRINT "LAWRENCE UNIVERSITY HYBRID ORBITAL PROGRAM" 900 M6%=1% : GOSUB 3700 : GOSUB 1000 : GOTO 910 UNLESS P0% : R3(K0%,K0%)=P0% : CLOSE K1% : CHAIN N1$+"HYBRID" 50 910 PRINT "YOU MUST RUN SPPLT AT A PLOTTING TERMINAL" : GOTO 5030 1000 PRINT "WHAT PLOT DEVICE ("; !****DEFINE PLOT DEVICE**** 1001 PRINT "TEK,"; ! [TEK] 1002 PRINT "TSP,"; ! [TSP] 1003 PRINT "HP,"; ! [HP] 1010 INPUT "NONE)"; P$ 1011 IF P$="TEK" THEN P0%=K1% : RETURN ! [TEK] 1012 IF P$="TSP" THEN P0%=K2% : RETURN ! [TSP] 1013 IF P$="HP" THEN P0%=K3% : RETURN ! [HP] 1020 P0%=K0% : RETURN ! USER HAS NO PLOT DEVICE 1100 RETURN UNLESS P0% : ON P0% GOTO 1101,1112,1113 !****ENTER PLOT MODE**** 1101 P5%=780% : P1$=CHR$(157%) : P2$=CHR$(13%)+CHR$(10%) : P8%=32% : PRINT CHR$(155%);CHR$(133%); : INPUT LINE P3$ ! [TEK] 1111 P3$=P1$+CHR$(128%+ASCII(RIGHT(P3$,K4%))) +CHR$(192%+ASCII(RIGHT(P3$,K5%))) +CHR$(128%+ASCII(RIGHT(P3$,K2%))) +CHR$(160%+ASCII(RIGHT(P3$,K3%)))+CHR$(159%) : GOTO 1190 ! [TEK] 1112 P4%=50% : P5%=510% : P1$=CHR$(13%)+CHR$(10%)+CHR$(144%) : P2$="" : P3$=CHR$(13%)+CHR$(10%)+CHR$(128%) : GOTO 1190 ! [TSP] 1113 P4%=1000% : P5%=9999% : P1$="PLTL" : P3$=" PLTT"+CHR$(13%)+CHR$(10%) : PRINT P1$ : GOTO 1190 ! [HP] 1190 P$="" : P9%=K0% : RETURN 1200 RETURN UNLESS P0% : ON P0% GOTO 1201,1202,1203 !****RESTORE PRINT MODE**** 1201 IF P9%>K4% THEN 1210 ELSE 1220 ! [TEK] 1202 IF P9% THEN 1210 ELSE 1220 ! [TSP] 1203 GOTO 1220 ! [HP] 1210 GOSUB 1380 ! FINISH OFF PLOT 1220 PRINT P3$; : RETURN ! SEND RELEASE CODE TO DEVICE 1300 RETURN UNLESS P0% : X2%=P5%*(X-X0)/(X1-X0) : Y2%=P5%*(Y-Y0)/(Y1-Y0) : X2%=K0% IF X2%P5% : Y2%=P5% IF Y2%>P5% : ON P0% GOTO 1301,1312,1312 !****PLOT (X,Y) IF L=0**** 1301 P$=P$+P1$ IF L<>F0 : X2%=X2%+243% : P1%=X2%/P8% : P2%=Y2%/P8% ! [TEK] 1311 P$=P$+CHR$(160%+P2%)+CHR$(224%+Y2%-P8%*P2%)+CHR$(160%+P1%) +CHR$(192%+X2%-P8%*P1%) : P9%=P9%+K4% : GOTO 1370 ! [TEK] 1312 IF L<>F0 THEN P8%=64% ELSE P8%=K0% 1313 GOTO 1314 UNLESS P8% : GOSUB 1316 UNLESS P0%=K3% : X3%,X4%=X2% : Y3%,Y4%=Y2% : GOSUB 1316 : RETURN IF P0%=K3% : GOSUB 1316 : GOTO 1370 ! LIFT PEN AND MOVE TO (X,Y) 1314 X3%=X2%-X4% : Y3%=Y2%-Y4% : Y1%=K1%+(ABS(X3%)+ABS(Y3%))/P4% : X1%=SGN(X3%)+X3%/Y1% : Y1%=SGN(Y3%)+Y3%/Y1% ! INCREMENTS 1315 X4%=X4%+X1% : X4%=X2% IF SGN(X4%-X2%)*X1%>=K0% : Y4%=Y4%+Y1% : Y4%=Y2% IF SGN(Y4%-Y2%)*Y1%>=K0% : GOSUB 1316 : GOTO 1315 UNLESS X4%=X2% AND Y4%=Y2% : RETURN ! LINEAR INTERPOLATION TO SLOW DOWN PEN 1316 ON P0% GOTO 1210,1322,1333 ! ERROR CONDITION FOR TEK; ELSE OK 1322 P1%=X4%/K8% : P2%=Y4%/K8% : IF P1%=63% THEN P$=P$+CHR$(191%) ELSE P$=P$+CHR$(192%+P1%) ! [TSP] 1323 IF P2%=63% THEN P$=P$+CHR$(191%) ELSE P$=P$+CHR$(192%+P2%) ! [TSP] 1324 P1%=Y4%+K8%*(X4%-P2%-K8%*P1%)+P8% : IF P1%=127% THEN P$=P$+CHR$(254%) ELSE P$=P$+CHR$(128%+P1%) ! [TSP] 1332 P9%=P9%+K3% : GOTO 1370 ! PLOT CODES [TSP] 1333 PRINT MID(NUM$(10000%+X4%),K3%,K4%);CHR$(32%); MID(NUM$(10000%+Y4%),K3%,K4%); : PRINT CHR$(222%); IF P8% : PRINT : GOTO 1370 ! [HP] 1370 L=F0 : GOSUB 1380 IF P9%>67% : RETURN ! TEST LINE LENGTH 1380 PRINT P1$;P$;P2$; : GOSUB 1190 ! SEND OUT PLOT STRING; RESET 1381 IF P0%=K1% THEN GOTO 1311 ! REMEMBER POINT [TEK] 1390 RETURN 2900 ! ****REENTRY POINT FROM HYBRID 2910 DIM #1, R1(37%,3%),R2(37%,3%),R3(37%,3%),R4(37%,3%) 2930 DEF FNA(S) ! FUNCTION TO ADJUST SUBSCRIPTS FOR ROTATE OPTION 2931 A=M+S 2932 IF A72 THEN A=A-72 ELSE 2935 2934 GOTO 2933 2935 FNA=A 2936 FNEND 2970 DIM S(72%),C(72%),X(150%),Y(150%) 2974 GOSUB 3700 : M6%=K0% 2976 INPUT "COMPARE OR MAX SCALE"; C$ : R2(K0%,K0%)=ASCII(C$) 2980 P0%=R3(K0%,K0%) : I5%=R4(K0%,K0%) ! RETRIEVE PLOT DEVICE CODE AND NUMBER OF CONTOURS 2981 N%=37% : A=-PI/36 2985 FOR I%=K0% TO 72% : A=A+PI/36. : S(I%)=SIN(A) 2990 C(I%)=COS(A) : NEXT I% ! STORE SINES AND COSINES NEEDED 3000 X8=-R4(K1%,K1%) : X9=R1(K1%,K1%) ! DETERMINE THE RANGE OF THE DATA 3010 Y8=-1.2*S(14%)*R4(14%,K1%) : Y9=-Y8 3015 IF ASCII(C$)=67% THEN 3035 ! TEST FOR C[OMPARE] 3020 IF Y8X9 THEN X1,Y1=Y9 ELSE X1,Y1=X9 3030 GOTO 3039 ! 'MAX SCALE' WILL FILL PAGE (WHEN S=1) 3035 X0,Y0=-6 : X1,Y1=6 ! 'COMPARE' BOUNDARIES ARE +/- 6 ANGSTROMS 3039 PRINT "OPTIONS: SCALE,TRANS,ROTATE,PLOT,AXIS,MORE,FINI" : GOTO 3910 3040 ! CALCULATE THE POSITIVE LOBE AND THEN PLOT IT 3044 GOSUB 1100 ! TURN ON THE PLOTTER...... 3045 FOR I%=K1% TO I5% : N0%=-K1% 3050 FOR K%=K1% TO N% : R=R2(K%,I%) ! ACCESS VIRTUAL CORE ONLY ONCE... 3055 K2=K%-K1% ! ADJUST SUBSCRIPTS SO THEY CORRESPOND TO THE SAME ANGLE 3060 IF R<=-F2 THEN 3120 ! TEST FOR FLAGS (IMAGINARY ROOT) 3070 N0%=N0%+K2% 3075 ! THE POINT AND ITS REFLECTION IN THE AXIS OF SYMMETRY ARE STORED IN CONSECUTIVE ORDER IN THE ARRAY 3090 !......TRICKY STEPS---IF R2 IS LEFT OF ORIGIN, USE SUPPLEMENTARY ANGLE (180-THETA) 3095 IF RF1 THEN GOSUB 3600 3200 ! ^^ PERFORM CONTINUITY CHECK ONLY ONCE PER ARRAY OF POINTS 3201 FOR I%=K1% TO I5% : N0%=-K1% 3210 FOR K%=K1% TO N% : R=-R3(K%,I%) ! NEGATIVE SIDE OF Y AXIS 3215 K2=K%-K1% ! ADJUST SUBSCRIPTS: HERE 0 MEANS 0 DEG 3220 IF R>F0 THEN 3260 ! TEST FOR FLAGS 3230 N0%=N0%+K2% : GOSUB 3400 3260 NEXT K% 3270 FOR K%=N% TO K1% STEP -K1% 3275 K2=K%-K1% 3280 R=-R4(K%,I%) : IF R>F0 THEN 3330 ! TEST FOR FLAGS 3300 N0%=N0%+K2% : GOSUB 3400 3330 NEXT K% : X(K0%)=X(K1%) : Y(K0%)=Y(K1%) : GOSUB 3500 : NEXT I% 3390 GOSUB 21300 : GOSUB 1200 : C$=CHR$(K0%) : GOTO 3910 ! END PLOT; GIVE OPTIONS 3400! SHORT SUBROUTINE TO ELIMINATE REPETITION IN ASSIGNING VALUES TO X & Y 3401 X(N0%)= R*C(FNA(K2)) : X(N0%+K1%)= R*C(FNA(-K2)) 3403 Y(N0%)= R*S(FNA(K2)) : Y(N0%+K1%)= R*S(FNA(-K2)) 3406 RETURN 3500 ! PLOTTING SUBROUTINE: ONE CONTOUR OF ONE LOBE AT A TIME 3510 L=F1 : X=(X(K1%)+T1)/S : Y=(Y(K1%)+T2)/S : GOSUB 1300 ! PUT PLOTTER AT FIRST POINT 3520 L=F0 3530 I1%=K1% : I2%=N0% : I3%=K2% 3540 FOR K%=I1% TO I2% STEP I3% 3550 X=(X(K%)+T1)/S : Y=(Y(K%)+T2)/S : GOSUB 1300 3560 NEXT K% : IF I3%=-K2% THEN RETURN 3570 I1%=N0%+K1% : I2%=K0% : I3%=-K2% : GOTO 3540 3600 ! ENTRY FOR SORTING SUBROUTINE 3601 FOR I%=K1% TO I5% 3605 IF I%=K1% THEN N1%=16% 3610 IF I%=K2% THEN N1%=13% ELSE N1%=10% 3620 FOR J%=N1% TO N% 3630 IF R4(J%,I%)>R3(J%,I%) AND R4(J%,I%)<=R4(J%-K1%,I%) THEN 3650 3640 GOTO 3660 3650 IF R3(J%,I%)>=R3(J%-K1%,I%) THEN 3670 3655 ! ELIMINATE BAD ROOTS AND ALL SUBSEQUENT ONES..... 3659 IF J%+K5%83% THEN 3970 ! TEST FOR S[CALE] 3940 INPUT "REDUCE SCALE BY FACTOR OF";S 3950 IF S>F0 THEN 3920 ELSE PRINT "POSITIVE SCALE FACTOR ONLY": S=F1 : GOTO 3920 3970 IF ASCII(C$)<>84% THEN 4100 ! TEST FOR T[RANS] 3980 X=ABS(S*X0-X8) : Y=ABS(S*Y0-Y8) ! COMPUTE ALLOWABLE TRANS 3982 IF YX OR ABS(T2)>X THEN 4000 ELSE 3920 4000 PRINT "TRY AGAIN": GOTO 3985 4100 IF ASCII(C$)=80% THEN 3044 ! TEST FOR P[LOT] 4110 IF ASCII(C$)<>82% THEN 4200 ! TEST FOR R[OTATE] 4120 INPUT "DEGREES ROTATION ";D 4125 IF D65% THEN 4300 ! TEST FOR A[XIS] 4210 IF ASCII(M$)=89% THEN 4225 ELSE INPUT "SCALE OR TRANS FIRST"; M$ ! ISSUE REMINDER 4220 IF ASCII(M$)=89% THEN 3920 !TEST FOR Y[ES] 4225 S5=.01*ABS(Y0) 4230 Y=(Y8+T2)/S+S5 4235 X=(-F1+T1)/S : L=F1 : GOSUB 1100 4240 GOSUB 1300 : L=F0 : GOSUB 1300 4250 Y=Y-S5 : GOSUB 1300 : X=F0+T1/S : GOSUB 1300 4260 Y=Y+S5 : GOSUB 1300 4270 Y=Y-S5 : GOSUB 1300 : X=(F1+T1)/S : GOSUB 1300 4280 Y=Y+S5 : GOSUB 1300 : GOSUB 1200 4290 M$=CHR$(K0%) : GOTO 3920 4300 CLOSE K1% : IF C$<>"NAME" THEN 4400 ELSE CHAIN N1$+"HYBRID"5400 ! OPTION TO SAVE TEMP FILE 4350 GOSUB 3700 : M6%=K0% : C$=CHR$(R2(K0%,K0%)) : GOTO 2980 ! RETURN FROM HYBRID 4400 IF C$="USE" THEN CHAIN N1$+"HYBRID"5500 ! OPTION TO USE OLD FILE 5000 L=F1 : X=X1 : GOSUB 1100 : GOSUB 1300 : GOSUB 1200 ! PULL THE PEN TO THE SIDE, AND TURN PLOTTER OFF. 5020 IF ASCII(C$)=77% THEN CHAIN N1$+"HYBRID" 50 ! TEST FOR M[ORE] 5030 KILL N$ : PRINT "Thank you for using SPPLT" : PRINT "Stephen L Holmgren and James S Evans" : GOTO 32000 20000 I8%,I9%=K0% UNLESS I7%=K6% : K0$=SYS(CHR$(I7%)+CHR$(I8%)+CHR$(I9%)) : RETURN ! SYS FUNCTION CALL 21200 I7%=K6% : I8%=K9% : GOSUB 20000 : PRINT MID(K0$,K3%,INSTR(K3%,K0$,CHR$(K0%))-K3%) : RETURN ! RSTS ERROR MESSAGE 21300 I7%=K0% : GOSUB 20000 : SLEEP F1 : RETURN ! CANCEL ^O 21400 I7%=K6% : I8%=-K7% : I9%=K0% : GOSUB 20000 : RETURN ! ENABLE ^C TRAP 30000 RESUME 31000 IF ERR=28% : I9%=ERR : GOSUB 21200 30040 GOTO 31990 UNLESS ERR=50% 30050 RESUME 3940 IF ERL=3940 : RESUME 3990 IF ERL=3990 : RESUME 4120 IF ERL=4120 : GOTO 31990 ! ILLEGAL NUMBER TRAP ***CHANGE TO ERR=52% PRIOR TO RSTS VERSION 05B-24*** 31000 GOSUB 21400 : IF ASCII(C$)=80% THEN GOSUB 1200 : GOSUB 21300 : RESUME 3390 ! CANCEL REMAINDER OF PLOT 31010 GOSUB 21300 : IF M6% THEN RESUME 5030 ELSE M6%=K1% : RESUME 3920 31990 I9%=117% : GOSUB 21200 : I9%=114% : GOSUB 21200 : PRINT "IF POSSIBLE, CONTACT MR. EVANS BEFORE LOGGING OFF" : ON ERROR GOTO 0 32000 END