Подключение внешних подпрограмм - Fortran - Ответ 14096180

program itog
implicit none 
integer :: i, j
real :: s, h, v, Sb, P, sk , b, x, Fx, u
real :: x1, x2, y1, y2, x3, y3, x4, y4, d1, d2, d3, d4
integer,dimension(1:20) :: a
integer, dimension (1:5,1:5) :: Y, y1
real, parameter :: d=63.80, e=69.99, pi=3.14
 
open (2, file="itog.out")
 
print *,"choose lab number"
do
read(*,*) menu_number
if (check(menu_number)==1) then
exit
else
print*, "Ошибка в введении номера задания, введите номер заново"
end if
end do
select case (i) !МЕНЮ 
case (1) !лабораторная 1
 
open (1,file="lab1-.in")
read(1,*) s
read (1,*) h
read (1,*) v
close(1)
call lab1 (s, h, v, Sk, Sb, P)
write(2,*) "squares=", sb, sk, p
 
 
case(2)! лаболаторная 2
 
open (1, file="lab-02-task-04x.in" )
read (1,*) b
read (1,*) x
read (1,*) u
close(1)
call f(u,b,x,Fx)
write(2,*) "function value=", fx
 
case(3)! лаболаторная 3
open(1,file="lab-03-task-x.in")
read(1,*) x
read(1,*) s
close(1)
call sk(x,s,f)
write(2,*)  "fuction value2=" F
 
 
case(4)!лаболаторная 4
real :: x, y 
integer :: R, R1 
real, parameter :: d=63.80, e=69.99
open(2,file="lab-4-task-R.in.f90")
read(1,*) R
close(1)
call bank (R1,x,y)
write(2,*) "RUB=", R1  ,"dollar= ", x, "euro= ", y 
 
 
case(5)!лаболаторная 5
open(1,file="lab-5-task-f.in")
read(1,*) f
read(1,*) n
read(1,*) t
close(1)
call ameba (f,t,n)
write(2,*) n
print *, "*"
 
case (6) !лаболаторная 6.1
open(1,file="lab-6.1in")
do i=1,20
read(1,*) a(i)
enddo
close(1)
 call area1(a)
print*, "ВЫВОД МАССИВА"
write(2,*) "ОДНОМЕРНЫЙ МАССИВ" a(i)
 
case(7)!лаболаторная 6.2
 open(1,file="lab-6.2-task-.in")
 open(2,file="lab-6.2-k.in")
 read (2,*) k
 do i=1,5
 read (1,*) (y(i,j), j=1,5)
 end do
close(1)
call lb62(y,k,y1)
do i=1,5
 write (2,*) (y(i,j),j=1,5)   
 end do
 write (2,*) "massiv number two"
 do i=1,5
write (2,*) (y1(i,j),j=1,5) 
 end do
print *, "*"
 
case (8)
open (1,file="lab-08-task-07tr1.in")
do i=1,3
read (1,*) a
 
read (1,*)b 
 
read (1,*) h
 call lab8(a,b,h,p,summa)
end do
write (2,*) "Summa perimetrov trapeciy=" , summa
 
close(1)
print *, "*"
case(9)
open(1, file="lab-09-task-08.in")
read (1,*) x1, x2, y1, y2, x3, y3, x4, y4 
close(1)
call L8(x1, x2, y1, y2, x3, y3, x4, y4, d1, d2, d3, d4, p) 
 
write(2,*) "p=", p
 print *, "9"
 end select 
 end program itog
include "lab1vvod.f90"
include "laba2vvod1.f90"
include "laba3vvod.f90"
include "lab4vvod.f90"
include "vvod 5lab.f90"
include "lab6vvod.f90"
include "lab62vvod.f90"
include "lab-08.f90"
include "lab9..f90"

subroutine  L8(x1, x2, y1, y2, x3, y3, x4, y4, d1, d2, d3, d4, p) 
real :: x1, x2, y1, y2, x3, y3, x4, y4, d1, d2, d3, d4, p
call vector(x1, y1, x2, y2, d1)
 call vector(x2, y2, x3, y3, d2)
 call vector(x3, y3, x4, y4, d3)
 call vector(x1, y1, x4, y4, d4)
p=d1+d2+d3+d4
contains 
subroutine vector(x, y, x0, y0, d)
real::  y, x0, y0, d, x
d=sqrt(((x-x0)**2)+((y-y0)**2))
end subroutine vector
end subroutine  L8