современный фортран , Бортеньев. О. В. Бартеньев Современный Фортран
 Скачать 2.24 Mb.
|
|
195 О. В. Бартеньев. Современный ФОРТРАН 1000 0000 1001 1100 x YT YB y XR 0100 0110 0010 0001 0011 XL а б Рис. 6.2. Задача отсечения: а - коды областей; б - решение задачи отсечения Для сокращения кода программы сначала выполним все отсечения для вершины 1, а затем поменяем вершины 1 и 2 местами (вершине 2 дадим номер 1; вершине 1 - номер 2) и вновь продолжим исследование вершины 1. Алгоритм: Интерфейс: Входные данные: XL, XR - x-координаты правой и левой границ окна вывода; YB, YT - y-координаты нижней и верхней границ окна вывода; x1, y1 и x2, y2 - координаты вершин отрезка. Выходные данные: x1, y1 и x2, y2 - координаты вершин усеченного отрезка (или исходного, если отрезок целиком принадлежит окну вывода) после решения задачи отсечения. В случае расположения отрезка вне окна вывода выведем сообщение "Отрезок вне окна". Промежуточные данные: c1, c2 - коды областей расположения первой и второй вершин отрезка; x1, y1 и x2, y2 - координаты вершин отрезка на линиях отсечения; fl - есть истина, если выполнен обмен вершинами 1 и 2. Алгоритм: 1°. Начало. 2°. Вычислить c1, c2. 3°. Если отрезок может пересекать окно вывода, то перейти к п. 4°, иначе перейти к п. 6° (все отсечения для c1 выполнены). 4°. Если c1 равен нулю, то поменять местами вершины 1 и 2. 5°. Найти линию отсечения, с которой пересекается отрезок 1, и перенести вершину 1 в точку пересечения отрезка и линии отсечения; вычислить c1 и перейти к п. 3°. 196 6. Встроенные процедуры 6°. Если IOR(c1, C2) = 0, то отрезок внутри окна; вывести x1, y1, x2, y2, иначе отрезок вне окна. 7°. Конец. Программа содержит две процедуры: подпрограмму swap - обмена значениями переменных - и функцию code, возвращающую код области расположения вершины отрезка. program clip ! Текст программы отсечения integer(2) :: XL = 15, XR = 60, YB = 15, YT = 60 integer(2) :: x1 = 10, y1 = 10, x2 = 65, y2 = 65 integer(2) c1, c2, code logical :: fl = .false. c1 = code(x1, y1, XL, XR, YB, YT) c2 = code(x2, y2, XL, XR, YB, YT) do while(iand(c1, c2) == 0 .and. ior(c1, c2) > 0) if(c1 == 0) then fl = .not. fl ! Обмен вершин отрезка call swap(x1, x2); call swap(y1, y2); call swap(c1, c2) end if if(x1 < XL) then ! Отсечение слева y1 = y1 + dfloat(y2 - y1) * dfloat(XL - x1) / dfloat(x2 - x1) x1 = XL else if(y1 < YB) then ! Отсечение снизу x1 = x1 + dfloat(x2 - x1) * dfloat(YB - y1) / dfloat(y2 - y1) y1 = YB else if(x1 > XR) then ! Отсечение справа y1 = y1 + dfloat(y2 - y1) * dfloat(XR - x1) / dfloat(x2 - x1) x1 = XR else if(y1 > YT) then ! Отсечение сверху x1 = x1 + dfloat(x2 - x1) * dfloat(YT - y1) / dfloat(y2 - y1) y1 = YT end if c1 = code(x1, y1, XL, XR, YB, YT) ! Код вершины 2 не изменился end do if(fl) then ! Обмен вершин отрезка call swap(x1, x2) ! Восстанавливаем прежний порядок call swap(y1, y2) ! вершин call swap(c1, c2) end if if(ior(c1, c2) == 0) then write(*, 1) x1, y1, x2, y2 ! x1, y1: 15, 15; x2, y2: 60, 60 else write(*, *) 'Отрезок вне окна вывода' end if 1 format(' x1, y1:', i4, ',', i4, '; x2, y2:', i4, ',', i4) end program clip 197 О. В. Бартеньев. Современный ФОРТРАН subroutine swap(a, b) integer(2) a, b, hold hold = a; a = b; b = hold end subroutine swap ! Вычисление кода области расположения вершины с координатами x, y function code(x, y, XL, XR, YB, YT) result (vcode) integer(2) x, y, XL, XR, YB, YT, vcode vcode = 0 if(x < XL) vcode = ior(vcode, 2#1000) if(y < YB) vcode = ior(vcode, 2#0001) if(x > XR) vcode = ior(vcode, 2#0010) if(y > YT) vcode = ior(vcode, 2#0100) end function code 6.15. Символьные функции Встроенные символьные функции ADJUSTL, ADJUSTR, LGE, LGT, LLE, LLT, INDEX, LEN_TRIM, REPEAT, SCAN, TRIM, VERIFY позволяют сравнивать символьные выражения, вычислять их длину, осуществлять поиск в строках других подстрок и выполнять преобразования строк. Функции рассмотрены в разд. 3.8.8. 6.16. Процедуры для работы с памятью LOC(gen) - встроенная функция; возвращает машинный адрес аргумента gen или адрес временного результата для аргумента gen. Результат имеет тип INTEGER(4). Если параметр gen является выражением, вызовом функции или константой, то создается временная переменная, содержащая результат выражения, вызов функции или константу, и функция LOC возвращает адрес этой временной переменной. Во всех других случаях функция возвращает машинный адрес фактического параметра. MALLOC(i) - встроенная функция; выделяет область памяти размером в i байт. Функция возвращает начальный адрес выделенной памяти. Тип аргумента и результата функции - INTEGER(4). CALL FREE(i) - встроенная подпрограмма; освобождает выделенную функцией MALLOC область памяти; i - начальный адрес выделенной функцией MALLOC памяти. Тип параметра i - INTEGER(4). Предупреждение. Если освобождаемая память не была ранее выделена функцией MALLOC или память освобождается более одного раза, то результат непредсказуем и выполнение подпрограммы FREE может серьезно повредить занимаемую программой память. 198 6. Встроенные процедуры Пример: integer(4) addr, size size = 1024 ! Размер в байтах addr = malloc(size) ! Выделяем память размером size call free(addr) ! и освобождаем ее end 6.17. Проверка состояния "конец файла" Встроенная функция EOF(устройство) возвращает .TRUE., если файл позиционирован на запись "конец файла" или вслед за этой записью, и .FALSE. - в противном случае. (Рассмотрена в разд. 11.16.) 6.18. Неэлементные подпрограммы даты и времени CALL DATE_AND_TIME([date] [, time] [, zone] [, values]) - возвращает дату и время, которые показывают встроенные системные часы. Все параметры процедуры имеют вид связи OUT. date - текстовая скалярная переменная длиной не менее восьми символов, содержащая в восьми первых символах дату в виде CCYYMMDD, где CC соответствует веку, YY - году, MM - месяцу, DD - дню. time - текстовая скалярная переменная длиной не менее 10 символов, содержащая в 10 первых символах время в виде HHMMSS.SSS, где HH соответствует часу, ММ - минутам, SS - секундам, SSS - миллисекундам. zone - текстовая скалярная переменная длиной не менее пяти символов, содержащая в пяти первых символах разницу между местным временем и универсальным согласованным временем (средним временем по Гринвичу) в виде SHHMM, где S - знак (+ или -), HH - часы, MM - минуты. values - одномерный стандартный целый массив размером не менее восьми, содержащий последовательность значений: год, месяц, день, разница во времени (в минутах) по отношению ко времени по Гринвичу, час дня, минуты, секунды, миллисекунды. Если какое-либо значение недоступно, то соответствующий элемент массива равен HUGE(0). character(10) dat, tim, zon call date_and_time(date = dat, time = tim, zone = zon) print *, dat, tim, ' ', zon CALL SYSTEM_CLOCK([count] [, count_rate] [, count_max]) - возвращает текущее значение системного таймера и его характеристики. Все параметры имеют стандартный целый тип. Вид связи параметров - OUT. count - текущее значение системного таймера или HUGE(0) при его отсутствии. Значение count увеличивается на единицу при каждом отсчете 199 О. В. Бартеньев. Современный ФОРТРАН таймера до тех пор, пока не достигнет значения count_max. После чего, начиная с нуля, выполняется новый цикл отсчета времени. count_rate - число отсчетов таймера в секунду или 0, если таймер отсутствует. count_max - максимальное значение, которое может принимать count или 0, если таймер отсутствует. integer cr, cm call system_clock(count_rate = cr, count_max = cm) write(*,*) cr, cm ! 1 86399 Подпрограмму DATE_AND_TIME можно приспособить для измерения времени вычислений, создав функцию timer: function timer( ) ! Возвращает процессорное время real(8) :: timer ! в миллисекундах integer(4) :: ival(8) call date_and_time(values = ival) timer = dble(ival(8)) * 0.001_8 + & dble(ival(7)) + dble(ival(6)) * 60.0_8 + & dble(ival(5)) * 3600.0_8 end function timer Пример. Замеряется время вычислений при правильной и неоптимальной организации вложенных циклов. program toappr integer(4), parameter :: n = 1000 real(4), dimension(n, n) :: array1, array2 real(8) :: start_time1, finish_time1 ! Время начала и завершения вычислений real(8) :: start_time2, finish_time2 ! соответственно при правильной и ! неоптимальной организации вложенных циклов real(8) :: timer ! Функция, возвращающая процессорное время ! в миллисекундах; имеет тип REAL(8) array1 = 1.1; array2 = 1.5 ! Инициализация массивов ! Правильная организация вложенного цикла обеспечивает естественный доступ ! к элементам массива по столбцам start_time1 = timer( ) ! Начало вычислений do j = 1, n ! Правильно: сначала задается столбец, do i = 1, n ! а затем меняется индекс строки array1(i, j) = array1(i, j) + array2(i, j) * 3.3 end do end do finish_time1 = timer( ) ! Конец вычислений array1 = 1.1; array2 = 1.5 ! Повторная инициализация массивов ! Неоптимальная организация вложенного цикла - неестественный доступ ! к элементам массива по строкам start_time2 = timer( ) ! Начало вычислений do i = 1, n ! Так программировать не надо. Обеспечьте do j = 1, n ! доступ к элементам массива по столбцам 200 6. Встроенные процедуры array1(i, j) = array1(i, j) + array2(i, j) * 3.3 end do end do finish_time2 = timer( ) ! Конец вычислений print *, (finish_time1 - start_time1) / (finish_time2 - start_time2) ! Результат: 0.629629629613660 end program toappr 6.19. Случайные числа Генерация случайных чисел выполняется подпрограммой RAN- DOM_NUMBER от значений, содержащихся в затравочном массиве. Размер и значения этого массива возвращаются подпрограммой RANDOM_SEED. Она же позволяет и изменить затравку. CALL RANDOM_NUMBER(harvest) - возвращает псевдослучайное число harvest или массив harvest таких чисел из равномерно распределенного интервала: 0 ≤ x < 1. Тип harvest - стандартный вещественный. Вид связи параметра harvest - OUT. Стартовая (затравочная) точка для генератора случайных чисел устанавливается и может быть запрошена RANDOM_SEED. Если RAN- DOM_SEED не использована, то значение затравки зависит от процессора. real x, hav(3) call random_seed( ) call random_number(x) call random_number(hav) print *, hav ! 5.252978E-01 6.502543E-01 4.247389E-01 CALL RANDOM_SEED([size] [, put] [, get]) - изменяет стартовую точку (затравку) генератора псевдослучайных чисел, используемого подпрограммой RANDOM_NUMBER. size - стандартное целое число, имеющее вид связи OUT, равное размеру n создаваемого процессором затравочного массива. put - стандартный целый массив с видом связи IN, используемый процессором для изменения затравки. get - стандартный целый массив с видом связи OUT, в который заносятся текущие значения затравки. При вызове RANDOM_SEED должно быть задано не более одного параметра. Размеры put и get должны быть больше, чем размер массива, который используется процессором для хранения затравочных чисел. Этот размер можно определить, вызвав RANDOM_SEED с параметром size. В настоящей реализации size = 1. Если при вызове RANDOM_SEED не задано ни одного параметра, то процессор устанавливает стартовую точку генератора случайных чисел в зависимости от системного времени. 201 О. В. Бартеньев. Современный ФОРТРАН Пример: integer sv, k integer, allocatable :: ap(:), ag(:) call random_seed(size = sv) ! Читаем размер затравочного массива allocate(ap(sv), ag(sv)) ! Размещаем массивы call random_seed(get = ag) ! Читаем в массив ag значение затравки print *, sv ! 1 print *, (ag(k), k = 1, sv) ! 1 ap = (/ (100*k, k = 1, sv) /) call random_seed(put = ap) ! Переопределяем значение затравки Помимо встроенной подпрограммы RANDOM_NUMBER в CVF и FPS есть дополнительные подпрограммы получения случайных чисел RANDOM и RAN, а также функции библиотеки PortLib: DRAND, DRANDM, IRAND, IRANDM, RAN, RAND и RANDOM. Все они взаимозаменяемы, поскольку используют один и тот же алгоритм генерации псевдослучайных чисел. 6.20. Встроенная подпрограмма CPU_TIME Подпрограмма CPU_TIME(time) возвращает процессорное время time, тип которого - REAL(4). Единицы измерения времени - секунды; после десятичной точки time содержит две значащих цифры. Может быть использована для оценки продолжительности вычислений, например: real(4) :: start_time, finish_time call cpu_time(start_time) <Вычисления> call cpu_time(finish_time) print *, 'Время вычислений = ', finish_time - start_time 202 7. Управляющие операторы и конструкции Последовательность выполнения программы определяется операторами и конструкциями, обеспечивающими ветвления и циклы. Совместно с ними могут быть использованы операторы перехода и прерывания цикла. Такие операторы и конструкции относятся к управляющим. Их рассмотрение мы начали во 2-й главе, ограничившись, правда, наиболее часто употребляемыми. Теперь же мы дадим полное описание всех управляющих конструкций (кроме приведенных в разд. 4.7 конструкций WHERE и FORALL). При этом часть управляющих операторов и конструкций будет выделена в разряд нерекомендуемых или устаревших, сохраненных в Фортране с целью преемственности с более ранними версиями. Как и ранее, необязательные элементы операторов заключаются в квадратные скобки. Используемые в главе сокращения введены в разд. 2.2. 7.1. Оператор GOTO безусловного перехода Используется для передачи управления по метке и имеет вид: GOTO метка В современном Фортране GOTO, так же как альтернативный выход из подпрограммы и дополнительный вход (ENTRY) в процедуру, следует полностью заменить другими управляющими конструкциями. Замечания: 1. Запрещается переход внутрь конструкций DO, IF, SELECT CASE и WHERE. 2. В Фортране можно также организовать переход по вычислению (вычисляемый GOTO) и предписанию (назначаемый GOTO). Описание этих операторов приведено в прил. 2. Пример. GOTO используется для организации повторных действий, т. е. цикла. integer(1) in 10 continue print *, 'Введите число от 1 до 10: ' read *, in if(in >= 1 .and. in <= 10) then print *, 'Ваш ввод: ', in else print *, 'Ошибка. Повторите ввод' goto 10 203 О. В. Бартеньев. Современный ФОРТРАН end if Выполняющий те же действия фрагмент без GOTO выглядит так: integer(1) in do print *, 'Введите число от 1 до 10: ' read *, in if(in >= 1 .and. in <= 10) then print *, 'Ваш ввод: ', in exit end if print *, 'Ошибка. Повторите ввод' end do 7.2. Оператор и конструкции IF Дополнительно по сравнению с более ранними версиями Фортрана в управляющие конструкции введено необязательное имя конструкции. Применение именованных конструкций позволяет создавать хорошо читаемые программы даже при большой глубине вложенности управляющих конструкций. В приводимых в настоящем разделе операторе и конструкциях IF ЛВ должно быть скаляром, т. е. операндами ЛВ не должны быть массивы или их сечения. 7.2.1. Условный логический оператор IF IF(ЛВ) оператор Если истинно ЛВ, то выполняется оператор, в противном случае управление передается на последующий оператор программы. В Фортране существует еще один условный оператор - арифметический IF. Этот оператор относится к устаревшим свойствам Фортрана. Его описание дано в прил. 2. 7.2.2. Конструкция IF THEN END IF [имя:] IF(ЛВ) THEN БОК END IF [имя] БОК выполняется, если истинно ЛВ. Если присутствует имя конструкции, то оно должно быть и в первом и в последнем операторе конструкции, например: swap: if(x < y) then hold = x; x = y; y = hold end if swap 204 7. Управляющие операторы и конструкции Замечание. Если БОК содержит один оператор, то лучше использовать оператор IF(ЛВ) оператор 7.2.3. Конструкция IF THEN ELSE END IF [имя:] IF(ЛВ) THEN БОК1 ELSE [имя] БОК2 END IF [имя] В случае истинности ЛВ выполняется БОК1, и выполняется БОК2, если ЛВ ложно. Имя конструкции, если оно задано, должно обязательно присутствовать и перед IF и после END IF. Пример: if(x**2 + y**2 < r**2) then print *, 'Точка внутри круга' else print *, 'Точка вне круга' end if 7.2.4. Конструкция IF THEN ELSE IF [имя:] IF(ЛВ1) THEN БОК1 ELSE IF(ЛВ2) THEN [имя] БОК2 [ELSE [имя] БОКn] END IF [имя] В случае истинности ЛВ1 выполняется БОК1 и управление передается на следующий за END IF оператор. Если ЛВ1 ложно, то управление передается на следующий ELSE IF, т. е. вычисляется значение ЛВ2 и, если оно истинно, выполняется БОК2. Если оно ложно, то управление передается на следующий ELSE IF, и т. д. Если ложны все ЛВ, то выполняется следующий за завершающим ELSE БOКn. Если завершающий ELSE отсутствует, то управление передается на расположенный за END IF оператор. Число операторов ELSE IF в конструкции может быть произвольным. Имя в ELSE и в ELSE IF можно задавать, если его имеют операторы IF и END IF. Имя, если оно задано, во всех частях конструкции должно быть одинаковым. |