-
Notifications
You must be signed in to change notification settings - Fork 1
/
OptQC_CPLX_WKVar.f90
139 lines (100 loc) · 2.63 KB
/
OptQC_CPLX_WKVar.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
module arrays_cplx
implicit none
type arr_dp_4_cplx
double complex, allocatable :: arr(:,:,:,:)
integer :: d1, d2, d3, d4 = 0
contains
procedure :: constructor => arr_dp_4_cplx_constructor
procedure :: destructor => arr_dp_4_cplx_destructor
end type arr_dp_4_cplx
type l_arr_dp_4_cplx
type(arr_dp_4_cplx), allocatable :: l(:)
integer :: d = 0
contains
procedure :: constructor => l_arr_dp_4_cplx_constructor
procedure :: destructor => l_arr_dp_4_cplx_destructor
end type l_arr_dp_4_cplx
type arr_dp_2_cplx
double complex, allocatable :: arr(:,:)
integer :: d1, d2 = 0
contains
procedure :: constructor => arr_dp_2_cplx_constructor
procedure :: destructor => arr_dp_2_cplx_destructor
end type arr_dp_2_cplx
type l_arr_dp_2_cplx
type(arr_dp_2_cplx), allocatable :: l(:)
integer :: d = 0
contains
procedure :: constructor => l_arr_dp_2_cplx_constructor
procedure :: destructor => l_arr_dp_2_cplx_destructor
end type l_arr_dp_2_cplx
contains
subroutine arr_dp_4_cplx_constructor(this,d1,d2,d3,d4)
implicit none
class(arr_dp_4_cplx) :: this
integer :: d1, d2, d3, d4
allocate(this%arr(d1,d2,d3,d4))
this%d1 = d1
this%d2 = d2
this%d3 = d3
this%d4 = d4
end subroutine arr_dp_4_cplx_constructor
subroutine arr_dp_4_cplx_destructor(this)
implicit none
class(arr_dp_4_cplx) :: this
deallocate(this%arr)
this%d1 = 0
this%d2 = 0
this%d3 = 0
this%d4 = 0
end subroutine arr_dp_4_cplx_destructor
subroutine l_arr_dp_4_cplx_constructor(this,d)
implicit none
class(l_arr_dp_4_cplx) :: this
integer :: d
allocate(this%l(d))
this%d = d
end subroutine l_arr_dp_4_cplx_constructor
subroutine l_arr_dp_4_cplx_destructor(this)
implicit none
class(l_arr_dp_4_cplx) :: this
integer :: i
do i = 1, this%d
call this%l(i)%destructor()
end do
deallocate(this%l)
this%d = 0
end subroutine l_arr_dp_4_cplx_destructor
subroutine arr_dp_2_cplx_constructor(this,d1,d2)
implicit none
class(arr_dp_2_cplx) :: this
integer :: d1, d2
allocate(this%arr(d1,d2))
this%d1 = d1
this%d2 = d2
end subroutine arr_dp_2_cplx_constructor
subroutine arr_dp_2_cplx_destructor(this)
implicit none
class(arr_dp_2_cplx) :: this
deallocate(this%arr)
this%d1 = 0
this%d2 = 0
end subroutine arr_dp_2_cplx_destructor
subroutine l_arr_dp_2_cplx_constructor(this,d)
implicit none
class(l_arr_dp_2_cplx) :: this
integer :: d
allocate(this%l(d))
this%d = d
end subroutine l_arr_dp_2_cplx_constructor
subroutine l_arr_dp_2_cplx_destructor(this)
implicit none
class(l_arr_dp_2_cplx) :: this
integer :: i
do i = 1, this%d
call this%l(i)%destructor()
end do
deallocate(this%l)
this%d = 0
end subroutine l_arr_dp_2_cplx_destructor
end module arrays_cplx