Задача: График функции
Стр. 122, №138
Найдите область определения функции D{f)^ ее нули, экстремумы
и множество значений W{f). "Руками компьютера" постройте график
функции. Нарисуйте и разметьте оси координат. В дополнение
можно воспользоваться и средствами графического пакета {см. главу 10).
138. у = 2cos(x)
program array2d
implicit none
integer, parameter:: x = 40, y = 20!можно задать размерность
integer y0,x0
real yr, xr
do y0 = y,-y,-1
yr = y0/4.0!с помощью "4.0" можно настраивать шаг графика
do x0= x,-x,-1!в данном случае 4 точки это 1
xr = x0/4.0
if (abs(yr - 2**(cos(xr))) < 0.2) then!задаем пример; с помощью "2.0"& можно настраивать точность линии графика
write (*,"('0 ',$)")
else if ((x0 == 0).and. (y0 == 0)) then!система координат
write (*,"('+ ',$)")
else if (x0 == 0) then
write (*,"('| ',$)")
else if (y0 == 0) then
write (*,"('--',$)")
else
write (*,"('. ',$)")
end if
end do
write(*,*)
end do
write(*,*)'Область определения (-∞; +∞)'!сделать, чтобы программа сама& находила все это я не смог, но и в задании сказано, что руками компьютера& требуется только построить график
write(*,*)'Область значения [1/2; 2]'
write(*,*)'max f(каждые 2pk) = 2; min f(каждые p + 2pk) = 1/2 '
end program
Задача: Многомерные массивы
Стр. 158, №17
Решите приведенные ниже задачи, выделив головной и подчиненные
алгоритмы (процедуры). Входные данные (при необходимости)
выберите самостоятельно.
17. Проверьте, является ли матрица А размера т х т магическим
квадратом; m = 5.
program n_17
integer, dimension(5,5):: M
integer:: F, i, j, S, SK,d, L
F = 0
SK = 0
S = 0
d = 0
L = 0
read *,M!читаем матрицу, индекс присваивается через пробел
do i = 1,5!рассчитывает сумму по первой строке и делаем из нее эталонную сумму
SK = M(i,1) + SK
end do
al:do while (d == 0)!этот цикл нужен только для быстрого прекращения всех& циклов через exit
do i = 1,5!сравниваем строки между собой, если какая-то отличается то& циклы прекращаются
do j = 1,5!сумма всех элементов строки
S = M(i,j) + S
end do
if (SK /= S) then!сравнение строки с эталонной суммой
write (*,*) 'No Magic'
exit al
end if
S = 0!обнуление, чтобы можно было рассчитать сумму следующей& строки
end do
do j = 1,5!сравниваем столбцы между собой, если какой-то отличается то циклы прекращаются
do i = 1,5!сумма всех элементов столбца
S = M(i,j) + S
end do
if (SK /= S) then!сравнение столбца с эталонной суммой
write (*,*) 'No Magic'
EXIT al
end if
S = 0!обнуление, чтобы можно было рассчитать сумму следующего& столбца
end do
do i = 1,5!сумма всех элементов диагоналей
S = M(i,i) + S
L = M(i, 6-i) + L
end do
if ((SK /= S).or. (SK /= L)) then!сравнение диагоналей с эталонной суммой
write (*,*) 'No Magic'
EXIT al
end if
write (*,*) 'Magic'!ну и если все хорошо, то программа дойдет до этого& шага
d = 1
end do al
end program n_17
Задача: Внутренняя сортировка
Стр. 183, №114
Решите задачу внутренней сортировки
114. пирамидальную
program n_114
integer:: a
dimension:: a(13)
read *,A!ввод массива
write (*, '(13i5)') a
print *, 'result:'
call sort(a, 13)!вызываем функцию, массив в качестве аргумента
write (*, '(13i5)') a
end program
subroutine sort(a, n)!основная функция сортировки
integer:: n
integer:: i, k, w, n1
integer:: a
dimension:: a(13)
n1 = n/2!разбивка "пирамиды" на две части
do i = n1, 1, -1
call surface(a, i, n)
end do
do k = 13, 2, -1
call surface(a, 1, k)
w = a(k)
a(k) = a(1)
a(1) = w
end do
return
end
subroutine surface(a, ii, k)!функция сравнения элементов
integer i,ii, k
integer j, m, copy
integer a
dimension a(13)
i=ii
copy=a(i)
m = 2*i
do while (m <= k)
if (m == k) then
j = m
else if (a(m) > a(m+1)) then
j = m
else
j = m + 1
end if
if (a(j) > copy) then!присвоение большим элементам на уровне большего& индекса
a(i) = a(j)
i = j
m = 2*i
else
exit
end if
end do
a(i) = copy
return
end
задача: Строки и строковые функции
Стр. 398, №26
Решите сформулированные ниже задачи, выделив головной и подчиненные алгоритмы.
26. Найдите символы, которые встречаются в тексте лишь один только
раз
(в тексте, прикрепленном в задании, так же имелись буквы Русского алфавита, с которыми компилятор работает не очень корректно, поэтому оставлен текст только на английском)
program n26
implicit none
integer:: i, iv
character (len = 500):: buffer
buffer = ('Catch the hear before you sell his skin. &
Constant dropping wears the stone.&
dont count your chickens before they are hatched.')
al: do i = 1, len_trim(buffer)
do iv = 1, len_trim(buffer)
if (((buffer(i:i) == ' ').or. (buffer(i:i) == '.').or. (buffer(i:i) == buffer(iv:iv))).and. (i /= iv)) then
cycle al
end if
end do
write (*,'(A4,$)') buffer(i:i)
end do al
end program
Все программы исправно и правильно работают как в компиляторе Geany, так и в онлайн компиляторах. Первые 2 задачи были выполнены и сданы очно.