Подпрограммы (Контрольные вопросы – правильные варианты)

Нахождение максимального элемента одномерного массива D(N)

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

CALL Max(D,K,Dmax) ! вызов процедуры

write(*,'(a,f5.1)') ' Dmax=',Dmax ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Max(A,N,Amax)

REAL A(N),Amax

Amax=A(1) ! начальное значение максимального элемента

do i=1,N ! цикл по элементам

if (A(i)>Amax) Amax=A(i) ! проверка на максимум

enddo

END SUBROUTINE Max

!*********************************************************

- использование общего блока памяти для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

common /com/ Dmin,Dmax,Sum,Pr ! общий блок памяти

CALL Max(D,K) ! вызов процедуры

write(*,'(a,f5.1)') ' Dmax=',Dmax ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Max(A,N)

REAL A(N),Amax

common /com/ Amin,Amax,S,P ! общий блок памяти

Amax=A(1) ! начальное значение максимального элемента

do i=1,N ! цикл по элементам

if (A(i)>Amax) Amax=A(i) ! проверка на максимум

enddo

END SUBROUTINE Max

!*********************************************************

Нахождение минимального элемента MIN одномерного массива D(N)

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

REAL Dmin ! минимальный элемент

CALL Min(D,K,Dmin) ! расчет минимального элемента

write(*,'(a,f5.1)') ' Dmin=',Dmin ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Min(A,N,Amin)

REAL A(N),Amin

Amin=A(1) ! начальное значение минимального элемента

do i=1,N ! цикл по элементам

if (A(i)<Amin) Amin=A(i) ! проверка на минимум

enddo

END SUBROUTINE Min

!*********************************************************

- использование общего блока памяти для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

common /com/ Dmin,Dmax,Sum,Pr ! общий блок памяти

CALL Min(D,K) ! вызов процедуры

write(*,'(a,f5.1)') ' Dmin=',Dmin ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Min(A,N)

REAL A(N)

common /com/ Amin,Amax,S,P ! общий блок памяти

Amin=A(1) ! начальное значение минимального элемента

do i=1,N ! цикл по элементам

if (A(i)<Amin) Amin=A(i) ! проверка на минимум

enddo

END SUBROUTINE Min

!*********************************************************

Нахождение суммы элементов Sum одномерного массива D(N)

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

CALL Summa(D,K,Sum) ! вызов процедуры

write(*,'(a,f5.1)') ' S=',Sum ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Summa(A,N,S)

REAL A(N),S

S=0 ! начальное значение суммы

do i=1,N ! цикл по строкам

S=S+A(i) ! поиск суммы S

enddo

END SUBROUTINE Summa

!*********************************************************

- использование общего блока памяти для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

common /com/ Dmin,Dmax,Sum,Pr ! общий блок памяти

CALL Summa(D,K) ! вызов процедуры

write(*,'(a,f5.1)') ' S=',Sum ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Summa(A,N)

REAL A(N),S

common /com/ min,max,S,P ! общий блок памяти

S=0 ! начальное значение суммы

do i=1,N ! цикл по строкам

S=S+A(i) ! поиск суммы S

enddo

END SUBROUTINE Summa

!*********************************************************

Нахождение произведения элементов Pr одномерного массива D(N)

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

CALL Proizv(D,K,Pr) ! вызов процедуры

write(*,'(a,f8.1)') ' P=',Pr ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Proizv(A,N,P)

REAL A(N),P

P=1 ! начальное значение произведения

do i=1,N ! цикл по строкам

P=P*A(i) ! поиск произведения

enddo

END SUBROUTINE Proizv

!*********************************************************

- использование общего блока памяти для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

common /com/ Dmin,Dmax,Sum,Pr ! общий блок памяти

CALL Proizv(D,K) ! вызов процедуры

write(*,'(a,f8.1)') ' P=',Pr ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Proizv(A,N)

REAL A(N),P

common /com/ min,max,S,P ! общий блок памяти

P=1 ! начальное значение произведения

do i=1,N ! цикл по строкам

P=P*A(i) ! поиск произведения

enddo

END SUBROUTINE Proizv

!*********************************************************

Замена отрицательных элементов одномерного массива D(N) на 1

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

CALL Exchange(D,K) ! вызов процедуры

write(*,'(100f5.1)') (D(i),i=1,K) ! вывод элементов

end program Lab8

!*********************************************************

SUBROUTINE Exchange(A,N)

REAL A(N)

do i=1,N ! цикл по элементам

if (A(i)<0) A(i)=1 ! замена

