Функции для указателей

Функции могут возвращать указатели в качестве своего результата. Они должны быть использованы, когда размер результата зависит от вычислений функции. Заметим, что:

• Результат должен иметь атрибут POINTER

• Возвращающая функция должна иметь правильный адрес или быть нулевой

• Результат в виде указателя для внешней процедуры требует наличия блока INTERFACE

Например:

INTERFACE

FUNCTION max_row ( a )

REAl, TARGET :: a(:,:)

REAL, POINTER :: max_row(:)

END FUNCTION max_row

END INTERFACE

REAL, TARGET :: a(3,3)

REAL, POINTER :: p(:)

...

p => max_row ( a )

...

FUNCTION max_row ( a ) ! внешняя

REAL, TARGET :: a(:,:)

REAL, POINTER :: max_row(:) ! результат функции

INTEGER :: location(2)

location = MAXLOC( a ) ! ряд и колонка для максимального значения

max_row => a(location(1),:) ! указатель на max row

END FUNCTION max_row

Здесь внешняя функция max_row возвращает ряд матрицы, содержащий наибольшее значение. Исход указателя только разрешает указать на формальный параметр, поскольку он объявлен как адресат, в противном случае будет иметь локальный массив и слева указатель повиснет при возврате. Обратим внимание на результат функции, использованной в правой части оператора присваивания указателя. Результат указателя может быть использован в выражении, в котором он должен быть ассоциирован с адресом.

В разделе приведены примеры и результаты их запуска на Alfa

№ п/п	Тема	Использованные операторы и атрибуты
1	Взаимодействие подпрограмм через параметры и COMMON-блоки	PROGRAM, CONTINUE, CALL, PRINT , FORMAT , STOP, DO, SUBROUTINE , COMMON, END, DIMENSION, EQUIVALENCE, RETURN,  FUNCTION
2	Декларации данных, объектно-ориентированные и атрибутные, указатели и адресаты	Subroutine,!, DATA, integer, real, character, complex, write, end, DO, END DO, DIMENSION, POINTER, TARGET, PARAMETER, logical, write, associated, interface, end interface, call
3	Внутренние подпрограммы, структурный тип	integer, real, type, end type, format, write, call, contains, subroutine, intent, end subroutine, end program
4	Определение и использование модуля, родовые процедуры	Module, end module, contains, real, integer, function, end function, use, module procedure, interface, end interface, write, program, end program
5	Приемы программирования обработки массивов с подпрограммами	INTERFACE, END INTERFACE, SUBROUTINE, END SUBROUTINE, INTEGER, REAL, INTENT, END, OPTIONAL, character, DIMENSION, do,end do, write, do while, read,CALL, if.. then.. else.. end if, present, FUNCTION, RETURN
6	Глобальные данные	PROGRAM, IMPLICIT NONE, REAL, INTEGER, CALL, Write, CONTAINS, SUBROUTINE, INTENT, PRINT, END SUBROUTINE, REAL FUNCTION, END FUNCTION, END PROGRAM
7	Разреженная матрица	Program, TYPE, END TYPE, REAL, INTEGER, TYPE (NONZERO), do, end do, write, end
8	Родовые процедуры	Module, end module, interface, end interface, function, result, end function, real, double precision, program, use, data, write, end program
9	Условная обработка массива	DO, END DO, WHERE
10	Выделение и возвращение памяти для массивов	ALLOCATABLE, ALLOCATE, DO, END DO, IF, ALLOCATE D, DEALLOCATE

  

Пример 1. Взаимодействие подпрограмм через параметры и COMMON-блоки

В файле /comm/f90exampl$ ./fcomm1.f программа,

показывающая взаимодействие программ через параметры, блоки COMMON и оператор EQUIVALENCE.

 

PROGRAM MAIN

COMMON B(50,50) , U(50)

N= 20

DO 1 I=1,N

DO 1 J=1,N

B(I,J)=I+J

1 CONTINUE

DO 20 i= 1,N

20 U(i)=1

CALL MATRIX (N)

C

DO 30 k=1,5

print 31, b(1,k)

30 continue

31 format (' A=', F10.2)

Z = SKALAR (N)

PRINT 3 , Z

3 FORMAT (' Z=',F15.5 )

STOP

END

c

SUBROUTINE MATRIX (N)

COMMON A(50,50) , X(50)

DIMENSION Y(50)

EQUIVALENCE (A(1),Y(1))

DO 2 I =1,N

S= 0.0

DO 1 J = 1,N

