home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 2 / FreeSoftwareCollection2pd199x-jp.img / fbasic / anal / anal.bas next >
BASIC Source File  |  1990-06-14  |  11KB  |  191 lines
  1. 10 REM
  2. 20 REM    構造式による分子量および元素分析計算プログラム
  3. 30 REM                  Ver. 0.01   1989/04/12 by Butch
  4. 40 REM                  Ver. 0.02   1989/09/06 by Butch
  5. 50 REM
  6. 60 REM
  7. 70 REM
  8. 80 REM
  9. 90 REM
  10. 99 REM ********** タイトル表示 **********
  11. 100 CLS
  12. 110 LOCATE 15,0:PRINT "構造式による分子量および元素分析計算プログラム"
  13. 120 LOCATE 15,2:PRINT "<<< Copyright (C)1989 Butch Software Inc.,>>>"
  14. 130 LOCATE 10,5:PRINT "Ph: Phenyl  Me: Methyl  Et: Ethyl   Pro: Propyl  Bu: Butyl"
  15. 140 LOCATE 10,7:PRINT "Pen: Pentyl Hex: Hexyl  Hep: Heptyl Oct: Octyl  Non: Nonyl"
  16. 150 LOCATE 10,9:PRINT "Vin: Vinyl  All: Allyl  Ace: Acetyl Bn: Benzyl  Bz: Benzoyl"
  17. 160 LOCATE 10,11:PRINT "Tms: Trimethylsilyl     Tbdms: tert-Butyldimethylsilyl"
  18. 170 LOCATE 10,13:PRINT "Thp: Tetrahydropyranyl"
  19. 180 LOCATE 10,15:PRINT "Ts: Tosyl   Ms: Mesyl   Tf: Trifluoromethansulfonyl"
  20. 190 LOCATE 10,17:PRINT "Tpp: Triphenylphosphine"
  21. 200 LOCATE 22,19:PRINT "括弧（）は２０個まで使用できます。"
  22. 210 LOCATE 25,22:PRINT "なにかキ－を押して下さい。";:TEMP$=INPUT$(1)
  23. 399 REM ********** 画面消去、配列宣言 **********
  24. 400 CLS:CLEAR
  25. 410 DIM GENSHI(103), GENNUM(103)
  26. 420 DIM KAKE$(40), BLK$(40), DUP(40), MUL(40)
  27. 429 REM ********** 元素をすべて文字列に **********
  28. 430 SYUUKI$="H B C N O F P S K V Y I W U HeLiBeNeNaMgAlSiClArCaScTiCrMnFeCoNiCuZnGaGeAsSeBrKrRbSrZrNbMoTcRuRhPdAgCdInSnSbTeXeCsBaLaHfTaReOsIrPtAuHgTlPbBiPoAtRnFrRaAcCePrNdPmSmEuGdTbDyHoErTmYbLuThPaNpPuAmCmBkCfEsFmMdNoLw"
  29. 449 REM ********** 略号をすべて文字列に **********
  30. 450 RYAKUGOU$="PhMeEtProBuPenHexHepOctNonVinAllAceBnBzTmsTbdmsThpTsMsTfTpp"
  31. 499 REM ********** 原子量を読み込む **********
  32. 500 RESTORE 20000
  33. 510 FOR II=1 TO 103
  34. 520 READ GENSHI(II)
  35. 530 NEXT II
  36. 599 REM ********** 重複回数初期化 **********
  37. 600 FOR II=1 TO 40
  38. 610 MUL(II)=1
  39. 620 NEXT II
  40. 999 REM ********** 画面消去、構造式入力 **********
  41. 1000 CLS
  42. 1010 PRINT "構造式を入力してください。":INPUT FORM$
  43. 1019 REM ********** 括弧の展開 **********
  44. 1020 KK=0:JJ=1:EDFLG=0
  45. 1030 FOR II=1 TO LEN(FORM$)
  46. 1040 TEMP$=MID$(FORM$,II,1)
  47. 1050 TEMP=ASC(TEMP$)
  48. 1060 IF EDFLG = 1 AND (TEMP >= &H30 AND TEMP <= &H39) THEN KAKE$(JJ-1)=KAKE$(JJ-1)+TEMP$: GOTO 1100 ELSE EDFLG = 0:DUP(JJ)=KK:REM ** ) の後の数字なら **
  49. 1070 IF TEMP=&H28 THEN GOSUB 10000:GOTO 1100:REM ** ( なら **
  50. 1080 IF TEMP=&H29 THEN GOSUB 12000:GOTO 1100:REM ** ) なら **
  51. 1090 BLK$(JJ)=BLK$(JJ)+TEMP$:DUP(JJ)=KK
  52. 1100 NEXT II
  53. 1110 IF ERO = 100 THEN GOTO 8000:REM ** ( が多い！ **
  54. 1120 IF KK<>0 THEN ERO=110 :GOTO 8010:REM ** ) が多い！ **
  55. 1200 FOR II=JJ TO 1 STEP -1
  56. 1210 IF DUP(II) > 0 THEN GOSUB 14000
  57. 1220 NEXT II
  58. 1229 REM ********** ミス入力（小文字で始まっていないか）の検査 **********
  59. 1300 FOR II=1 TO JJ
  60. 1310 IF BLK$(II)="" GOTO 1330
  61. 1320 IF ASC(BLK$(II))> &H5A OR ASC(BLK$(II)) < &H41 THEN ERO=120:GOTO 8020:REM ** 小文字で始まっている **
  62. 1330 NEXT II
  63. 1339 REM ********** 原子、略号、数字の切り出し **********
  64. 1400 FOR II=1 TO JJ
  65. 1410 IF BLK$(II)="" THEN GOTO 1590
  66. 1420 ATM$=LEFT$(BLK$(II),1):KETA=0
  67. 1425 IF LEN(BLK$(II))=1 GOTO 1580
  68. 1430 FOR KK=2 TO LEN(BLK$(II))
  69. 1440 TEMP$=MID$(BLK$(II),KK,1)
  70. 1450 TEMP=ASC(TEMP$)
  71. 1460 IF TEMP >= &H41 AND TEMP <= &H5A THEN GOSUB 15000:ATM$=TEMP$:KETA=0:GOTO 1500:REM ** 大文字なら次の元素 **
  72. 1470 IF TEMP >= &H30 AND TEMP <= &H39 THEN KETA = KETA+1:ATM$=ATM$+TEMP$:GOTO 1500:REM ** 数字なら **
  73. 1480 IF KETA <> 0 THEN ERO = 130:GOTO 8030:REM ** 数字の後が大文字でない！ **
  74. 1490 ATM$ = ATM$+TEMP$
  75. 1500 NEXT KK
  76. 1579 REM ********** 原子、略号の検索 **********
  77. 1580 GOSUB 15000
  78. 1590 IF ERO=150 THEN GOTO 8040:REM ** 見つからない！ **
  79. 1600 NEXT II
  80. 1999 REM ********** 分子式、分子量の計算 **********
  81. 2000 BUNSHIKI$="  ":MOLWGT=0
  82. 2010 FOR II=1 TO 103
  83. 2020 IF GENNUM(II) <> 0 THEN BUNSHIKI$=BUNSHIKI$+MID$(SYUUKI$,2*II-1,2)+STR$(GENNUM(II))+" ; ":MOLWGT=MOLWGT+GENNUM(II)*GENSHI(II)
  84. 2030 NEXT II
  85. 2040 PRINT "分子式は　:";BUNSHIKI$
  86. 2050 PRINT "分子量は　:";:PRINT USING "####.###";MOLWGT
  87. 2199 REM ********** 元素分析の計算 **********
  88. 2200 PRINT:INPUT "元素分析計算を実行しますか。";YN$
  89. 2210 IF YN$<>"n" AND YN$<>"N" AND YN$<>"y" AND YN$<>"Y" THEN GOTO 2200
  90. 2220 IF YN$="n" OR YN$="N" THEN GOTO 3030
  91. 3000 FOR II=1 TO 103
  92. 3010 IF GENNUM(II) <> 0 THEN PRINT MID$(SYUUKI$,2*II-1,2);"の％は     ";:PRINT USING "##.###";GENNUM(II)*GENSHI(II)*100/MOLWGT
  93. 3020 NEXT II
  94. 3029 REM ********** 再実行？ **********
  95. 3030 PRINT:INPUT "もう一度やりますか ";YN$
  96. 3040 IF YN$<>"n" AND YN$<>"N" AND YN$<>"y" AND YN$<>"Y" THEN GOTO 3030
  97. 3050 IF YN$="y" OR YN$="Y" THEN GOTO 400 ELSE END
  98. 7999 REM ********** エラー表示 **********
  99. 8000 PRINT ") が多すぎます。":GOTO 3030
  100. 8010 PRINT "( が多すぎます。":GOTO 3030
  101. 8020 PRINT "大文字から始まっていない文字列があります。":GOTO 3030
  102. 8030 PRINT "数字の後が大文字ではありません。":GOTO 3030
  103. 8040 PRINT "入力に誤りがあります。":GOTO 3030
  104. 9999 REM ********** ( なら **********
  105. 10000 KK=KK+1:JJ=JJ+1
  106. 11990 RETURN
  107. 11999 REM ********** ) なら **********
  108. 12000 KK=KK-1
  109. 12010 IF KK < 0 THEN ERO=100
  110. 12020 EDFLG = 1:JJ=JJ+1
  111. 12190 RETURN
  112. 13999 REM ********** ) の後の数字を展開 **********
  113. 14000 III=II:IF KAKE$(II)="" THEN KAKE=1 ELSE KAKE=VAL(KAKE$(II))
  114. 14010 WHILE DUP(III) > 0
  115. 14020 MUL(III)=MUL(III)*KAKE
  116. 14030 DUP(III)=DUP(III)-1
  117. 14040 III=III-1
  118. 14050 WEND
  119. 14060 RETURN
  120. 14999 REM ********** 元素、略号の検索 **********
  121. 15000 IF KETA = 0 THEN KOSUU = 1 ELSE KOSUU = VAL(RIGHT$(ATM$,KETA))
  122. 15010 SRC$ = LEFT$(ATM$,LEN(ATM$)-KETA)
  123. 15100 PRSNC = INSTR(SYUUKI$,SRC$):REM ** 元素か？ **
  124. 15110 IF PRSNC = 0 THEN GOTO 15200 ELSE GENNUM((PRSNC+1)/2)=GENNUM((PRSNC+1)/2)+KOSUU*MUL(II):GOTO 15990
  125. 15200 PRSNC = INSTR(RYAKUGOU$,SRC$):REM ** 略号か？ **
  126. 15210 IF PRSNC = 0 THEN ERO=150:GOTO 15990
  127. 15220 IF PRSNC = 1 THEN GENNUM(3)=GENNUM(3)+6*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+5*KOSUU*MUL(II):GOTO 15990:REM ** Ph **
  128. 15230 IF PRSNC = 3 THEN GENNUM(3)=GENNUM(3)+1*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+3*KOSUU*MUL(II):GOTO 15990:REM ** Me **
  129. 15240 IF PRSNC = 5 THEN GENNUM(3)=GENNUM(3)+2*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+5*KOSUU*MUL(II):GOTO 15990:REM ** Et **
  130. 15250 IF PRSNC = 7 THEN GENNUM(3)=GENNUM(3)+3*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+7*KOSUU*MUL(II):GOTO 15990:REM ** Pro **
  131. 15260 IF PRSNC = 10 THEN GENNUM(3)=GENNUM(3)+4*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+9*KOSUU*MUL(II):GOTO 15990:REM ** Bu **
  132. 15270 IF PRSNC = 12 THEN GENNUM(3)=GENNUM(3)+5*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+11*KOSUU*MUL(II):GOTO 15990:REM ** Pen **
  133. 15280 IF PRSNC = 16 THEN GENNUM(3)=GENNUM(3)+6*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+13*KOSUU*MUL(II):GOTO 15990:REM ** Hex **
  134. 15290 IF PRSNC = 18 THEN GENNUM(3)=GENNUM(3)+7*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+15*KOSUU*MUL(II):GOTO 15990:REM ** Hep **
  135. 15300 IF PRSNC = 21 THEN GENNUM(3)=GENNUM(3)+8*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+17*KOSUU*MUL(II):GOTO 15990:REM ** Oct **
  136. 15310 IF PRSNC = 24 THEN GENNUM(3)=GENNUM(3)+9*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+19*KOSUU*MUL(II):GOTO 15990:REM ** Non **
  137. 15320 IF PRSNC = 27 THEN GENNUM(3)=GENNUM(3)+2*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+3*KOSUU*MUL(II):GOTO 15990:REM ** Vin **
  138. 15330 IF PRSNC = 30 THEN GENNUM(3)=GENNUM(3)+3*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+5*KOSUU*MUL(II):GOTO 15990:REM ** All **
  139. 15340 IF PRSNC = 33 THEN GENNUM(3)=GENNUM(3)+2*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+3*KOSUU*MUL(II):GENNUM(5)=GENNUM(5)+1*KOSUU*MUL(II):GOTO 15990:REM ** Ace **
  140. 15350 IF PRSNC = 36 THEN GENNUM(3)=GENNUM(3)+7*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+7*KOSUU*MUL(II):GOTO 15990:REM ** Bn **
  141. 15360 IF PRSNC = 38 THEN GENNUM(3)=GENNUM(3)+7*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+5*KOSUU*MUL(II):GENNUM(5)=GENNUM(5)+1*KOSUU*MUL(II):GOTO 15990:REM ** Bz **
  142. 15370 IF PRSNC = 40 THEN GENNUM(3)=GENNUM(3)+3*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+9*KOSUU*MUL(II):GENNUM(22)=GENNUM(22)+1*KOSUU*MUL(II):GOTO 15990:REM ** Tms **
  143. 15380 IF PRSNC = 43 THEN GENNUM(3)=GENNUM(3)+6*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+15*KOSUU*MUL(II):GENNUM(22)=GENNUM(22)+1*KOSUU*MUL(II):GOTO 15990:REM ** Tbdms **
  144. 15390 IF PRSNC = 48 THEN GENNUM(3)=GENNUM(3)+5*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+9*KOSUU*MUL(II):GENNUM(5)=GENNUM(5)+1*KOSUU*MUL(II):GOTO 15990:REM ** Thp **
  145. 15400 IF PRSNC = 51 THEN GENNUM(3)=GENNUM(3)+7*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+7*KOSUU*MUL(II):GENNUM(5)=GENNUM(5)+2*KOSUU*MUL(II):GENNUM(8)=GENNUM(8)+1*KOSUU*MUL(II):GOTO 15990:REM ** Ts **
  146. 15410 IF PRSNC = 53 THEN GENNUM(3)=GENNUM(3)+1*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+3*KOSUU*MUL(II):GENNUM(5)=GENNUM(5)+2*KOSUU*MUL(II):GENNUM(8)=GENNUM(8)+1*KOSUU*MUL(II):GOTO 15990:REM ** Ms **
  147. 15420 IF PRSNC = 55 THEN GENNUM(3)=GENNUM(3)+1*KOSUU*MUL(II):GENNUM(6)=GENNUM(6)+3*KOSUU*MUL(II):GENNUM(5)=GENNUM(5)+2*KOSUU*MUL(II):GENNUM(8)=GENNUM(8)+1*KOSUU*MUL(II):GOTO 15990:REM ** Tf **
  148. 15430 IF PRSNC = 57 THEN GENNUM(3)=GENNUM(3)+18*KOSUU*MUL(II):GENNUM(1)=GENNUM(1)+15*KOSUU*MUL(II):GENNUM(7)=GENNUM(7)+1*KOSUU*MUL(II):GOTO 15990:REM ** Tpp **
  149. 15990 RETURN
  150. 19999 REM ********** 原子量のデータ **********
  151. 20000 DATA 1.00797,10.811,12.01115,14.0067,15.9994,18.9984,30.9738,32.064
  152. 20010 DATA 39.102,50.942,88.905,126.904,183.85,238.03
  153. 20020 DATA 4.0026,6.939,9.0122,20.183,22.9898,24.312,26.9815
  154. 20030 DATA 28.086,35.453,39.948,40.08,44.956,47.90,51.996
  155. 20040 DATA 54.938,55.847,58.933,58.71,63.54,65.37,69.72,72.59
  156. 20050 DATA 74.922,78.96,79.909,83.80,85.47,87.62,91.22,92.906
  157. 20060 DATA 95.94,98,101.07,102.905,106.4,107.870,112.40,114.82
  158. 20070 DATA 118.69,121.75,127.60,131.30,132.905,137.34,138.91
  159. 20080 DATA 178.49,180.948,186.2,190.2,192.2,195.09,196.967
  160. 20090 DATA 200.59,204.37,207.19,208.980,210,210,222
  161. 20100 DATA 223,226,227,140.12,140.907,144.24,147
  162. 20110 DATA 150.35,151.96,157.25,158.924,162.50,164.930
  163. 20120 DATA 167.26,168.934,173.04,174.97,232.038,231
  164. 20130 DATA 237,242,243,247,247,249,254,253,256,254,257
  165. 29999 REM ********** 変数表 **********
  166. 30000 REM GENSHI()   :　各原子量
  167. 30010 REM GENNUM()   :　各元素の数
  168. 30020 REM KAKE$()    :　）の後の数字:文字型　
  169. 30030 REM KAKE       :　）の後の数字:整数型
  170. 30040 REM BLK$()     :　）、（で挟まれたブロックの文字列
  171. 30050 REM DUP()      :　各ブロックの（（））の重複度
  172. 30060 REM MUL()      :　各ブロックの展開された重複度
  173. 30070 REM SYUUKI$    :　元素を並べた文字列
  174. 30080 REM RYAKUGOU$  :　略号を並べた文字列
  175. 30090 REM II         :　使い捨て
  176. 30100 REM JJ         :　何ブロック目？
  177. 30110 REM KK         :　（）の整合性
  178. 30120 REM EDFLG      :　）の後か？
  179. 30130 REM FORM$      :　入力された文字列
  180. 30140 REM TEMP$      :　使い捨て
  181. 30150 REM TEMP       :　使い捨てTEMP$のアスキーコード
  182. 30160 REM ERO        :　エラー番号
  183. 30170 REM ATM$       :　切り出した元素又は略号
  184. 30180 REM KETA       :　数字の桁数
  185. 30190 REM BUNSHIKI$  :　分子式
  186. 30200 REM MOLWGT     :　分子量
  187. 30210 REM YN$        :　キー入力（Ｙ　ＯＲ　Ｎ）
  188. 30220 REM KOSUU      :　切り出した元素又は略号の個数
  189. 30230 REM SRC$       :　検索すべき文字列
  190. 30240 REM PRSNC      :　検索で見つかった位置
  191.