Skip to content

Commit af467b1

Browse files
rousonrouson
authored
Merge pull request #14 from sourceryinstitute/double-precision
Feature: support double precision & 3D arrays intrinsic_array_t constructor
2 parents 604b461 + bf0c949 commit af467b1

File tree

2 files changed

+61
-15
lines changed

2 files changed

+61
-15
lines changed

‎src/intrinsic_array_m.F90‎

Lines changed: 18 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -7,20 +7,26 @@ module intrinsic_array_m
77
public :: intrinsic_array_t
88

99
type, extends(characterizable_t) :: intrinsic_array_t
10-
complex, allocatable :: complex_1D(:)
11-
integer, allocatable :: integer_1D(:)
12-
logical, allocatable :: logical_1D(:)
13-
real, allocatable :: real_1D(:)
10+
complex, allocatable :: complex_1D(:)
11+
complex(kind(1.D0)), allocatable :: complex_double_1D(:)
12+
integer, allocatable :: integer_1D(:)
13+
logical, allocatable :: logical_1D(:)
14+
real, allocatable :: real_1D(:)
15+
double precision, allocatable :: double_precision_1D(:)
1416

15-
complex, allocatable :: complex_2D(:,:)
16-
integer, allocatable :: integer_2D(:,:)
17-
logical, allocatable :: logical_2D(:,:)
18-
real, allocatable :: real_2D(:,:)
17+
complex, allocatable :: complex_2D(:,:)
18+
complex(kind(1.D0)), allocatable :: complex_double_2D(:,:)
19+
integer, allocatable :: integer_2D(:,:)
20+
logical, allocatable :: logical_2D(:,:)
21+
real, allocatable :: real_2D(:,:)
22+
double precision, allocatable :: double_precision_2D(:,:)
1923

20-
complex, allocatable :: complex_3D(:,:,:)
21-
integer, allocatable :: integer_3D(:,:,:)
22-
logical, allocatable :: logical_3D(:,:,:)
23-
real, allocatable :: real_3D(:,:,:)
24+
complex, allocatable :: complex_3D(:,:,:)
25+
complex(kind(1.D0)), allocatable :: complex_double_3D(:,:,:)
26+
integer, allocatable :: integer_3D(:,:,:)
27+
logical, allocatable :: logical_3D(:,:,:)
28+
real, allocatable :: real_3D(:,:,:)
29+
double precision, allocatable :: double_precision_3D(:,:,:)
2430
contains
2531
procedure :: as_character
2632
end type

‎src/intrinsic_array_s.F90‎

Lines changed: 43 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
module procedure construct
77

88
#ifndef NAGFOR
9-
select rank(array)
9+
select rank(array)
1010
rank(1)
1111
#endif
1212
select type(array)
@@ -18,6 +18,8 @@
1818
intrinsic_array%logical_1D = array
1919
type is(real)
2020
intrinsic_array%real_1D = array
21+
type is(double precision)
22+
intrinsic_array%double_precision_1D = array
2123
class default
2224
error stop "intrinsic_array_t construct: unsupported rank-2 type"
2325
end select
@@ -32,6 +34,8 @@
3234
intrinsic_array%logical_2D = array
3335
type is(real)
3436
intrinsic_array%real_2D = array
37+
type is(double precision)
38+
intrinsic_array%double_precision_2D = array
3539
class default
3640
error stop "intrinsic_array_t construct: unsupported rank-2 type"
3741
end select
@@ -46,6 +50,8 @@
4650
intrinsic_array%logical_3D = array
4751
type is(real)
4852
intrinsic_array%real_3D = array
53+
type is(double precision)
54+
intrinsic_array%double_precision_3D = array
4955
class default
5056
error stop "intrinsic_array_t construct: unsupported rank-3 type"
5157
end select
@@ -61,13 +67,20 @@
6167
integer, parameter :: single_number_width=32
6268

6369
if (1 /= count( &
64-
[ allocated(self%complex_1D), allocated(self%integer_1D), allocated(self%logical_1D), allocated(self%real_1D) &
65-
,allocated(self%complex_2D), allocated(self%integer_2D), allocated(self%logical_2D), allocated(self%real_2D) &
70+
[ allocated(self%complex_1D), allocated(self%complex_double_1D), allocated(self%integer_1D), &
71+
allocated(self%logical_1D), allocated(self%real_1D), &
72+
allocated(self%complex_2D), allocated(self%complex_double_2D), allocated(self%integer_2D), &
73+
allocated(self%logical_2D), allocated(self%real_2D), &
74+
allocated(self%complex_3D), allocated(self%complex_double_3D), allocated(self%integer_3D), &
75+
allocated(self%logical_3D), allocated(self%real_3D) &
6676
])) error stop "intrinsic_array_t as_character: ambiguous component allocation status."
6777

6878
if (allocated(self%complex_1D)) then
6979
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_1D))
7080
write(character_self, *) self%complex_1D
81+
else if (allocated(self%complex_double_1D)) then
82+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_1D))
83+
write(character_self, *) self%complex_double_1D
7184
else if (allocated(self%integer_1D)) then
7285
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_1D))
7386
write(character_self, *) self%integer_1D
@@ -77,9 +90,15 @@
7790
else if (allocated(self%real_1D)) then
7891
character_self = repeat(" ", ncopies = single_number_width*size(self%real_1D))
7992
write(character_self, *) self%real_1D
93+
else if (allocated(self%double_precision_1D)) then
94+
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_1D))
95+
write(character_self, *) self%double_precision_1D
8096
else if (allocated(self%complex_2D)) then
8197
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_2D))
8298
write(character_self, *) self%complex_2D
99+
else if (allocated(self%complex_double_2D)) then
100+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_2D))
101+
write(character_self, *) self%complex_double_2D
83102
else if (allocated(self%integer_2D)) then
84103
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_2D))
85104
write(character_self, *) self%integer_2D
@@ -89,6 +108,27 @@
89108
else if (allocated(self%real_2D)) then
90109
character_self = repeat(" ", ncopies = single_number_width*size(self%real_2D))
91110
write(character_self, *) self%real_2D
111+
else if (allocated(self%double_precision_2D)) then
112+
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_2D))
113+
write(character_self, *) self%double_precision_2D
114+
else if (allocated(self%complex_3D)) then
115+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_3D))
116+
write(character_self, *) self%complex_3D
117+
else if (allocated(self%complex_double_3D)) then
118+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_3D))
119+
write(character_self, *) self%complex_double_3D
120+
else if (allocated(self%integer_3D)) then
121+
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_3D))
122+
write(character_self, *) self%integer_3D
123+
else if (allocated(self%logical_3D)) then
124+
character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
125+
write(character_self, *) self%logical_3D
126+
else if (allocated(self%real_3D)) then
127+
character_self = repeat(" ", ncopies = single_number_width*size(self%real_3D))
128+
write(character_self, *) self%real_3D
129+
else if (allocated(self%double_precision_3D)) then
130+
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_3D))
131+
write(character_self, *) self%double_precision_3D
92132
end if
93133

94134
character_self = trim(adjustl(character_self))

0 commit comments

Comments
 (0)