1 S = S +A(I,J)*X(J)

2 Y(I) = S

RETURN

END

  FUNCTION SKALAR (N)

COMMON Y(50) , F(49,49) , X(50)

S = 0.0

DO 1 I =1,N

1 S = S+X(I)*Y(I)

SKALAR = S

RETURN

END

 

В результате трансляции получен абсолютный код в файле /comm/f90exampl$ ./fcomm1

 

Вот что видно на экране после запуска

al2:~/ comm/f90exampl$ ./fcomm1

A= 230.00

A= 3.00

A= 4.00

A= 5.00

A= 6.00

Z= 0.00000

Press any key to continue...

Пример 2. Декларации данных, объектно-ориентированные и атрибутные

В примере вызываются три подпрограммы exdata, entidec и attrdec. В подпрограмме exdata даются примеры с операторами DATA. В подпрограмме entidec демонстрируются объектно-ориентированные декларации, содержащие описание свойств данных, указатели и адресаты для них, операция связи указателя с адресатом. В подпрограмме attrdec демонстрируются описание интерфейса в качестве предварительного описания вызываемой подпрограммы, атрибутное описание данных и еще раз указатели и адресаты.

program example2 call exdata ! пример с операторами DATA call entidec ! пример с объектно-ориентированными объявлениями call attrdec ! пример с aтрибутными объявлениями end

subroutine entidec ! Entity-oriented declaration: INTEGER, DIMENSION (:), POINTER :: days, hours ! Указатели на массив с неопределенными границами INTEGER (2), PARAMETER :: limit=12 INTEGER, TARGET :: A(4), B(8) ! Aдресаты для указателей INTEGER , POINTER :: d, h ! Указатели на целые INTEGER (2) :: k = 4 INTEGER, TARGET :: p ! Aдресат для указателя Logical ans days => A ! Cвязь указателя с массивом DO I = 1 , 4 A(I) = I B(2 * I - 1) = 2 B(2 * I) = 6 + I END DO Ans=associated(days) ! Cведения о наличии связи указателя с массивом Write(*,'((a5),l1)') ' ans=',ans P = 5 d => p ! Cвязь указателя с переменной write (*,'((a4),2i2)') ' p =', d, p end

subroutine attrdec interface ! Начало описания интерфейса subroutine summaa(poa,n,s) integer, DIMENSION(:), POINTER :: poa integer n, s end subroutine summaa end interface !Attribute-oriented declaration: INTEGER days, hours, t INTEGER (2) :: k=4,limit DIMENSION days(:), hours(:) POINTER days, hours PARAMETER ( limit=12) INTEGER, TARGET :: A(4), B(8) DO I = 1 , 4 A(I) = I B(2*I-1) = 2 B(2*I) = 6 + I END DO Days => A write (*, '((a3) ,i2)' ) ' k=', k call summaa(days, 4, t) write (*, '((a3), i5 )' ) ' t =', t days => A hours => B DO i = 1, 4 Write (*, '( (a3), i2, (a3), i3)' ) ' a(', i, ')=' , days(i) END DO End

Subroutine summaa ( poa, n, s) integer, DIMENSION(:), POINTER :: poa integer n, s s=0 do i = 1, n write (*, '( (a13), i2, (a3), i3)' ) 'with poa a(', i, ')=' , poa(i) s = s + poa (i) end do write (*, '( (a3), i2)' ) 's=' , s end

Subroutine exdata ! statement DATA integer n, order, alpha, list(100) real coef(4), eps(2), pi(5), x(5,5) character*12 help complex*8 cstuff DATA n /0/, order /3/ DATA alpha /'A'/ DATA coef /1.0, 2*3.0, 1.0/, eps(1) /.00001/ DATA cstuff /(-1.0, -1.0)/ ! The following example initializes diagonal and below in ! a 5x5 matrix: DATA ((x (j, i), i = 1, j ), j = 1, 5) / 15 * 1.0 / DATA pi /5*3.14159/ DATA list / 100 * 0 / DATA help(1:4), help(5:8), help(9:12) /3*'HELP'/ Write (*, '((a3), i2)' ) ' n=' , n Write (*, '((a7), i2)' ) ' order=', order End

Результат запуска получился такой n= 0 order= 3 ans=T p = 5 5 k= 4 with poa a( 1 )= 1 with poa a( 2 )= 2 with poa a( 3 )= 3 with poa a( 4 )= 4 s=10 t =10 a( 1 )= 1 a( 2 )= 2 a( 3 )= 3 a( 4 )= 4 Press any key to continue...

 

