Технический форум - Помогите, пожалуйста, с задачкой. Fortran, Pascal

Технический форум (http://www.tehnari.ru/)

- Помощь студентам (http://www.tehnari.ru/f41/)

Помогите, пожалуйста, с задачкой. Fortran, Pascal

нужно перевести с фортрана на паскаль

use MSFLIB
real a(5,6), s, SUMM, F
integer i, j
external F
common /matr/a
data a/5.3,-0.25,1.35,2.25,-0.5, 2.1,7.1,-2.5,0.9,-1.7, &
-3.2,4.3,6.83,-4.3,3.7, -1.25,-0.7,0.35,5.25,-1.25, &
0.5,-1.5,1.8,-0.83,8.9, -3.05,0.15,-1.7,4.1,2.0/

i=SYSTEMQQ('CHCP 1251 > NUL')

!write(*,*)'Введите построчно вещественную матрицу A[5x6]'
!read(*,*)((a(i,j),j=1,6),i=1,5)

write(*,*)
write(*,*)'ИСХОДНАЯ МАТРИЦА:'
write(*,16)((a(i,j),j=1,6),i=1,5)
16 format(6(1X,F5.2))

do j=1,6,1
! call UPOR(a(1,j),5,1)
enddo

s=5.5
!s=SUMM(F,1,5,1)

write(*,*)
write(*,*)'УПОРЯДОЧЕННАЯ МАТРИЦА:'
write(*,16)((a(i,j),j=1,6),i=1,5)
write(*,26)s
26 format(/1X,'Сумма элементов "ГД" в упорядоченной матрице равна ',F6.2/)

end

real function F(i)
integer i
real a(5,6)
common /matr/a

F=a(i,i)

return
end

Ну да, я ж понимаю - несмотря на то, что недавно была рассмотрена аналогичная (кстати, более сложная!) задачка с той же матрицей (тыц!), чуть-чуть пошевелить мозгами и переделать фактически готовое решение - ни! Неодолимо. Ну что же, ладно:

Код:

Uses CRT;



Const

 M=5;

 N=6;



Type

 Matr=Array[1..M,1..N] of Real;

 Vect=Array[1..M] of Real;



Const

 A:Matr=(( 5.30,  2.10, -3.20, -1.25,  0.50, -3.05),

         (-0.25,  7.10,  4.30, -0.70,-11.00,  0.15),

         ( 1.35, -2.50,  6.83,  0.35,  1.80, -1.70),

         ( 2.25,  0.90, -4.30,  5.25, -0.83,  4.10),

         (-0.50, -1.70, -3.70, -1.25,  8.90,  2.00));





Procedure Upor(var U:vect);

var

 p,q:Byte;

 d:Real;

begin

 for p:=1 to M-1 do

  for q:=1 to M-p do

   if U[q]>U[q+1] then

    begin

     d:=U[q];

     U[q]:=U[q+1];

     U[q+1]:=d;

    end;

end;



Procedure Output(T:Matr);

var p,q:Byte;

begin

 for p:=1 to M do

  begin

   for q:=1 to N do

    write(T[p,q]:8:2);

   writeln;

  end;

 writeln;

end;



Var

 B:Matr;

 V:Vect;

 i,j:Byte;

 Sum:Real;



Begin

 ClrScr;

 B:=A;

 Output(B);

 for j:=1 to N do

  begin

   for i:=1 to M do V[i]:=B[i,j];

   Upor(V);

   for i:=1 to M do B[i,j]:=V[i];

  end;

 Output(B);

 Sum:=0;

 for i:=1 to M do Sum:=Sum+B[i,i];

 Writeln;

 Writeln('Sum= ',Sum:0:3);

 ReadKey

End.

Cпасибо большое