Программа

1 R = 8.31

10   'Ввод данных
20 INPUT "Введите температуру ", T!
30 INPUT "Введите темпертуру Дебая ", Teta!
40 SCREEN 2                 'Переключение видеосистемы в графический режим
50 LeftOutGraph! = .01
60 RightOutGraph! = 3.5
70 GOSUB 1000               'Вывод графика
80 LOCATE 25, 3             'Установка курсора
85 X! = Teta! / T!
87 GOSUB 3000               'Вычисление
90 PRINT "Cv="; Cv!;        'Вывод результата
100 END

1000 'Процедура вывода графика
1010 MaxX% = 319                             'Максимальная координата X
1020 MaxY% = 199                             'Максимальная координата Y
1030 LINE (0, 0)-(MaxX%, MaxY%), 15, B       'Прорисовка рамки
1040 ScaleX! = (RightOutGraph! - LeftOutGraph!) / (MaxX% * 8) * 10
1041                                         'Вычисление масштаба по  оси X
1050 IF ScaleX! = 0 THEN ScaleX! = 1
1060            'Если масштаб по оси X равен 0, то переопределение масштаба
1070 'Поиск максимального и минимального значений функции
1071 'на выводимом промежутке:
1075 X! = LeftOutGraph!
1077 GOSUB 2000
1080 HiY! = F!          'Начальное определение максимума
1090 LoY! = HiY!        'Начальное определение минимума
1100 FOR MeterOutGraph% = 1 TO MaxX% * 8 / 10
1110                'Цикл просмотра значений функции на выводимом промежутке
1175 X! = LeftOutGraph! + MeterOutGraph% * ScaleX!
1177 GOSUB 2000
1120 BufY! = F!                          'Вычисление функции в текущей точке
1130 IF BufY! > HiY! THEN 'Если значение функции перевосходит максимальное
1140 HiY! = BufY!'то переопределение максимального значения функции
1150 ELSEIF BufY! < LoY! THEN 'Иначе, если значение функции меньше
1170  'минимального, то переопределение максимального значения функции
1180 LoY! = BufY!
1190 END IF
1200 NEXT MeterOutGraph%
1210 ScaleY! = (HiY! - LoY!) / (MaxY% * 8) * 10'Вычисление масштаба по  оси Y
1220 IF ScaleY! = 0 THEN ScaleY! = 1
1230            'Если масштаб по оси Y равен 0, то переопределение масштаба
1235 X! = LeftOutGraph!
1237 GOSUB 2000
1240 PSET (MaxX% / 10, MaxY% * 9 / 10 - (F - LoY!) / ScaleY!), 15
1250                                      'Прорисовка первой точки графика
1260 FOR MeterOutGraph% = 1 TO MaxX% * 8 / 10  'Цикл прорисовки графика
1265 X! = LeftOutGraph! + MeterOutGraph% * ScaleX!
1267 GOSUB 2000
1270 LINE -(MeterOutGraph%+MaxX%/10,MaxY%*9/10-(F-LoY!)/ScaleY!),15
1280                         'Прорисовка линии от предыдущей точки к текущей
1290 NEXT MeterOutGraph%
1300 OXy! = MaxY% * 9 / 10 + LoY! / ScaleY! 'Вычисление Y-координаты оси OX
1310 'Если Y-координата оси OX выходит за границу вывода,
1311 'то переопределение ее:
1320 IF OXy! > MaxY% * 19 / 20 THEN OXy! = MaxY% * 19 / 20
1330 IF OXy! < MaxY% / 20 THEN OXy! = MaxY% / 20
1340 LINE (MaxX% / 20, OXy!)-(MaxX% * 19 / 20, OXy!), 15 'Прорисовка оси OX
1360 'Прорисовка стрелки на оси OX:
1370 LINE (MaxX% * 19 / 20, OXy!)-(MaxX% * 18.5 / 20, OXy! + MaxY% / 90), 15
1380 LINE (MaxX% * 19 / 20, OXy!)-(MaxX% * 18.5 / 20, OXy! - MaxY% / 90), 15
1390 OYx! = MaxX% / 10 - LeftOutGraph! / ScaleX!
1391                                         'Вычисление X-координаты оси OY
1400 'Если X-координата оси OY выходит за границу вывода,
1401 'то переопределение ее:
1410 IF OYx! > MaxX% * 19 / 20 THEN OYx! = MaxX% * 19 / 20
1420 IF OYx! < MaxX% / 20 THEN OYx! = MaxX% / 20
1430 LINE (OYx!, MaxY% / 20)-(OYx!, MaxY% * 19 / 20), 15 'Прорисовка оси OY
1450 'Прорисовка стрелки на оси OY:
1460 LINE (OYx!,MaxY%/20)-(OYx!+MaxX%/120,MaxY%/20+MaxY%*9/160),15
1470 LINE (OYx!,MaxY%/20)-(OYx!-MaxX%/120,MaxY%/20+MaxY%*9/160),15
1480 RETURN

2000 'Связывание выводимой функции с вызовом из подпрограммы вывода графика
2007 GOSUB 3000
2010 F! = Cv!
2020 RETURN

3000 'Вычисление исследуемой функции
3002 LeftInt! = .00001
3004 RightInt! = X!
3006 BreakInt% = 4
3008 GOSUB 4000
3010 Cv! = 9 * R / (X!) ^ 3 * Integral!
3020 RETURN

4000 'Вычисление интеграла
4010 LenghtStepInt! = (RightInt! - LeftInt!) / BreakInt% / 2
4011                               'Вычисление длины шага интегрирования
4020 XInt! = LeftInt! + LenghtStepInt!
4021                         'Начальное определение промежуточной абсциссы
4030 Sum1! = 0               'Обнуление промежуточной суммы 1
4035 XFun! = XInt!
4037 GOSUB 5000
4040 Sum2! = Fun!         'Начальное определение промежуточной суммы 2
4050 FOR MeterInt% = 2 TO BreakInt%'Цикл набора промежуточных сумм
4060 XInt! = XInt! + LenghtStepInt!'Переопределение абсциссы
4065 XFun! = XInt!
4067 GOSUB 5000
4070 Sum1! = Sum1! + Fun!'Набор промежуточной суммы 1
4080 XInt! = XInt! + LenghtStepInt!'Переопределение абсциссы
4085 XFun! = XInt!
4087 GOSUB 5000
4090 Sum2! = Sum2! + Fun!'Набор промежуточной суммы 2
4100 NEXT MeterInt%
4102 XFun! = LeftInt!
4103 GOSUB 5000
4105 FunLeftInt! = Fun!
4106 XFun! = RightInt!
4107 GOSUB 5000
4108 FunRightInt! = Fun!
4110 Integral!=LenghtStepInt!/3*(FunLeftInt!+FunRightInt!+2*Sum1!+4*Sum2!)
4120                                       'Определение значения интеграла
4130 RETURN

5000 'Вычисление интегрируемой функции
5010 Fun! = XFun! ^ 4 * EXP(XFun!) / (EXP(XFun!) - 1) ^ 2
5020 RETURN