Пример 3. Внутренние подпрограммы, структурный тип

 В примере демонстрируется описание и использование структурного типа dt, описание внутренней подпрограммы averag, ее параметрам задаются виды in, out, inout. А также показывается трансяция с помощью .bat -файла.

Текст программы !calculate value into a running average and retutn the average cubed type dt integer count real average end type type (dt) r 10 format (1x, i5,1x,f5.2,2x,f5.1,2x,f3.1) r%count=5 r%average=4 val =5 cu_ave=1 write(*,10) r%count, r%average, val , cu_ave call averag (val , r, cu_ave) write(*,10) r%count, r%average, val , cu_ave

Contains subroutine averag (value, data1, cube_ave) type (dt) :: data1 real dummy ! значение не может быть изменено, пока cube_ave не будет определено ! прежде, чем будет использовано. Data1 определено, когда процедура ! вызвана и получит переопределенное в подпрограмме. intent (IN) :: value; intent (OUT) :: cube_ave intent (INOUT) :: data1 ! count number of times AVERANGE has been called jn the data set ! being passed. dummy = count*average+value data1%count=data1%count+1 data1%average=dummy/data1%count cube_ave=data1%average**3 end subroutine averag

end program

Программу запускаю на трансляцию командой al2:~/ comm/f90exampl$ ff90.bat f90_ex4

Результат трансляции таков al2:~/ comm/f90exampl$ ff90.bat f90_ex4 Press any key to continue... В файле ff90.bat находится команда f90 -O0 -o $1 $1.f -lm

Запускаю командой al2:~/ comm/f90exampl$ f90_ex4

Результат запуска 5 4.00 5.0 1.0 6 0.83 5.0 0.6 Press any key to continue...

Пример 4. Определение и использование модуля, родовые процедуры

Пример демонстрирует использование модуля. Заметим, что определение модуля должно предшествовать его использованию. В модуле дано предварительное объявление свойств процедур sub1 и sub2, их текст дан уже вне модуля как описание процедур модуля. Программа change_kind использует объявленный модуль. В ней подпрограммы sub1 и sub2 объединены в родовое семейство default, которое используется для вычисления вещественной или целой величины, применяются преобразователи типа - функции real и int. Выбор нужной подпрограммы осуществляется в соответствии с описанием интерфейса и типа аргумента.

! procedure sub1 and sub2 defined as follows: module Module1 contains function Sub1(y) real(8) y sub1=real(y) end function function Sub2(z) integer(2) z sub2=int(z) end function end module

!A hpogram that changes non-default integers and reals ! into default integer and reals program change_kind use Module1 interface default module procedure Sub1, Sub2 end interface ! integer(2) in integer indef real(8) re

in=5 indef=default(in) write (*,'(i4)') indef re=3.5 redef=default(re) write (*,'(f4.2) ') redef end program

Трансляция прошла успешно и при запуске получен результат:  al2:~/ comm/f90exampl$ ./f90_ex3 5 3.50 Press any key to continue...

 

Пример 5. Приемы программирования обработки массивов с подпрограммами

 Пример показывает приемы программирования: работа с массивом, цикл, описание и вызов подпрограмм, интерфейс к процедурам (при ключевых и необязательных параметрах нужно обязательно задавать интерфейс), типы всех параметров, формальных и фактических, должны соответствовать, свойство быть входным или выходным параметром должно правильно использоваться и др.

Показано, что если параметр INOUT задан через ключевой параметр с заданием исходного значения, то вычисленное выходное значение не возвращается !!!

Показано действие функции present() для необязательных параметров.

Показаны операторы write с выдачей на экран и оператор read c вводом с клавиатуры.

! test array, loop, interface, key argument,input/output,intent,optional

! massiv - loop do -- end do

INTERFACE

SUBROUTINE sub1(a, b, c, d)

INTEGER, INTENT(INOUT) :: a, b

REAL, INTENT(IN), OPTIONAL :: c, d

END SUBROUTINE sub1

!

SUBROUTINE sub2(a,b,stat)

INTEGER, INTENT(IN) :: a, b

INTEGER, INTENT(INOUT) :: stat

END SUBROUTINE sub2

END INTERFACE

!

character(1) input

integer k, l, a, b, stat

real p, q

DIMENSION array(20)

INTEGER :: x = 0

 do j = 2, 20, 2

array(j) = 12.0

end do

!

! perfom a function 11 times

c

do k=-330, -60, -3

int = j / 3

