home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / imd / imd.bas
Encoding:
BASIC Source File  |  1988-05-13  |  8.0 KB  |  245 lines
  1. 10 REM  This program will calculate 3rd order, 5th order, 7th order, and 
  2. 20 REM  three transmitter intermodulation products.  The hit width is
  3. 30 REM  variable to 999Khz.  Enter a zero (0) when finished enteriing
  4. 40 REM  transmitter or receiver frequencies.
  5. 50 REM '
  6. 60 REM '
  7. 70 REM            THIS PROGRAM IS OF UNKNOWN ORIGIN.  
  8. 71 REM '
  9. 80 REM  This program has been modified to it's present state by
  10. 90 REM                     Jerry Waclawski
  11. 100 REM                    4508 Mark Ave.
  12. 110 REM                    Las Vegas, NV  89108
  13. 120 REM '
  14. 130 REM '
  15. 140 REM '
  16. 150   REM                         *** INPUT DATA  TRANSMITTERS ***
  17. 160   '
  18. 170   '
  19. 180 DEFDBL R,T
  20. 190   A = 0
  21. 200  DIM T(100)
  22. 210  PRINT CHR$(12)
  23. 220  PRINT TAB(33);"I N T E R M O D"
  24. 230  PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
  25. 240  INPUT "ENTER SITE NAME:  ",S$
  26. 250  PRINT
  27. 260  INPUT "ENTER DATE  (MM/DD/YY):  ",D$
  28. 270  PRINT
  29. 280  INPUT "ENTER HIT WINDOW WIDTH IN KHZ: ",W
  30. 290  PRINT
  31. 300  W = W/1000
  32. 310  A = A + 1
  33. 320  INPUT "ENTER TRANSMIT FREQUENCY:  ",T(A)
  34. 330  IF T(A) = 0 THEN 390
  35. 340  IF T(A) > 999 THEN 350 ELSE 360
  36. 350  PRINT CHR$(7);"TX FREQUENCY MUST BE LESS THEN 999 MHZ.":GOTO 320
  37. 360  FRMT$=      "T     ##     ###.####"
  38. 370  PRINT USING FRMT$;A,T(A)
  39. 380  GOTO 310
  40. 390  INPUT "DO YOU WANT A PRINTOUT?  (Y/N)",A$
  41. 400  IF A$ = "Y" THEN GOSUB 690
  42. 410  INPUT "DO YOU WANT TO CORRECT OR ADD XMITS?  (Y/N)",A$
  43. 420  IF A$ <> "Y" THEN 460
  44. 430  INPUT "ENTER TRANSMITTER NUMBER TO CHANGE",A
  45. 440  INPUT "ENTER NEW TX FREQ.",T(A)
  46. 450  GOTO 410
  47. 460  INPUT "DO YOU WANT A PRINTOUT AGAIN?  (Y/N)",A$
  48. 470  IF A$ = "Y" THEN GOSUB 690 ELSE 560
  49. 480  PRINT CHR$(12)
  50. 490  '
  51. 500  '
  52. 510  '
  53. 520  '
  54. 530  REM   *** START TRANSMIT BUBBLESORT ***
  55. 540  '
  56. 550  '
  57. 560  A = 0                         'RESET A
  58. 570  F = 1                         'SET FLAG
  59. 580  A = A + 1                     'STEP A UP ONE
  60. 590  IF T(A+1) = 0 THEN 620        'CHECK IF OUT OF DATA
  61. 600  IF T(A) > T(A+1) THEN 640     'GOTO SWAP ROUTINE 
  62. 610  GOTO 580                      'FETCH ANOTHER
  63. 620  IF F = 0 THEN 560             'OUT OF DATA  GO AGAIN
  64. 630  GOTO 840                      'OUT OF DATA AND FLAG SET
  65. 640  X = T(A)                      'SAVE T(A)
  66. 650  T(A) = T(A+1)                 'SWAP
  67. 660  T(A+1) = X                    'SWAP
  68. 670  F=0                           'RESET FLAG
  69. 680  GOTO 580                      'FETCH ANOTHER
  70. 690  LPRINT
  71. 700  LPRINT "T R A N S M I T T E R S";TAB(37);"SITE: ";S$;TAB(66);"DATE: ";D$
  72. 710  LPRINT
  73. 720  A = 0
  74. 730  A = A+1
  75. 740  IF T(A)=0 THEN RETURN
  76. 750  LPRINT USING "   T ##     ###.####";A,T(A)
  77. 760  GOTO 730
  78. 770  '
  79. 780  '
  80. 790  '
  81. 800  '
  82. 810  REM                        *** INPUT DATA  RECEIVERS ***
  83. 820  '
  84. 830  '
  85. 840  D=0
  86. 850  DIM R(100)
  87. 860  PRINT CHR$(12)
  88. 870  D=D+1
  89. 880  INPUT "ENTER RECEIVER FREQ:  ",R(D)
  90. 890  IF R(D)=0 THEN 950
  91. 900  IF R(D) > 999 THEN 910 ELSE 920
  92. 910  PRINT CHR$(7);"RX FREQUENCY MUST BE LESS THEN 999 MHZ":GOTO 880
  93. 920  FRMT$=  "R     ##     ###.####"
  94. 930  PRINT USING FRMT$;D,R(D)
  95. 940  GOTO 870
  96. 950  INPUT "DO YOU WANT A PRINTOUT?  (Y/N)",A$
  97. 960  IF A$="Y" THEN GOSUB 1250
  98. 970  INPUT "DO YOU WANT TO CORRECT OR ADD RECS?  (Y/N)",A$
  99. 980  IF A$ <> "Y" THEN 1020
  100. 990  INPUT "ENTER RECEIVER NUMBER TO CHANGE OR ADD",D
  101. 1000  INPUT "ENTER NEW RECEIVER FREQUENCY",R(D)
  102. 1010  GOTO 970
  103. 1020  INPUT "DO YOU WANT A PRINTOUT AGAIN?  (Y/N)",A$
  104. 1030  IF A$="Y" THEN GOSUB 1250 ELSE 1120
  105. 1040  PRINT CHR$(12)
  106. 1050  '
  107. 1060  '
  108. 1070  '
  109. 1080  '
  110. 1090  REM   *** START RECEIVE BUBBLESORT ***
  111. 1100  '
  112. 1110  '
  113. 1120 D = 0                         'RESET D
  114. 1130 F = 1                         'SET FLAG
  115. 1140 D = D+1                       'STEP D UP ONE
  116. 1150 IF R(D+1) = 0 THEN 1180       'CHECK IF OUT OF DATA
  117. 1160 IF R(D) > R(D+1) THEN 1200    'GOTO SWAP ROUTINE
  118. 1170 GOTO 1140                     'FETCH ANOTHER
  119. 1180 IF F=0 THEN 1120              'OUT OF DATA GO AGAIN
  120. 1190 GOTO 1400                     'OUT OF DATA AND FLAG SET
  121. 1200 X=R(D)                        'SAVE R(D)
  122. 1210 R(D) = R(D+1)                 'SWAP
  123. 1220 R(D+1) = X                    'SWAP
  124. 1230 F = 0                         'RESET FLAG
  125. 1240 GOTO 1140                     'FETCH ANOTHER
  126. 1250 LPRINT
  127. 1260 LPRINT "R E C E I V E R S ";TAB(37);"SITE: ";S$;TAB(66);"DATE: ";D$
  128. 1270 LPRINT
  129. 1280 D = 0
  130. 1290 D = D+1
  131. 1300 IF R(D) = 0 THEN RETURN
  132. 1310 LPRINT USING "R ##     ###.####";D,R(D)
  133. 1320 GOTO 1290
  134. 1330 '
  135. 1340 '
  136. 1350 '
  137. 1360 '
  138. 1370 REM                           *** START IM CALCULATIONS ***
  139. 1380 '
  140. 1390 '
  141. 1400 K = 0
  142. 1410 K = K+1
  143. 1420 IF K = 5 THEN 1900
  144. 1430 ON K GOSUB 1550,1670,1680,1750
  145. 1440 A = 1
  146. 1450 E = 1
  147. 1460 E = E+1
  148. 1470 IF E = A THEN 1500
  149. 1480 ON K GOSUB 1820,1840,1860,1880
  150. 1490 GOSUB 2200
  151. 1500 IF T(E) <> 0 THEN 1460
  152. 1510 IF T(A) = 0 THEN 1410
  153. 1520 A = A+1
  154. 1530 E =1
  155. 1540 GOTO 1470
  156. 1550 LPRINT CHR$(12)
  157. 1560 GOSUB 2380
  158. 1570 LPRINT
  159. 1580 LPRINT TAB(14);"   I N T E R M O D    P R O G R A M      "; "(+/-";W*1000;"KHZ)"
  160. 1590 LPRINT:LPRINT
  161. 1600 LPRINT "SITE:  ";S$;TAB(58);"DATE:  ";D$
  162. 1610 LPRINT:LPRINT:LPRINT
  163. 1620 GOSUB 2380
  164. 1630 LPRINT TAB(25);"THIRD ORDER INTERMOD PRODUCTS";TAB(64);"+/-";W*1000;"Khz"
  165. 1640 LPRINT:LPRINT
  166. 1650 LPRINT "Receiver    2X Trans          Trans               IM Freq                Error"
  167. 1660 LPRINT
  168. 1670 RETURN
  169. 1680 LPRINT:LPRINT:LPRINT
  170. 1690 GOSUB 2380
  171. 1700 LPRINT TAB(25);"FIFTH ORDER INTERMOD PRODUCTS";TAB(64);"+/-";W*1000;"Khz"
  172. 1710 LPRINT
  173. 1720 LPRINT"Receiver     3X Trans          2X Trans            IM Freq                Error"
  174. 1730 LPRINT
  175. 1740 RETURN
  176. 1750 LPRINT:LPRINT:LPRINT
  177. 1760 GOSUB 2380
  178. 1770 LPRINT TAB(24);"SEVENTH ORDER INTERMOD PRODUCTS";TAB(64);"+/-";W*1000;"Khz"
  179. 1780 LPRINT
  180. 1790 LPRINT"Receiver    4X Trans          3X Trans            IM Freq                Error"
  181. 1800 LPRINT
  182. 1810 RETURN
  183. 1820 G = T(A) + T(A) - T(E)
  184. 1830 RETURN
  185. 1840 G = T(A) + T(A) +T(E)
  186. 1850 RETURN
  187. 1860 G = T(A) + T(A) + T(A) - T(E) - T(E)
  188. 1870 RETURN
  189. 1880 G = T(A) + T(A) + T(A) + T(A) - T(E) - T(E) - T(E)
  190. 1890 RETURN
  191. 1900 LPRINT:LPRINT:LPRINT
  192. 1910 GOSUB 2380
  193. 1920 LPRINT TAB(21);"THREE TRANSMITTER THIRD ORDER PRODUCTS";TAB(64);"+/-";W*1000;"Khz"
  194. 1930 LPRINT
  195. 1940 LPRINT "Receiver     Trans          Trans          Trans            IM Freq       Error"
  196. 1950 LPRINT
  197. 1960 A = 1
  198. 1970 B = 2
  199. 1980 C = 2
  200. 1990 C = C+1
  201. 2000 IF C = A OR C = B THEN 2030
  202. 2010 G = T(A) + T(B) - T(C)
  203. 2020 GOSUB 2200
  204. 2030 IF T(C+1) <> 0 THEN 1990
  205. 2040 IF T(B+1) = 0 THEN 2080
  206. 2050 B = B+1
  207. 2060 C = 1
  208. 2070 GOTO 2000
  209. 2080 IF T(A+2) = 0 THEN 2410
  210. 2090 A = A+1
  211. 2100 B = A+1
  212. 2110 C = 1
  213. 2120 GOTO 2000
  214. 2130 '
  215. 2140 '
  216. 2150 '
  217. 2160 '
  218. 2170 REM                          *** COMPARE SUBROUTINES ***
  219. 2180 '
  220. 2190 '
  221. 2200 D = 0
  222. 2210 D=D+1
  223. 2220 IF R(D) = 0 THEN 2280
  224. 2230 H = (G-R(D))
  225. 2240 J = ABS(H)
  226. 2250 IF J >(W+.001)THEN 2210
  227. 2260 ON K GOSUB 2290,2320,2290,2290,2350
  228. 2270 GOTO 2210
  229. 2280 RETURN
  230. 2290 FRMT$= "###.####  = ###.####     -    ###.####            ###.####              #### Khz"
  231. 2300 LPRINT USING FRMT$;R(D),T(A),T(E),G,H*1000
  232. 2310 RETURN
  233. 2320 FRMT$="###.####      -    ###.####            ###.####               ####Khz"
  234. 2330 LPRINT USING FRMT$;R(D),T(A),T(E),G,H*1000
  235. 2340 RETURN
  236. 2350 FRMT$="###.####  =  ###.####   +   ###.####   -   ###.####         ###.####      ####Khz"
  237. 2360 LPRINT USING FRMT$;R(D),T(A),T(B),T(C),G,H*1000
  238. 2370 RETURN
  239. 2380 FOR X=1 TO 79:LPRINT "*";:NEXT X
  240. 2390 RETURN
  241. 2400 LPRINT:LPRINT
  242. 2410 LPRINT "END OF PROGRAM----BYE FOR NOW"
  243. 2420 LPRINT CHR$(12)
  244. 2430 END