Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Фортран / Коды 5.2 / 5 вариант

.txt
Скачиваний:
0
Добавлен:
16.05.2024
Размер:
1.21 Кб
Скачать
PROGRAM variant_5

integer, parameter :: NMAX = 100, m = 2
integer :: B, n
real :: r
real :: A(NMAX,m)

call in_file(A, n, r)
do i=1, N-1
do j=i+1, N
value = FIND_S(a(i,1),a(i,2),a(j,1),a(j,2))
call compare(A, B, n)
end do
end do

if(B==1) then
do i=1, n
if(A(i,1)<0) then
A(i,1) = 0
A(i,2) = A(i,2) + r
end if
end do

end if

do i=1, n
write (*,*) A(i,1), A(i,2)
end do

END PROGRAM

real function FIND_S (x1, y1, x2, y2)

real :: x1, y1, x2, y2
FIND_S = sqrt(((x2-x1)**2)+((y2-y1)**2))


end function

subroutine compare(A, B, n)

integer, parameter :: NMAX = 100, m = 2
real, parameter :: r=1
integer :: n
logical :: flag
real :: A(NMAX,M)
integer :: B
flag = .true.
B = 0

do while (flag)
do i=1, n-1
do while (flag)
do j=i+1, n
value = FIND_S (A(i,1), A(i,2), A(j,1), A(j,2))
if(value > R) then
B = 1
flag = .false.

end if
end do
end do
end do
end do
end subroutine

subroutine in_file(A, n, real)

integer, parameter :: NMAX = 100
integer :: n
real A(NMAX,2)

open(3, file = 'in.txt')

read (3, *) n
read (3, *) r
do i=1, n
read(3,*) A(i,1), A(i,2)
end do

close(3)

end subroutine
Соседние файлы в папке Коды 5.2