isb = -9 -k

array(isb) = MyFunc(int)

end do

C

do j = 1, 10

write (*, '(i5)' ) j

end do

write (*, '(i5)' ) j

! loop do while -- end do

 input = ' '

do while ((input .ne. 'n') .and. (input .ne. 'y'))

write (*, '(A)' ) 'Enter y or n '

read (*, '(A)' ) input

end do

!

k=1 ; l= 2

write (*,'(a6, i3, a3 ,i3 )' ) ' 1. a=', k, ' b=', l

CALL sub1( k, l )

k=2; l= -2; p=3.2 ; q=-3.6

CALL sub1( k, l, p, q )

write (*,'(a6,i3,a3,i3 )') ' 2 . a=',k,' b=',l

k=3; l=4; p=5

CALL sub1( k, l, p )

write (*, '(a6, i3, a3, i3 )' ) ' 3 . a=', k, ' b=', l

!

CALL sub2( a = 1, b = 2, stat = x )

write (*, '(a9,i3)' ) ' 1. stat=', stat

CALL sub2( 1, stat = x, b=2)

write (*, '(a9, i3)' ) ' 2. stat=',stat

CALL sub2( 1, 2, stat = x )

write (*, '(a9, i3)' ) ' 3. stat=', stat

stat = 0

CALL sub2( 1, 2, stat )

write (*,'(a9,i3)') ' 4 . stat=',stat

END

SUBROUTINE sub1( a, b, c,d )

INTEGER, INTENT(INOUT) :: a, b

REAL, INTENT(IN), OPTIONAL :: c, d

write (*,'(a13,l5)') ' present(c)=', present(c)

write (*,'(a13,l5)') ' present(d )=', present(d)

if (present(c) .and. present(d)) then

! Function present(d) - задан ли параметр

a = a + b + c + d

b = c - d

else

a = a + b

b = a - b

end if

END SUBROUTINE sub1

FUNCTION MyFunc (i)

integer i

write (*, '(I5)' ) i

myfunc = i

RETURN

END

SUBROUTINE sub2(a, b, stat)

INTEGER, INTENT (IN) :: a, b

INTEGER, INTENT(INOUT) :: stat

Stat = a + b + stat

write (*, '(a13 , i3)' ) ' sub2: stat=', stat

END SUBROUTINE sub2

 

В результате запуска получаем

 al2:~/ comm/f90exampl$ ./f90_ex5

1

2

3

4

5

6

7

8

9

10

11

Enter y or n

y

1. a= 1 b= 2

present(c)= F

present(d )= F

present(c)= T

present(d )= T

2 . a 0 b= 6

present(c)= T

present(d )= F

3 . a 7 b= 3

sub2: stat= 3

1. stat= 0

sub2: stat= 3

2. stat= 0

sub2: stat= 3

3. stat= 0

sub2: stat= 3

4 . stat 3

Press any key to continue...

Пример 6. Глобальные данные

Пример показывает описание и использование глобальных данных (переменной NumberCalcsDone)

! global date

PROGRAM CalculatePay

IMPLICIT NONE

REAL :: Pay, Tax, Delta

INTEGER :: NumberCalcsDone = 0

Pay = 2.5; Tax = -3.567 ; Delta = 234.567

CALL PrintPay (Pay, Tax)

Tax = NewTax (Tax, Delta)

write (*,'(a7,i2)') ' count=',NumberCalcsDone

CONTAINS

SUBROUTINE PrintPay (Pay, Tax)

REAL, INTENT (IN) :: Pay, Tax

REAL :: TaxPaid

TaxPaid = Pay * Tax

PRINT *, TaxPaid

NumberCalcsDone = NumberCalcsDone + 1

END SUBROUTINE PrintPay

REAL FUNCTION NewTax (Tax, Delta)

REAL, INTENT (IN) :: Tax, Delta

NewTax = Tax + Delta * Tax

NumberCalcsDone = NumberCalcsDone + 1

END FUNCTION NewTax

END PROGRAM CalculatePay

 Здесь переменная NumberCalcsDone - глобальная для головной программы, для подпрограммы PrintPay и для подпрограммы-функции NewTax.

 В результате запуска получаем

 al2:~/ comm/f90exampl$ ./f90_ex6

-8.917500

count= 2

Press any key to continue...

 Пример 7. Разреженная матрица

 Пример показывает работу со структурой (разреженная матрица) : задание значений через обращение к функции с именем, совпадающим с именем типа, определенного в описании.

program razrmatr

