Нужно перевести вот эту функцию:
Код:
Subroutine KGAUSS(Ab, N, X, IAI)
Real(8) Ab(N,N+1), X(N) ! Описание массивов
IAI=1
Do k=1, N ! <==> For k=1 To N ! Перебор строк - шаги прямого хода
Call CMEHA ! Выбор и анализ гл. элемента
If( IAI == 0 ) Return ! <==> Exit Sub ! Выход, если гл. элемент = 0
Do i=k+1, N ! Перебор строк с k+1-ой по N-ую
Ab(i,k) = Ab(i,k)/Ab(k,k)
Ab(i,k+1:N+1) = Ab(i,k+1:N+1) - Ab(i,k)*Ab(k,k+1:N+1)
End Do
End Do ! <==> Next k
Do k = N, 1,-1 ! Обратная подстановка (обратный ход)
X(k)=Ab(k,N+1)/Ab(k,k)
Ab(1:N-1,N+1) = Ab(1:N-1,N+1) - Ab(1:N-1,k)*X(k)
End Do
Contains ! -------Внутренние подпрограммы: ----------------------------------------
Subroutine CMEHA ! Процедура выбора гл. элемента и перестановки строк
Real(8) W(N+1) ; Integer L(1) ! Описание массивов
L=MaxLoc(abs(Ab(K:N,K))) ! Опр. номера строки с гл. элементом
W=Ab(K,:); Ab(K,:)=Ab(L(1)+K-1,:); Ab(L(1)+K-1,:)=W ! Перестановки
If(abs(Ab(K,K) )== 0D0) IAI=0 ! IAI - признак вырожденности системы
End Subroutine
End
Начал делать, но не получается перестановка (прошу помощи):
Код:
Sub KGAUSS(Ab() As Double, N, X() As Double, IAI)
'Real(8) Ab(N,N+1), X(N) ! Описание массивов
Dim j As Long 'переменная для реализации неявного цикла "Ab(i,k+1:N+1)"
Dim mx As Double, L As Long
IAI = 1
For k = 1 To N ' Перебор строк - шаги прямого хода
GoSub CMEHA ' Выбор и анализ гл. элемента
If IAI = 0 Then Exit Sub ' Выход, если гл. элемент = 0
For i = k + 1 To N ' Перебор строк с k+1-ой по N-ую
Ab(i, k) = Ab(i, k) / Ab(k, k)
For j = k + 1 To N + 1
Ab(i, j) = Ab(i, j) - Ab(i, k) * Ab(k, j)
Next
Next
Next 'k
For k = N To 1 Step -1 ' Обратная подстановка (обратный ход)
X(k) = Ab(k, N + 1) / Ab(k, k)
For j = 1 To N - 1
Ab(j, N + 1) = Ab(j, N + 1) - Ab(j, k) * X(k)
Next
Next
Exit Sub
CMEHA: ' Процедура выбора гл. элемента и перестановки строк
'Real(8) W(N+1) ; Integer L(1) ! Описание массивов
'L=MaxLoc(abs(Ab(K:N,K))) ! Опр. номера строки с гл. элементом
mx = 0
L = 0
For j = k To N
If Abs(Ab(j, k)) > mx Then L = j: mx = Ab(j, k)
Next
'W=Ab(K,:); Ab(K,:)=Ab(L(1)+K-1,:); Ab(L(1)+K-1,:)=W ! Перестановки
'==недоделано: надо реализовать перестановку
If Ab(k, k) = 0# Then IAI = 0 ' IAI - признак вырожденности системы
Return
End Sub