home *** CD-ROM | disk | FTP | other *** search
/ Explore the World of Soft…ids, Adults, Educational / RocelcoInc-ExploreTheWorldOfSoftware-KidsAdultsEducational-Vol2-Shareware.iso / educate / disk133 / nmr6.bas < prev    next >
Encoding:
BASIC Source File  |  1985-04-19  |  6.6 KB  |  187 lines
  1. 1 'NMR6--Part 6 of NMRCALC package.  Energy level diagrams.
  2. 10 DEFINT I-N
  3. 20 'COMMON IPFLAG,IREAD,FF$
  4. 21 OPEN "scratch.nmr" FOR INPUT AS 1
  5. 22 INPUT #1, IPFLAG: INPUT #1, IREAD: LINE INPUT #1, FF$
  6. 23 CLOSE #1
  7. 30 DIM E(128), FZ(128), SINT(3003), BC(7), ILOW(3003), IHIGH(3003), IX(128),           IY(128), ILEN(7)
  8. 40 FOR I = 1 TO 7:  READ ILEN(I): NEXT
  9. 45 DATA 160,80,53,27,16,8,5
  10. 50 SCREEN 0,0,0: COLOR 14,4,1: KEY OFF: CLS
  11. 60 PRINT:PRINT"Routine to generate energy level (and Fz-level) diagrams.":          PRINT:PRINT"To return from plot, hit any key after plot completed.":PRINT
  12. 65 GOSUB 63999
  13. 70 ON ERROR GOTO 60000
  14. 80 ILINE = 0: TH1 = 0: TH2 = 0
  15. 90 YRANGE = 160: YTOP = (200 - YRANGE)/2
  16. 95 IF IREAD > 0 THEN GOSUB 5030
  17. 100 SCREEN 0,0,0: COLOR 14,4,1: CLS: PRINT: PRINT"Enter command ('ME' for menu):  ";: GOSUB 500
  18. 110 IF P$ = "EN" THEN GOSUB 1000
  19. 120 IF P$ = "FZ" THEN GOSUB 2000
  20. 130 IF P$ = "ME" THEN GOSUB 3000
  21. 140 IF P$ = "TR" THEN GOSUB 6000
  22. 150 IF P$ = "QL" THEN GOSUB 900: CHAIN "nmr4"
  23. 160 IF P$ = "QP" THEN GOSUB 900: CHAIN "nmr5"
  24. 170 IF P$ = "QM" THEN GOSUB 900: CHAIN "nmr1"
  25. 180 IF P$ = "QT" THEN PRINT:PRINT "End of run.  Exiting to system.": END
  26. 190 IF P$ = "RD" THEN GOSUB 5000
  27. 200 IF P$ = "TH" THEN GOSUB 4000
  28. 210 IF P$ = "FF" THEN LPRINT CHR$(12);
  29. 300 GOTO 100
  30. 500 P1$ = INKEY$: IF P1$ = "" THEN 500
  31. 510 IF ASC(P1$) > 90 THEN P1$ = CHR$(ASC(P1$) - 32)
  32. 520 PRINT P1$;
  33. 530 P2$ = INKEY$: IF P2$ = "" THEN 530
  34. 540 IF ASC(P2$) > 90 THEN P2$ = CHR$(ASC(P2$) - 32)
  35. 550 PRINT P2$
  36. 560 P$ = P1$ + P2$
  37. 570 RETURN
  38. 600 P$ = INKEY$: IF P$ = "" THEN 600
  39. 610 IF ASC(P$) > 90 THEN P$ = CHR$(ASC(P$) - 32)
  40. 620 PRINT P$
  41. 630 RETURN
  42. 900 OPEN "scratch.nmr" FOR OUTPUT AS 1
  43. 910 PRINT #1, IPFLAG: PRINT #1, IREAD: PRINT #1, FF$
  44. 920 CLOSE 1
  45. 930 RETURN
  46. 1000 CLS: PRINT:PRINT"Energy level plotting mode selected. "
  47. 1010 GOSUB 63999
  48. 1030 ESCALE = YRANGE/(EMIN - EMAX)
  49. 1040 B = YTOP - ESCALE*EMAX
  50. 1050 FOR I = 1 TO NF
  51. 1060 IY(I) = ESCALE*E(I) + B
  52. 1070 NEXT
  53. 1080 IMODE = 1
  54. 1090 GOSUB 10000
  55. 1100 P$ = INKEY$: IF P$ = "" THEN 1100 ELSE RETURN
  56. 2000 CLS:PRINT:PRINT"Fz-level plotting mode selected."
  57. 2010 GOSUB 63999
  58. 2020 ESCALE = YRANGE/(FZMIN - FZMAX)
  59. 2030 B = YTOP - ESCALE*FZMAX
  60. 2040 FOR I = 1 TO NF
  61. 2050 IY(I) = ESCALE*FZ(I) + B
  62. 2060 NEXT
  63. 2070 IMODE = 2
  64. 2080 GOSUB 10000
  65. 2090 GOTO 1100
  66. 3000 CLS:PRINT:PRINT"Menu of available options:  ":PRINT
  67. 3010 PRINT"EN--Do energy level plot."
  68. 3015 PRINT"FF--Form feed to printer (useful if printer plotting)."
  69. 3020 PRINT"FZ--Do Fz-level plot."
  70. 3030 PRINT"ME--Display this menu."
  71. 3050 PRINT"QL--Exit to line-listing routine (NMR4)."
  72. 3060 PRINT"QM--Exit to main program (NMR1)."
  73. 3070 PRINT"QP--Exit to plotting routine (NMR5)."
  74. 3080 PRINT"QT--Exit to main system (terminate execution)."
  75. 3090 PRINT"RD--Read in needed information from disk."
  76. 3100 PRINT"TH--Enter threshold options."
  77. 3120 PRINT"TR--Select transition drawing options."
  78. 3150 GOTO 63999
  79. 4000 CLS:PRINT:PRINT"Routine to select threshold selection options.":PRINT
  80. 4010 PRINT"The rules:  1)  If both thresholds are zero, all lines plotted."
  81. 4020 PRINT"            2)  THRESHOLD1 sets the minimum line intensity."
  82. 4030 PRINT"            3)  THRESHOLD2 sets the maximum line intensity."
  83. 4040 PRINT"                (Default:  THRESHOLD2 = 1.00001)"
  84. 4050 PRINT:PRINT
  85. 4060 INPUT"Enter THRESHOLD1:  ",TH1
  86. 4070 INPUT"Enter THRESHOLD2:  ",TH2
  87. 4075 IF TH1 = 0 AND TH2 = 0 THEN 63999
  88. 4080 IF TH1 >= 0 AND TH2 = 0 THEN TH2 = 1.00001
  89. 4090 IF TH1 > TH2 THEN BEEP: PRINT: GOTO 4050
  90. 4100 GOTO 63999
  91. 5000 CLS:PRINT:PRINT"Ready for relevant information from the disk.":PRINT:            PRINT"Do you need to specify the data set name? ";: GOSUB 600
  92. 5010 IF P$ = "N" THEN 5030 ELSE IF P$ <> "Y" THEN 5000
  93. 5020 PRINT: INPUT"Enter data set name:  ",FF$
  94. 5030 PRINT: PRINT "Now reading in needed information.":PRINT
  95. 5040 DF$ = FF$ + ".inf": PRINT: PRINT"Reading in file ";DF$
  96. 5050 OPEN DF$ FOR INPUT AS 1
  97. 5060 INPUT #1, NS
  98. 5070 INPUT #1, NF
  99. 5080 FOR I = 0 TO NS: INPUT #1, BC(I): NEXT
  100. 5090 CLOSE 1
  101. 5100 FZ = NS/2 + 1: K = 0
  102. 5110 FOR I = 1 TO NS + 1
  103. 5120 FZ = FZ - 1
  104. 5130 FOR J = 1 TO BC(I-1)
  105. 5140 K = K + 1: FZ(K) = FZ
  106. 5150 NEXT
  107. 5160 NEXT
  108. 5170 K = 0
  109. 5180 FOR I = 1 TO NS + 1
  110. 5190 DF$ = FF$ + "." + RIGHT$(STR$(I), LEN(STR$(I)) - 1)
  111. 5200 PRINT"Reading in file ";DF$
  112. 5210 OPEN DF$ FOR INPUT AS #1
  113. 5220 INPUT #1, N
  114. 5230 FOR J = 1 TO N
  115. 5240 K = K + 1
  116. 5250 INPUT #1, E(K)
  117. 5260 NEXT
  118. 5270 CLOSE #1
  119. 5280 NEXT
  120. 5290 EMIN = 1E+20: EMAX = -1E+20
  121. 5300 FOR I = 1 TO NF
  122. 5310 EI = E(I)
  123. 5320 IF EI > EMAX THEN EMAX = EI: GOTO 5340
  124. 5330 IF EI < EMIN THEN EMIN = EI
  125. 5340 NEXT
  126. 5350 FZMAX = FZ(1): FZMIN = FZ(NF)
  127. 5360 NL = 0
  128. 5370 FOR I = 1 TO NS: NL = NL + BC(I-1)*BC(I): NEXT
  129. 5380 DF$ = FF$ + ".lin"
  130. 5390 OPEN DF$ FOR INPUT AS 1: PRINT"Reading in file ";DF$
  131. 5400 FOR I = 1 TO NL
  132. 5410 INPUT #1, SLINE#
  133. 5420 SM = 1000*(SLINE# - INT(SLINE#)): SL = INT(SLINE#): SM = INT(SM + .1)
  134. 5430 ILOW(I) = SM: IHIGH(I) = SL
  135. 5440 INPUT #1, JUNK#
  136. 5450 INPUT #1, SINTIN#: SINT(I) = SINTIN#
  137. 5460 NEXT
  138. 5470 CLOSE 1
  139. 5475 K = 0
  140. 5480 FOR I = 1 TO NS + 1
  141. 5490 N = BC(I-1): XINCR = 640/(N + 1)
  142. 5500 FOR J = 1 TO N
  143. 5510 K = K + 1
  144. 5520 IX(K) = J*XINCR
  145. 5530 NEXT
  146. 5540 NEXT
  147. 5550 PRINT:PRINT"Preliminary reading finished.": GOTO 63999
  148. 6000 CLS:PRINT:PRINT"Routine to select transition-plotting option.":PRINT
  149. 6010 PRINT"This option is currently ";
  150. 6020 IF ILINE = 0 THEN PRINT "OFF" ELSE PRINT "ON"
  151. 6030 PRINT:PRINT"Change option? ";: GOSUB 600
  152. 6040 IF P$ = "N" THEN 63999
  153. 6050 IF P$ <> "Y" THEN BEEP: GOTO 6030
  154. 6060 IF ILINE = 0 THEN ILINE = 1 ELSE ILINE = 0
  155. 6070 GOTO 63999
  156. 10000 SCREEN 0: SCREEN 2: OUT 985,14: LINE (0,0)-(639,199),,B: IB = B
  157. 10002 LOCATE 2,2
  158. 10004 IF IMODE = 1 THEN PRINT"Energy level diagram--";
  159. 10006 IF IMODE = 2 THEN PRINT"Fz-level diagram--";
  160. 10010 FOR I = 0 TO 639
  161. 10020 IF I MOD 8 = 0 THEN PSET (I,IB)
  162. 10030 NEXT
  163. 10040 IL = ILEN(NS)
  164. 10050 FOR I = 1 TO NF
  165. 10060 IXI = IX(I): IYI = IY(I)
  166. 10070 LINE (IXI - IL, IYI) - (IXI + IL, IYI)
  167. 10080 NEXT
  168. 10085 IF ILINE = 0 THEN RETURN
  169. 10090 LOCATE 24,2
  170. 10100 IF TH1 = 0 AND TH2 = 0 THEN PRINT "All lines plotted.";: GOTO 10150
  171. 10110 PRINT"Intensity range:";
  172. 10120 PRINT USING "##.#####"; TH1;
  173. 10130 PRINT " - ";
  174. 10140 PRINT USING "##.#####"; TH2;
  175. 10150 FOR I = 1 TO NL
  176. 10160 SI = SINT(I)
  177. 10165 IF TH2 = 0 THEN 10180
  178. 10170 IF SI < TH1 OR SI > TH2 THEN 10200
  179. 10180 IA = ILOW(I): IB = IHIGH(I)
  180. 10190 LINE (IX(IA), IY(IA)) - (IX(IB), IY(IB))
  181. 10200 NEXT
  182. 10210 RETURN
  183. 60000 CLS:PRINT:PRINT"Error encountered!  Did you read in all needed files?"
  184. 60010 GOSUB 63999
  185. 60020 RESUME 100
  186. 63999 IF IPFLAG = 1 THEN RETURN ELSE PRINT: INPUT"Hit <Return> to continue.",A$:       RETURN
  187.