Производные типы
Оператор select type
Схема выполнения
- Находится и выполняется блок type is
- Если не найден type is, то находится и выполняется class is.
- Если найдено соответствие нескольким блокам class is, то выбирается ближайший родитель.
- Если не найден ни один блок выбирается class default.
...
type (PARENT), target :: P
type (CHILD_CHILD_A), target :: CCA
PAR => CCA ! потомок потомка А
select type (PAR)
class is (PARENT)
write (*,*) "PARENT"
class is (CHILD_A)
write(*,*) "CHILD" ! выбирается ближайший родитель
class default
write(*,*) "default...."
end select
end
Оператор class(*)
Неограниченно полиморфная переменная принимает любые типы
type T1
integer index
real val
end type T1
type T2
logical status
character symbol
character(10) name
end type T2
complex(16), target :: CMP
type (T1), target :: PT1
type (T2), target :: PT2
class (*), pointer :: PAR ! неограниченно полиморфная
PAR => PT1 ! сейчас типа T1
PAR => PT2 ! теперь типа T2
PAR => CMP ! затем комплексный тип
Процедурные указатели
procedure(proc), pointer :: p1 => null()
Procedure описывает процедурный указатель, позволяет добавлять в созданный тип процедуры.
type NewType
integer a
real b
contains
procedure proc1
procedure :: proc2 => other_pr
end type NewType
...
call A.proc1(a,b)
Атрибуты pass и nopass
Используются для процедур привязанных к производному типу по имени.
pass позволяет получить доступ к переменной, посредством которой вызывалась процедура (по умолчанию).
Вызывающая переменная записывается в процедуре, первым параметром и должна быть объявлена оператором class.
При вызове процедуры данный параметр опускается.
nopass отменяет доступ к вызывающей переменной.
Процедуры привязанные к типу
module algebra
type, public :: vector
real x1, y1, x2, y2
contains
procedure, public, pass :: length
procedure, nopass :: info
end type vector
CONTAINS
subroutine info()
write(*,*) "I'am VECTOR"
end subroutine info
integer function length(vc) ! атрибут pass
class(vector), intent(out) :: vc
length = sqrt((vc.x1-vc.x2)**2 + (vc.y1-vc.y2)**2)
end function length
end module algebra
program prog
use algebra
class (vector), allocatable :: VEC
allocate(VEC, source = vector(0.0,0.0,3.0,4.0))
call VEC.info()
write(*,*) VEC.length() ! формальный параметр отсутствует
! однако при описании объявлен
deallocate(VEC)
end
Завершающие процедуры
Оператор final объявляет процедуры (деструкторы), которые выполняются при удалении ранее размещенных в памяти элементов
type NewType
...
contains
final :: finish
end type NewType
Атрибут private
Используется для задания отдельных полей производных типов в модулях. Доступ к приватной части происходит при помощи public-процедур.
module MyModule
...
type NewType
integer A
real, private :: B
integer C
real, private :: D
end type NewType
...
end module MyModule
Пример
module MyModule
type NewType
integer A
real, private :: B
contains
procedure :: SetParamB
end type NewType
contains
subroutine SetParamB(T,newvalue)
class(NewType) T
real newvalue
if (newvalue < 0) then
write(*,*) "Error in parameter B, must be >=0"
T.B = 0
else
T.B = newvalue
end if
end subroutine
end module
program prog
use MyModule
class(NewType), allocatable :: nw
allocate(nw)
nw.A = 1000
!nw.B = 4.5 ! ошибка доступа
call nw.SetParamB(4.5)
call nw.SetParamB(-9.4) ! некорректные данные
end
Перегрузка операций
Набросок модуля арифметики длинных чисел
module long
type LongNumbe
integer(1) val(length) ! цифры
integer total ! количество
end type LongNumber
contains
subroutine asgn(n,val) ! присваивание
! операторы
end subroutine asgn
function plus(n1,n2) ! операция сложение и другие
! операторы
end function plus
subroutine PrintLong(n) ! вывод числа
! операторы
end subroutine PrintLong
end module long
Набросок вызывающей программы
program prog
use long
type (LongNumber) a, b, c, d
call asgn(a,"2823892839283923837483485555555")
call asgn(b,"92882746")
call asgn(c,"2038493849300000")
!---- хотим найти выражение
! d = a*(b+c)+c*(a+b)+b
d = plus(plus(umn(a,plus(b,c)),umn(c,plus(a,b))),b)
! очень громоздкая запись
! осложнение если будет много операций
call PrintLong(d)
end
Перегрузка операции присваивания
interface assignment (=)
module procedure asgn ! имя процедуры
end interface
Перегрузка операции сложения, умножения и др.
interface operator (+)
module procedure plus ! имя процедуры
end interface
Замена имени процедуры на знак операции.
Унарная операция - функция с одним входным параметром имеющего вид связи IN.
Двуместная операция - функция с двумя параметрами имеющими вид связи IN.
Нельзя изменять тип встроенной операции. (например '*' оформить как унарную).
Процедура, задающая '=' должна быть подпрограммой с двумя параметрами.
- 1-й вид связи OUT или INOUT (левая часть),
- 2-й параметр IN (правая часть).
Задаваемые операции
Вводятся аналогично унарным и двуместным операциям.
Имя операции задаётся по общим правилам.
В выражениях операция ограничивается точками.
interface operator (.PLUS.)
module procedure plus
end interface
...
SUMMA = A.PLUS.B
Приоритет операций
- унарная перегруженная или задаваемая операция
- арифметические операции
- символьная операция конкатенация
- операции отношения
- логические операции
- задаваемая или перегруженная бинарная операция
Задание
Создать модуль для работы с длинными числами. Реализовать операции присваивания, сложения и вывода длинных целых чисел.