Пример 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 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

Дата добавления: 2015-11-14