Genadyruk
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
program profile_v_2
implicit none
real r, rmax
integer number_string, string
print*, 'Enter maximum radius'
read(*,*) rmax
rmax = rmax/60.
print*, 'Enter primary radius'
read(*,*) r
r = r/60.
string = number_string ('V0.txt')
call calculate ('V0.txt', 'profile_0.txt', string, r, rmax)
string = number_string ('V1.txt')
call calculate ('V1.txt', 'profile_1.txt', string, r, rmax)
string = number_string ('V2.txt')
call calculate ('V2.txt', 'profile_2.txt', string, r, rmax)
string = number_string ('V3.txt')
call calculate ('V3.txt', 'profile_3.txt', string, r, rmax)
string = number_string ('V4.txt')
call calculate ('V4.txt', 'profile_4.txt', string, r, rmax)
string = number_string ('V5.txt')
call calculate ('V5.txt', 'profile_5.txt', string, r, rmax)
string = number_string ('V6.txt')
call calculate ('V6.txt', 'profile_6.txt', string, r, rmax)
end program
!*************************************************
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function number_string(name1)
implicit none
character (*) name1
integer :: i = 0, ios = 0, number_string
open (10, file = name1, status = 'old')
do while (ios == 0)
read(10,*,iostat = ios)
i = i + 1
end do
number_string = i - 1
close (10)
end function
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!######################################################
!000000000000000000000000000000000000000000000000000000
subroutine calculate(name1, name2, string, r, rmax)
implicit none
character(*) name1, name2
real :: a, b, c, d, r0 = 0., r, rmax, x0, y0
! alpha -> x
! delta -> y
real, allocatable :: massive (:,:), x(:), y(:)
integer :: l = 3, k, ios = 0, i, j, m, string
k = string
allocate (massive (k,l), x(k), y(k))
open (20, file = name1, status = 'old')
do i = 1, k
read(20,*,iostat = ios) (massive(i,j), j = 1, l)
x(i) = massive (i, 2)
y(i) = massive (i, 3)
end do
deallocate (massive)
a = maxval (x)
b = minval (x)
c = maxval (y)
d = minval (y)
x0 = (a+b)/2
y0 = (c+d)/2
do i = 1, k
x(i) = x(i) - x0
y(i) = y(i) - y0
end do
open (21, file = name2, status = 'new')
m = 0
do while (r0.lt.rmax)
r0 = r0 + r
j = 0
m = m + 1
do i = 1, k
if (sqrt(x(i)**2 + y(i)**2).lt.r0) then
j = j + 1
end if
end do
write (21,*) m, j
end do
deallocate (x,y)
close (20)
close (21)
end subroutine
|
