100 REM ************** N M R ******************
110 SCREEN 2:CLS:KEY OFF
120 DEFINT I,J,N,V,X,Y
130 PSET (10,1):LINE -STEP(620,0):LINE -STEP(0,164):LINE -STEP(-620,0):LINE -STEP(0,-164):PSET (20,6):LINE -STEP(600,0):LINE -STEP(0,154):LINE -STEP(-600,0):LINE -STEP(0,-154)
140 X=200:Y=64:PSET (X,Y):LINE -STEP(15,0):LINE -STEP(-5,-4):LINE -STEP(0,-30):LINE -STEP(34,34):LINE -STEP(10,0):LINE -STEP(-5,-4):LINE -STEP(0,-30):LINE -STEP(5,-4):LINE -STEP(-15,0)
150 LINE -STEP(5,4):LINE -STEP(0,30):LINE -STEP(-34,-34):LINE -STEP(-10,0):LINE -STEP(5,4):LINE -STEP(0,30):LINE -STEP(-5,4)
160 PSET (X+90,Y):LINE -STEP(15,0):LINE -STEP(-5,-4):LINE -STEP(0,-30):LINE -STEP(20,20):LINE -STEP(20,-20):LINE -STEP(0,30):LINE -STEP(-5,4):LINE -STEP(15,0):LINE -STEP(-5,-4):LINE -STEP(0,-30)
170 LINE -STEP(5,-4):LINE -STEP(-10,0):LINE -STEP(-20,20):LINE -STEP(-20,-20):LINE -STEP(-10,0):LINE -STEP(5,4):LINE -STEP(0,30):LINE -STEP(-5,4)
180 X=X+185:PSET (X,Y):LINE -STEP(15,0):LINE -STEP(-5,-4):LINE -STEP(0,-12):LINE -STEP(5,0):PSET (X+16,Y-20):LINE -STEP(-6,0):LINE -STEP(0,-14):LINE -STEP(5,0)
190 PSET (X+15,Y-38):LINE -STEP(-15,0):LINE -STEP(5,4):LINE -STEP(0,30):LINE -STEP(-5,4):CIRCLE (X+18,Y-27),15,,4.7,1.8,.45:CIRCLE (X+17,Y-27),24,,4.7,4.9,.45
200 PSET (X+24,Y-16):LINE -STEP(12,12):LINE -STEP(-5,4):LINE -STEP(15,0):LINE -STEP(-17,-17):CIRCLE (X+17,Y-27),24,,5.3,1.7,.45
210 LOCATE 20,4:PRINT "Ver. 1.1":LOCATE 12,29:PRINT "M. Rudolf und U. Jordis"
220 LOCATE 16,18:PRINT "SIMULATION  AND  INTERPRETATION  OF  AROMATIC"
230 X=209:Y=138:GOSUB 7180:LOCATE 18,28:PRINT "H-  AND":X=283:Y=138:GOSUB 7180:X=288:Y=138:GOSUB 7200:LOCATE 18,38:PRINT "C-  NMR  SPECTRA"
240 LOCATE 23,4:PRINT "loading..."
250 REM ********** read data ***********
260 DIM OG(2):DIM UG(2):DIM CH$(7):DIM LZ2%(5)
270 DIM I%(621):DIM KK(26):DIM KK$(26):DIM X(200):DIM Y(200)
280 DIM S$(200):DIM E$(5):DIM IS$(200):DIM S(200,6):DIM V(5,5):DIM HV(5)
290 DIM XP%(5):DIM YP%(5):DIM H(5):DIM N(5):DIM RFAK(200)
300 DIM KXP%(5):DIM KYP%(5):DIM CV(5):DIM CI(5):DIM CZ%(5):DIM CS%(5)
310 DIM LP2(2,98):DIM LPI2(2,98):DIM LZ%(2):DIM API%(1000):DIM BPI%(1000)
320 DIM LL1(98):DIM LI1(98):DIM LL2(5,32):DIM LI2(5,32)
330 DIM LL3(5,5,32):DIM LI3(5,5,32):DIM ASP%(5):DIM LANZ%(5)
340 DIM K1%(2,620):DIM PIC%(9000)
350 FOR N=0 TO 7:READ CH$(N):NEXT N
360 DATA "ortho","meta","para","ipso","ortho","meta","para","relax.fact."
370 FOR N=0 TO 5:READ XP%(N),YP%(N):NEXT N
380 DATA 40,4,49,8,49,11,40,15,31,11,31,8
390 FOR N=0 TO 5:READ CZ%(N),CS%(N):NEXT N
400 DATA 4,40,8,51,12,51,16,40,12,30,8,30
410 FOR N=0 TO 5:READ KXP%(N),KYP%(N):NEXT N
420 DATA 1,15,3,20,5,20,7,15,5,10,3,10
430 FOR I=0 TO 5:FOR J=0 TO 5:READ V(I,J):NEXT J:NEXT I
440 DATA 0,1,2,3,2,1,1,0,1,2,3,2,2,1,0,1,2,3,3,2,1,0,1,2,2,3,2,1,0,1,1,2,3,2,1,0
450 REM read substituents and increments for 1-H and 13-C and relax.factor
460 ANZ%=1
470 READ S$(ANZ%),IS$(ANZ%):FOR J=0 TO 6:READ S(ANZ%,J):NEXT J:READ RFAK(ANZ%)
480 IF S$(ANZ%)<>"end" THEN ANZ%=ANZ%+1:GOTO 470
490 ANZ%=ANZ%-1
500 DATA "H","H",0,0,0,0,0,0,0,1
510 DATA "CH3","H3C",-.16,-.09,-.18,9.3,.6,0,-3.1,.4
520 DATA "ME","ME",-.16,-.09,-.18,9.3,.6,0,-3.1,.4
530 DATA "CH2CH3","H3CH2C",-.13,-.07,-.14,15.7,-.6,-.1,-2.8,.35
540 DATA "ET","ET",-.13,-.07,-.14,15.7,-.6,-.1,-2.8,.35
550 DATA "C2H5","H5C2",-.13,-.07,-.14,15.7,-.6,-.1,-2.8,.35
560 DATA "PR","PR",-.1,0,-.12,14.1,-.3,0,-2.8,.35
570 DATA "CH2CH2CH3","H3CH2CH2C",-.1,0,-.12,14.1,-.3,0,-2.8,.35
580 DATA "CH(CH3)2","(H3C)2CH",-.13,-.08,-.18,20.1,-2,0,-2.5,.35
590 DATA "IPR","IPR",-.13,-.08,-.18,20.1,-2,0,-2.5,.35
600 DATA "C(CH3)3","(H3C)3C",.02,-.09,-.22,22.1,-3.4,-.4,-3.1,.35
610 DATA "TBU","TBU",.02,-.09,-.22,22.1,-3.4,-.4,-3.1,.35
620 DATA "CH2CL","CLCH2",.08,.01,0,9.1,0,.2,-.2,.5
630 DATA "CH2OH","HOCH2",-.07,-.07,-.07,13,-1.4,0,-1.2,.5
640 DATA "CH2NH2","H2NCH2",.01,.01,.01,14.9,-1.6,-.2,-2,.5
650 DATA "CHCH2","H2CCH",.06,-.03,-.1,7.6,-1.8,-1.8,-3.5,.5
660 DATA "CHCHC6H5","H5C6HCCH",.15,-.01,-.16,8.9,-2,.2,-.9,.5
670 DATA "CHCHPH","PHHCCH",.15,-.01,-.16,8.9,-2,.2,-.9,.5
680 DATA "CHNC6H5","H5C6NHC",.6,.2,.2,7.7,.5,.2,2.6,.5
690 DATA "CHNPH","PHNHC",.6,.2,.2,7.7,.5,.2,2.6,.5
692 DATA "CCH","HCC",.15,-.02,-.01,-6.1,3.8,.4,-.2,.5
700 DATA "C6H5","H5C6",.25,.12,.1,13,-1.1,.5,-1,.5
710 DATA "PH","PH",.25,.12,.1,13,-1.1,.5,-1,.5
720 DATA "CHO","OHC",.53,.22,.35,9,1.2,1.2,6,.5
730 DATA "COH","OHC",.53,.22,.35,9,1.2,1.2,6,.5
740 DATA "COCH3","H3COC",.62,.14,.21,9.3,.2,.2,4.2,.5
750 DATA "COME","MEOC",.62,.14,.21,9.3,.2,.2,4.2,.5
760 DATA "AC","AC",.62,.14,.21,9.3,.2,.2,4.2,.5
770 DATA "COC2H5","H5C2OC",.63,.13,.2,8.5,0,-.6,4.3,.5
780 DATA "COET","ETOC",.63,.13,.2,8.5,0,-.6,4.3,.5
790 DATA "COC6H5","H5C6OC",.47,.13,.22,9.1,1.3,-.3,3.8,.5
800 DATA "COPH","PHOC",.47,.13,.22,9.1,1.3,-.3,3.8,.5
810 DATA "COOH","HOOC",.75,.15,.28,2.4,1.6,-.1,4.8,.5
820 DATA "CO2H","HO2C",.75,.15,.28,2.4,1.6,-.1,4.8,.5
830 DATA "COOCH3","H3COOC",.71,.11,.21,2.1,1.2,0,4.4,.5
840 DATA "COOME","MEOOC",.71,.11,.21,2.1,1.2,0,4.4,.5
850 DATA "COOPH","PHOOC",.9,.17,.27,1.2,1.5,0,4.9,.5
860 DATA "COOC6H5","H5C6OOC",.9,.17,.27,1.2,1.5,0,4.9,.5
870 DATA "CONH2","H2NOC",.61,.1,.17,4.4,-.3,-.9,1.5,.5
880 DATA "COF",FOC",.71,.21,.38,4.3,1.6,-.7,5.3,.5
890 DATA "COCL","CLOC",.84,.2,.36,4.6,2.9,.6,7,.5
900 DATA "COBR","BROC",.77,.21,.38,4.8,3,.45,6.9,.5
910 DATA "CN","NC",.36,.18,.28,-16,3.5,.7,4.3,.5
920 DATA "NH2","H2N",-.79,-.25,-.59,19.2,-12.4,1.3,-9.5,.7
930 DATA "NHCH3","H3CHN",-.8,-.22,-.68,21.7,-16.2,.7,-11.8,.7
940 DATA "NHME","MEHN",-.8,-.22,-.68,21.7,-16.2,.7,-11.8,.7
950 DATA "N(CH3)2","(H3C)2N",-.66,-.18,-.67,22.4,-15.7,.8,-11.8,.7
960 DATA "NME2","ME2N",-.66,-.18,-.67,22.4,-15.7,.8,-11.8,.7
970 DATA "NHNH2",H2NHN",-.6,-.08,-.55,22.8,-16.5,.5,-9.6,.7
980 DATA "NNC6H5",H5C6NN",.67,.2,.2,24,-5.8,.3,2.2,.7
990 DATA "NNPH",PHNN",.67,.2,.2,24,-5.8,.3,2.2,.7
1000 DATA "NHCOCH3","H3COCHN",.12,-.07,-.28,11.1,-9.9,.2,-5.6,.7
1010 DATA "NMEAC",ACMEN",-.16,.05,-.02,16.2,-1.4,1.2,-.9,.7
1020 DATA "NCH3COCH3","H3CCOH3CN",-.16,.05,-.02,16.2,-1.4,1.2,-.9,.7
1030 DATA "NHAC","ACHN",.12,-.07,-.28,11.1,-9.9,.2,-5.6,.7
1040 DATA "NHCOME","MEOCHN",.12,-.07,-.28,11.1,-9.9,.2,-5.6,.7
1050 DATA "NCO","OCN",-.21,-.21,-.2,5.1,-3.7,1.1,-2.8,.5
1060 DATA "NH3+","+H3N",.4,.2,.2,3,-5.3,1.1,-.3,.7
1070 DATA "NME3+","+ME3N",.69,.36,.31,18.5,-8.3,1.5,1.5,.7
1080 DATA "N(CH3)3+","+(H3C)3N",.69,.36,.31,18.5,-8.3,1.5,1.5,.7
1090 DATA "NO","ON",.58,.31,.37,37.4,-7.7,.8,7,.5
1100 DATA "NO2","O2N",.87,.23,.38,19.6,-5.3,.8,6,.5
1110 DATA "SH","HS",-.12,-.16,-.2,2.2,.7,.4,-3.1,.5
1120 DATA "SCH3","H3CS",-.12,-.16,-.2,9.9,-2,.1,-3.7,.5
1130 DATA "SME","MES",-.12,-.16,-.2,9.9,-2,.1,-3.7,.5
1140 DATA "SC6H5","H5C6S",.04,-.07,-.1,7,2.1,.3,-1.2,.5
1150 DATA "SPH","PHS",.04,-.07,-.1,7,2.1,.3,-1.2,.5
1160 DATA "SO3H","HO3S",.64,.26,.36,15,-2.2,1.3,3.8,.5
1170 DATA "SO3ME","MEO3S",.6,.26,.33,6.7,-.7,1.4,5.8,.5
1180 DATA "SO3CH3","H3CO3S",.6,.26,.33,6.7,-.7,1.4,5.8,.5
1190 DATA "SO2NH2","H2NO2S",.66,.26,.36,15,-2.8,.2,3.4,.5
1200 DATA "OH","HO",-.45,-.07,-.43,26.9,-12.7,1.4,-7.3,.5
1210 DATA "OCH3","H3CO",-.41,-.09,-.4,30.2,-14.7,.9,-8.1,.5
1220 DATA "OME","MEO",-.41,-.09,-.4,30.2,-14.7,.9,-8.1,.5
1230 DATA "OC2H5","H5C2O",-.46,-.1,-.43,30.8,-13.9,1,-7.9,.5
1240 DATA "OET","ETO",-.46,-.1,-.43,30.8,-13.9,1,-7.9,.5
1250 DATA "OPH","PHO",-.29,-.05,-.23,29.1,-9.5,.3,-5.3,.5
1260 DATA "OC6H5","H5C6O",-.29,-.05,-.23,29.1,-9.5,.3,-5.3,.5
1270 DATA "OCOCH3","H3COCO",-.31,0,-.13,23,-6.4,1.3,-2.3,.5
1280 DATA "OAC","ACO",-.31,0,-.13,23,-6.4,1.3,-2.3,.5
1290 DATA "OCOME","MEOCO",-.31,0,-.13,23,-6.4,1.3,-2.3,.5
1300 DATA "OCOPH","PHOCO",-.09,.09,-.08,22.6,-6.8,.9,-2.8,.5
1310 DATA "OCOC6H5","H5C6OCO",-.09,.09,-.08,22.6,-6.8,.9,-2.8,.5
1320 DATA "OSO2CH3","H3CO2SO",-.05,.07,-.01,20.9,-6.5,1.5,-1.1,.5
1330 DATA "OSO2ME","MEO2SO",-.05,.07,-.01,20.9,-6.5,1.5,-1.1,.5
1340 DATA "F","F",-.26,-0.01,-.22,35.1,-14.3,.9,-4.4,.4
1350 DATA "CL","CL",.08,0,-.06,6.4,.2,1,-2,.5
1360 DATA "BR","BR",.25,-.1,-.04,-5.4,3.3,2.2,-1,.4
1370 DATA "J","J",.39,-.17,-.08,-32.3,9.9,2.6,-.4,.4
1380 DATA "I","I",.39,-.17,-.08,-32.3,9.9,2.6,-.4,.4
1390 DATA "CF3",F3C",.27,.14,.2,2.6,-3.1,.4,3.4,.5
1400 DATA "CCL3","CL3C",.6,0,0,15.6,-3.2,-.4,1.6,.5
1410 DATA "P(C6H5)2","(H5C6)2P",.05,-.05,0,8.7,5.1,-.1,0,.5
1420 DATA "PPH2","PH2P",.05,-.05,0,8.7,5.1,-.1,0,.5
1430 DATA "POPH2","PH2OP",.49,.24,.34,4.2,3.7,.1,3.5,.5
1440 DATA "PO(C6H5)2","(H5C6)2OP",.49,.24,.34,4.2,3.7,.1,3.5,.5
1450 DATA "SIME3","ME3SI",.22,-.02,-.02,13.4,4.4,-1.1,-1.1,.5
1460 DATA "SI(CH3)3","(H3C)3SI",.22,-.02,-.02,13.4,4.4,-1.1,-1.1,.5
1470 DATA "LI","LI",.77,.26,-.29,58.1,15.2,-3.8,5.4,.5
1480 DATA "MGBR","BRMG",.4,-.19,-.26,35.8,11.4,2.7,4,.5
1490 DATA "ANHYDRID","ANHYDRID",0,.84,-.02,2.6,0,-3.3,10.9,.5
1500 DATA "PHTHALIMID","PHTHALIMID",0,.53,-.03,0,4.3,-9.8,15.6,.5
1510 DATA "CYPENTYL","CYPENTYL",0,-.06,-.04,0,15.4,-18,13.7,.35
1520 DATA "CYHEXYL","CYHEXYL",0,-.25,-.08,0,8.3,-11.3,11.8,.35
1530 DATA "PHENYLEN","PHENYLEN",.4,.04,0,0,5.2,-5.7,4.2,.3
1540 DATA "STHIENO","STHIENO",.52,.03,.06,0,11.1,-16.1,12.6,.5
1550 DATA "CTHIENO","CTHIENO",.42,0,0,0,11.2,-17,11.8,.3
1560 DATA "NPYRROLO","NPYRROLO",.52,0,0,0,-.9,-15,9.5,.5
1570 DATA "CPYRROLO","CPYRROLO",.38,-.18,-.13,0,7,-16.6,6.1,.3
1580 DATA "OFURO","OFURO",.29,0,0,0,-.6,-33.9,10.8,.5
1590 DATA "CFURO","CFURO",.23,-.13,-.07,0,27,-16.1,30,.3
1600 DATA "IMIDAZO","IMIDAZO",0,.44,-.44,0,9.4,-22.5,16.9,.5
1610 DATA "STHIAZOL","STHIAZOL",0,.97,-.57,0,24.1,-11.1,26.5,.4
1620 DATA "NTHIAZOL","NTHIAZOL",0,.86,-.68,0,4.7,-29.9,8.4,.5
1630 DATA "CPYRIDO","CPYRIDO",0,.79,-.07,0,20.8,1.6,22.2,.3
1640 DATA "NPYRIDO","NPYRIDO",0,.42,-.62,0,.4,-20.8,-3.1,.5
1650 DATA "CPYRIDAZO","CPYRIDAZO",0,1.04,0,0,22.5,2.6,26.6,.5
1660 DATA "NPYRIDAZO","NPYRIDAZO",0,.31,-.73,0,-1.6,-23,1.1,.5
1670 DATA "CPYRIMIDO","CPYRIMIDO",0,.75,0,0,21.6,3.4,28.3,.35
1680 DATA "NPYRIMIDO","NPYRIMIDO",0,.58,-.43,0,-3.3,-22.7,-4,.5
1690 DATA "PYRAZINO","PYRAZINO",0,.81,-.39,0,16.3,-15.2,16.1,.5
1700 DATA "CISATO","CISATO",0,-.06,-.26,0,12.9,5.3,15.9,.5
1710 DATA "NISATO","NISATO",0,.62,.03,0,-18.4,-12.5,-10.3,.5
1720 REM you can add substituents and increments o,m,p here
1730 DATA "end","end",0,0,0,0,0,0,0,0
1740 REM ***** coupling constants **************
1750 GOSUB 1770:GOTO 1810
1760 REM ortho-H,meta-H,para-H,ortho-F,meta-F,para-F
1770 FOR N=1 TO 26:READ KK$(N),KK(N):NEXT N:RETURN
1780 DATA "ortho H-H",7,"meta H-H",2,"para H-H",.8,"ortho H-F",8.5,"meta H-F",5,"para H-F",2,"ortho H-PR2",6,"meta H-PR2",4,"para H-PR2",3.5,"ortho H-P(O)R2",12,"meta H-P(O)R2",4,"para H-P(O)R2",1.5
1790 DATA "ipso C-F",245,"ortho C-F",21,"meta C-F",8,"para C-F",3,"ipso C-CF3",32,"ortho C-CF3",4,"ipso C-PR2",12,"ortho C-PR2",20,"meta C-PR2",7,"ipso C-P(O)R2",104,"ortho C-P(O)R2",10,"meta C-P(O)R2",18,"para C-P(O)R2",2
1800 DATA "C-H off-res.",40
1810 HSFR=60:CSFR=20:REM default frequencies
1820 YF!=1:LH%=12:REM height per proton splitup-tree
1830 LOCATE 23,4:PRINT SPC(15):GOSUB 7120
1840 REM ********* input substituents *********
1850 EK%=0:E$(0)="":OG(1)=10:UG(1)=5:OG(2)=180:UG(2)=60:ORK%=0:IK%=0:BK%=0:RES=1:KKO=1:PIC2%=1:MODE%=1
1860 CLS:SCREEN 2:LOCATE 1,30:PRINT "NMR:   STRUCTURE INPUT":PSET (229,9):LINE-(406,9)
1870 LOCATE 6,40:PRINT "1":LOCATE 8,46:PRINT "2":LOCATE 11,46:PRINT "3":LOCATE 13,40:PRINT "4":LOCATE 11,34:PRINT "5":LOCATE 8,34:PRINT "6"
1880 LINE(314,35)-STEP (58,20):LINE -STEP (0,32):LINE -STEP (-58,20):LINE -STEP (-58,-20):LINE -STEP (0,-32):LINE -STEP (58,-20)
1890 CIRCLE (314,71),43,1,,,.48:HCO%=0
1900 FOR I=0 TO 5:IF E$(I)="" THEN GOTO 1940
1910 IF I<4 THEN LOCATE YP%(I),XP%(I) ELSE LOCATE YP%(I),XP%(I)-LEN(E$(I))+1
1920 PRINT E$(I):NEXT I
1930 LOCATE 23,23:PRINT "enter substituents   ( H = <ENTER> )":BEEP
1940 FOR J=I TO 5
1950 IF EK%>0 THEN EK%=0:GOTO 2240
1960 GOSUB 5920:REM sub for input
1970 A$="":FOR N=1 TO LEN(E$(J)):B$=MID$(E$(J),N,1):IF B$=" " OR B$="-" THEN GOTO 1980 ELSE A$=A$+B$
1980 NEXT N:E$(J)=A$:REM removes " " and "-"
1990 M$="":FOR N=1 TO LEN(E$(J)):I=ASC(MID$(E$(J),N,1)):IF I>96 THEN M$=M$+CHR$(I-32) ELSE M$=M$+CHR$(I)
2000 NEXT N:E$(J)=M$
2010 IF E$(J)="ANHYDRID" THEN IF J<5 THEN E$(J+1)="ANHYDRID":EK%=1 ELSE GOTO 2360
2020 IF E$(J)="CYPENTYL" THEN IF J<5 THEN E$(J+1)="CYPENTYL":EK%=1 ELSE GOTO 2360
2030 IF E$(J)="CYHEXYL" THEN IF J<5 THEN E$(J+1)="CYHEXYL":EK%=1 ELSE GOTO 2360
2040 IF E$(J)="PHTHALIMID" THEN IF J<5 THEN E$(J+1)="PHTHALIMID":EK%=1 ELSE GOTO 2360
2050 IF E$(J)="PHENYLEN" THEN IF J<5 THEN E$(J+1)="PHENYLEN":EK%=1 ELSE GOTO 2360
2060 IF E$(J)="IMIDAZO" THEN IF J<5 THEN E$(J+1)="IMIDAZO":EK%=1 ELSE GOTO 2360
2070 IF E$(J)="STHIENO" THEN IF J<5 THEN E$(J+1)="CTHIENO":EK%=1 ELSE GOTO 2360
2080 IF E$(J)="CTHIENO" THEN IF J<5 THEN E$(J+1)="STHIENO":EK%=1 ELSE GOTO 2360
2090 IF E$(J)="STHIAZOL" THEN IF J<5 THEN E$(J+1)="NTHIAZOL":EK%=1 ELSE GOTO 2360
2100 IF E$(J)="NTHIAZOL" THEN IF J<5 THEN E$(J+1)="STHIAZOL":EK%=1 ELSE GOTO 2360
2110 IF E$(J)="NPYRROLO" THEN IF J<5 THEN E$(J+1)="CPYRROLO":EK%=1 ELSE GOTO 2360
2120 IF E$(J)="CPYRROLO" THEN IF J<5 THEN E$(J+1)="NPYRROLO":EK%=1 ELSE GOTO 2360
2130 IF E$(J)="CFURO" THEN IF J<5 THEN E$(J+1)="OFURO":EK%=1 ELSE GOTO 2360
2140 IF E$(J)="OFURO" THEN IF J<5 THEN E$(J+1)="CFURO":EK%=1 ELSE GOTO 2360
2150 IF E$(J)="CPYRIDO" THEN IF J<5 THEN E$(J+1)="NPYRIDO":EK%=1 ELSE GOTO 2360
2160 IF E$(J)="NPYRIDO" THEN IF J<5 THEN E$(J+1)="CPYRIDO":EK%=1 ELSE GOTO 2360
2170 IF E$(J)="CPYRIDAZO" THEN IF J<5 THEN E$(J+1)="NPYRIDAZO":EK%=1 ELSE GOTO 2360
2180 IF E$(J)="NPYRIDAZO" THEN IF J<5 THEN E$(J+1)="CPYRIDAZO":EK%=1 ELSE GOTO 2360
2190 IF E$(J)="NPYRIMIDO" THEN IF J<5 THEN E$(J+1)="CPYRIMIDO":EK%=1 ELSE GOTO 2360
2200 IF E$(J)="CPYRIMIDO" THEN IF J<5 THEN E$(J+1)="NPYRIMIDO":EK%=1 ELSE GOTO 2360
2210 IF E$(J)="PYRAZINO" THEN IF J<5 THEN E$(J+1)="PYRAZINO":EK%=1 ELSE GOTO 2360
2220 IF E$(J)="CISATO" THEN IF J<5 THEN E$(J+1)="NISATO":EK%=1 ELSE GOTO 2360
2230 IF E$(J)="NISATO" THEN IF J<5 THEN E$(J+1)="CISATO":EK%=1 ELSE GOTO 2360
2240 GOSUB 3240
2250 IF KO%>0 THEN KO%=0:GOTO 1960:REM on error
2260 IF E$(J)="H" THEN HCO%=HCO%+1
2270 IF J<0 THEN J=0
2280 IF KO%=1 THEN GOTO 5920
2290 IF J<4 THEN LOCATE YP%(J),XP%(J):PRINT SPC(25):LOCATE YP%(J),XP%(J):PRINT E$(J)
2300 IF J>3 THEN LOCATE YP%(J),XP%(J)-25:PRINT SPC(25):LOCATE YP%(J),XP%(J)-LEN(E$(J))+1:PRINT E$(J)
2310 LOCATE 22,19:PRINT SPC(20):NEXT J:LOCATE 22,3:PRINT SPC(30)
2320 MA%=MODE%:MODE%=1:IF HCO%=0 THEN MODE%=2
2330 IF MA%=2 THEN MODE%=2
2340 IF PIC2%>1 THEN IF MA%<>MODE% THEN CLS:LOCATE 10,28:BEEP:PRINT "wrong type of spectrum !!":GOSUB 7120:GOTO 1840
2350 GOTO 2390
2360 BEEP:LOCATE 21,29:PRINT "impossible structure !!":GOSUB 7120:LOCATE 21,28:PRINT SPC(30)
2370 IF J<4 THEN LOCATE YP%(J),XP%(J):PRINT SPC(10) ELSE LOCATE YP%(J),XP%(J)-10:PRINT SPC(10)
2380 J=J-1:GOTO 2310
2390 REM ********* calculation ********
2400 IF MODE%=2 THEN GOTO 2460
2410 FOR N=0 TO 5:IF E$(N)<>"H" THEN GOTO 2450
2420 HV(N)=7.26:FOR J=0 TO 5:IF V(N,J)=0 THEN GOTO 2440
2430 HV(N)=HV(N)+S(N(J),V(N,J)-1)
2440 NEXT J
2450 NEXT N
2460 FOR I=0 TO 5:CV(I)=128.5:FOR J=0 TO 5:CV(I)=CV(I)+S(N(J),V(I,J)+3):NEXT J:CI(I)=RFAK(N(I))
2470 NEXT I:IF MODE%=2 THEN IF PIC2%=1 THEN GOTO 6390 ELSE GOTO 6610
2480 REM ********* display ********
2490 MODE%=1:X=226:Y=4:GOSUB 7180:LOCATE 1,30:PRINT "H-NMR     SHIFT VALUES"
2500 FOR N=0 TO 5:IF E$(N)<>"H" THEN GOTO 2550
2510 IF N=0 OR N=3 THEN LOCATE YP(N),XP(N)-2
2520 IF N=1 OR N=2 THEN LOCATE YP(N),XP(N)-1
2530 IF N=4 OR N=5 THEN LOCATE YP(N),XP(N)-4
2540 PRINT USING "##.##";HV(N)
2550 NEXT N:IF PIC2%=2 THEN GOTO 2640
2560 LOCATE 20,30:PRINT "(shift values in ppm)"
2570 LOCATE 23,1:PRINT "e...exit to DOS, 1...coupled spectrum, 2...new structure, 3...":X=498:Y=178:GOSUB 7180:X=504:Y=178:GOSUB 7200:LOCATE 23,65:PRINT "C shift values"
2580 BEEP:A$=INPUT$(1):IF INSTR("123eE",A$)=0 THEN GOTO 2580
2590 IF INSTR("Ee",A$)>0 THEN CLS:SCREEN 0:SYSTEM
2600 LOCATE 23,1:PRINT SPC(79):LOCATE 22,55:PRINT SPC(10):ON VAL(A$) GOTO 2610,1840,6390
2610 REM ********** calc. of coupled spectrum *****
2620 LOCATE 23,16:PRINT SPC(60):LOCATE 23,4:PRINT "frequency (MHz)   (";:PRINT HSFR;:PRINT ")";:LOCATE 23,40:LINE INPUT A$:IF LEN(A$)=0 THEN HFR=HSFR:GOTO 2640 ELSE RA%=1:GOSUB 5550
2630 HFR=VAL(A$)
2640 IK%=0
2650 FOR N=0 TO 5:H(N)=HV(N)*HFR:LANZ%(N)=1:LL3(N,0,1)=H(N):LI3(N,0,1)=1:NEXT N
2660 LOCATE 23,4:PRINT " computing...";:PRINT SPC(15)
2670 FOR N=0 TO 5:ASP%(N)=0:LANZ%(N)=1:IF E$(N)<>"H" THEN GOTO 2900
2680 GOSUB 7100
2690 IF E$(AA%)="H" AND ABS(H(N)-H(AA%))/HFR>.01 THEN X=AA%:KK=KK(1):GOSUB 7810
2700 IF E$(BB%)="H" AND ABS(H(N)-H(BB%))/HFR>.01 THEN X=BB%:KK=KK(1):GOSUB 7810
2710 IF E$(CC%)="H" AND ABS(H(N)-H(CC%))/HFR>.01 THEN X=CC%:KK=KK(2):GOSUB 7810
2720 IF E$(DD%)="H" AND ABS(H(N)-H(DD%))/HFR>.01 THEN X=DD%:KK=KK(2):GOSUB 7810
2730 IF E$(EE%)="H" AND ABS(H(N)-H(EE%))/HFR>.01 THEN X=EE%:KK=KK(3):GOSUB 7810
2740 REM ********** F and P coupling *********
2750 IF E$(AA%)="F" THEN KK=KK(4):GOSUB 3200
2760 IF E$(BB%)="F" THEN KK=KK(4):GOSUB 3200
2770 IF E$(CC%)="F" THEN KK=KK(5):GOSUB 3200
2780 IF E$(DD%)="F" THEN KK=KK(5):GOSUB 3200
2790 IF E$(EE%)="F" THEN KK=KK(6):GOSUB 3200
2800 IF E$(AA%)="PPH2" OR E$(AA%)="PH2P" OR E$(AA%)="P(C6H5)2" OR E$(AA%)="(H5C2)2P" THEN KK=KK(7):GOSUB 3200
2810 IF E$(BB%)="PPH2" OR E$(BB%)="PH2P" OR E$(BB%)="P(C6H5)2" OR E$(BB%)="(H5C2)2P" THEN KK=KK(7):GOSUB 3200
2820 IF E$(CC%)="PPH2" OR E$(CC%)="PH2P" OR E$(CC%)="P(C6H5)2" OR E$(CC%)="(H5C2)2P" THEN KK=KK(8):GOSUB 3200
2830 IF E$(DD%)="PPH2" OR E$(DD%)="PH2P" OR E$(DD%)="P(C6H5)2" OR E$(DD%)="(H5C2)2P" THEN KK=KK(8):GOSUB 3200
2840 IF E$(EE%)="PPH2" OR E$(EE%)="PH2P" OR E$(EE%)="P(C6H5)2" OR E$(EE%)="(H5C2)2P" THEN KK=KK(9):GOSUB 3200
2850 IF E$(AA%)="POPH2" OR E$(AA%)="PH2OP" OR E$(AA%)="PO(C6H5)2" OR E$(AA%)="(H5C2)2OP" THEN KK=KK(10):GOSUB 3200
2860 IF E$(BB%)="POPH2" OR E$(BB%)="PH2OP" OR E$(BB%)="PO(C6H5)2" OR E$(BB%)="(H5C2)2OP" THEN KK=KK(10):GOSUB 3200
2870 IF E$(CC%)="POPH2" OR E$(CC%)="PH2OP" OR E$(CC%)="PO(C6H5)2" OR E$(CC%)="(H5C2)2OP" THEN KK=KK(11):GOSUB 3200
2880 IF E$(DD%)="POPH2" OR E$(DD%)="PH2OP" OR E$(DD%)="PO(C6H5)2" OR E$(DD%)="(H5C2)2OP" THEN KK=KK(11):GOSUB 3200
2890 IF E$(EE%)="POPH2" OR E$(EE%)="PH2OP" OR E$(EE%)="PO(C6H5)2" OR E$(EE%)="(H5C2)2OP" THEN KK=KK(12):GOSUB 3200
2900 NEXT N:FR=HFR
2910 FOR N=0 TO 5:IF E$(N)<>"H" THEN GOTO 2930
2920 FOR J=0 TO ASP%(N):FOR I=1 TO LANZ%(N):LL3(N,J,I)=LL3(N,J,I)/FR:NEXT I:NEXT J
2930 NEXT N:GOSUB 2960
2940 IF PIC2%=2 THEN KKO=1:ON ART% GOTO 3650,4170
2950 GOTO 3650
2960 REM ************ sorting of lines ***********
2970 FOR N=0 TO 5
2980 FOR J=1 TO LANZ%(N):LL2(N,J)=LL3(N,ASP%(N),J):LI2(N,J)=LI3(N,ASP%(N),J):NEXT J
2990 NEXT N
3000 FOR N=0 TO 5
3010 FOR J=1 TO LANZ%(N)-1:FOR I=J+1 TO LANZ%(N):IF LL2(N,J)>LL2(N,I) THEN SWAP LL2(N,J),LL2(N,I):SWAP LI2(N,J),LI2(N,I)
3020 IF LL2(N,J)=LL2(N,I) THEN LI2(N,J)=LI2(N,J)+LI2(N,I):LI2(N,I)=0
3030 NEXT I:NEXT J
3040 LZ2%(N)=0:FOR J=1 TO LANZ%(N):IF LI2(N,J)>.001 THEN LZ2%(N)=LZ2%(N)+1:LL2(N,LZ2%(N))=LL2(N,J):LI2(N,LZ2%(N))=LI2(N,J)
3050 NEXT J
3060 NEXT N:X=0
3070 FOR N=0 TO 5:IF MODE%=1 AND E$(N)<>"H" THEN GOTO 3090
3080 FOR J=1 TO LZ2%(N):X=X+1:LL1(X)=LL2(N,J):LI1(X)=LI2(N,J):NEXT J
3090 NEXT N
3100 FOR I=1 TO X-1:FOR J=I+1 TO X:IF LL1(I)<LL1(J) THEN SWAP LL1(I),LL1(J):SWAP LI1(I),LI1(J)
3110 IF LL1(I)=LL1(J) THEN LI1(I)=LI1(I)+LI1(J):LI1(J)=0
3120 NEXT J:NEXT I
3130 LZ%(1)=0:MAX=0
3140 FOR J=1 TO X:IF LI1(J)>.001 THEN LZ%(1)=LZ%(1)+1:LL1(LZ%(1))=LL1(J):LI1(LZ%(1))=LI1(J)
3150 NEXT J:LI1(J)=0
3160 FOR J=1 TO LZ%(1):IF LI1(J)>MAX THEN MAX=LI1(J)
3170 NEXT J
3180 RETURN
3190 REM here all lines ll1(n) are sorted,Intensities: li1(n)
3200 REM ****** m-, p-,F-,P- and off res.coupling *******
3210 ASP%(N)=ASP%(N)+1:FOR J=1 TO LANZ%(N)
3220 LL3(N,ASP%(N),2*J-1)=LL3(N,ASP%(N)-1,J)-KK/2:LL3(N,ASP%(N),2*J)=LL3(N,ASP%(N),2*J-1)+KK:LI3(N,ASP%(N),2*J-1)=LI3(N,ASP%(N)-1,J)/2:LI3(N,ASP%(N),2*J)=LI3(N,ASP%(N),2*J-1)
3230 NEXT J:LANZ%(N)=LANZ%(N)*2:RETURN
3240 REM ******** check of substituents **********
3250 KO%=0
3260 FOR I=1 TO ANZ%:IF E$(J)=S$(I) OR E$(J)=IS$(I) THEN N(J)=I:IF J<4 THEN E$(J)=S$(I):RETURN ELSE E$(J)=IS$(I):RETURN
3270 NEXT I
3280 LOCATE 21,5:PRINT "Substituent ";:PRINT E$(J);:PRINT " not available. Input ? for display of substituents":KO%=1:E$(J)=""
3290 GOSUB 7120:IF A$="?" THEN GOTO 3330
3300 LOCATE 21,1:PRINT SPC(78)
3310 IF J<4 THEN LOCATE YP%(J),XP%(J):PRINT SPC(10) ELSE LOCATE YP%(J),XP%(J)-10:PRINT SPC(10)
3320 RETURN
3330 REM ******** list of all substituents ***********
3340 SCREEN 0,1:X=4:Y=1
3350 LOCATE 1,29:PRINT "list of substituents":LOCATE 2,29:PRINT "====================":PRINT :FOR N=Y TO ANZ%
3360 LOCATE X,5:PRINT S$(N);:N=N+1:IF S$(N)="end" THEN GOTO 3370 ELSE LOCATE X,30:PRINT S$(N);:N=N+1:IF S$(N)="end" THEN GOTO 3370 ELSE LOCATE X,55:PRINT S$(N):X=X+1:IF X<21 THEN NEXT N
3370 GOSUB 7120
3380 IF N>=ANZ% THEN GOTO 3400
3390 CLS:Y=N+1:X=4:GOTO 3350
3400 REM ********* display subst. ***********
3410 SCREEN 2:LOCATE 25,28:PRINT "press any key to continue":LOCATE 1,25:PRINT "annelated five-membered rings":PSET (190,9):LINE -(422,9)
3420 X=80:Y=14:GOSUB 7780:X=X+25:Y=Y+9:GOSUB 7800:LOCATE 4,24:PRINT "CYPENTYL"
3430 X=80:Y=54:GOSUB 7780:X=X+25:Y=Y+9:GOSUB 7800:PSET (X+27,Y-2):LINE -STEP(13,9):LOCATE 8,24:PRINT "CFURO":LOCATE 11,24:PRINT "OFURO":LOCATE 11,17:PRINT "O"
3440 X=80:Y=95:GOSUB 7780:X=X+25:Y=Y+9:GOSUB 7800:PSET (X+27,Y-2):LINE -STEP(13,9):LOCATE 13,24:PRINT "CPYRROLO":LOCATE 16,24:PRINT "NPYRROLO":LOCATE 16,17:PRINT "N":LOCATE 17,17:PRINT "H"
3450 X=80:Y=137:GOSUB 7780:X=X+25:Y=Y+9:GOSUB 7800:PSET (X+27,Y-2):LINE -STEP(13,9):LOCATE 18,24:PRINT "CTHIENO":LOCATE 21,24:PRINT "STHIENO":LOCATE 21,17:PRINT "S"
3460 X=384:Y=14:GOSUB 7780:X=X+25:Y=Y+9:GOSUB 7800:PSET (X+27,Y-2):LINE -STEP(13,9):LOCATE 3,60:PRINT "NTHIAZOL":LOCATE 6,60:PRINT "STHIAZOL":LOCATE 3,55:PRINT "N":LOCATE 6,55:PRINT "S"
3470 X=384:Y=54:GOSUB 7780:X=X+25:Y=Y+9:GOSUB 7800:PSET (X+27,Y-2):LINE -STEP(13,9):LOCATE 9,60:PRINT "IMIDAZOL":LOCATE 8,55:PRINT "N":LOCATE 11,55:PRINT "N":LOCATE 12,55:PRINT "H"
3480 X=344:Y=100:GOSUB 7780:X=X+25:Y=Y+9:GOSUB 7800:LOCATE 15,57:PRINT "ANHYDRID":LOCATE 12,50:PRINT "O":LOCATE 18,50:PRINT "O":LOCATE 15,53:PRINT "O"
3490 PSET(X+24,Y-6):LINE -STEP(0,-8):PSET (X+29,Y-6):LINE -STEP(0,-8):PSET (X+24,Y+19):LINE -STEP(0,7):PSET (X+29,Y+19):LINE -STEP(0,7)
3500 X=368:Y=140:GOSUB 7780:X=X+25:Y=Y+9:GOSUB 7800:LOCATE 20,61:PRINT "PHTHALIMID":LOCATE 17,53:PRINT "O":LOCATE 23,53:PRINT "O":LOCATE 20,56:PRINT "NH"
3510 PSET(X+24,Y-6):LINE -STEP(0,-8):PSET (X+29,Y-6):LINE -STEP(0,-8):PSET (X+24,Y+19):LINE -STEP(0,7):PSET (X+29,Y+19):LINE -STEP(0,7):BEEP
3520 A$=INKEY$:IF LEN(A$)=0 THEN 3520
3530 CLS:LOCATE 25,28:PRINT "press any key to continue":LOCATE 1,25:PRINT "annelated six-membered rings":PSET (190,9):LINE -(413,9)
3540 X=80:Y=14:GOSUB 7780:PSET (X+25,Y+9):LINE -STEP(25,-9):LINE -STEP(25,9):LINE -STEP(0,12):LINE -STEP(-25,9):LINE -STEP(-25,-9):LOCATE 4,25:PRINT "CYHEXYL"
3550 X=80:Y=54:GOSUB 7780:GOSUB 7790:LOCATE 9,25:PRINT "PHENYLEN"
3560 X=80:Y=94:GOSUB 7780:GOSUB 7790:LOCATE 13,25:PRINT "CPYRIDO":LOCATE 16,25:PRINT "NPYRIDO":LOCATE 16,17:PRINT "N"
3570 X=80:Y=134:GOSUB 7780:GOSUB 7790:LOCATE 18,25:PRINT "CPYRIDAZO":LOCATE 21,25:PRINT "NPYRIDAZO":LOCATE 21,17:PRINT "N":LOCATE 20,20:PRINT "N"
3580 X=384:Y=16:GOSUB 7780:GOSUB 7790:LOCATE 3,62:PRINT "CPYRIMIDO":LOCATE 6,62:PRINT "NPYRIMIDO":LOCATE 6,55:PRINT "N":LOCATE 4,58:PRINT "N"
3590 X=384:Y=57:GOSUB 7780:GOSUB 7790:LOCATE 9,62:PRINT "PYRAZINO":LOCATE 11,55:PRINT "N":LOCATE 8,55:PRINT "N"
3600 X=384:Y=112:GOSUB 7780:PSET (X+25,Y+9):LINE -STEP(25,-9):LINE -STEP(25,9):LINE -STEP(0,12):LINE -STEP(-25,9):LINE -STEP(-25,-9):LOCATE 15,65:PRINT "CISATO":LOCATE 18,65:PRINT "NISATO":LOCATE 16,58:PRINT "O":LOCATE 18,60:PRINT "O"
3610 LOCATE 18,55:PRINT "N":LOCATE 19,55:PRINT "H":LOCATE 13,55:PRINT "O"
3620 PSET (X+48,Y):LINE -STEP (0,-7):PSET (X+53,Y):LINE -STEP(0,-7):PSET (X+73,Y+23):LINE -STEP(11,4):PSET (X+76,Y+20):LINE -STEP(11,4):BEEP
3630 A$=INKEY$:IF LEN(A$)=0 THEN 3630
3640 GOTO 1860
3650 REM ********* line spectrum **********
3660 IF LEN(INKEY$) THEN 3660
3670 ART%=1:UG(2)=INT(UG(2)):OG(2)=INT(OG(2)):PK%=0
3680 GOSUB 7280:IF PIC2%<>3 THEN GOTO 3730
3690 Y=4:LOCATE 1,31:IF MODE%=1 THEN X=233:GOSUB 7180:PRINT "H-"; ELSE X=227:GOSUB 7180:X=233:GOSUB 7200:PRINT "C-";
3700 LOCATE 1,33:PRINT "NMR spectrum (";:PRINT FR;:PRINT "MHz) of mixture A:B =";100*AP;":";100*BP
3710 IF MODE%=2 THEN IF ORK%=1 THEN LOCATE 2,65:PRINT "(off-resonance)"
3720 GOTO 3770
3730 IF MODE%=2 THEN FOR N=0 TO 5:XW%=(OG(2)-CV(N))*ST/5+20:PSET (XW%,185):LINE -(XW%,190):NEXT N:GOTO 3760
3740 FOR N=0 TO 5:XW%=(OG(1)-HV(N))*10*ST+20:IF E$(N)="H" THEN PSET (XW%,185):LINE -(XW%,190)
3750 NEXT N
3760 GOSUB 4950
3770 FOR N=1 TO LZ%(1):Y(N)=LI1(N)*100*YF!/MAX
3780 IF MODE%=1 THEN X(N)=(OG(1)-LL1(N))*10*ST+20
3790 IF MODE%=2 THEN X(N)=(OG(2)-LL1(N))*ST/5+20
3800 IF X(N)<621 AND X(N)>19 THEN PSET (X(N),171-Y(N)):LINE -(X(N),171)
3810 NEXT N:IF PIC2%=2 THEN LOCATE 1,1:A$=INPUT$(1):GOTO 7990
3820 IF IK%>0 THEN GOSUB 5820
3830 IF BK%=1 THEN IF OG(MODE%)>LL3(EN%,ASP%(EN%),LANZ%(EN%)) AND UG(MODE%)<LL3(EN%,ASP%(EN%),1) THEN GOSUB 6180
3840 GOSUB 5610
3850 ON ART% GOTO 3650,4170
3860 REM *************** 1-H options ***********
3870 CLS:BK%=0:PK%=0:SCREEN 0,1
3880 IF LEN(INKEY$) THEN 3880
3890 LOCATE 23,22:PRINT "HELP.................................h"
3900 LOCATE 21,22:PRINT "Exit to DOS..........................e"
3910 LOCATE 19,22:PRINT "New structure........................n"
3920 LOCATE 17,22:PRINT "C-13 NMR spectrum....................c"
3930 LOCATE 15,22:PRINT "Change resolution of spectrum........8"
3940 LOCATE 13,22:PRINT "Simulate spectrum....................7"
3950 LOCATE 11,22:PRINT "Line-spectrum........................6"
3960 LOCATE 9,22:PRINT "Display individual shift values......5"
3970 LOCATE 7,22:PRINT "Change frequency.....................4"
3980 LOCATE 5,22:PRINT "Change coupl.constants/increments....3"
3990 LOCATE 3,22:PRINT "Change y-scale.......................2"
4000 LOCATE 1,22:PRINT "Change ppm-scale.....................1"
4010 A$=INKEY$:IF LEN(A$)=0 THEN 4010
4020 IF INSTR("12345678hHnNcCeE",A$)=0 THEN GOTO 4010
4030 CLS:IF INSTR("nN",A$)>0 THEN GOTO 1840
4040 IF INSTR("Cc43",A$)>0 AND PIC2%=3 THEN GOTO 8840
4050 IF INSTR("eE",A$)>0 THEN SYSTEM
4060 IF INSTR("cC",A$)>0 THEN MODE%=2:BK%=0:GOTO 6390
4070 IF A$="h" OR A$="H" THEN GOSUB 6270
4080 IF A$="1" THEN KKO=1:GOTO 4840
4090 IF A$="2" THEN KKO=1:GOTO 4400
4100 IF A$="3" THEN RA%=3:KKO=1:GOTO 4510
4110 IF A$="4" THEN CLS:FRA=HFR:KKO=1:GOTO 4440
4120 IF A$="8" THEN CLS:ART%=2:RA%=3:KKO=1:GOTO 4470
4130 IF A$="7" THEN ART%=2:GOTO 4170
4140 IF A$="6" THEN GOTO 3650
4150 IF A$="5" THEN GOSUB 5150
4160 GOTO 3860
4170 REM ************* curve ***********
4180 GOSUB 7280:PK%=0:IF PIC2%<>3 THEN GOTO 4210
4190 Y=4:X=233:GOSUB 7180:LOCATE 1,31:PRINT "H-"; 
4200 LOCATE 1,33:PRINT "NMR-spectrum (";:PRINT FR;:PRINT "MHz) of mixture A:B =";100*AP;":";100*BP:GOTO 4230
4210 FOR N=0 TO 5:XW%=(OG(1)-HV(N))*10*ST+20:IF MODE%=2 OR E$(N)="H" THEN PSET (XW%,185):LINE -(XW%,190)
4220 NEXT N:GOSUB 4950
4230 FOR N=1 TO LZ%(1):X(N)=(OG(1)-LL1(N))*10*ST+20:Y(N)=LI1(N)*70*YF!/MAX:NEXT N
4240 IF KKO>1 THEN PSET (20,167):FOR N=20 TO 620:LINE -(N,K1%(1,N)):NEXT N:GOTO 4330
4250 PSET (20,167):I%(19)=0:A=RES^(1/3)
4260 FOR N=20 TO 620:S=0:IF X(1)-N>50 THEN PSET (N,167):K1%(1,N)=167:GOTO 4310
4270 IF N-X(LZ%(1))>50 THEN PSET (N,167):K1%(1,N)=167:GOTO 4310
4280 FOR J=1 TO LZ%(1):IF ABS(N-X(J))>50 THEN GOTO 4300
4290 B=N-X(J):S=S+Y(J)*A/(B*B*RES+1)
4300 NEXT J:LINE -(N,167-S):K1%(1,N)=167-S
4310 I%(N)=I%(N-1)+S:NEXT N
4320 F=130/(I%(620)-I%(10)+.0001):FOR N=20 TO 620:I%(N)=I%(N)*F:NEXT N:KKO=2:BEEP
4330 IF LEN(INKEY$) THEN 4330
4340 IF PIC2%=2 THEN LOCATE 1,1:A$=INPUT$(1):GOTO 7990
4350 IF IK%>0 THEN GOSUB 5820
4360 IF BK%>0 THEN IF OG(1)>LL3(EN%,ASP%(EN%),LANZ%(EN%)) AND UG(1)<LL3(EN%,ASP%(EN%),1) THEN GOSUB 6180
4370 GOSUB 5610
4380 ON ART% GOTO 3650,4170
4390 REM ******* options from menu *********
4400 LOCATE 23,5:PRINT "Magnification factor:       (";:PRINT YF!;:PRINT ")  :";
4410 LOCATE 23,40:LINE INPUT A$:IF LEN(A$)=0 THEN GOTO 4430 ELSE RA%=7:GOSUB 5550
4420 YF!=VAL(A$)
4430 ON ART% GOTO 3650,4170
4440 LOCATE 23,5:PRINT "Input new frequency  (MHz): ";:LOCATE 23,40:LINE INPUT A$:RA%=2:GOSUB 5550
4450 HFR=VAL(A$):ST=ST*HFR/FRA:IF ST>200 THEN ST=200
4460 OG(1)=INT(10*(LL1(1)+.3))/10:UG(1)=OG(1)-60/ST:GOTO 2640
4470 LOCATE 23,5:PRINT "resolution       (";:PRINT RES;:PRINT ")  : ";:LOCATE 23,40:LINE INPUT A$:IF LEN(A$)=0 THEN GOTO 4170 ELSE RA%=13:GOSUB 5550
4480 RES=VAL(A$):IF RES<.01 THEN RES=.01
4490 IF RES>9 THEN RES=9
4500 GOTO 4170
4510 REM ********** change coupl. constants *********
4520 CLS:LOCATE 7,23:PRINT "change coupling constants............1":LOCATE 11,23:PRINT "change increments....................2":LOCATE 15,23:PRINT "restart with default values..........3":BEEP
4530 A$=INPUT$(1):IF INSTR("123mM",A$)=0 THEN BEEP:GOTO 4530
4540 IF INSTR("mM",A$)>0 THEN ON MODE% GOTO 3860,7420
4550 CLS:ON VAL(A$) GOTO 4560,4690,4830
4560 IF MODE%=2 THEN GOTO 4590
4570 CLS:I=1:J=6:LOCATE 19,26:PRINT "input <d> for default values":LOCATE 21,26:PRINT "<enter> to keep values given":GOSUB 4620
4580 I=7:J=12:GOSUB 4620:ON MODE% GOTO 2640,6620
4590 I=13:J=18:LOCATE 19,26:PRINT "input <d> for default values":LOCATE 21,26:PRINT "<enter> to keep values given":GOSUB 4620
4600 I=19:J=26:GOSUB 4620
4610 ON MODE% GOTO 2640,6620
4620 LOCATE 1,28:PRINT "coupling constants (Hz)":LOCATE 2,28:PRINT "-----------------------"
4630 X=4:FOR N=I TO J:LOCATE X,25:PRINT KK$(N):LOCATE X,42:PRINT "(";:PRINT KK(N);:PRINT ")":X=X+2:NEXT N
4640 X=4:N=I
4650 LOCATE X,52:PRINT SPC(10):LOCATE X,53:LINE INPUT A$:IF LEN(A$)=0 THEN GOTO 4670 ELSE IF INSTR("dD",A$)>0 THEN CLS:RESTORE 1800:RESTORE 1790:RESTORE 1780:GOSUB 1770:ON MODE% GOTO 2640,6620
4660 RA%=3:GOSUB 5550:KK(N)=VAL(A$)
4670 LOCATE 19,26:PRINT SPC(30):LOCATE X,52:PRINT KK(N):X=X+2:N=N+1:IF N<=J THEN GOTO 4650
4680 CLS:RETURN
4690 CLS:LOCATE 3,5:PRINT "input substituent: ":LOCATE 3,24:LINE INPUT A$:M$=""
4700 FOR N=1 TO LEN(A$):I=ASC(MID$(A$,N,1)):IF I>96 THEN I=I-32
4710 M$=M$+CHR$(I):NEXT N:A$=M$
4720 FOR J=1 TO ANZ%:IF A$=S$(J) OR A$=IS$(J) THEN GOTO 4740
4730 NEXT J:LOCATE 7,5:PRINT "substituent ";A$;" not present.":GOSUB 7120:ON ART% GOTO 3860,7420
4740 CLS:LOCATE 1,10:PRINT "increments for substituent ";A$;" :":X=5:LOCATE 5,19:PRINT "1-H":LOCATE 11,19:PRINT "13-C"
4750 FOR N=0 TO 6:LOCATE X,27:PRINT CH$(N):LOCATE X,39:PRINT "(";:PRINT USING"###.##";S(J,N);:PRINT ")":X=X+2:NEXT N:LOCATE X,27:PRINT CH$(7):LOCATE X,39:PRINT "(";:PRINT RFAK(J);:PRINT ")":X=5:N=0
4760 LOCATE 21,20:PRINT "press <enter> to keep values given"
4770 LOCATE X,49:PRINT SPC(10):LOCATE X,50:LINE INPUT A$:IF LEN(A$)=0 THEN GOTO 4790 ELSE RA%=11:GOSUB 5550
4780 S(J,N)=VAL(A$)
4790 LOCATE X,49:PRINT S(J,N):N=N+1:X=X+2:IF N<7 THEN GOTO 4770
4800 LOCATE X,49:PRINT SPC(10):LOCATE X,50:LINE INPUT A$:IF LEN(A$)=0 THEN GOTO 4820 ELSE RA%=12:GOSUB 5550
4810 RFAK(J)=VAL(A$)
4820 LOCATE X,49:PRINT RFAK(J):GOTO 7010
4830 RESTORE:CLS:GOTO 240
4840 REM ******* change ppm-scale *********
4850 LOCATE 23,5:PRINT "lower limit    (";:IF MODE%=1 THEN PRINT USING"##.##";UG(1); ELSE PRINT INT(UG(2));
4860 PRINT ")    :";:LOCATE 23,40:LINE INPUT A$:IF LEN(A$)=0 GOTO 4880 ELSE RA%=4:GOSUB 5550
4870 UG(MODE%)=VAL(A$):UG(MODE%)=INT(10*UG(MODE%))/10:IF UG(MODE%)<0 THEN UG(MODE%)=0
4880 LOCATE 23,5:PRINT "upper limit     (";:IF MODE%=1 THEN PRINT USING"##.##";OG(1); ELSE PRINT INT(OG(2));
4890 PRINT ")    :";:LOCATE 23,40:LINE INPUT A$:IF LEN(A$)=0 GOTO 4910 ELSE RA%=5:GOSUB 5550
4900 OG(MODE%)=VAL(A$):OG(MODE%)=INT(10*OG(MODE%))/10:IF MODE%=1 THEN IF OG(1)>12 THEN OG=12
4910 IF MODE%=2 THEN IF OG(2)>220 THEN OG(2)=220
4920 IF MODE%=1 THEN IF UG(1)>=OG(1)-.3 THEN BEEP:OG(1)=UG(1)+.3
4930 IF UG(2)>=OG(2)-15 THEN UG(2)=OG(2)-15
4940 ON ART% GOTO 3650,4170
4950 REM ****** upper left formula *******
4960 X=114:Y=15:GOSUB 7180:X=140:Y=22:GOSUB 7190
4970 X=140:Y=36:GOSUB 7200:X=113:Y=43:GOSUB 7210
4980 X=88:Y=36:GOSUB 7220:X=88:Y=22:GOSUB 7230
4990 PSET (115,8):LINE -STEP(32,9):LINE -STEP(0,20):LINE -STEP(-32,9):LINE -STEP(-32,-9):LINE -STEP(0,-20):LINE -STEP(32,-9):CIRCLE(115,27),23,1,,,.45
5000 FOR N=0 TO 5:IF N<4 THEN LOCATE KXP%(N),KYP%(N) ELSE LOCATE KXP%(N),KYP%(N)-LEN(E$(N))+1
5010 IF MODE%=2 OR MODE%=1 AND E$(N)<>"H" THEN PRINT E$(N):GOTO 5060
5020 IF N=0 OR N=3 THEN LOCATE KXP%(N),KYP%(N)-1
5030 IF N=1 OR N=2 THEN LOCATE KXP%(N),KYP%(N)
5040 IF N=4 OR N=5 THEN LOCATE KXP%(N),KYP%(N)-3
5050 PRINT USING "#.##";HV(N)
5060 NEXT N:GET (0,0)-(230,60),API%
5070 IF MODE%=1 THEN X=385:Y=4:GOSUB 7180:LOCATE 1,50:PRINT "H-NMR   ("; ELSE X=244:Y=4:GOSUB 7180:X=X+5:GOSUB 7200:LOCATE 1,33:PRINT "C-NMR   (";
5080 PRINT FR;:PRINT "MHz)";:IF MODE%=1 THEN RETURN ELSE IF ORK%=1 THEN PRINT " off-resonance"
5090 LOCATE 1,73:PRINT "c":LOCATE 1,75:PRINT "ppm":PSET (587,1):LINE -STEP(0,45):PSET (574,9):LINE -STEP(51,0):Y=15
5100 FOR N=0 TO 5:A$=STR$(CV(N)):X=576:ON N+1 GOSUB 7180,7190,7200,7210,7220,7230
5110 X=596:FOR V=2 TO LEN(A$):B$=MID$(A$,V,1):IF B$="." THEN A=11 ELSE A=VAL(B$)+1
5120 ON A GOSUB 7170,7180,7190,7200,7210,7220,7230,7240,7250,7260,7270
5130 X=X+6:NEXT V:Y=Y+6:NEXT N
5140 RETURN
5150 REM ****** display/print lines ************
5160 IF PIC2%>1 THEN GOTO 5400
5170 FOR N=0 TO 5:IF MODE%=1 AND E$(N)<>"H" THEN GOTO 5390
5180 CLS:IF MODE%=1 THEN PRINT TAB(5);"H"; ELSE PRINT TAB(5);"C";
5190 PRINT N+1;:PRINT ":";
5200 IF MODE%=1 THEN PRINT TAB(13);USING"##.##";HV(N); ELSE PRINT  TAB(13);USING"###.#";CV(N);
5210 PRINT " ppm";:PRINT TAB(30);LZ2%(N);:PRINT "line(s)  ";:PRINT TAB(55);"(";:PRINT FR;:PRINT " MHz)"
5220 PRINT "   --------------------------------------------------------------"
5230 PRINT TAB(5);"line  no.";TAB(25);"ppm";TAB(41);"Hz";TAB(55);"intensity":PRINT
5240 FOR X=1 TO LZ2%(N):PRINT TAB(8);X;TAB(23);USING"###.##";LL2(N,X);:IF MODE%=1 THEN PRINT TAB(39);USING"####.#";LL2(N,X)*FR; ELSE PRINT TAB(40);USING"####";LL2(N,X)*FR;
5250 PRINT TAB(57);USING"#.###";LI2(N,X):NEXT X:PRINT
5260 LOCATE 23,17:PRINT "p...print,  m...menu, any key to continue":A$=INPUT$(1)
5270 IF INSTR("mM",A$)>0 THEN RETURN
5280 IF INSTR("pP",A$)=0 THEN GOTO 5390
5290 REM print lines
5300 ON ERROR GOTO 7880
5310 LPRINT:LPRINT:IF MODE%=1 THEN LPRINT TAB(2);"H"; ELSE LPRINT TAB(2);"C";
5320 LPRINT N+1;:LPRINT ":";
5330 IF MODE%=1 THEN LPRINT TAB(10);USING"##.##";HV(N); ELSE LPRINT  TAB(10);USING"###.#";CV(N);
5340 LPRINT " ppm";:LPRINT TAB(27);LZ2%(N);:LPRINT "line(s)  ";:LPRINT TAB(52);"(";:LPRINT FR;:LPRINT " MHz)"
5350 LPRINT "--------------------------------------------------------------"
5360 LPRINT TAB(2);"line  no.";TAB(22);"ppm";TAB(38);"Hz";TAB(52);"intensity  ":LPRINT
5370 FOR X=1 TO LZ2%(N):LPRINT TAB(5);X;TAB(20);USING"###.##";LL2(N,X);:IF MODE%=1 THEN LPRINT TAB(36);USING"####.#";LL2(N,X)*FR; ELSE LPRINT TAB(37);USING"####";LL2(N,X)*FR;
5380 LPRINT TAB(54);USING"#.###";LI2(N,X):NEXT X:LPRINT:LPRINT
5390 NEXT N:CLS:RETURN
5400 REM ********** lines of mixed spectrum **********
5410 A=1:B=0:CLS:LOCATE 1,25:IF MODE%=1 THEN PRINT "1-H "; ELSE PRINT "13-C ";
5420 PRINT "NMR spectrum   (";FR;"MHz)":PRINT "Lines of mixture A:B =";100*AP;":";100*BP:PRINT:GOSUB 5530
5430 FOR N=A TO LZ%(1):B=B+1:C=LL1(N)*FR:PRINT TAB(4);N;TAB(19);USING"###.##";LL1(N);
5440 PRINT TAB(39);USING"####.#";C;:PRINT TAB(60);USING"#.###";LI1(N):IF B>16 THEN A=B:B=0:GOSUB 7120:CLS:GOSUB 5530
5450 NEXT N:LOCATE 23,23:PRINT "p...print,  any other key to continue":A$=INPUT$(1):IF INSTR("Pp",A$)=0 THEN RETURN
5460 ON ERROR GOTO 7880
5470 LPRINT:IF MODE%=1 THEN LPRINT TAB(25);"1-H NMR:  "; ELSE LPRINT TAB(25);"13-C NMR:  ";
5480 LPRINT "  (";FR;"MHz)":LPRINT:LPRINT "Lines of mixture A:B =";100*AP;":";100*BP
5490 LPRINT:LPRINT TAB(2);"line no.";TAB(21);"ppm";TAB(41);"Hz";TAB(58);"intensity"
5500 LPRINT "--------------------------------------------------------------------------":FOR N=1 TO LZ%(1):LPRINT TAB(4);N;:LPRINT TAB(19);USING"###.##";LL1(N);
5510 LPRINT TAB(39);USING"####.#";LL1(N)*FR;:LPRINT TAB(60);USING"#.###";LI1(N):NEXT N
5520 RETURN
5530 PRINT TAB(2);"line no.";TAB(21);"ppm";TAB(41);"Hz";TAB(58);"intensity"
5540 PRINT "--------------------------------------------------------------------------":RETURN
5550 REM ********** input check **********
5560 IF INSTR("mM",A$)>0 AND RA%>1 THEN ON MODE% GOTO 3860,7420
5570 IF RIGHT$(STR$(VAL(A$)),LEN(A$))<>A$ THEN GOTO 5600
5580 LOCATE 23,40:PRINT SPC(10):IF RA%<>11 THEN A$=STR$(ABS(VAL(A$)))
5590 RETURN
5600 LOCATE 23,40:BEEP:PRINT "Input a number !! - press any key":A$=INPUT$(1):LOCATE 23,40:PRINT SPC(35):ON RA% GOTO 2620,4440,4650,4850,4880,4480,4410,6060,6590,7750,4770,4800,4470,8090
5610 REM ********* options: move ppm-scale,integr,tree ********
5620 IF MODE%=1 THEN OLIM%=12 ELSE OLIM%=220
5630 IF LEN(INKEY$) THEN 5630
5640 M$=INKEY$:IF LEN(M$)=0 THEN GOTO 5640
5650 IF M$="4" OR LEN(M$)>1 AND RIGHT$(M$,1)="K" THEN IF UG(MODE%)<=0 THEN BEEP:GOTO 5630
5660 IF LEN(M$)>1 AND RIGHT$(M$,1)="K" THEN KKO=1:Q=5*MODE%^5/ST:UG(MODE%)=UG(MODE%)-Q:IF UG(MODE%)>0 THEN OG(MODE%)=OG(MODE%)-Q:RETURN ELSE UG(MODE%)=0:OG(MODE%)=(60+2940*(MODE%-1))/ST:RETURN
5670 IF M$="4" THEN KKO=1:Q=15*MODE%^5/ST:UG(MODE%)=UG(MODE%)-Q:IF UG(MODE%)>0 THEN OG(MODE%)=OG(MODE%)-Q:RETURN ELSE UG(MODE%)=0:OG(MODE%)=(60+2940*(MODE%-1))/ST:RETURN
5680 IF M$="6" OR LEN(M$)>1 AND RIGHT$(M$,1)="M" THEN IF OG(MODE%)>=OLIM% THEN BEEP:GOTO 5630
5690 IF LEN(M$)>1 AND RIGHT$(M$,1)="M" THEN KKO=1:Q=5*MODE%^5/ST:OG(MODE%)=OG(MODE%)+Q:IF OG(MODE%)<OLIM% THEN UG(MODE%)=UG(MODE%)+Q:RETURN ELSE OG(MODE%)=OLIM%:UG(MODE%)=OLIM%-(60+2940*(MODE%-1))/ST:RETURN
5700 IF M$="6" THEN KKO=1:Q=15*MODE%^5/ST:OG(MODE%)=OG(MODE%)+Q:IF OG(MODE%)<=OLIM% THEN UG(MODE%)=UG(MODE%)+Q:RETURN ELSE OG(MODE%)=OLIM%:UG(MODE%)=OLIM%-(60+2940*(MODE%-1))/ST:RETURN
5710 IF INSTR("hH",M$)>0 THEN GOSUB 6270:ON ART% GOTO 3650,4170
5720 IF INSTR("sS",M$)>0 AND PIC2%<2 THEN GOSUB 6050
5730 IF INSTR("iI",M$)>0 THEN IF MODE%=1 THEN IF IK%=0 THEN IK%=1:GOSUB 5820 ELSE IK%=0:GOSUB 5820 ELSE BEEP
5740 IF INSTR("Aa",M$)>0 THEN IF PK%>0 THEN FOR N=1 TO 7:LOCATE N,1:PRINT SPC(28):NEXT N:PUT (0,0),API%:GOTO 7930 ELSE GOTO 7930
5750 IF INSTR("Tt",M$)=0 THEN GOTO 5810
5760 IF PK%=2 THEN PK%=0:PUT (0,0),API%:GOTO 5630
5765 IF PK%=1 THEN FOR N=1 TO 7:LOCATE N,1:PRINT SPC(28):NEXT N:IF PIC2%=1 THEN PK%=2:GOTO 5630 ELSE PK%=0:GOTO 5630
5770 PK%=1:LOCATE 1,1:PRINT "spectrum parameters:        ":LOCATE 2,1:PRINT "--------------------";SPC(8):LOCATE 3,1:PRINT "frequency:";SPC(18):LOCATE 3,18:PRINT FR;"MHz"
5780 LOCATE 4,1:PRINT "magnification:";SPC(14):LOCATE 4,18:PRINT YF!:LOCATE 5,1:PRINT "lower limit:";SPC(17):LOCATE 5,18:PRINT USING"###.##";UG(MODE%);
5790 PRINT " ppm":LOCATE 6,1:PRINT "upper limit:";SPC(17):LOCATE 6,18:PRINT USING"###.##";OG(MODE%);
5800 PRINT " ppm":LOCATE 7,1:IF ART%=1 THEN PRINT SPC(28):GOTO 5630 ELSE LOCATE 7,1:PRINT "resolution:";SPC(17):LOCATE 7,18:PRINT RES:GOTO 5630
5810 IF INSTR("sSiIhH",M$)>0 THEN GOTO 5630 ELSE ON MODE% GOTO 3860,7420
5820 REM ********** integral ***********
5830 IF ART%=2 THEN GOTO 5910
5840 Y=133:FOR N=1 TO LZ%(1):IF OG(1)<=LL1(N) THEN Y=Y-LI1(N)*120/HCO%
5850 NEXT N
5860 PSET (10,Y),IK%
5870 FOR N=1 TO LZ%(1):IF LL1(N)<UG(1) THEN LINE -(620,Y),IK%:RETURN
5880 IF LL1(N)<OG(1) THEN LINE -(X(N)-4,Y),IK%:Y=Y-LI1(N)*120/HCO%:LINE -(X(N)-4,Y),IK%
5890 NEXT N
5900 LINE -(620,Y),IK%:RETURN
5910 PSET (10,142),IK%:FOR N=27 TO 620:LINE -(N-7,142-I%(N)),IK%:NEXT N:RETURN
5920 REM ******** input substituents *********
5930 LOCATE YP%(J),XP%(J)
5940 PRINT CHR$(95):E$(J)=""
5950 A$=INKEY$:IF LEN(A$)=0 THEN GOTO 5950
5960 IF A$="?" THEN E$(J)="":GOTO 3330
5970 IF LEN(E$(J))=0 AND ASC(A$)=13 THEN E$(J)="H":RETURN
5980 IF ASC(A$)=8  THEN IF LEN(E$(J))>0 THEN E$(J)=LEFT$(E$(J),LEN(E$(J))-1):GOTO 6020 ELSE GOTO 5950
5990 IF LEN(A$)=2 THEN IF LEN(E$(J))>0 THEN E$(J)=LEFT$(E$(J),LEN(E$(J))-1):GOTO 6020 ELSE GOTO 5950
6000 IF ASC(A$)=13 AND LEN(E$(J))>0 THEN IF J<4 THEN LOCATE YP%(J),XP%(J)+LEN(E$(J)):PRINT " ":RETURN ELSE LOCATE YP%(J),XP%(J)-8:PRINT SPC(8):LOCATE YP%(J),XP%(J)-LEN(E$(J))+1:PRINT E$(J):RETURN
6010 IF LEN(A$)=1 THEN E$(J)=E$(J)+A$
6020 IF J<4 THEN LOCATE YP%(J),XP%(J):PRINT SPC(8):LOCATE YP%(J),XP%(J):PRINT E$(J);:PRINT CHR$(95)
6030 IF J>3 THEN LOCATE YP%(J),XP%(J)-10:PRINT SPC(10):LOCATE YP%(J),XP%(J)-LEN(E$(J)):PRINT E$(J);:PRINT CHR$(95)
6040 GOTO 5950
6050 REM ********** display splitting **********
6060 LOCATE 23,22:BEEP:PRINT "   Indicate no. of ";:IF MODE%=1 THEN PRINT "H    " ELSE PRINT "C    "
6070 A$=INPUT$(1):LOCATE 23,22:PRINT SPC(20):IF INSTR("0 ",A$)>0 THEN GOTO 6160
6080 RA%=8:GOSUB 5550
6090 J=VAL(A$)-1:IF J<0 OR J>5 THEN GOTO 6050
6100 IF MODE%=1 THEN IF E$(J)<>"H" THEN LOCATE 23,15:BEEP:PRINT "   no proton at pos. ";:PRINT J+1;:PRINT " - press any key  ";:A$=INPUT$(1):LOCATE 23,15:PRINT SPC(40):GOTO 6160
6110 IF UG(MODE%)>LL3(J,ASP%(J),1) OR OG(MODE%)<LL3(J,ASP%(J),LANZ%(J)) THEN BEEP:GOTO 6050
6120 IF BK%>0 THEN IF J=JALT THEN CO%=0:GOSUB 6180:PPM=OG(MODE%):GOSUB 7340:RETURN
6130 LOCATE 23,30:IF BK%>0 THEN IF OG(MODE%)>LL3(JALT%,ASP%(J),1) AND UG(MODE%)<LL3(JALT%,ASP%(J),LANZ%(J)) THEN PRINT "erase previous tree (y/n) ?":A$=INPUT$(1):IF INSTR("nNyY",A$)=0 THEN BEEP:GOTO 6130
6140 LOCATE 23,30:PRINT SPC(30):IF INSTR("yY",A$)>0 THEN CO%=0:EN%=JALT%:GOSUB 6180
6150 JALT%=J:CO%=1:EN%=J:GOSUB 6180
6160 PPM=OG(MODE%):GOSUB 7340
6170 BEEP:RETURN
6180 REM ********* draw split-up tree **********
6190 FOR N=ASP%(EN%) TO 0 STEP -1:YALT%=Y-LH%:Y=24+LH%*N+10*N
6200 FOR I=1 TO 2^N:IF MODE%=1 THEN YL%=(OG(1)-LL3(EN%,N,I))*10*ST+20 ELSE YL%=(OG(2)-LL3(EN%,N,I))*ST/5+20
6210 PSET (YL%,Y),CO%:LINE -STEP(0,-LH%),CO%:IF N=ASP%(EN%) THEN GOTO 6240
6220 IF MODE%=1 THEN YL1%=(OG(1)-LL3(EN%,N+1,2*I-1))*10*ST+20:YL2%=(OG(1)-LL3(EN%,N+1,2*I))*10*ST+20:LINE (YL%,Y)-(YL1%,YALT%),CO%:LINE (YL%,Y)-(YL2%,YALT%),CO%
6230 IF MODE%=2 THEN YL1%=(OG(2)-LL3(EN%,N+1,2*I-1))*ST/5+20:YL2%=(OG(2)-LL3(EN%,N+1,2*I))*ST/5+20:LINE (YL%,Y)-(YL1%,YALT%),CO%:LINE (YL%,Y)-(YL2%,YALT%),CO%
6240 NEXT I:NEXT N:BK%=CO%
6250 LOCATE 2,INT(YL%/8):IF CO%=1 THEN PRINT EN%+1 ELSE PRINT "  "
6260 RETURN
6270 REM ************ help-page **********
6280 IF LEN(INKEY$) THEN 6280
6290 CLS:SCREEN 0,1:X=18:LOCATE X,16:PRINT "h.................................this help page":X=X-2
6300 LOCATE X,16:PRINT "t.....................toggle spectrum parameters":X=X-2
6310 LOCATE X,16:PRINT "s......................display splitting pattern":X=X-2
6320 LOCATE X,16:PRINT "m................................returns to menu":X=X-2
6330 IF MODE%=1 THEN LOCATE X,16:PRINT "i........................display/delete integral":X=X-2
6340 LOCATE X,16:PRINT "a............................add second spectrum":X=X-2
6350 LOCATE X,16:PRINT "<SHIFT> and ";:PRINT CHR$(27);", ";CHR$(26);:PRINT "....coarse move to left or right":X=X-2
6360 LOCATE X,16:PRINT CHR$(27);", ";CHR$(26);:PRINT "..............move spectrum to left or right":X=X-2
6370 LOCATE 1,35:PRINT "HELP - PAGE":LOCATE 2,35:PRINT "==========="
6380 GOSUB 7120:RETURN
6390 REM *********** 13-C display ***********
6400 SCREEN 2:MODE%=2:CLS:X=226:Y=4:GOSUB 7180:X=232:GOSUB 7200
6410 LOCATE 1,31:PRINT "C-NMR:   SHIFT VALUES":PSET(225,9):LINE-(405,9)
6420 FOR N=0 TO 3:LOCATE CZ%(N),CS%(N):PRINT E$(N):NEXT N
6430 FOR N=4 TO 5:PP=CS%(N)-LEN(E$(N)):LOCATE CZ%(N),PP:PRINT E$(N):NEXT N
6440 FOR N=0 TO 5:CV(N)=INT(10*CV(N))/10:NEXT N
6450 LOCATE 6,37:PRINT CV(0):LOCATE 8,44:PRINT CV(1):LOCATE 12,44:PRINT CV(2):LOCATE 14,37:PRINT CV(3):LOCATE 12,30:PRINT CV(4):LOCATE 8,30:PRINT CV(5)
6460 LINE (314,33)-STEP(81,23):LINE-STEP(0,38):LINE-STEP(-81,23):LINE-STEP(-80,-23):LINE-STEP(0,-38):LINE-STEP (80,-23)
6470 CIRCLE (314,74),44,1,,,.45
6480 LOCATE 20,30:PRINT "(shift values in ppm)"
6490 BEEP:IF HCO%>0 THEN LOCATE 23,1:PRINT "e..exit to DOS,  1..display of spectrum,  2..new structure,  3..":X=512:Y=178:GOSUB 7180:LOCATE 23,66:PRINT "H shift values":GOTO 6540
6500 LOCATE 23,7:PRINT "e....exit to DOS,   1....display of spectrum,   2....new structure"
6510 A$=INPUT$(1):IF INSTR("12eE",A$)=0 THEN BEEP:GOTO 6510
6520 IF INSTR("eE",A$)>0 THEN CLS:SCREEN 0:SYSTEM
6530 ON VAL(A$) GOTO 6570,1840
6540 A$=INPUT$(1):IF INSTR("123eE",A$)=0 THEN BEEP:GOTO 6540
6550 IF INSTR("eE",A$)>0 THEN CLS:SCREEN 0:SYSTEM
6560 ON VAL(A$) GOTO 6570,1840,7010
6570 REM ********** calc. of 13-C spectrum **********
6580 LOCATE 23,1:PRINT SPC(79):LOCATE 22,50:PRINT SPC(20)
6590 LOCATE 23,4:PRINT "frequency  (MHz)    (";:PRINT CSFR;:PRINT ") ";:LOCATE 23,40:LINE INPUT A$:IF LEN(A$)=0 THEN CFR=CSFR:GOTO 6620 ELSE RA=9:GOSUB 5550
6600 CFR=VAL(A$)
6610 REM here from offres, frequ.change
6620 LOCATE 23,4:PRINT "computing...";:PRINT SPC(30)
6630 FR=CFR:FOR N=0 TO 5:LL3(N,0,1)=CV(N)*FR:LI3(N,0,1)=CI(N):ASP%(N)=0:LANZ%(N)=1:NEXT N
6640 FOR N=0 TO 5:GOSUB 7100
6650 IF E$(N)="F" THEN KK=KK(13):GOSUB 3200
6660 IF E$(AA%)="F" THEN KK=KK(14):GOSUB 3200
6670 IF E$(BB%)="F" THEN KK=KK(14):GOSUB 3200
6680 IF E$(CC%)="F" THEN KK=KK(15):GOSUB 3200
6690 IF E$(DD%)="F" THEN KK=KK(15):GOSUB 3200
6700 IF E$(EE%)="F" THEN KK=KK(16):GOSUB 3200
6710 IF E$(N)="CF3" OR E$(N)="F3C" THEN KK=KK(17):GOSUB 3200
6720 IF E$(AA%)="CF3" OR E$(AA%)="F3C" THEN KK=KK(18):GOSUB 3200
6730 IF E$(BB%)="CF3" OR E$(BB%)="F3C" THEN KK=KK(18):GOSUB 3200
6740 IF E$(N)="PPH2" OR E$(N)="PH2P" THEN KK=KK(19):GOSUB 3200
6750 IF E$(N)="P(C6H5)2" OR E$(N)="(H5C6)2P" THEN KK=KK(19):GOSUB 3200
6760 IF E$(AA%)="PPH2" OR E$(AA%)="PH2P" THEN KK=KK(20):GOSUB 3200
6770 IF E$(AA%)="P(C6H5)2" OR E$(AA%)="(H5C6)2P" THEN KK=KK(20):GOSUB 3200
6780 IF E$(BB%)="PPH2" OR E$(BB%)="PH2P" THEN KK=KK(20):GOSUB 3200
6790 IF E$(BB%)="P(C6H5)2" OR E$(BB%)="(H5C6)2P" THEN KK=KK(20):GOSUB 3200
6800 IF E$(CC%)="PPH2" OR E$(CC%)="PH2P" THEN KK=KK(21):GOSUB 3200
6810 IF E$(CC%)="P(C6H5)2" OR E$(CC%)="(H5C6)2P" THEN KK=KK(21):GOSUB 3200
6820 IF E$(DD%)="PPH2" OR E$(DD%)="PH2P" THEN KK=KK(21):GOSUB 3200
6830 IF E$(DD%)="P(C6H5)2" OR E$(DD%)="(H5C6)2P" THEN KK=KK(21):GOSUB 3200
6840 IF E$(N)="POPH2" OR E$(N)="PH2OP" THEN KK=KK(22):GOSUB 3200
6850 IF E$(N)="PO(C6H5)2" OR E$(N)="(H5C6)2OP" THEN KK=KK(22):GOSUB 3200
6860 IF E$(AA%)="POPH2" OR E$(AA%)="PH2OP" THEN KK=KK(23):GOSUB 3200
6870 IF E$(AA%)="PO(C6H5)2" OR E$(AA%)="(H5C6)2OP" THEN KK=KK(23):GOSUB 3200
6880 IF E$(BB%)="POPH2" OR E$(BB%)="PH2OP" THEN KK=KK(23):GOSUB 3200
6890 IF E$(BB%)="PO(C6H5)2" OR E$(BB%)="(H5C6)2OP" THEN KK=KK(23):GOSUB 3200
6900 IF E$(CC%)="POPH2" OR E$(CC%)="PH2OP" THEN KK=KK(24):GOSUB 3200
6910 IF E$(CC%)="PO(C6H5)2" OR E$(CC%)="(H5C6)2OP" THEN KK=KK(24):GOSUB 3200
6920 IF E$(DD%)="POPH2" OR E$(DD%)="PH2OP" THEN KK=KK(24):GOSUB 3200
6930 IF E$(DD%)="PO(C6H5)2" OR E$(DD%)="(H5C6)2OP" THEN KK=KK(24):GOSUB 3200
6940 IF E$(EE%)="POPH2" OR E$(EE%)="PH2OP" THEN KK=KK(25):GOSUB 3200
6950 IF E$(EE%)="PO(C6H5)2" OR E$(EE%)="(H5C6)2OP" THEN KK=KK(25):GOSUB 3200
6960 IF ORK%=1 THEN IF E$(N)="H" THEN KK=KK(26):GOSUB 3200:REM off-res
6970 NEXT N
6980 FOR N=0 TO 5:FOR I=0 TO ASP%(N):FOR J=1 TO LANZ%(N):LL3(N,I,J)=LL3(N,I,J)/FR:NEXT J:NEXT I:NEXT N
6990 GOSUB 2960
7000 IK%=0:BK%=0:GOTO 3650
7010 REM ********* 1-H display **********
7020 CLS:SCREEN 2
7030 X=226:Y=3:MODE%=1:GOSUB 7180:LOCATE 1,30:PRINT "H-NMR:    SHIFT VALUES":PSET(225,9):LINE -(406,9)
7040 LINE(314,35)-STEP (58,20):LINE -STEP (0,32):LINE -STEP (-58,20):LINE -STEP (-58,-20):LINE -STEP (0,-32):LINE -STEP (58,-20)
7050 CIRCLE (314,71),43,1,,,.48
7060 FOR J=0 TO 5:IF J<4 THEN LOCATE YP%(J),XP%(J):PRINT SPC(25):LOCATE YP%(J),XP%(J):PRINT E$(J)
7070 IF J>3 THEN LOCATE YP%(J),XP%(J)-25:PRINT SPC(25):LOCATE YP%(J),XP%(J)-LEN(E$(J))+1:PRINT E$(J)
7080 NEXT J
7090 GOTO 2390
7100 REM ********* sub aa% ********
7110 AA%=(N+1) MOD 6:BB%=(N+5) MOD 6:CC%=(N+2) MOD 6:DD%=(N+4) MOD 6:EE%=(N+3) MOD 6:RETURN
7120 REM ********* sub key ********
7130 IF LEN(INKEX$) THEN 7130
7140 LOCATE 23,28:BEEP:PRINT "press any key to continue"
7150 A$=INPUT$(1):LOCATE 23,28:PRINT SPC(25):RETURN
7160 REM ********** small numbers ***********
7170 PSET (X+1,Y):PSET (X+2,Y):PSET (X+3,Y-1):LINE -(X+3,Y-3):PSET (X+1,Y-4):PSET (X+2,Y-4):PSET (X,Y-3):LINE -(X,Y-1):RETURN:REM 0
7180 PSET (X,Y):LINE -(X+2,Y):PSET (X+1,Y-4):LINE -(X+1,Y):PSET (X,Y-3):RETURN:REM 1
7190 PSET (X,Y):LINE -(X+3,Y):PSET (X,Y-3):PSET (X+1,Y-4):PSET (X+2,Y-4):PSET (X+3,Y-3):PSET (X+3,Y-2):PSET (X+2,Y-1):RETURN:REM 2
7200 PSET (X,Y):LINE -(X+3,Y):LINE -(X+3,Y-4):LINE -(X,Y-4):PSET (X+1,Y-2):PSET (X+2,Y-2):RETURN:REM 3
7210 PSET (X,Y-4):LINE -(X,Y-2):LINE -(X+4,Y-2):PSET (X+3,Y-4):LINE -(X+3,Y):RETURN:REM 4
7220 PSET (X,Y):LINE -(X+2,Y):PSET (X+3,Y-1):PSET (X+2,Y-2):LINE -(X,Y-2):LINE -(X,Y-4):LINE -(X+3,Y-4):RETURN:REM 5
7230 PSET (X+1,Y):PSET (X+2,Y):PSET (X+3,Y-1):PSET (X+2,Y-2):LINE -(X,Y-2):PSET (X,Y-1):PSET (X,Y-3):PSET (X+1,Y-4):PSET (X+2,Y-4):RETURN:REM 6
7240 PSET (X,Y):LINE -(X+3,Y-3):PSET (X+3,Y-4):LINE -(X,Y-4):RETURN:REM 7
7250 PSET (X+1,Y):PSET (X+2,Y):PSET (X+3,Y-1):PSET (X+1,Y-2):PSET (X+2,Y-2):PSET (X,Y-1):PSET (X,Y-3):PSET (X+1,Y-4):PSET (X+2,Y-4):PSET (X+3,Y-3):RETURN:REM 8
7260 PSET (X,Y):LINE -(X+2,Y):PSET (X+3,Y-1):LINE -(X+3,Y-3):PSET (X+2,Y-4):PSET (X+1,Y-4):PSET (X,Y-3):PSET (X+1,Y-2):PSET (X+2,Y-2):RETURN:REM 9
7270 PSET (X+1,Y):RETURN:REM "."
7280 REM ************ scale ************
7290 SCREEN 2:IF OG(1)>12 THEN OG(1)=12
7300 IF OG(2)>220 THEN OG(2)=220
7310 IF UG(MODE%)<0 THEN UG(MODE%)=0
7320 CLS:ST=(60+2940*(MODE%-1))/(OG(MODE%)-UG(MODE%)):PPM=OG(MODE%)
7330 LINE (20,171)-(620,171)
7340 FOR Q=20 TO 622 STEP ST:PSET (Q,172):PSET (Q,173):
7350 IF MODE%=2 THEN GOTO 7380
7360 IF ST>60 THEN IF INT(PPM*10)=PPM*10 AND INT(PPM)<>PPM THEN PSET (Q,174):PSET (Q,175):LOCATE 23,Q\8-1:PRINT INT(10*PPM)/10;
7370 IF INT(PPM)=PPM THEN PSET (Q,174):PSET (Q,175):LOCATE 23,Q\8:PRINT PPM;
7380 IF MODE%=2 AND ST<75 THEN IF (PPM+.5)\20=PPM/20 THEN PSET (Q,174):PSET (Q,175):LOCATE 23,Q\8-1:PRINT PPM;
7390 IF MODE%=2 AND ST>=75 THEN IF (PPM+.5)\10=PPM/10 THEN PSET (Q,174):PSET (Q,175):LOCATE 23,Q\8-1:PRINT PPM;
7400 IF MODE%=1 THEN PPM=INT(10*(PPM-.1)+.5)/10 ELSE PPM=INT(10*(PPM-5)+.5)/10:PPM=5*(PPM\5)
7410 NEXT Q:LOCATE 23,5:PRINT " ppm ":RETURN
7420 REM ************* menu 13-C ************
7430 CLS:SCREEN 0,1:X=23
7440 IF LEN(INKEY$) THEN 7440
7450 LOCATE X,22:PRINT "HELP.................................h":X=X-2
7460 LOCATE X,22:PRINT "Exit to DOS..........................e":X=X-2
7470 IF HCO%>0 THEN LOCATE X,22:PRINT "Proton NMR spectrum..................p":X=X-2
7480 LOCATE X,22:PRINT "New structure........................n":X=X-2
7490 LOCATE X,22:IF ORK%=0 THEN PRINT "Off-resonance spectrum...............o" ELSE PRINT "Decoupled spectrum...................d"
7500 X=X-2:LOCATE X,22:PRINT "Line-spectrum........................6":X=X-2
7510 LOCATE X,22:PRINT "Display individual shift values......5":X=X-2
7520 LOCATE X,22:PRINT "Change frequency.....................4":X=X-2
7530 LOCATE X,22:PRINT "Change coupl. const./increments......3":X=X-2
7540 LOCATE X,22:PRINT "Change y-scale.......................2":X=X-2
7550 LOCATE X,22:PRINT "Change ppm-scale.....................1":X=X-2
7560 A$=INKEY$:IF LEN(A$)=0 THEN 7560
7570 IF INSTR("123456pPcCnNeEoO0hHdD",A$)=0 THEN BEEP:GOTO 7560
7580 IF ORK%=0 AND INSTR("dD",A$)>0 THEN BEEP:GOTO 7560
7590 IF ORK%=1 AND INSTR("oO0",A$)>0 THEN BEEP:GOTO 7560
7600 IF INSTR("34Oo0PpDd",A$)>0 AND PIC2%=3 THEN GOTO 8840
7610 CLS:IF INSTR("eE",A$)>0 THEN SYSTEM
7620 IF INSTR("hH",A$)>0 THEN GOSUB 6270:GOTO 7420
7630 IF INSTR("Nn",A$)>0 THEN CLS:PRINT "     ":GOTO 1840
7640 IF INSTR("oO0",A$)>0 THEN ORK%=1:GOTO 6620
7650 IF INSTR("dD",A$)>0 THEN ORK%=0:GOTO 6620
7660 IF INSTR("pP",A$)>0 THEN BK%=0:IK%=0:GOTO 7010
7670 IF A$="1" THEN GOTO 4840
7680 IF A$="2" THEN GOTO 4400
7690 IF A$="3" THEN GOTO 4510
7700 IF A$="4" THEN GOTO 7750
7710 IF A$="5" THEN GOSUB 5150
7720 IF A$="6" THEN GOTO 3650
7730 GOTO 7420
7740 REM change c-frequ.
7750 LOCATE 23,5:PRINT "Input new frequency  (MHz): ";:LOCATE 23,40:LINE INPUT A$:RA%=10:GOSUB 5550
7760 CFR=VAL(A$):CLS:GOTO 6620
7770 REM ********* sub 5,6-ring **********
7780 PSET (X,Y):LINE -STEP(25,9):LINE -STEP(0,12):LINE -STEP(-25,9):LINE -STEP(-25,-9):LINE -STEP(0,-12):LINE -STEP(25,-9):PSET (X,Y+3):LINE -STEP(-20,7):PSET (X-20,Y+20):LINE -STEP(20,7):PSET (X+20,Y+20):LINE -STEP(0,-10):RETURN:REM 6-ring
7790 PSET (X+50,Y):LINE -STEP(25,9):LINE -STEP(0,12):LINE -STEP(-25,9):LINE -STEP(-25,-9):LINE -STEP(0,-12):LINE -STEP(25,-9):PSET (X+50,Y+3):LINE -STEP(20,7):PSET (X+50,Y+27):LINE -STEP(20,-7):RETURN:REM naphtho
7800 PSET (X,Y):LINE -STEP(28,-6):LINE -STEP(20,13):LINE -STEP(-20,12):LINE -STEP(-28,-6):RETURN:REM 5-ring
7810 REM ********* coupling **********
7820 ASP%(N)=ASP%(N)+1
7830 FOR J=1 TO LANZ%(N):DEL=LL3(N,ASP%(N)-1,J)-H(X):W=(SQR(DEL*DEL+KK*KK)+KK+LL3(N,ASP%(N)-1,J)+H(X))/2
7840 Q1=LL3(N,ASP%(N)-1,J)+H(X)-W:Q2=Q1+KK:Q3=W-KK:Q4=W:Q=(Q4-Q1)/(Q3-Q2+.0001)
7850 IF DEL<0 THEN A=Q1:B=Q2 ELSE A=Q4:B=Q3
7860 LL3(N,ASP%(N),2*J-1)=A:LL3(N,ASP%(N),2*J)=B:LI3(N,ASP%(N),2*J-1)=LI3(N,ASP%(N)-1,J)/(Q+1):LI3(N,ASP%(N),2*J)=Q*LI3(N,ASP%(N)-1,J)/(Q+1)
7870 NEXT J:LANZ%(N)=2*LANZ%(N):RETURN
7880 REM *********** on error *********
7890 LOCATE 23,15:BEEP:PRINT "turn on the printer !! - c to continue, q to quit"
7900 A$=INPUT$(1):IF INSTR("cCqQ",A$)=0 THEN GOTO 7900
7910 LOCATE 23,15:PRINT SPC(50):IF INSTR("qQ",A$)>0 THEN ON MODE% GOTO 3860,7420
7920 GOTO 5290
7930 REM ************ 2. PICTURE *********
7940 GET (0,0)-(230,60),BPI%:PIC2%=2
7950 FOR N=1 TO LZ%(1):LP2(2,N)=X(N)
7960 LPI2(2,N)=LI1(N)*55/MAX:NEXT N:LZ%(2)=LZ%(1):MAX2=MAX
7970 IF ART%=2 THEN FOR N=20 TO 620:K1%(2,N)=167-K1%(1,N):NEXT N
7980 CLS:SCREEN 2:LOCATE 1,28:PRINT "INPUT OF SECOND STRUCTURE":E$(0)="":GOTO 1870
7990 GET (0,0)-(230,60),API%
8000 FOR N=1 TO LZ%(1):LP2(0,N)=X(N)  
8010 LPI2(0,N)=LI1(N)*55/MAX:NEXT N:MAX1=MAX:LZ%(0)=LZ%(1)
8020 IF ART%=2 THEN FOR N=20 TO 620:K1%(0,N)=167-K1%(1,N):NEXT N
8030 CLS:SCREEN 2:A=59:C=2
8040 GOSUB 8530
8050 PUT (0,0),BPI%:LOCATE 1,67:PRINT "Compound A"
8060 GOSUB 8640
8070 A=120:C=0:GOSUB 8530
8080 PUT (0,62),API%:LOCATE 9,67:PRINT "Compound B":GOSUB 8640
8090 LOCATE 23,38:PRINT SPC(20):LOCATE 23,1:PRINT "Input percentage of compound A: ":LOCATE 23,40:LINE INPUT A$:RA%=14:GOSUB 5550
8100 AP=VAL(A$):IF AP>100 OR AP<0 THEN BEEP:GOTO 8090
8110 LOCATE 23,1:PRINT SPC(60):AP=INT(AP)/100:BP=1-AP
8120 K=0:FOR N=1 TO LZ%(2):K=K+1:X(K)=LP2(2,N):LI1(K)=LPI2(2,N)*MAX2*AP:NEXT N
8130 FOR N=1 TO LZ%(0):K=K+1:X(K)=LP2(0,N):LI1(K)=LPI2(0,N)*MAX1*BP:NEXT N
8140 FOR I=1 TO K-1:FOR J=I TO K:IF X(I)>X(J) THEN SWAP X(I),X(J):SWAP LI1(I),LI1(J)
8150 NEXT J:NEXT I:LZG%=0:MAX=0
8160 FOR N=1 TO K-1:IF X(N)=X(N+1) THEN LI1(N+1)=LI1(N+1)+LI1(N):LI1(N)=0
8170 NEXT N
8180 FOR N=1 TO K:IF LI1(N)>0 THEN LZG%=LZG%+1:X(LZG%)=X(N):LI1(LZG%)=LI1(N):IF LI1(LZG%)>MAX THEN MAX=LI1(LZG%)
8190 NEXT N
8200 FOR N=1 TO LZG%:LI1(N)=55*LI1(N)/MAX:NEXT N
8210 A=180
8220 GOSUB 8530:Y=130:LOCATE 17,3:IF MODE%=1 THEN X=9:GOSUB 7180:PRINT "H-"; ELSE X=3:GOSUB 7180:X=9:GOSUB 7200:PRINT "C-";
8230 PRINT "NMR spectrum of mixture":LOCATE 17,65:PRINT "A:B =";100*AP;":";100*BP
8240 PPM=OG(MODE%):FOR Q= 20 TO 621 STEP ST:IF MODE%=2 THEN GOTO 8280
8250 IF ST>60 THEN IF INT(PPM*10)=PPM*10 AND INT(PPM)<>PPM THEN LOCATE 24,Q\8-1:PRINT INT(10*PPM)/10;
8260 IF INT(PPM)=PPM THEN LOCATE 24,Q\8:PRINT PPM;
8270 GOTO 8300
8280 IF ST<75 THEN IF (PPM+.5)\20=PPM/20 THEN LOCATE 24,Q\8-1:PRINT PPM;
8290 IF ST>=75 THEN IF (PPM+.5)\10=PPM/10 THEN LOCATE 24,Q\8-1:PRINT PPM;
8300 IF MODE%=1 THEN PPM=INT(10*(PPM-.1)+.5)/10 ELSE PPM=INT(10*(PPM-5)+.5)/10
8310 NEXT Q:LOCATE 24,5:PRINT " ppm ";:LOCATE 1,1:PRINT
8320 IF ART%=1 THEN FOR N=1 TO LZG%:PSET (X(N),A-LI1(N)):LINE -(X(N),A):NEXT N
8330 IF ART%=2 THEN A=A-2:GOSUB 8670 
8340 GET (0,0)-(639,199),PIC%:PIC2%=3
8350 IF LEN(INKEY$) THEN 8350
8360 M$=INKEY$:IF M$="" THEN GOTO 8360
8370 IF INSTR("Mm",M$)>0 THEN GOTO 8780
8380 IF INSTR("Cc",M$)>0 THEN GOTO 8030
8390 CLS:GOSUB 7280
8400 Y=4:LOCATE 1,31:IF MODE%=1 THEN X=233:GOSUB 7180:PRINT "H-"; ELSE X=227:GOSUB 7180:X=233:GOSUB 7200:PRINT "C-";
8405 PRINT "NMR spectrum of mixture A:B = ";100*AP;":";100*BP
8410 IF ART%=1 THEN FOR N=1 TO LZG%:PSET (X(N),171-2.5*LI1(N)):LINE -(X(N),171):NEXT N
8420 IF ART%=2 THEN PSET (20,167):FOR N=20 TO 620:LINE -(N,K1%(1,N)):NEXT N
8430 IF LEN(INKEY$) THEN 8430
8440 M$=INKEY$:IF M$="" THEN GOTO 8440
8450 IF INSTR("Mm",M$)>0 THEN GOTO 8780
8460 IF INSTR("Cc",M$)>0 THEN GOTO 8030
8470 IF LEN(INKEY$) THEN 8470
8480 CLS:SCREEN 0:LOCATE 7,17:PRINT "c........................change ratio of A/B":LOCATE 10,17:PRINT "m........................return to main menu":LOCATE 18,27:PRINT "any other key to continue"
8490 A$=INKEY$:IF A$="" THEN 8490
8500 CLS:SCREEN 2:IF INSTR("CcMm",A$)=0 THEN PUT (0,0),PIC%:GOTO 8350
8510 IF INSTR("Mm",A$)>0 THEN GOTO 8780
8520 GOTO 8030
8530 REM *********** scales for 2nd picture ********
8540 LINE (20,A)-(620,A)
8550 PPM=OG(MODE%):FOR Q=20 TO 622 STEP ST:PSET (Q,A+1):PSET (Q,A+2)
8560 IF MODE%=2 THEN GOTO 8590
8570 IF ST>60 THEN IF INT(PPM*10)=PPM*10 THEN PSET (Q,A+3):PSET (Q,A+4)
8580 IF PPM=INT(PPM) THEN PSET (Q,A+3):PSET (Q,A+4):GOTO 8610
8590 IF ST<75 THEN IF (PPM+.5)\20=PPM/20 THEN PSET (Q,A+3):PSET (Q,A+4)
8600 IF ST>=75 THEN IF (PPM+.5)\10=PPM/10 THEN PSET (Q,A+3):PSET (Q,A+4)
8610 IF MODE%=1 THEN PPM=INT(10*(PPM-.1)+.5)/10 ELSE PPM=INT(10*(PPM-5)+.5)/10:PPM=5*(PPM\5)
8620 NEXT Q
8630 RETURN
8640 REM *********** small spectra ***************
8650 IF ART%=1 THEN FOR N=1 TO LZ%(C):PSET (LP2(C,N),A-LPI2(C,N)):LINE -(LP2(C,N),A):NEXT N:RETURN
8660 A=A-2:PSET (20,A):FOR N=20 TO 620:LINE -(N,A-K1%(C,N)\3):NEXT N:RETURN
8670 REM ********** small curve ***********
8680 PSET (20,A):I%(19)=0:Q=RES^(1/3)
8690 FOR N=20 TO 620:S=0:IF X(1)-N>50 THEN PSET (N,A):K1%(1,N)=167:GOTO 8740
8700 IF N-X(LZG%)>50 THEN PSET (N,A):K1%(1,N)=167:GOTO 8740
8710 FOR J=1 TO LZG%:IF ABS(N-X(J))>50 THEN GOTO 8730
8720 Z=N-X(J):S=S+LI1(J)*Q*.6/(Z*Z*RES+1)
8730 NEXT J:LINE -(N,A-S):K1%(1,N)=167-2.5*S
8740 I%(N)=I%(N-1)+3*S:NEXT N
8750 F=130/(I%(620)-I%(10)+.0001):FOR N=20 TO 620:I%(N)=I%(N)*F:NEXT N:BEEP
8760 KKO=2
8770 RETURN
8780 REM ******** return to main options **********
8790 S=0:FOR N=1 TO LZG%:S=S+LI1(N):NEXT N:HCO%=1:KKO=1:MAX=MAX/200
8800 LZ%(1)=LZG%:FOR N=1 TO LZG%:LI1(N)=LI1(N)/S
8810 IF MODE%=1 THEN LL1(N)=OG(1)-(X(N)-20)/(10*ST) ELSE LL1(N)=OG(2)-5*(X(N)-20)/ST
8820 NEXT N
8830 ON ART% GOTO 3650,4170
8840 REM *********** error **************
8850 CLS:BEEP:LOCATE 10,26:PRINT "this option does not work with":LOCATE 12,33:PRINT "'mixed'  spectra"
8860 GOSUB 7120
8870 ON MODE% GOTO 3860,7420