|
111
|
1 ! { dg-do compile }
|
|
|
2 ! { dg-require-visibility "" }
|
|
|
3 ! Test fix for PR47082, in which an ICE in the ALLOCATE at line 248.
|
|
|
4 !
|
|
|
5 ! Contributed by Salvatore Filippone <salvatore.filippone@uniroma2.it>
|
|
|
6 !
|
|
|
7 module psb_penv_mod
|
|
|
8
|
|
|
9 interface psb_init
|
|
|
10 module procedure psb_init
|
|
|
11 end interface
|
|
|
12
|
|
|
13 interface psb_exit
|
|
|
14 module procedure psb_exit
|
|
|
15 end interface
|
|
|
16
|
|
|
17 interface psb_info
|
|
|
18 module procedure psb_info
|
|
|
19 end interface
|
|
|
20
|
|
|
21 integer, private, save :: nctxt=0
|
|
|
22
|
|
|
23
|
|
|
24
|
|
|
25 contains
|
|
|
26
|
|
|
27
|
|
|
28 subroutine psb_init(ictxt,np,basectxt,ids)
|
|
|
29 implicit none
|
|
|
30 integer, intent(out) :: ictxt
|
|
|
31 integer, intent(in), optional :: np, basectxt, ids(:)
|
|
|
32
|
|
|
33
|
|
|
34 ictxt = nctxt
|
|
|
35 nctxt = nctxt + 1
|
|
|
36
|
|
|
37 end subroutine psb_init
|
|
|
38
|
|
|
39 subroutine psb_exit(ictxt,close)
|
|
|
40 implicit none
|
|
|
41 integer, intent(inout) :: ictxt
|
|
|
42 logical, intent(in), optional :: close
|
|
|
43
|
|
|
44 nctxt = max(0, nctxt - 1)
|
|
|
45
|
|
|
46 end subroutine psb_exit
|
|
|
47
|
|
|
48
|
|
|
49 subroutine psb_info(ictxt,iam,np)
|
|
|
50
|
|
|
51 implicit none
|
|
|
52
|
|
|
53 integer, intent(in) :: ictxt
|
|
|
54 integer, intent(out) :: iam, np
|
|
|
55
|
|
|
56 iam = 0
|
|
|
57 np = 1
|
|
|
58
|
|
|
59 end subroutine psb_info
|
|
|
60
|
|
|
61
|
|
|
62 end module psb_penv_mod
|
|
|
63
|
|
|
64
|
|
|
65 module psb_indx_map_mod
|
|
|
66
|
|
|
67 type :: psb_indx_map
|
|
|
68
|
|
|
69 integer :: state = -1
|
|
|
70 integer :: ictxt = -1
|
|
|
71 integer :: mpic = -1
|
|
|
72 integer :: global_rows = -1
|
|
|
73 integer :: global_cols = -1
|
|
|
74 integer :: local_rows = -1
|
|
|
75 integer :: local_cols = -1
|
|
|
76
|
|
|
77
|
|
|
78 end type psb_indx_map
|
|
|
79
|
|
|
80 end module psb_indx_map_mod
|
|
|
81
|
|
|
82
|
|
|
83
|
|
|
84 module psb_gen_block_map_mod
|
|
|
85 use psb_indx_map_mod
|
|
|
86
|
|
|
87 type, extends(psb_indx_map) :: psb_gen_block_map
|
|
|
88 integer :: min_glob_row = -1
|
|
|
89 integer :: max_glob_row = -1
|
|
|
90 integer, allocatable :: loc_to_glob(:), srt_l2g(:,:), vnl(:)
|
|
|
91 contains
|
|
|
92
|
|
|
93 procedure, pass(idxmap) :: gen_block_map_init => block_init
|
|
|
94
|
|
|
95 end type psb_gen_block_map
|
|
|
96
|
|
|
97 private :: block_init
|
|
|
98
|
|
|
99 contains
|
|
|
100
|
|
|
101 subroutine block_init(idxmap,ictxt,nl,info)
|
|
|
102 use psb_penv_mod
|
|
|
103 implicit none
|
|
|
104 class(psb_gen_block_map), intent(inout) :: idxmap
|
|
|
105 integer, intent(in) :: ictxt, nl
|
|
|
106 integer, intent(out) :: info
|
|
|
107 ! To be implemented
|
|
|
108 integer :: iam, np, i, j, ntot
|
|
|
109 integer, allocatable :: vnl(:)
|
|
|
110
|
|
|
111 info = 0
|
|
|
112 call psb_info(ictxt,iam,np)
|
|
|
113 if (np < 0) then
|
|
|
114 info = -1
|
|
|
115 return
|
|
|
116 end if
|
|
|
117
|
|
|
118 allocate(vnl(0:np),stat=info)
|
|
|
119 if (info /= 0) then
|
|
|
120 info = -2
|
|
|
121 return
|
|
|
122 end if
|
|
|
123
|
|
|
124 vnl(:) = 0
|
|
|
125 vnl(iam) = nl
|
|
|
126 ntot = sum(vnl)
|
|
|
127 vnl(1:np) = vnl(0:np-1)
|
|
|
128 vnl(0) = 0
|
|
|
129 do i=1,np
|
|
|
130 vnl(i) = vnl(i) + vnl(i-1)
|
|
|
131 end do
|
|
|
132 if (ntot /= vnl(np)) then
|
|
|
133 ! !$ write(0,*) ' Mismatch in block_init ',ntot,vnl(np)
|
|
|
134 end if
|
|
|
135
|
|
|
136 idxmap%global_rows = ntot
|
|
|
137 idxmap%global_cols = ntot
|
|
|
138 idxmap%local_rows = nl
|
|
|
139 idxmap%local_cols = nl
|
|
|
140 idxmap%ictxt = ictxt
|
|
|
141 idxmap%state = 1
|
|
|
142
|
|
|
143 idxmap%min_glob_row = vnl(iam)+1
|
|
|
144 idxmap%max_glob_row = vnl(iam+1)
|
|
|
145 call move_alloc(vnl,idxmap%vnl)
|
|
|
146 allocate(idxmap%loc_to_glob(nl),stat=info)
|
|
|
147 if (info /= 0) then
|
|
|
148 info = -2
|
|
|
149 return
|
|
|
150 end if
|
|
|
151
|
|
|
152 end subroutine block_init
|
|
|
153
|
|
|
154 end module psb_gen_block_map_mod
|
|
|
155
|
|
|
156
|
|
|
157 module psb_descriptor_type
|
|
|
158 use psb_indx_map_mod
|
|
|
159
|
|
|
160 implicit none
|
|
|
161
|
|
|
162
|
|
|
163 type psb_desc_type
|
|
|
164 integer, allocatable :: matrix_data(:)
|
|
|
165 integer, allocatable :: halo_index(:)
|
|
|
166 integer, allocatable :: ext_index(:)
|
|
|
167 integer, allocatable :: ovrlap_index(:)
|
|
|
168 integer, allocatable :: ovrlap_elem(:,:)
|
|
|
169 integer, allocatable :: ovr_mst_idx(:)
|
|
|
170 integer, allocatable :: bnd_elem(:)
|
|
|
171 class(psb_indx_map), allocatable :: indxmap
|
|
|
172 integer, allocatable :: lprm(:)
|
|
|
173 type(psb_desc_type), pointer :: base_desc => null()
|
|
|
174 integer, allocatable :: idx_space(:)
|
|
|
175 end type psb_desc_type
|
|
|
176
|
|
|
177
|
|
|
178 end module psb_descriptor_type
|
|
|
179
|
|
|
180 module psb_cd_if_tools_mod
|
|
|
181
|
|
|
182 use psb_descriptor_type
|
|
|
183 use psb_gen_block_map_mod
|
|
|
184
|
|
|
185 interface psb_cdcpy
|
|
|
186 subroutine psb_cdcpy(desc_in, desc_out, info)
|
|
|
187 use psb_descriptor_type
|
|
|
188
|
|
|
189 implicit none
|
|
|
190 !....parameters...
|
|
|
191
|
|
|
192 type(psb_desc_type), intent(in) :: desc_in
|
|
|
193 type(psb_desc_type), intent(out) :: desc_out
|
|
|
194 integer, intent(out) :: info
|
|
|
195 end subroutine psb_cdcpy
|
|
|
196 end interface
|
|
|
197
|
|
|
198
|
|
|
199 end module psb_cd_if_tools_mod
|
|
|
200
|
|
|
201 module psb_cd_tools_mod
|
|
|
202
|
|
|
203 use psb_cd_if_tools_mod
|
|
|
204
|
|
|
205 interface psb_cdall
|
|
|
206
|
|
|
207 subroutine psb_cdall(ictxt, desc, info,mg,ng,vg,vl,flag,nl,repl, globalcheck)
|
|
|
208 use psb_descriptor_type
|
|
|
209 implicit None
|
|
|
210 Integer, intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl
|
|
|
211 integer, intent(in) :: flag
|
|
|
212 logical, intent(in) :: repl, globalcheck
|
|
|
213 integer, intent(out) :: info
|
|
|
214 type(psb_desc_type), intent(out) :: desc
|
|
|
215
|
|
|
216 optional :: mg,ng,vg,vl,flag,nl,repl, globalcheck
|
|
|
217 end subroutine psb_cdall
|
|
|
218
|
|
|
219 end interface
|
|
|
220
|
|
|
221 end module psb_cd_tools_mod
|
|
|
222 module psb_base_tools_mod
|
|
|
223 use psb_cd_tools_mod
|
|
|
224 end module psb_base_tools_mod
|
|
|
225
|
|
|
226 subroutine psb_cdall(ictxt, desc, info,mg,ng,vg,vl,flag,nl,repl, globalcheck)
|
|
|
227 use psb_descriptor_type
|
|
|
228 use psb_gen_block_map_mod
|
|
|
229 use psb_base_tools_mod, psb_protect_name => psb_cdall
|
|
|
230 implicit None
|
|
|
231 Integer, intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl
|
|
|
232 integer, intent(in) :: flag
|
|
|
233 logical, intent(in) :: repl, globalcheck
|
|
|
234 integer, intent(out) :: info
|
|
|
235 type(psb_desc_type), intent(out) :: desc
|
|
|
236
|
|
|
237 optional :: mg,ng,vg,vl,flag,nl,repl, globalcheck
|
|
|
238 integer :: err_act, n_, flag_, i, me, np, nlp, nnv, lr
|
|
|
239 integer, allocatable :: itmpsz(:)
|
|
|
240
|
|
|
241
|
|
|
242
|
|
|
243 info = 0
|
|
|
244 desc%base_desc => null()
|
|
|
245 if (allocated(desc%indxmap)) then
|
|
|
246 write(0,*) 'Allocated on an intent(OUT) var?'
|
|
|
247 end if
|
|
|
248
|
|
|
249 allocate(psb_gen_block_map :: desc%indxmap, stat=info)
|
|
|
250 if (info == 0) then
|
|
|
251 select type(aa => desc%indxmap)
|
|
|
252 type is (psb_gen_block_map)
|
|
|
253 call aa%gen_block_map_init(ictxt,nl,info)
|
|
|
254 class default
|
|
|
255 ! This cannot happen
|
|
|
256 info = -1
|
|
|
257 end select
|
|
|
258 end if
|
|
|
259
|
|
|
260 return
|
|
|
261
|
|
|
262 end subroutine psb_cdall
|