enddo

END SUBROUTINE Exchange

!*********************************************************

Сортировка элементов одномерного массива D(N) по возрастанию

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::K=5; ! количество элементов

REAL D(K)/1.5, -4.6, 10, -1.7, -4.9/ ! массив D

CALL Sort(D,K) ! вызов процедуры

write(*,'(100f5.1)') (D(i),i=1,K) ! вывод элементов

end program Lab8

!*********************************************************

SUBROUTINE Sort(A,N)

REAL A(N)

do j=1,N-1 ! первый цикл по элементам

do i=1,N-1 ! второй цикл по элементам

if (A(i)>A(i+1)) then ! обмен значениями через буфер AA

AA=A(i); A(i)=A(i+1); A(i+1)=AA;

endif

enddo

enddo

END SUBROUTINE Sort

!*********************************************************

Нахождение минимального элемента Bmin двумерного массива B(N,M)

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::N=2,M=3; ! количество строк и столбцов

REAL B(N,M)/12, 6.1, 4, 1, -7, 7/ ! массив B

CALL Min(B,N,M,Bmin) ! вызов процедуры

write(*,'(a,f5.1)') ' Bmin=',Bmin ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Min(A,N,M,Amin)

REAL A(N,M),Amin

Amin=A(1,1) ! начальное значение минимального элемента

do j=1,M ! цикл по столбцам

do i=1,N ! цикл по строкам

if (A(i,j)<Amin) Amin=A(i,j) ! проверка на минимум

enddo

enddo

END SUBROUTINE Min

!*********************************************************

Нахождение максимального элемента Bmax двумерного массива B(N,M)

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::N=2,M=3; ! количество строк и столбцов

REAL B(N,M)/12, 6.1, 4, 1, -7, 7/ ! массив B

CALL Max(B,N,M,Bmax) ! вызов процедуры

write(*,'(a,f5.1)') ' Bmax=',Bmax ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Max(A,N,M,Amax)

REAL A(N,M),Amax

Amax=A(1,1) ! начальное значение максимального элемента

do j=1,M ! цикл по столбцам

do i=1,N ! цикл по строкам

if (A(i,j)>Amax) Amax=A(i,j) ! проверка на максимум

enddo

enddo

END SUBROUTINE Max

!*********************************************************

Нахождение суммы элементов Sum двумерного массива B(N,M)

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::N=2,M=3; ! количество строк и столбцов

REAL B(N,M)/12, 6.1, 4, 1, -7, 7/ ! массив B

CALL Summa(B,N,M,Sum) ! вызов процедуры

write(*,'(a,f5.1)') ' Sum=',Sum ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Summa(A,N,M,S)

REAL A(N,M),S

S=0 ! начальное значение суммы

do j=1,M ! цикл по столбцам

do i=1,N ! цикл по строкам

S=S+A(i,j) ! поиск суммы S

enddo

enddo

END SUBROUTINE Summa

!*********************************************************

Нахождение произведения элементов Pr двумерного массива B(N,M)

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::N=2,M=3; ! количество строк и столбцов

REAL B(N,M)/12, 6.1, 4, 1, -7, 7/ ! массив B

CALL Proizv(B,N,M,Pr) ! вызов процедуры

write(*,'(a,f8.1)') ' Pr=',Pr ! вывод результата

end program Lab8

!*********************************************************

SUBROUTINE Proizv(A,N,M,P)

REAL A(N,M),P

P=1 ! начальное значение произведения

do j=1,M ! цикл по столбцам

do i=1,N ! цикл по строкам

P=P*A(i,j) ! поиск произведения

enddo

enddo

END SUBROUTINE Proizv

!*********************************************************

Замена положительных элементов двумерного массива B(N,M) на 0

- использование списка параметров для передачи результатов

!*********************************************************

program Lab8

INTEGER,PARAMETER::N=2,M=3; ! количество строк и столбцов

REAL B(N,M)/12, 6.1, 4, 1, -7, 7/ ! массив B

CALL Exchange(B,N,M) ! вызов процедуры

do i=1,N ! вывод результата

write(*,'(100f5.1)') (B(i,j),j=1,M)

enddo

end program Lab8

!*********************************************************

SUBROUTINE Exchange(A,N,M)

REAL A(N,M)

do j=1,M ! цикл по столбцам

do i=1,N ! цикл по строкам

if (A(i,j)>0) A(i,j)=0 ! замена

enddo

enddo

END SUBROUTINE Exchange

!*********************************************************

15