-
Notifications
You must be signed in to change notification settings - Fork 0
/
AllocInit.f90
119 lines (96 loc) · 3.77 KB
/
AllocInit.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
!> MODULE AllocInits allocates arrays, and initialises to a given value,
!! Used to prevent common errors when allocations are made without being
!! initialised. (gfortran doesn't catch this.)
module AllocInits
use CheckStop_mod, only : CheckStop
implicit none
private
public :: AllocInit
interface AllocInit
module procedure alloc_real_1d_init_scalar
module procedure alloc_real_1d_init_array
module procedure alloc_real_2d_init_scalar
module procedure alloc_real_3d_init_scalar
module procedure alloc_integer_1d_init_scalar
module procedure alloc_integer_1d_init_array
end interface AllocInit
contains
subroutine alloc_real_1d_init_scalar(a, init, n1, txt)
real, allocatable, dimension(:), intent(inout) :: a
real, intent(in) :: init
integer, intent(in) :: n1
character(len=*), intent(in) :: txt
integer :: istat
if (allocated(a) .and. any(shape(a) /= [n1])) deallocate(a)
if (.not. allocated(a)) then
allocate(a(n1), stat=istat)
call CheckStop(istat /= 0, "ERROR alloc_real_1d_init_scalar:"//trim(txt))
end if
a = init
end subroutine alloc_real_1d_init_scalar
subroutine alloc_real_1d_init_array(a, init, n1, txt)
real, allocatable, dimension(:), intent(inout) :: a
real, dimension(:), intent(in) :: init
integer, intent(in) :: n1
character(len=*), intent(in) :: txt
integer :: istat
if (allocated(a) .and. any(shape(a) /= [n1])) deallocate(a)
if (.not. allocated(a)) then
allocate(a(n1), stat=istat)
call CheckStop(istat /= 0, "ERROR alloc_real_1d_init_array:"//trim(txt))
end if
a = init
end subroutine alloc_real_1d_init_array
subroutine alloc_real_2d_init_scalar(a, init, n1, n2, txt)
real, allocatable, dimension(:,:), intent(inout) :: a
real, intent(in) :: init
integer, intent(in) :: n1, n2
character(len=*), intent(in) :: txt
integer :: istat
if (allocated(a) .and. any(shape(a) /= [n1, n2])) deallocate(a)
if (.not. allocated(a)) then
allocate(a(n1, n2), stat=istat)
call CheckStop(istat /= 0, "ERROR alloc_real_2d_init_scalar:"//trim(txt))
end if
a = init
end subroutine alloc_real_2d_init_scalar
subroutine alloc_real_3d_init_scalar(a, init, n1, n2, n3, txt)
real, allocatable, dimension(:,:,:), intent(inout) :: a
real, intent(in) :: init
integer, intent(in) :: n1, n2, n3
character(len=*), intent(in) :: txt
integer :: istat
if (allocated(a) .and. any(shape(a) /= [n1, n2, n3])) deallocate(a)
if (.not. allocated(a)) then
allocate(a(n1, n2, n3), stat=istat)
call CheckStop(istat /= 0, "ERROR alloc_real_3d_init_scalar:"//trim(txt))
end if
a = init
end subroutine alloc_real_3d_init_scalar
subroutine alloc_integer_1d_init_scalar(a, init, n1, txt)
integer, allocatable, dimension(:), intent(inout) :: a
integer, intent(in) :: init
integer, intent(in) :: n1
character(len=*), intent(in) :: txt
integer :: istat
if (allocated(a) .and. any(shape(a) /= [n1])) deallocate(a)
if (.not. allocated(a)) then
allocate(a(n1), stat=istat)
call CheckStop(istat /= 0, "ERROR alloc_integer_1d_init_scalar:"//trim(txt))
end if
a = init
end subroutine alloc_integer_1d_init_scalar
subroutine alloc_integer_1d_init_array(a, init, n1, txt)
integer, allocatable, dimension(:), intent(inout) :: a
integer, dimension(:), intent(in) :: init
integer, intent(in) :: n1
character(len=*), intent(in) :: txt
integer :: istat
if (allocated(a) .and. any(shape(a) /= [n1])) deallocate(a)
if (.not. allocated(a)) then
allocate(a(n1), stat=istat)
call CheckStop(istat /= 0, "ERROR alloc_integer_1d_init_scalar:"//trim(txt))
end if
a = init
end subroutine alloc_integer_1d_init_array
end module AllocInits