Skip to content

Feature: support double precision & 3D arrays intrinsic_array_t constructor #14

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
rouson merged 3 commits into from
Jun 27, 2022
Merged

Feature: support double precision & 3D arrays intrinsic_array_t constructor #14

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
a3065a9
feat(intrinsic_array): support double-prec. & 3D
rouson Jun 22, 2022
a3bf638
merge origin/double-precision
rouson Jun 27, 2022
bf0c949
Merge branch 'main' into double-precision
rouson Jun 27, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 18 additions & 12 deletions src/intrinsic_array_m.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,20 +7,26 @@ module intrinsic_array_m
public :: intrinsic_array_t

type, extends(characterizable_t) :: intrinsic_array_t
complex, allocatable :: complex_1D(:)
integer, allocatable :: integer_1D(:)
logical, allocatable :: logical_1D(:)
real, allocatable :: real_1D(:)
complex, allocatable :: complex_1D(:)
complex(kind(1.D0)), allocatable :: complex_double_1D(:)
integer, allocatable :: integer_1D(:)
logical, allocatable :: logical_1D(:)
real, allocatable :: real_1D(:)
double precision, allocatable :: double_precision_1D(:)

complex, allocatable :: complex_2D(:,:)
integer, allocatable :: integer_2D(:,:)
logical, allocatable :: logical_2D(:,:)
real, allocatable :: real_2D(:,:)
complex, allocatable :: complex_2D(:,:)
complex(kind(1.D0)), allocatable :: complex_double_2D(:,:)
integer, allocatable :: integer_2D(:,:)
logical, allocatable :: logical_2D(:,:)
real, allocatable :: real_2D(:,:)
double precision, allocatable :: double_precision_2D(:,:)

complex, allocatable :: complex_3D(:,:,:)
integer, allocatable :: integer_3D(:,:,:)
logical, allocatable :: logical_3D(:,:,:)
real, allocatable :: real_3D(:,:,:)
complex, allocatable :: complex_3D(:,:,:)
complex(kind(1.D0)), allocatable :: complex_double_3D(:,:,:)
integer, allocatable :: integer_3D(:,:,:)
logical, allocatable :: logical_3D(:,:,:)
real, allocatable :: real_3D(:,:,:)
double precision, allocatable :: double_precision_3D(:,:,:)
contains
procedure :: as_character
end type
Expand Down
46 changes: 43 additions & 3 deletions src/intrinsic_array_s.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
module procedure construct

#ifndef NAGFOR
select rank(array)
select rank(array)
rank(1)
#endif
select type(array)
Expand All @@ -18,6 +18,8 @@
intrinsic_array%logical_1D = array
type is(real)
intrinsic_array%real_1D = array
type is(double precision)
intrinsic_array%double_precision_1D = array
class default
error stop "intrinsic_array_t construct: unsupported rank-2 type"
end select
Expand All @@ -32,6 +34,8 @@
intrinsic_array%logical_2D = array
type is(real)
intrinsic_array%real_2D = array
type is(double precision)
intrinsic_array%double_precision_2D = array
class default
error stop "intrinsic_array_t construct: unsupported rank-2 type"
end select
Expand All @@ -46,6 +50,8 @@
intrinsic_array%logical_3D = array
type is(real)
intrinsic_array%real_3D = array
type is(double precision)
intrinsic_array%double_precision_3D = array
class default
error stop "intrinsic_array_t construct: unsupported rank-3 type"
end select
Expand All @@ -61,13 +67,20 @@
integer, parameter :: single_number_width=32

if (1 /= count( &
[ allocated(self%complex_1D), allocated(self%integer_1D), allocated(self%logical_1D), allocated(self%real_1D) &
,allocated(self%complex_2D), allocated(self%integer_2D), allocated(self%logical_2D), allocated(self%real_2D) &
[ allocated(self%complex_1D), allocated(self%complex_double_1D), allocated(self%integer_1D), &
allocated(self%logical_1D), allocated(self%real_1D), &
allocated(self%complex_2D), allocated(self%complex_double_2D), allocated(self%integer_2D), &
allocated(self%logical_2D), allocated(self%real_2D), &
allocated(self%complex_3D), allocated(self%complex_double_3D), allocated(self%integer_3D), &
allocated(self%logical_3D), allocated(self%real_3D) &
])) error stop "intrinsic_array_t as_character: ambiguous component allocation status."

if (allocated(self%complex_1D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_1D))
write(character_self, *) self%complex_1D
else if (allocated(self%complex_double_1D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_1D))
write(character_self, *) self%complex_double_1D
else if (allocated(self%integer_1D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_1D))
write(character_self, *) self%integer_1D
Expand All @@ -77,9 +90,15 @@
else if (allocated(self%real_1D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%real_1D))
write(character_self, *) self%real_1D
else if (allocated(self%double_precision_1D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_1D))
write(character_self, *) self%double_precision_1D
else if (allocated(self%complex_2D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_2D))
write(character_self, *) self%complex_2D
else if (allocated(self%complex_double_2D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_2D))
write(character_self, *) self%complex_double_2D
else if (allocated(self%integer_2D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_2D))
write(character_self, *) self%integer_2D
Expand All @@ -89,6 +108,27 @@
else if (allocated(self%real_2D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%real_2D))
write(character_self, *) self%real_2D
else if (allocated(self%double_precision_2D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_2D))
write(character_self, *) self%double_precision_2D
else if (allocated(self%complex_3D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_3D))
write(character_self, *) self%complex_3D
else if (allocated(self%complex_double_3D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_3D))
write(character_self, *) self%complex_double_3D
else if (allocated(self%integer_3D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_3D))
write(character_self, *) self%integer_3D
else if (allocated(self%logical_3D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
write(character_self, *) self%logical_3D
else if (allocated(self%real_3D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%real_3D))
write(character_self, *) self%real_3D
else if (allocated(self%double_precision_3D)) then
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_3D))
write(character_self, *) self%double_precision_3D
end if

character_self = trim(adjustl(character_self))
Expand Down