16.04.2014, 21:46 | #1 (permalink) |
Member
Регистрация: 16.04.2014
Сообщений: 51
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Помогите пожалуйста с задачкой, Fortran, Pascal
Код:
external F Dimension a(5,6),B(5) Real a,B Integer I,j 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.1,1.8,-0.83,8.9,-3.05,0.15,-1.7,4.1,2.0/ !read(*,*)A write(*,45) 45 format(6x,'Matrica A') write(*,76)((A(i,j),j=1,6,1),i=1,5,1) 76 format(6(3x,f5.2)) Do j=1,6,1 Do i=1,5,1 B(i)=0 B(i)=A(I,j) enddo call RAZD(B,5,F,L) do i=1,5,1 a(i,j)=b(i) enddo enddo write(*,*)'in UPOR' pause write(*,*) 'out Upor' ! call Upor(a,5,6) write(*,55) 55 format(6x, 'perestavlennaya Matrica A') write(*,76)((a(i,j),j=1,6,1),i=1,5,1) END Real function F(x) real x F=x return end Subroutine RAZD (A, m, F, K) Dimension A(M) Integer i, j, m, k logical p Real A,x i=1 j=M do while (i<j) if (F(A(i)).GE.0) then p=.true. do while (j>i .and. P) If (F(A(j))<0) then x=a(i) A(i)=A(j) A(j)=x p=.false. endif j=j-1 enddo Endif i=i+1 Enddo if (j.eq.M) then k=j+1 else If (p) then k=i-1 else k=j Endif Endif return end |
16.04.2014, 21:46 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Я уверен, что решение вашей проблемы имеется по этим ссылкам Помогите, пожалуйста, подредактировать, Pascal Пожалуйста, помогите решить простую задачу по информатике в FORTRAN про массив Пожалуйста, помогите с программой. Free Pascal Pascal ABC, запуталась, помогите пожалуйста Помогите с задачкой пожалуйста по С++. |
17.04.2014, 15:16 | #2 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Да знаете - я уж как-то по-своему. Если устроит:
Код:
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 Razd(var R:Vect; var Nr:Byte); var k,l,p:byte; d:real; bu:boolean; begin p:=1; for k:=1 to M do begin if R[k]<0 then Inc(p) else begin bu:=false; l:=k; repeat Inc(l); if l<=M then if R[l]<0 then begin d:=R[k]; R[k]:=R[l]; R[l]:=d; Inc(p); bu:=true; end; until bu or (l>=M); end; end; Nr:=p; end; Procedure Upor(g:byte; var U:vect); var p,q:Byte; d:Real; begin for p:=g to M-1 do for q:=g to M-p+g-1 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; Nom:Array[1..N] of Byte; Begin ClrScr; B:=A; Output(B); for j:=1 to N do begin for i:=1 to M do V[i]:=B[i,j]; Razd(V,Nom[j]); for i:=1 to M do B[i,j]:=V[i]; end; Output(B); for j:=1 to N do begin for i:=1 to M do V[i]:=B[i,j]; Upor(Nom[j],V); for i:=1 to M do B[i,j]:=V[i]; end; Output(B); ReadKey End. |
17.04.2014, 21:36 | #3 (permalink) |
Member
Регистрация: 16.04.2014
Сообщений: 51
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Круто!
Спасибо большое!!!
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|