Цифровая модель процесса теплообмена в твердом теле (для МАНГУСТА, и для других)

[Петр Иванович]

В основном это написано для МАНГУСТА, но возможно, кому-то еще понравится эта модель.

Модель (двухмерная) реализована в формате Excel-2007, файл *.xlsm со встроенным макросом можно скачать здесь:
http://yadi.sk/d/VhcvHA9LQPUF

Рисунок, иллюстрирующий работу макроса, вот:


Идея модели - имеется твёрдое тело, в одну точку которого - в точку А13 бьёт излучение лазера (мазера). В ячейке A1 можно указать другую мощность лазера, желательно в пределах 1-1000.
Теплота, получаемая точкой А13 вв виде электромагнитного излучения, за некоторое время t цикла полностью разлетается (переизлучается молекулами ячейки) по соседям - четверть - соседней ячейке В2, четверть - ячейке сверху А12, четверть - ячейку снизу А14, четверть - обратно в "атмосферу". И так - каждая ячейка (домен атомов или молекул, входящих в состав твёрдого тела).
Для упрощения принято, что окружающая тело атмосфера полностью, т.е. абсолютно прозрачна для переизлучаемого твёрдым телом теплового электромагнитного излучения, то есть тепловое излучение, вылетевшее за пределы твердого тела, назад из атмосферы не переизлучается. То есть в этой модели мы имеем по сути не газовую атмосферу, а физический вакуум.
Если бы так было на самом деле, то нафиг были бы нужны вееры, вентиляторы, кулеры на процессорных радиаторах и т.д.

Для работы макроса надо разрешить поддержку макросов Excel'ом и запустить макрос "Теплообмен".
Перед запуском можно зайти в макрос, визуально просмотреть его код, убедиться в отсутствии вирусов - именно поэтому я не поставил макрос в автозапуск.

[Петр Иванович]

Для тех, кто еще пользуется ранними Excel'ами, выкладываю полный код макроса тут:

Sub Теплообмен()
'
' Теплообмен Макрос
'
' Сочетание клавиш: Ctrl+Shift+Q
'
    Dim Q(20, 25) As Single  'количество тепла в ячейке
    Dim A(20, 25) As Single 'количество тепла, передаваемое этой ячейкой соседям
   
10  'Сколько тепла ячейка передаёт соседям
    For iR = 0 To 20
    For iC = 0 To 25
    A(iR, iC) = Q(iR, iC) / 4
    Next iC
    Next iR
   
    'Тепло, улетевшее в окружающее пространство, пропадает
    For iC = 0 To 25
    A(0, iC) = 0
    A(20, iC) = 0
    Next iC
   
    For iR = 0 To 20
    A(iR, 0) = 0
    A(iR, 25) = 0
    Next iR
   
    For iR = 1 To 19
    For iC = 1 To 24
    Q(iR, iC) = A(iR + 1, iC) + A(iR - 1, iC) + A(iR, iC + 1) + A(iR, iC - 1)
    Next iC
    Next iR
   
    'Нагрев основной ячейки
    Q(10, 1) = Q(10, 1) + Cells(1, 1)
 
    'Рисуем цветную картинку
    For iR = 1 To 19
    For iC = 1 To 24
   
    Cells(iR + 3, iC) = Round(Q(iR, iC))
   
    Select Case Round(Q(iR, iC))
    Case 1 To 10
    Cells(iR + 3, iC).Font.Color = RGB(100, 0, 0)
    Case 11 To 50
    Cells(iR + 3, iC).Font.Color = RGB(180, 0, 0)
    Case 51 To 150
    Cells(iR + 3, iC).Font.Color = RGB(255, 0, 0)
    Case Else
    Cells(iR + 3, iC).Font.Color = RGB(0, 0, 0)
    End Select
   
    If Q(iR, iC) > 254 Then Cells(iR + 3, iC).Interior.Color = RGB(255, Round(Q(iR, iC) / 3), 0) Else: Cells(iR + 3, iC).Interior.Color = RGB(Round(Q(iR, iC)), 0, Round(255 - Q(iR, iC)))
    Next iC
    Next iR

GoTo 10
   
End Sub


То есть этот макрос можно попросту скопировать в свой Excel и запустить - в нем нет никаких операторов, несовместимых с более ранними версиями Excel.

[Мангуст]

Пётр Иванович, спасибо за инфу!