TYPE NONZERO ! определение типа из трех компонент

REAL VALUE

INTEGER ROW, COLUMN

END TYPE

TYPE (NONZERO) :: A(100) ! описание с новым типом

A(1) = NONZERO(5.0, 1, 1) ! задание значения элементу из первой строки и первой колонки

A(2) = NONZERO(1.20, 2, 2)

A(3) = NONZERO(1.45, 3, 3)

A(4) = NONZERO(5.2, 4, 4)

A(5) = NONZERO(5.2, 5, 5)

A(6) = NONZERO(3.4, 6, 6)

A(7) = NONZERO(15.4, 7,7)

A(8) = NONZERO(1.0, 8, 8)

A(9) = NONZERO(5.7, 9, 9)

A(10) = NONZERO(1.8, 10, 10)

A(11) = NONZERO(5.2, 11, 11)

A(12) = NONZERO(17.2, 12, 12)

A(13) = NONZERO(-1.0, 13, 13)

A(14) = NONZERO(-7.0, 14, 14)

S = 0

do i = 1, 14 ! суммирование значений

s= s + A(i)%value

end do

write (*, '(a3, f4 .1)' ) ' s=' , s ! печать суммы

end

 Вот результат запуска

 al2:~/ comm/f90exampl$ ./f90_ex7

s=59.8

Press any key to continue...

Пример 8. Родовые процедуры

 Еще один пример с родовыми процедурами (семейством) force для работы с типами 'real_force' и 'double_force'. Определена величина force для хранения результата функции. Интерфейс описан в модуле, а реализация процедур семейства в виде программных единиц, внешних для главной программы. Исходные данные задаются оператором data.

 module proced_def

!'force'

! 'real_force' и d 'double_force'.

interface force

function real_force(mass, accel) result (force)

real force, mass, accel

end function real_force

function double_force(mass, accel) result(force)

double precision force, mass, accel

end function double_force

end interface

end module

program main

use proced_def ! procedure_def main.

real rmass, raccel, rforce

double precision dmass, daccel, dforce

data rmass/2401.0/, raccel/9.81245/

data dmass/2401.0d0/, daccel/9.81245d0/

!'force'.

!'real_force', 'double_force'.

rforce = force(rmass, raccel)

dforce = force(dmass, daccel)

write (*, '(1x, 1p, e16.9, t25, d16.9)' ) rforce, dforce

end program

!'force'.

function real_force(mass, accel) result(force)

real force, mass, accel

force = mass*accel

end function real_force

function double_force(mass, accel) result(force)

double precision force, mass, accel

force = mass*accel

end function double_force

При запуске получился результат:

al2:~/ comm/f90exampl$ ./f90_ex9

2.355969336E+04 2.355969245D+04

Press any key to continue...

Пример 9. Оператор WHERE - условная обработка массивов

В программе создается, изменяется и печатается массив. При внесении изменений используется оператор WHERE, обрабатывающий те элементы массива, которые удовлетворяют условию, записанному в скобках. Действие оператора эквивалентно циклу просмотра всех элеменов массива.

 

INTEGER :: A(2,3)

DO I = 1, 2

DO J = 1, 3

A(I, J) = (I+J)*(-1)**J

END DO

END DO

WHERE( A<0 ) A = 0

WHERE( A**2>10 ) A = 999

WHERE( A/=0 ) A = 1/A

DO I = 1, 2

DO J = 1, 3

WRITE (*, 'A3,I2,A2,I2,A3,I5') ' A(', I, ', ', J, ') =', A(I, J)

END DO

END DO

! Оператор allocate, allocatable, allocated,deallocate, associated

! Метод для создания и выделения памяти в соответствии с образом массива

PROGRAM ALLOCM

INTEGER, ALLOCATABLE :: matrix( : , : )

REAL , ALLOCATABLE :: vector( : )

N = 2

ALLOCATE (matrix(3,5),vector(-2:N+2))

DO I = 1, 3

DO J=1,5

matrix(i,j) = i*j

END DO

END DO

K = N+2

DO I = 1, K

vector(I) = I

END DO

IF ( ALLOCATE D(matrix) ) write(*, '(a12)') 'alloc matrix'

IF ( ALLOCATE D(vector) ) write(*, '(a12)') 'alloc vector'

DEALLOCATE (matrix,vector)

IF (.not. ALLOCATE D(matrix)) write(*, '(a15)') 'no alloc matrix'

IF (.not. ALLOCATE D(vector)) write(*, '(a15)') 'no alloc vector'