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

[maksimkuz]

Помогите, пожалуйста, с задачкой. 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

 

[Vladimir_S]

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

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.

 

[maksimkuz]

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