1! Lawrence University Department of Chemistry Appleton, Wisconsin 54911 (414) 739-3681, Ext. 456 2! Program name, version, date, authorship: NMRSIM, Version 1C, 13-Dec-74 (Main program for NMRSIM) NMRSIM was written by Dr. James S. Evans, Department of Chemistry, Lawrence University. 3! Purpose of program: NMRSIM simulates nmr spectra from values of coupling constants, chemical shifts, rf power, and relaxation times. 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: NMRSIM, written in BASIC-PLUS, uses virtual core files and several non-privileged SYS functions, and runs in 8K under RSTS Versions 4A-12 (PDP-11/35), 05-21 (PDP-11/45), and 05B-24. 6! Availability: NMRSIM 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. 7! Limitations: Variables in NMRSIM are dimensioned to handle up to 6 spin-1/2 nuclei, or fewer with larger spins. Larger systems might be feasible on an 11/45 configured for 16K of user core. 8! Further documentation: User's guide: 6 pages of run instructions and operational features for students who will use NMRSIM in physical or organic chemistry courses. 9! Programmer's guide: discussion of algorithms and instructions for system implementation. 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. 100 PRINT : PRINT "LAWRENCE UNIVERSITY NMR SPECTRUM SIMULATOR" 110 DIM Z%(64%,6%),P%(64%),V%(7%),W%(7%) 112 DIM #2, N%(30%),N$(20%)=2%,N0$(10%)=8%, B$(6%)=4%,L%(6%),G(6%),J(6%,6%), I6%(64%,6%),I7%(64%),I8%(7%),I9%(7%),I(1000%,1%) 120 GOSUB 3200 : I(1000%,K1%)=F0 ! PRE-EXTEND VIRTUAL CORE FILE 122 READ A$,L%,G : GOTO 130 IF A$=B0$ : GOTO 122 ! READ PAST NUCLEI 130 N%(K0%)=K2% : N0$(K0%)="0" : B$(K0%)=" " : N%(I%)=K0% FOR I%=K1% TO 30% : READ N$(I%) FOR I%=K0% TO 20% ! INITIALIZATION 140 PRINT "WHAT PLOT DEVICE ("; 141 PRINT "TEK,"; ! [TEK] 142 PRINT "TSP,"; ! [TSP] 143 PRINT "HP,"; ! [HP] 150 INPUT "NONE)"; P$ ! SET PLOT DEVICE CODE 151 IF P$="TEK" THEN N%(K2%)=K1% : GOTO 500 ! [TEK] 152 IF P$="TSP" THEN N%(K2%)=K2% : GOTO 500 ! [TSP] 153 IF P$="HP" THEN N%(K2%)=K3% : GOTO 500 ! [HP] 160 N%(K2%)=K0% : GOTO 500 ! DEFAULT IS NON-PLOTTING TERMINAL 180 DATA H,1,26.7519, D,2,4.1065, B10,6,2.8744, B11,3,8.5512, C13,1,6.7281, N14,2,1.9331, N15,1,2.7117, F,1,25.1802, P,1,10.8401, "",0,0 190 DATA LN, NM, CC, CS, NO, "", CO, "", "", "", HE, NP, MR, LL, XS, LS, YS, "", PL, "", EX ! OPERATION CODES 200 GOSUB 3200 ! CHAIN ENTRY FROM NMRCAL OR NMRPLT 210 Z%(I%,J%)=I6%(I%,J%) FOR J%=K0% TO K6% FOR I%=K0% TO 64% : P%(I%)=I7%(I%) FOR I%=K0% TO 64% : V%(I%)=I8%(I%) FOR I%=K0% TO K7% : W%(I%)=I9%(I%) FOR I%=K0% TO K7% ! COPY SPIN ARRAYS INTO REAL CORE FOR SPEED 220 L9%=Z%(K0%,K0%) : Z9%=Z%(K0%,K1%) : N8%=Z%(K0%,K2%) : N7%=N%(K5%) : I5%=Z%(K0%,K5%) : I6%=Z%(K0%,K6%) : I%=N%(K7%) : GOTO 600 ! RETRIEVE CONSTANTS AND SECTION NUMBER 500 GOSUB 21300 : PRINT : INPUT "NEXT"; A$ : GOTO 520 IF LEFT(A$,K2%)=N$(I%) FOR I%=K0% TO 20% ! CANCEL ^O; GET NEXT COMMAND 510 I9%=109% : GOSUB 21200 : GOTO 500 ! 'WHAT?' 520 M6%=K0% : N%(K7%)=I% ! RESET ^C FLAG; SAVE OPERATION CODE 600 ON I%+K1% GOTO 1000,1100,1200,1300,1400,510,1600,1700,510,510, 2000,2100,2100,2100,2100,2100,2100,510,2100,510,3000 ! I%=PROGRAM SECTION NUMBER MINUS 10 1000 N%(K1%)=10% : PRINT : PRINT "AVAILABLE NUCLEI: "; : RESTORE ! LN=LIST NUCLEI AVAILABLE 1010 READ A$,L%,G : IF A$<>B0$ THEN PRINT A$;B$(K0%); : GOTO 1010 1020 PRINT : GOTO 500 1100 N%(K1%)=11% : N%(K0%),I5%=K1% : N%(I%)=K0% FOR I%=11% TO 16% : PRINT : PRINT "HOW MANY NUCLEI"; ! NM=DEFINE NEW MOLECULE 1110 INPUT " (<=6)"; N8% : GOTO 1110 IF N8%K6% : Z%(K0%,K2%)=N8% : L9%=K0% : PRINT : PRINT "IDENTIFY NUCLEI (ALL OF ONE TYPE, THEN NEXT)" : FOR I%=K1% TO N8% 1120 PRINT "#"; I%; : INPUT B$(I%) : RESTORE 1130 READ A$,L%,G : GOTO 1140 IF A$=B$(I%) : GOTO 1130 IF A$<>B0$ : PRINT B$(I%);" NOT AVAILABLE: REENTER";: GOTO 1120 1140 G(I%)=G : L%(I%),V%(I%)=L% : L9%=L9%+L% : I5%=I5%*(L%+K1%) ! G=GYROMAGNETIC RATIO, L%=2*SPIN, L9%=2*MAX SPIN OF SYSTEM, I5%=FACTOR FOR TOTAL INTENSITY 1150 NEXT I% : Z%(K0%,K0%)=L9% : Z%(K0%,K5%)=I5% : W%(K0%)=L9%+K1% : W%(I%)=K0% FOR I%=K1% TO W%(K0%) ! W%(K%)=SIZE FOR EACH SPIN NOW PREPARE BASIS FUNCTIONS 1160 FOR I%=K1% TO 64% : Z%(I%,K0%)=K0% : FOR J%=K1% TO N8% : Z%(I%,J%)=V%(J%) : Z%(I%,K0%)=Z%(I%,K0%)+V%(J%) : NEXT J% : K%=(L9%-Z%(I%,K0%))/K2%+K1% : W%(K%)=W%(K%)+K1% : L%=K1% ! Z%(I%,0%)=2*NET SPIN FOR FUNCTION I%; Z%(I%,J%)=QUANTUM NOS. 1170 V%(L%)=V%(L%)-K2% : GOTO 1180 IF L%(L%)>=-V%(L%) : V%(L%)=L%(L%) : L%=L%+K1% : IF L%>N8% THEN 1190 ELSE 1170 ! V%(L%)=TEMPORARY HERE, PERMANENT AFTER LINE 780 1180 NEXT I% : PRINT "TOO MANY NUCLEI WITH BIG SPINS" : GOTO 500 1190 Z9%,Z%(K0%,K1%)=I% : GOSUB 3300 : FOR I%=K1% TO Z9% : K%=(L9%-Z%(I%,K0%))/K2%+K1% : P%(V%(K%))=I% : V%(K%)=V%(K%)-K1% : NEXT I% : GOSUB 3300 : N%(11%)=K1% ! V%(K%)=POINTING VECTOR TO FUNCTIONS FOR K-TH SPIN 1200 N%(K1%)=12% : GOTO 1100 UNLESS N%(11%) : N%(12%)=K0% : PRINT : PRINT " PAIR COUPLING CONSTANT (HZ)" : FOR I%=K1% TO N8% : FOR J%=I%+K1% TO N8% ! CC=COUPLING CONSTANTS 1210 PRINT I%; J%; TAB(K8%); : INPUT J(I%,J%) : J(J%,I%)=J(I%,J%) : NEXT J% : NEXT I% : N%(12%)=K1% : GOTO 500 IF N%(K0%)=K2% 1300 N%(K1%)=13% : GOTO 1100 UNLESS N%(11%) : N%(13%)=K0% : PRINT : PRINT "ATOM# TYPE CHEMICAL SHIFT (HZ)"; : FOR I%=K1% TO N8% : PRINT IF B$(I%)<>B$(I%-K1%) ! CS=CHEMICAL SHIFTS 1310 PRINT I%; TAB(K8%); B$(I%); TAB(12%); : INPUT J(I%,I%) : NEXT I% : N%(13%)=K1% : GOTO 500 IF N%(K0%)=K2% 1400 N%(K1%)=14% : GOTO 1100 UNLESS N%(11%) : I6%,N%(14%)=K0% : PRINT : INPUT "TYPE OF NUCLEUS OBSERVED";A$ : FOR I%=K1% TO N8% : GOTO 1410 IF B$(I%)<>A$ : Z%(K0%,K4%)=I% : I6%=I6%+L%(I%)*(L%(I%)+K2%) ! NO=NUCLEUS OBSERVED 1410 NEXT I% : GOTO 1420 IF I6% : PRINT A$;" NOT PRESENT" : GOTO 1400 1420 I6%,Z%(K0%,K6%)=I5%*I6%/K6% : N%(14%)=K1% : GOTO 500 IF N%(K0%)=K2% 1600 N%(K1%)=16% : GOTO 1400 UNLESS N%(14%) : GOTO 1300 UNLESS N%(13%) : GOTO 1200 UNLESS N%(12%) : PRINT : PRINT "TOTAL INTENSITY EXPECTED ="I6% : PRINT ! CO=COMPUTE LINE SPECTRUM 1610 INPUT "NAME FOR LINE SPECTRUM FILE (MAX=6 CHARS)"; F$ : OPEN F$+N2$ AS FILE K1% : CLOSE K1% ! ERR=2 IF BAD FILENAME 1620 K%=VAL(N0$(K0%)) : GOTO 1640 IF F$=N0$(I%) FOR I%=K1% TO K% : GOTO 1630 IF K%<10% : PRINT "TOO MANY "; : GOSUB 3800 : GOTO 1620 ! LIMIT OF 10 FILES TO BE SAVED 1630 I%=K%+K1% : N0$(I%)=F$+B0$ : N0$(K0%)=NUM$(I%) ! STORE FILENAME 1640 N%(K6%)=I% : GOSUB 3700 : CHAIN N1$+"NMRCAL" 200 ! SAVE POINTER TO FILENAME; SAVE SPIN ARRAYS ! NMRCAL RETURNS TO STATEMENT 1700 1700 PRINT "IN"N7%; "LINES FROM "; : OPEN N0$(N%(K6%))+N2$ AS FILE K1% : J%=Z%(K0%,K4%) : PRINT #K1%, B$(J%);",",G(J%) : E1=1.E10 : E2=-E1 ! PREPARE ASCII FILE OF LINES 1710 FOR I%=K1% TO N7% : E7=I(I%,K0%) : E1=E7 IF E7E2 : PRINT #K1%, E7;",",I(I%,K1%) 1720 NEXT I% : PRINT E2;" TO "E1; "HZ" : PRINT #K1%, CHR$(26%); : CLOSE K1% : N%(16%)=K1% : N%(K0%)=K2% : GOTO 500 ! WRITE ^Z AS END OF FILE MARK; RELAX REQUIREMENT FOR SEQUENTIAL PASSAGE; GET NEXT COMMAND 2000 M6%=K0% : PRINT : PRINT "SELECT ONE OF THESE CODES IN RESPONSE TO 'NEXT?'" : PRINT 2010 PRINT "EX = EXIT (ONLY WAY OUT!) NP = NEW PLOT" : PRINT "HE = HELP MESSAGE MR = MINIMUM RESOLUTION" : PRINT "LN = LIST NUCLEI LL = LIST LINES" : PRINT "NM = NEW MOLECULE XS = X-SCALE PARAMETERS" 2020 PRINT "CC = COUPLING CONSTANTS"; : PRINT " LS = LINESHAPE PARAMETERS" : PRINT "CS = CHEMICAL SHIFTS YS = Y-SCALE PARAMETERS" : PRINT "NO = NUCLEUS OBSERVED PL = PLOT WITH CURRENT SCALE" : PRINT "CO = COMPUTE LINE SPECTRUM" 2030 PRINT "^C ABORTS 'HE', 'LL', OR 'PL' OUTPUT" : PRINT "MORE ^C'S LEAD TO 'WHAT?' AND THEN TO HELP MESSAGE" : PRINT : GOTO 500 2100 N%(22%)=K0% : CLOSE K2% : CHAIN N1$+"NMRPLT" 200 3000 N%(K1%)=30% : K%=VAL(N0$(K0%)) : GOTO 3010 UNLESS K% : PRINT "PLEASE DEAL WITH "; : GOSUB 3800 3010 KILL N$+N0$ : PRINT "THANK YOU FOR USING NMRSIM---J.S.EVANS" : GOTO 32000 3200 F0=0 : F1=1 : B0$="" : N2$=".NMR" : M6%,K0%=0% : K1%=1% : K2%=2% : K3%=3% : K4%=4% : K5%=5% : I7%,K6%=6% : K7%=7% : K8%=8% : K9%=9% : ON ERROR GOTO 30000 : GOSUB 21400 ! INITIALIZE CONSTANTS; ENABLE ^C TRAP 3210 N1$=CHR$(35%) 3220 N$="NMRTMP.J" : I8%=K9% : GOSUB 20000 : N0$=RIGHT(NUM$(100%+ASCII(K0$)/K2%),K3%) : OPEN N$+N0$ AS FILE K2%, CLUSTERSIZE K8% : RETURN ! OPEN VIRTUAL CORE FILE 3300 V%(K1%)=K1% : V%(I%)=V%(I%-K1%)+W%(I%) FOR I%=K2% TO W%(K0%) : RETURN ! (RE)GENERATE TRANSFER VECTOR 3700 I6%(I%,J%)=Z%(I%,J%) FOR J%=K0% TO K6% FOR I%=K0% TO 64% : I7%(I%)=P%(I%) FOR I%=K0% TO 64% : I8%(I%)=V%(I%) FOR I%=K0% TO K7% : I9%(I%)=W%(I%) FOR I%=K0% TO K7% : CLOSE K2% : RETURN ! WRITE OUT CHANGES IN SPIN ARRAYS 3800 RETURN UNLESS K% : PRINT "FILES STORED BY PROGRAM" : PRINT "SA=SAVE, KI=KILL (ANSWER FOR EACH)" : I%=K0% ! REPACK LIST OF SPECTRUM FILES, KILLING THOSE NOT WANTED 3810 I%=I%+K1% : RETURN IF I%>K% : PRINT N0$(I%); : INPUT A$ : GOTO 3810 IF A$<>"KI" : KILL N0$(I%)+N2$ : N0$(I%)=N0$(K%) : I%=I%-K1% : K%=K%-K1% : GOTO 3810 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 30030 GOTO 30040 IF ERR<>K2% : RESUME 1610 IF ERL=1610 : GOTO 31990 ! BAD FILE NAME 30040 GOTO 31990 UNLESS ERR=50% 30050 RESUME 1110 IF ERL=1110 : RESUME 1210 IF ERL=1210 : RESUME 1310 IF ERL=1310 : GOTO 31990 ! ILLEGAL NUMBER TRAP ***CHANGE TO ERR=52% PRIOR TO RSTS VERSION 05B-24*** 31000 GOSUB 21400 : GOSUB 21300 : IF M6%=K1% THEN RESUME 2000 ELSE M6%=K1% : RESUME 500 ! FIRST ^C GIVES 'WHAT?'; SECOND ^C GIVES HELP MESSAGE 31990 I9%=117% : GOSUB 21200 : I9%=114% : GOSUB 21200 : PRINT "IF POSSIBLE, CONTACT MR. EVANS BEFORE LOGGING OFF" : ON ERROR GOTO 0 32000 END