OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cfac_process_maprow.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, University of Bordeaux.
8C
9C This version of MUMPS is provided to you free of charge. It is
10C released under the CeCILL-C license
11C (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14 RECURSIVE SUBROUTINE cmumps_maplig( COMM_LOAD, ASS_IRECV,
15 & BUFR, LBUFR, LBUFR_BYTES,
16 &
17 & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE,
18 & NFRONT_PERE, NASS_PERE, NFS4FATHER, LMAP, TROW,
19 & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
20 & LRLUS, N, IW,
21 & LIW, A, LA,
22 & PTRIST, PTLUST, PTRFAC,
23 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP,
24 & IFLAG, IERROR, MYID, COMM, PERM, IPOOL, LPOOL, LEAF,
25 & NBFIN, ICNTL, KEEP,KEEP8,DKEEP,
26 & root, OPASSW, OPELIW,
27 & ITLOC, RHS_MUMPS,
28 & FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE,
29 & LPTRAR, NELT, FRTPTR, FRTELT,
30 &
31 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
32 & , LRGROUPS
33 & )
34 USE cmumps_buf
35 USE cmumps_load
36 USE cmumps_lr_data_m
37 USE cmumps_dynamic_memory_m, ONLY : cmumps_dm_set_dynptr
38 USE cmumps_fac_front_aux_m, ONLY : cmumps_get_size_schur_in_front
39#if ! defined(NO_FDM_MAPROW)
40 USE mumps_fac_maprow_data_m
41#endif
42 USE cmumps_struc_def, ONLY : cmumps_root_struc
43 IMPLICIT NONE
44#if ! defined(NO_FDM_MAPROW)
45#endif
46 TYPE (cmumps_root_struc ) :: root
47 INTEGER lbufr, lbufr_bytes
48 INTEGER icntl( 60 ), keep(500)
49 INTEGER(8) keep8(150)
50 REAL dkeep(230)
51 INTEGER comm_load, ass_irecv
52 INTEGER bufr( lbufr )
53 INTEGER slavef, nbfin
54 INTEGER(8) :: la, iptrlu, lrlu, lrlus, posfac
55 INTEGER iwpos, iwposcb
56 INTEGER n, liw
57 INTEGER iw( liw )
58 COMPLEX a( la )
59 INTEGER, intent(in) :: lrgroups(n)
60 INTEGER(8) :: ptrfac(keep(28))
61 INTEGER(8) :: ptrast(keep(28))
62 INTEGER(8) :: pamaster(keep(28))
63 INTEGER ptrist(keep(28)), ptlust(keep(28))
64 INTEGER step(n), pimaster(keep(28))
65 INTEGER procnode_steps( keep(28) )
66 INTEGER comp
67 INTEGER nstk( keep(28) )
68 INTEGER perm(n)
69 INTEGER iflag, ierror, comm, myid
70 INTEGER lpool, leaf
71 INTEGER ipool( lpool )
72 INTEGER inode_pere, ison
73 INTEGER :: nfs4father
74 INTEGER nbrows_already_sent
75 INTEGER nslaves_pere, nfront_pere, nass_pere
76 INTEGER list_slaves_pere( * )
77 INTEGER lmap
78 INTEGER trow( lmap )
79 DOUBLE PRECISION opassw, opeliw
80 COMPLEX dblarr(keep8(26))
81 INTEGER intarr(keep8(27))
82 INTEGER lptrar, nelt
83 INTEGER frtptr( n+1 ), frtelt( nelt )
84 INTEGER itloc( n+keep(253) ), fils( n ), dad( keep(28) )
85 COMPLEX :: rhs_mumps(keep(255))
86 INTEGER(8), INTENT(IN) :: ptrarw( lptrar ), ptraiw( lptrar )
87 INTEGER nd( keep(28) ), frere( keep(28) )
88 INTEGER istep_to_iniv2(keep(71)),
89 & tab_pos_in_pere(slavef+2,max(1,keep(56)))
90 include 'mpif.h'
91 include 'mumps_tags.h'
92 INTEGER ierr
93 INTEGER :: status(mpi_status_size)
94 INTEGER nosla, i
95 INTEGER i_posmyidin_pere
96 INTEGER indice_pere
97 INTEGER pdest, pdest_master
98 LOGICAL :: local_assembly_to_be_done
99 INTEGER nrows_to_send
100 INTEGER pdest_master_ison, ipos_in_slave
101 LOGICAL desclu, slave_ison
102 LOGICAL blocking, set_irecv, message_received
103 INTEGER msgsou, msgtag
104 INTEGER lp
105 LOGICAL packed_cb
106 LOGICAL is_error_broadcasted, is_oftype5or6
107 INTEGER itype_son, typesplit
108 INTEGER :: keep253_loc
109 INTEGER :: nvschur, nslaves_l, nrow_l, irow_l, nass_l, nelim_l
110 LOGICAL :: cb_is_lr
111 INTEGER :: iwxxf_handler
112 COMPLEX :: adummy(1)
113 COMPLEX, POINTER, DIMENSION(:) :: son_a
114 INTEGER(8) :: iachk, recsize
115#if ! defined(NO_FDM_MAPROW)
116 INTEGER :: info_tmp(2)
117#endif
118 include 'mumps_headers.h'
119 INTEGER mumps_procnode, mumps_typenode, mumps_typesplit
120 EXTERNAL mumps_procnode, mumps_typenode, mumps_typesplit
121 INTEGER lmap_loc, allocok
122 INTEGER, ALLOCATABLE, DIMENSION(:) :: nbrow
123 INTEGER, ALLOCATABLE, DIMENSION(:) :: slaves_pere
124 INTEGER, ALLOCATABLE, DIMENSION(:) :: map, perm_loc
125 is_error_broadcasted = .false.
126 typesplit = mumps_typesplit( procnode_steps(step(inode_pere)),
127 & keep(199) )
128 itype_son = mumps_typenode( procnode_steps(step(ison)),
129 & keep(199) )
130 is_oftype5or6 = ((typesplit.EQ.5).OR.(typesplit.EQ.6))
131 lp = icntl(1)
132 IF (icntl(4) .LE. 0) lp = -1
133 cb_is_lr = (iw(ptrist(step(ison))+xxlr).EQ.1 .OR.
134 & iw(ptrist(step(ison))+xxlr).EQ.3)
135 iwxxf_handler = iw(ptrist(step(ison))+xxf)
136#if ! defined(NO_FDM_MAPROW)
137#endif
138 ALLOCATE(slaves_pere(0:max(1,nslaves_pere)), stat=allocok)
139 if (allocok .GT. 0) THEN
140 IF (lp > 0) THEN
141 write(lp,*) myid,
142 & ' : PB allocation SLAVES_PERE in CMUMPS_MAPLIG'
143 ENDIF
144 iflag =-13
145 ierror = nslaves_pere+1
146 GOTO 700
147 endif
148 IF (nslaves_pere.GT.0)
149 &slaves_pere(1:nslaves_pere) = list_slaves_pere(1:nslaves_pere)
150 slaves_pere(0) = mumps_procnode( procnode_steps(step(inode_pere)),
151 & keep(199) )
152 ALLOCATE(nbrow(0:nslaves_pere), stat=allocok)
153 if (allocok .GT. 0) THEN
154 IF (lp>0) THEN
155 write(lp,*) myid,
156 & ' : PB allocation NBROW in CMUMPS_MAPLIG'
157 ENDIF
158 iflag =-13
159 ierror = nslaves_pere+1
160 GOTO 670
161 endif
162 lmap_loc = lmap
163 ALLOCATE(map(lmap_loc), stat=allocok)
164 if (allocok .GT. 0) THEN
165 IF (lp>0) THEN
166 write(lp,*) myid, ' : PB allocation LMAP in CMUMPS_MAPLIG'
167 ENDIF
168 iflag =-13
169 ierror = lmap
170 GOTO 680
171 endif
172 map( 1 : lmap ) = trow( 1 : lmap )
173 pdest_master_ison = mumps_procnode(procnode_steps(step(ison)),
174 & keep(199))
175 slave_ison = pdest_master_ison .NE. myid
176 IF (slave_ison) THEN
177 IF ( ptrist(step( ison )) .EQ. 0 ) THEN
178 CALL cmumps_treat_descband( ison, comm_load,
179 & ass_irecv,
180 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
181 & iwpos, iwposcb, iptrlu,
182 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
183 & ptlust, ptrfac,
184 & ptrast, step, pimaster, pamaster, nstk, comp,
185 & iflag, ierror, comm,
186 & perm,
187 & ipool, lpool, leaf,
188 & nbfin, myid, slavef,
189 &
190 & root, opassw, opeliw, itloc, rhs_mumps,
191 & fils, dad, ptrarw, ptraiw,
192 & intarr, dblarr,icntl,keep,keep8,dkeep,nd, frere, lptrar,
193 & nelt, frtptr, frtelt,
194 & istep_to_iniv2, tab_pos_in_pere, .true.
195 & , lrgroups
196 & )
197 IF ( iflag .LT. 0 ) THEN
198 is_error_broadcasted = .true.
199 GOTO 670
200 ENDIF
201 END IF
202#if ! defined(NO_FDM_MAPROW)
203 IF (
204 & ( iw( ptrist(step(ison)) + 1 + keep(ixsz) ) .NE.
205 & iw( ptrist(step(ison)) + 3 + keep(ixsz) ) ) .OR.
206 & ( keep(50) .NE. 0 .AND.
207 & iw( ptrist(step(ison)) + 6 + keep(ixsz) ) .NE. 0 ) )
208 & THEN
209 info_tmp=0
210 CALL mumps_fmrd_save_maprow(
211 & iw(ptrist(step(ison))+xxa),
212 & inode_pere, ison, nslaves_pere, nfront_pere,
213 & nass_pere, lmap, nfs4father,
214 & slaves_pere(1:nslaves_pere),
215 & map,
216 & info_tmp)
217 IF (info_tmp(1) < 0) THEN
218 iflag = info_tmp(1)
219 ierror = info_tmp(2)
220 ENDIF
221 GOTO 670
222 ELSE
223 GOTO 10
224 ENDIF
225#endif
226 DO WHILE (
227 & ( iw( ptrist(step(ison)) + 1 + keep(ixsz) ) .NE.
228 & iw( ptrist(step(ison)) + 3 + keep(ixsz) ) ) .OR.
229 & ( keep(50) .NE. 0 .AND.
230 & iw( ptrist(step(ison)) + 6 + keep(ixsz) ) .NE. 0 ) )
231 IF ( keep(50).eq.0) THEN
232 msgsou = pdest_master_ison
233 msgtag = bloc_facto
234 ELSE
235 IF ( iw( ptrist(step(ison)) + 1 + keep(ixsz) ) .NE.
236 & iw( ptrist(step(ison)) + 3 + keep(ixsz) ) ) THEN
237 msgsou = pdest_master_ison
238 msgtag = bloc_facto_sym
239 ELSE
240 msgsou = mpi_any_source
241 msgtag = bloc_facto_sym_slave
242 END IF
243 END IF
244 blocking = .true.
245 set_irecv= .false.
246 message_received = .false.
247 CALL cmumps_try_recvtreat( comm_load,
248 & ass_irecv, blocking, set_irecv, message_received,
249 & msgsou, msgtag,
250 & status,
251 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
252 & iwpos, iwposcb, iptrlu,
253 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
254 & ptlust, ptrfac,
255 & ptrast, step, pimaster, pamaster, nstk, comp,
256 & iflag, ierror, comm,
257 & perm, ipool, lpool, leaf, nbfin, myid, slavef,
258 &
259 & root, opassw, opeliw, itloc, rhs_mumps,
260 & fils, dad, ptrarw, ptraiw,
261 & intarr, dblarr,icntl,keep,keep8,dkeep,nd, frere, lptrar,
262 & nelt, frtptr, frtelt,
263 & istep_to_iniv2, tab_pos_in_pere, .true.
264 & , lrgroups
265 & )
266 IF ( iflag .LT. 0 ) THEN
267 is_error_broadcasted = .true.
268 GOTO 670
269 ENDIF
270 END DO
271 ENDIF
272#if ! defined(NO_FDM_MAPROW)
273 10 CONTINUE
274#endif
275 IF ( nslaves_pere .EQ. 0 ) THEN
276 nbrow( 0 ) = lmap_loc
277 ELSE
278 DO i = 0, nslaves_pere
279 nbrow( i ) = 0
280 END DO
281 DO i = 1, lmap_loc
282 indice_pere = map( i )
283 CALL mumps_bloc2_get_islave(
284 & keep,keep8, inode_pere, step, n, slavef,
285 & istep_to_iniv2, tab_pos_in_pere,
286 &
287 & nass_pere,
288 & nfront_pere - nass_pere,
289 & nslaves_pere,
290 & indice_pere,
291 & nosla,
292 & ipos_in_slave )
293 nbrow( nosla ) = nbrow( nosla ) + 1
294 END DO
295 DO i = 1, nslaves_pere
296 nbrow(i)=nbrow(i)+nbrow(i-1)
297 ENDDO
298 ENDIF
299 ALLOCATE(perm_loc(lmap_loc), stat=allocok)
300 IF (allocok .GT. 0) THEN
301 IF (lp.GT.0) THEN
302 write(lp,*) myid,': pb allocation perm_loc in cmumps_maplig'
303 ENDIF
304 IFLAG =-13
305 IERROR = LMAP_LOC
306 GOTO 670
307 ENDIF
308 KEEP253_LOC = 0
309 DO I = LMAP_LOC, 1, -1
310 INDICE_PERE = MAP( I )
311 IF (INDICE_PERE > NFRONT_PERE - KEEP(253)) THEN
312 KEEP253_LOC = KEEP253_LOC + 1
313 ENDIF
314 CALL MUMPS_BLOC2_GET_ISLAVE(
315 & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF,
316 & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
317 &
318 & NASS_PERE,
319 & NFRONT_PERE - NASS_PERE,
320 & NSLAVES_PERE,
321 & INDICE_PERE,
322 & NOSLA,
323 & IPOS_IN_SLAVE )
324 PERM_LOC( NBROW( NOSLA ) ) = I
325 NBROW( NOSLA ) = NBROW( NOSLA ) - 1
326 ENDDO
327 DO I = 0, NSLAVES_PERE
328 NBROW(I)=NBROW(I)+1
329 END DO
330.EQ..AND..EQ..AND. IF ((KEEP(114)1) (KEEP(50)2)
331.GT..AND..GT. & (KEEP(116)0) ((LMAP_LOC-KEEP253_LOC)0)
332 & ) THEN
333.EQ. IF (ITYPE_SON1) THEN
334 NELIM_L = IW(PTLUST(STEP(ISON))+1+KEEP(IXSZ))
335 NASS_L = NELIM_L +
336 & IW(PTLUST(STEP(ISON))+3+KEEP(IXSZ))
337 IROW_L = PTLUST(STEP(ISON))+6+KEEP(IXSZ)+NASS_L
338 NROW_L = LMAP_LOC
339 ELSE
340 NROW_L = LMAP_LOC
341 NSLAVES_L = IW( PTRIST(STEP( ISON )) + 5 + KEEP(IXSZ) )
342 IROW_L = PTRIST(STEP(ISON)) + 6 + NSLAVES_L + KEEP(IXSZ)
343 ENDIF
344 CALL CMUMPS_GET_SIZE_SCHUR_IN_FRONT (
345 & N,
346 & NROW_L-KEEP253_LOC,
347 & KEEP(116),
348 & IW(IROW_L),
349 & PERM, NVSCHUR )
350 ELSE
351 NVSCHUR = 0
352 ENDIF
353 PDEST_MASTER = SLAVES_PERE(0)
354 I_POSMYIDIN_PERE = -99999
355 LOCAL_ASSEMBLY_TO_BE_DONE = .FALSE.
356 DO I = 0, NSLAVES_PERE
357.EQ. IF (SLAVES_PERE(I) MYID) THEN
358 I_POSMYIDIN_PERE = I
359 LOCAL_ASSEMBLY_TO_BE_DONE = .TRUE.
360#if ! defined(NO_FDM_DESCBAND)
361.EQ. IF (PTRIST(STEP(INODE_PERE)) 0
362.AND..NE. & MYID PDEST_MASTER) THEN
363 CALL CMUMPS_TREAT_DESCBAND( INODE_PERE, COMM_LOAD,
364 & ASS_IRECV,
365 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
366 & IWPOS, IWPOSCB, IPTRLU,
367 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
368 & PTLUST, PTRFAC,
369 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP,
370 & IFLAG, IERROR, COMM,
371 & PERM, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
372 &
373 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
374 & FILS, DAD, PTRARW, PTRAIW,
375 & INTARR, DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE, LPTRAR,
376 & NELT, FRTPTR, FRTELT,
377 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.
378 & , LRGROUPS
379 & )
380.LT. IF ( IFLAG 0 ) THEN
381 IS_ERROR_BROADCASTED = .TRUE.
382 GOTO 600
383 ENDIF
384 ENDIF
385#endif
386 ENDIF
387 END DO
388.NE..AND. IF (KEEP(120)0 LOCAL_ASSEMBLY_TO_BE_DONE) THEN
389 CALL CMUMPS_LOCAL_ASSEMBLY_TYPE2(I_POSMYIDIN_PERE,
390 & SLAVES_PERE(I_POSMYIDIN_PERE),
391 & MYID, PDEST_MASTER, ISON, INODE_PERE,
392 & NSLAVES_PERE, NASS_PERE, NFRONT_PERE, NFS4FATHER,
393 & LMAP_LOC, MAP, NBROW, PERM_LOC,
394 & IS_ofType5or6, IFLAG, IERROR,
395 & N, SLAVEF, KEEP, IPOOL, LPOOL, STEP,
396 & PROCNODE_STEPS, COMM_LOAD, ISTEP_TO_INIV2, TAB_POS_IN_PERE,
397 & KEEP8, IW, LIW, A, LA, LRLU, LRLUS, IPTRLU, IWPOSCB,
398 & PTRIST, PTLUST, PTRAST, PAMASTER, PIMASTER, ND,
399 & NELT, FRTPTR, FRTELT,
400 & OPASSW, OPELIW,
401 & ITLOC, RHS_MUMPS, KEEP253_LOC, NVSCHUR,
402 & FILS, DAD, LPTRAR, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL,
403 & ITYPE_SON, LRGROUPS)
404 LOCAL_ASSEMBLY_TO_BE_DONE = .FALSE.
405 IF (IFLAG < 0) THEN
406 GOTO 600
407 ENDIF
408 ENDIF
409 DO I = NSLAVES_PERE, 0, -1
410 PDEST = SLAVES_PERE( I )
411.NE. IF ( PDEST MYID ) THEN
412 DESCLU = .FALSE.
413 NBROWS_ALREADY_SENT = 0
414 IF (I == NSLAVES_PERE) THEN
415 NROWS_TO_SEND=LMAP_LOC-NBROW(I)+1
416 ELSE
417 NROWS_TO_SEND=NBROW(I+1)-NBROW(I)
418 ENDIF
419.EQ. PACKED_CB=(IW(PTRIST(STEP(ISON))+XXS)S_CB1COMP)
420 IERR = -1
421.EQ. DO WHILE (IERR -1)
422 IF ( IW ( PTRIST(STEP(ISON) )+KEEP(IXSZ) )
423.GT. & N + KEEP(253) ) THEN
424 WRITE(*,*) MYID,': internal error in maplig'
425 WRITE(*,*) MYID,': ptrist(step(ison))/n=',
426 & PTRIST(STEP(ISON)), N
427 WRITE(*,*) MYID,': i, nbrow(i)=',I, NBROW(I)
428 WRITE(*,*) MYID,': nslaves_pere=',NSLAVES_PERE
429 WRITE(*,*) MYID,': ison, inode_pere=',ISON,INODE_PERE
430 WRITE(*,*) MYID,': son header=',
431 & IW(PTRIST(STEP(ISON)): PTRIST(STEP(ISON))+5+KEEP(IXSZ))
432 CALL MUMPS_ABORT()
433 END IF
434.EQ..AND..NE. IF (NROWS_TO_SEND 0 PDESTPDEST_MASTER) THEN
435 IERR = 0
436 CYCLE
437 ENDIF
438 IF (CB_IS_LR) THEN
439 CALL CMUMPS_BUF_SEND_CONTRIB_TYPE2(
440 & NBROWS_ALREADY_SENT,
441 & DESCLU, INODE_PERE,
442 & NFRONT_PERE, NASS_PERE, NFS4FATHER,
443 & NSLAVES_PERE, ISON,
444 & NROWS_TO_SEND, LMAP_LOC, MAP,
445 & PERM_LOC(min(LMAP_LOC,NBROW(I))),
446 & IW( PTRIST(STEP(ISON))),
447 & ADummy, 1_8,
448 & I, PDEST, PDEST_MASTER,
449 & COMM, IERR,
450 & KEEP,KEEP8, STEP, N, SLAVEF,
451 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PACKED_CB,
452 & KEEP253_LOC, NVSCHUR,
453 & ITYPE_SON, MYID,
454 & NPIV_CHECK = IW(PTLUST(STEP(ISON))+3+KEEP(IXSZ)))
455 ELSE
456 CALL CMUMPS_DM_SET_DYNPTR(
457 & IW(PTRIST(STEP(ISON))+XXS),
458 & A, LA,
459 & PTRAST(STEP(ISON)),
460 & IW(PTRIST(STEP(ISON))+XXD),
461 & IW(PTRIST(STEP(ISON))+XXR),
462 & SON_A, IACHK, RECSIZE )
463 CALL CMUMPS_BUF_SEND_CONTRIB_TYPE2( NBROWS_ALREADY_SENT,
464 & DESCLU, INODE_PERE,
465 & NFRONT_PERE, NASS_PERE, NFS4FATHER,
466 & NSLAVES_PERE, ISON,
467 & NROWS_TO_SEND, LMAP_LOC, MAP,
468 & PERM_LOC(min(LMAP_LOC,NBROW(I))),
469 & IW( PTRIST(STEP(ISON))),
470 & SON_A(IACHK:IACHK+RECSIZE-1_8),
471 & RECSIZE,
472 & I, PDEST, PDEST_MASTER,
473 & COMM, IERR,
474 & KEEP,KEEP8, STEP, N, SLAVEF,
475 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PACKED_CB,
476 & KEEP253_LOC, NVSCHUR,
477 & ITYPE_SON, MYID)
478 ENDIF
479.EQ. IF ( IERR -2 ) THEN
480 IFLAG = -17
481.GT. IF (LP 0) THEN
482 WRITE(LP,*)
483 & "FAILURE: SEND BUFFER TOO SMALL IN CMUMPS_MAPLIG"
484 ENDIF
485 IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) +
486 & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ))
487 & * KEEP( 35 )
488 GO TO 600
489 END IF
490.EQ. IF ( IERR -3 ) THEN
491.GT. IF (LP 0) THEN
492 WRITE(LP,*)
493 & "FAILURE: RECV BUFFER TOO SMALL IN CMUMPS_MAPLIG"
494 ENDIF
495 IFLAG = -20
496 IERROR = (NROWS_TO_SEND + 3 )* KEEP( 34 ) +
497 & NROWS_TO_SEND * IW(PTRIST(STEP(ISON))+KEEP(IXSZ))
498 & * KEEP( 35 )
499 GOTO 600
500 ENDIF
501.NE. IF (KEEP(219)0) THEN
502.EQ. IF ( IERR -4 ) THEN
503 IFLAG = -13
504 IERROR = NFS4FATHER
505.GT. IF (LP 0) THEN
506 WRITE(LP, *)
507 & "FAILURE: MAX_ARRAY allocation failed IN CMUMPS_MAPLIG"
508 ENDIF
509 GO TO 600
510 END IF
511 END IF
512.EQ. IF ( IERR -1 ) THEN
513 IF (LOCAL_ASSEMBLY_TO_BE_DONE) THEN
514 CALL CMUMPS_LOCAL_ASSEMBLY_TYPE2(I_POSMYIDIN_PERE,
515 & SLAVES_PERE(I_POSMYIDIN_PERE),
516 & MYID, PDEST_MASTER, ISON, INODE_PERE,
517 & NSLAVES_PERE, NASS_PERE, NFRONT_PERE, NFS4FATHER,
518 & LMAP_LOC, MAP, NBROW, PERM_LOC,
519 & IS_ofType5or6, IFLAG, IERROR,
520 & N, SLAVEF, KEEP, IPOOL, LPOOL, STEP,
521 & PROCNODE_STEPS, COMM_LOAD, ISTEP_TO_INIV2,
522 & TAB_POS_IN_PERE,
523 & KEEP8, IW, LIW, A, LA, LRLU, LRLUS, IPTRLU, IWPOSCB,
524 & PTRIST, PTLUST, PTRAST, PAMASTER, PIMASTER, ND,
525 & NELT, FRTPTR, FRTELT,
526 & OPASSW, OPELIW,
527 & ITLOC, RHS_MUMPS, KEEP253_LOC, NVSCHUR,
528 & FILS, DAD,
529 & LPTRAR, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL,
530 & ITYPE_SON, LRGROUPS)
531 LOCAL_ASSEMBLY_TO_BE_DONE = .FALSE.
532 IF (IFLAG < 0) THEN
533 GOTO 600
534 ENDIF
535 ELSE
536 BLOCKING = .FALSE.
537 SET_IRECV = .TRUE.
538 MESSAGE_RECEIVED = .FALSE.
539 CALL CMUMPS_TRY_RECVTREAT( COMM_LOAD,
540 & ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
541 & MPI_ANY_SOURCE, MPI_ANY_TAG,
542 & STATUS,
543 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
544 & IWPOS, IWPOSCB, IPTRLU,
545 & LRLU, LRLUS, N, IW, LIW, A, LA,
546 & PTRIST, PTLUST, PTRFAC,
547 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP,
548 & IFLAG, IERROR, COMM,
549 & PERM, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
550 &
551 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD,
552 & PTRARW, PTRAIW,
553 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE,LPTRAR,
554 & NELT, FRTPTR, FRTELT,
555 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.
556 & , LRGROUPS
557 & )
558.LT. IF ( IFLAG 0 ) THEN
559 IS_ERROR_BROADCASTED=.TRUE.
560 GOTO 600
561 ENDIF
562 END IF
563 END IF
564 ENDDO
565 ENDIF
566 END DO
567 IF (LOCAL_ASSEMBLY_TO_BE_DONE) THEN
568 CALL CMUMPS_LOCAL_ASSEMBLY_TYPE2(I_POSMYIDIN_PERE,
569 & SLAVES_PERE(I_POSMYIDIN_PERE),
570 & MYID, PDEST_MASTER, ISON, INODE_PERE,
571 & NSLAVES_PERE, NASS_PERE, NFRONT_PERE, NFS4FATHER,
572 & LMAP_LOC, MAP, NBROW, PERM_LOC,
573 & IS_ofType5or6, IFLAG, IERROR,
574 & N, SLAVEF, KEEP, IPOOL, LPOOL, STEP,
575 & PROCNODE_STEPS, COMM_LOAD, ISTEP_TO_INIV2, TAB_POS_IN_PERE,
576 & KEEP8, IW, LIW, A, LA, LRLU, LRLUS, IPTRLU, IWPOSCB,
577 & PTRIST, PTLUST, PTRAST, PAMASTER, PIMASTER, ND,
578 & NELT, FRTPTR, FRTELT,
579 & OPASSW, OPELIW,
580 & ITLOC, RHS_MUMPS, KEEP253_LOC, NVSCHUR,
581 & FILS, DAD, LPTRAR, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL,
582 & ITYPE_SON, LRGROUPS)
583 LOCAL_ASSEMBLY_TO_BE_DONE = .FALSE.
584 IF (IFLAG < 0) THEN
585 GOTO 600
586 ENDIF
587 ENDIF
588 IF (CB_IS_LR) THEN
589 CALL CMUMPS_BLR_FREE_CB_LRB(IWXXF_HANDLER,
590 & .FALSE., KEEP8, KEEP(34))
591.EQ..OR..EQ. IF ((KEEP(486)3)KEEP(486)0) THEN
592 CALL CMUMPS_BLR_END_FRONT(IWXXF_HANDLER, IFLAG, KEEP8,
593 & KEEP(34))
594 ENDIF
595 ENDIF
596.EQ. IF (KEEP(214) 2) THEN
597 CALL CMUMPS_STACK_BAND( N, ISON,
598 & PTRIST, PTRAST, PTLUST, PTRFAC, IW, LIW, A, LA,
599 & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,
600 & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER,
601 & IFLAG, IERROR, SLAVEF, PROCNODE_STEPS, DAD, MYID,
602 & COMM, KEEP,KEEP8, DKEEP, ITYPE_SON )
603.LT. IF (IFLAG 0) THEN
604 IS_ERROR_BROADCASTED = .TRUE.
605 GOTO 600
606 ENDIF
607 ENDIF
608 CALL CMUMPS_FREE_BAND( N, ISON, PTRIST, PTRAST, IW, LIW,
609 & A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU,
610 & STEP, MYID, KEEP, KEEP8, ITYPE_SON
611 &)
612 600 CONTINUE
613 DEALLOCATE(PERM_LOC)
614 670 CONTINUE
615 DEALLOCATE(MAP)
616 680 CONTINUE
617 DEALLOCATE(NBROW)
618 DEALLOCATE(SLAVES_PERE)
619 700 CONTINUE
620.LT..AND..NOT. IF (IFLAG 0 IS_ERROR_BROADCASTED) THEN
621 CALL CMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
622 ENDIF
623 RETURN
624 END SUBROUTINE CMUMPS_MAPLIG
625 SUBROUTINE CMUMPS_MAPLIG_FILS_NIV1( COMM_LOAD, ASS_IRECV,
626 & BUFR, LBUFR, LBUFR_BYTES,
627 &
628 & INODE_PERE, ISON, NSLAVES_PERE, LIST_SLAVES_PERE,
629 & NFRONT_PERE, NASS_PERE, NFS4FATHER, LMAP, TROW,
630 & PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
631 & LRLUS, N, IW,
632 & LIW, A, LA,
633 & PTRIST, PTLUST, PTRFAC,
634 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP,
635 & IFLAG, IERROR, MYID, COMM, PERM, IPOOL, LPOOL, LEAF,
636 & NBFIN, ICNTL, KEEP,KEEP8,DKEEP, root,
637 & OPASSW, OPELIW, ITLOC, RHS_MUMPS,
638 & FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
639 & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,
640 &
641 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
642 & , LRGROUPS
643 & )
644 USE CMUMPS_BUF
645 USE CMUMPS_LOAD
646 USE CMUMPS_LR_TYPE
647 USE CMUMPS_LR_STATS
648 USE CMUMPS_FAC_LR, ONLY: CMUMPS_DECOMPRESS_PANEL
649 USE CMUMPS_FAC_FRONT_AUX_M, ONLY : CMUMPS_GET_SIZE_SCHUR_IN_FRONT
650 USE CMUMPS_LR_DATA_M
651 USE CMUMPS_STRUC_DEF, ONLY : CMUMPS_ROOT_STRUC
652 USE CMUMPS_DYNAMIC_MEMORY_M, ONLY : CMUMPS_DM_SET_DYNPTR
653 & , CMUMPS_DM_FREE_BLOCK
654 IMPLICIT NONE
655 TYPE (CMUMPS_ROOT_STRUC) :: root
656 INTEGER COMM_LOAD, ASS_IRECV
657 INTEGER ICNTL( 60 ), KEEP(500)
658 INTEGER(8) KEEP8(150)
659 REAL DKEEP(230)
660 INTEGER LBUFR, LBUFR_BYTES
661 INTEGER SLAVEF, NBFIN
662 INTEGER(8) :: LA, IPTRLU, LRLU, LRLUS, POSFAC
663 INTEGER IWPOS, IWPOSCB
664 INTEGER N, LIW
665 COMPLEX A( LA )
666 INTEGER, intent(in) :: LRGROUPS(N)
667 INTEGER COMP
668 INTEGER IFLAG, IERROR, COMM, MYID
669 INTEGER LPOOL, LEAF
670 INTEGER INODE_PERE, ISON
671 INTEGER NFS4FATHER
672 REAL, POINTER, DIMENSION(:) :: M_ARRAY
673 LOGICAL :: M_ARRAY_RETRIEVED
674 INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE
675 INTEGER LIST_SLAVES_PERE(NSLAVES_PERE)
676 INTEGER NELIM, LMAP, TROW( LMAP ), NASS
677 DOUBLE PRECISION OPASSW, OPELIW
678 COMPLEX DBLARR(KEEP8(26))
679 INTEGER INTARR(KEEP8(27))
680 INTEGER LPTRAR, NELT
681 INTEGER IW( LIW )
682 INTEGER BUFR( LBUFR )
683 INTEGER IPOOL( LPOOL )
684 INTEGER NSTK( KEEP(28) ), ND( KEEP(28) ), FRERE( KEEP(28) )
685 INTEGER PERM(N)
686 INTEGER(8) :: PTRFAC(KEEP(28))
687 INTEGER(8) :: PTRAST(KEEP(28))
688 INTEGER(8) :: PAMASTER(KEEP(28))
689 INTEGER PTRIST(KEEP(28)), PTLUST(KEEP(28)),
690 & STEP(N), PIMASTER(KEEP(28))
691 INTEGER PROCNODE_STEPS( KEEP(28) )
692 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
693 INTEGER ITLOC( N+KEEP(253) ), FILS( N ), DAD( KEEP(28) )
694 COMPLEX :: RHS_MUMPS(KEEP(255))
695 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
696 INTEGER ISTEP_TO_INIV2(KEEP(71)),
697 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
698 INTEGER LP
699 INCLUDE 'mpif.h'
700 INCLUDE 'mumps_tags.h'
701 INTEGER :: IERR
702 INTEGER :: STATUS(MPI_STATUS_SIZE)
703 INTEGER NOSLA, I, ISTCHK, ISTCHK_LOC
704 INTEGER NBROWS_ALREADY_SENT
705 INTEGER INDICE_PERE
706 INTEGER INDICE_PERE_ARRAY_ARG(1)
707 INTEGER PDEST, PDEST_MASTER, NFRONT
708 LOGICAL SAME_PROC, DESCLU
709 INTEGER(8) :: IACHK, POSROW, ASIZE, RECSIZE
710 COMPLEX, POINTER, DIMENSION(:) :: SON_A
711 INTEGER(8) :: DYNSIZE
712 INTEGER NSLSON, NBCOLS, NROW, NROWS_TO_SEND,
713 & NPIV, NROWS_TO_STACK, II, IROW_SON,
714 & IPOS_IN_SLAVE, DECR, ITYPE_SON
715 INTEGER NBCOLS_EFF
716 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED
717 LOGICAL PACKED_CB
718 LOGICAL :: CB_IS_LR
719 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR
720 INTEGER :: NB_BLR_COLS, NB_BLR_ROWS,
721 & NB_BLR_SHIFT, PANEL2DECOMPRESS,
722 & CURRENT_PANEL_SIZE, PANEL_BEG_OFFSET,
723 & NROWS_ALREADY_STACKED, NROWS_TO_STACK_LOC
724 INTEGER :: NVSCHUR, IROW_L
725 INTEGER(8) :: LA_TEMP
726 COMPLEX :: ADummy(1)
727 COMPLEX, ALLOCATABLE :: A_TEMP(:)
728 TYPE (LRB_TYPE), POINTER :: CB_LRB(:,:)
729 INTEGER :: XXG_STATUS
730 INCLUDE 'mumps_headers.h'
731 INTEGER MUMPS_PROCNODE, MUMPS_TYPENODE
732 EXTERNAL MUMPS_PROCNODE, MUMPS_TYPENODE
733 INTEGER LMAP_LOC, allocok
734 INTEGER, ALLOCATABLE, DIMENSION(:) :: NBROW
735 INTEGER, ALLOCATABLE, DIMENSION(:) :: SLAVES_PERE
736 INTEGER, ALLOCATABLE, DIMENSION(:) :: MAP, PERM_LOC
737 LP = ICNTL(1)
738.LE. IF (ICNTL(4) 0) LP = -1
739.le. if (NSLAVES_PERE0) then
740 write(6,*) ' error 2 in maplig_fils_niv1 ', NSLAVES_PERE
741 CALL MUMPS_ABORT()
742 endif
743 ALLOCATE(NBROW(0:NSLAVES_PERE), stat=allocok)
744.GT. IF (allocok 0) THEN
745 IF (LP > 0)
746 & write(LP,*) MYID,
747 & ' : pb allocation nbrow in cmumps_maplig_fils_niv1'
748 IFLAG =-13
749 IERROR = NSLAVES_PERE+1
750 GOTO 700
751 ENDIF
752 ALLOCATE(SLAVES_PERE(0:NSLAVES_PERE), stat =allocok)
753.GT. IF ( allocok 0 ) THEN
754 IF (LP > 0) write(LP,*) MYID,
755 & ' : pb allocation slaves_pere in cmumps_maplig_fils_niv1'
756 IFLAG =-13
757 IERROR = NSLAVES_PERE+1
758 GOTO 700
759 ENDIF
760 SLAVES_PERE(1:NSLAVES_PERE) = LIST_SLAVES_PERE(1:NSLAVES_PERE)
761 SLAVES_PERE(0) = MUMPS_PROCNODE(
762 & PROCNODE_STEPS(STEP(INODE_PERE)),
763 & KEEP(199) )
764 LMAP_LOC = LMAP
765 ALLOCATE(MAP(LMAP_LOC), stat=allocok)
766.GT. if (allocok 0) THEN
767 IF (LP > 0) write(LP,*) MYID,
768 & ' : pb allocation lmap in cmumps_maplig_fils_niv1'
769 IFLAG =-13
770 IERROR = LMAP_LOC
771 GOTO 700
772 endif
773 MAP( 1 : LMAP_LOC ) = TROW( 1 : LMAP_LOC )
774 DO I = 0, NSLAVES_PERE
775 NBROW( I ) = 0
776 END DO
777 IF (NSLAVES_PERE == 0) THEN
778 NBROW(0) = LMAP_LOC
779 ELSE
780 DO I = 1, LMAP_LOC
781 INDICE_PERE = MAP( I )
782 CALL MUMPS_BLOC2_GET_ISLAVE(
783 & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF,
784 & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
785 &
786 & NASS_PERE,
787 & NFRONT_PERE - NASS_PERE,
788 & NSLAVES_PERE,
789 & INDICE_PERE,
790 & NOSLA,
791 & IPOS_IN_SLAVE )
792 NBROW( NOSLA ) = NBROW( NOSLA ) + 1
793 END DO
794 DO I = 1, NSLAVES_PERE
795 NBROW(I)=NBROW(I)+NBROW(I-1)
796 ENDDO
797 ENDIF
798 ALLOCATE(PERM_LOC(LMAP_LOC), stat=allocok)
799.GT. if (allocok 0) THEN
800 IF (LP > 0) THEN
801 write(LP,*) MYID,
802 & ': pb allocation perm_loc in cmumps_maplig_fils_niv1'
803 ENDIF
804 IFLAG =-13
805 IERROR = LMAP_LOC
806 GOTO 700
807 endif
808 ISTCHK = PIMASTER(STEP(ISON))
809 NBCOLS = IW(ISTCHK+KEEP(IXSZ))
810 DO I = LMAP_LOC, 1, -1
811 INDICE_PERE = MAP( I )
812 CALL MUMPS_BLOC2_GET_ISLAVE(
813 & KEEP,KEEP8, INODE_PERE, STEP, N, SLAVEF,
814 & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
815 &
816 & NASS_PERE,
817 & NFRONT_PERE - NASS_PERE,
818 & NSLAVES_PERE,
819 & INDICE_PERE,
820 & NOSLA,
821 & IPOS_IN_SLAVE )
822 PERM_LOC( NBROW( NOSLA ) ) = I
823 NBROW( NOSLA ) = NBROW( NOSLA ) - 1
824 ENDDO
825 DO I = 0, NSLAVES_PERE
826 NBROW(I)=NBROW(I)+1
827 END DO
828 PDEST_MASTER = MYID
829.NE. IF ( SLAVES_PERE(0) MYID ) THEN
830 WRITE(*,*) 'error 1 in maplig_fils_niv1:',myid, slaves_pere
831 CALL mumps_abort()
832 END IF
833 pdest = pdest_master
834 i = 0
835 istchk = pimaster(step(ison))
836 nbcols = iw(istchk+keep(ixsz))
837 nelim = iw(istchk+1+keep(ixsz))
838 nrow = iw(istchk+2+keep(ixsz))
839 npiv = iw(istchk+3+keep(ixsz))
840 nass = npiv+nelim
841 IF (npiv.LT.0) THEN
842 write(6,*) ' Error 2 in CMUMPS_MAPLIG_FILS_NIV1 ', npiv
843 CALL mumps_abort()
844 ENDIF
845 nslson = iw(istchk+5+keep(ixsz))
846 nfront = npiv + nbcols
847 packed_cb=(iw(ptrist(step(ison))+xxs) .eq. s_cb1comp)
848 IF (i == nslaves_pere) THEN
849 nrows_to_stack=lmap_loc-nbrow(i)+1
850 ELSE
851 nrows_to_stack=nbrow(i+1)-nbrow(i)
852 ENDIF
853 IF ((keep(114).EQ.1) .AND. (keep(50).EQ.2) .AND.
854 & (keep(116).GT.0) .AND. ((nfront-nass-keep(253)).GT.0)
855 & ) THEN
856 irow_l = pimaster(step(ison)) + 6 + keep(ixsz) + nass
857 CALL cmumps_get_size_schur_in_front (
858 & n,
859 & nfront-nass-keep(253),
860 & keep(116),
861 & iw(irow_l),
862 & perm, nvschur )
863 ELSE
864 nvschur = 0
865 ENDIF
866 decr=1
867 iw(ptlust(step(inode_pere))+xxnbpr) =
868 & iw(ptlust(step(inode_pere))+xxnbpr) - decr
869 iw(ptrist(step(ison))+xxnbpr) =
870 & iw(ptrist(step(ison))+xxnbpr) - decr
871 cb_is_lr = (iw(istchk+xxlr).EQ.1 .OR.
872 & iw(istchk+xxlr).EQ.3)
873 nrows_already_stacked = 0
874 100 CONTINUE
875 nrows_to_stack_loc = nrows_to_stack
876 panel_beg_offset = 0
877 IF (cb_is_lr.AND.nrows_to_stack.GT.0) THEN
878 CALL cmumps_blr_retrieve_cb_lrb(
879 & iw(istchk+xxf), cb_lrb)
880 CALL cmumps_blr_retrieve_begsblr_sta(
881 & iw(istchk+xxf), begs_blr)
882 nb_blr_rows = size(begs_blr) - 1
883 CALL cmumps_blr_retrieve_nb_panels(iw(istchk+xxf),
884 & nb_blr_shift)
885 panel2decompress = -1
886 DO ii=nb_blr_shift+1,nb_blr_rows
887 IF (begs_blr(ii+1)-1-nass.GT.
888 & nrows_already_stacked+nbrow(i)-1) THEN
889 panel2decompress = ii
890 EXIT
891 ENDIF
892 ENDDO
893 IF (panel2decompress.EQ.-1) THEN
894 write(*,*) 'Internal error: PANEL2DECOMPRESS not found'
895 CALL mumps_abort()
896 ENDIF
897 IF (keep(50).EQ.0) THEN
898 nb_blr_cols = size(begs_blr) - 1
899 ELSE
900 nb_blr_cols = panel2decompress
901 ENDIF
902 current_panel_size = begs_blr(panel2decompress+1)
903 & - begs_blr(panel2decompress)
904 panel_beg_offset = nbrow(i) + nrows_already_stacked
905 & - begs_blr(panel2decompress) + nass
906 nrows_to_stack_loc =
907 & min(nrows_to_stack-nrows_already_stacked,
908 & current_panel_size-panel_beg_offset)
909 la_temp = current_panel_size*nbcols
910 CALL mumps_dm_fac_upd_dyn_memcnts(la_temp,
911 & .false., keep8, iflag, ierror, .true., .true.)
912 allocate(a_temp(la_temp),stat=allocok)
913 IF (allocok.GT.0) THEN
914 CALL mumps_seti8toi4(la_temp,ierror)
915 iflag = -13
916 GOTO 700
917 ENDIF
918#if defined(BLR_MT)
919!$OMP PARALLEL
920#endif
921 CALL cmumps_decompress_panel(a_temp, la_temp, 1_8,
922 & nbcols, nbcols, .true., 1, 1,
923 & nb_blr_cols-nb_blr_shift,
924 & cb_lrb(panel2decompress-nb_blr_shift,
925 & 1:nb_blr_cols-nb_blr_shift),
926 & 0, 'V', 5,
927 & cbasm_tofix_in=.true.,
928 & only_nelim_in=current_panel_size-panel_beg_offset)
929#if defined(BLR_MT)
930!$OMP END PARALLEL
931#endif
932 ENDIF
933 CALL cmumps_dm_set_dynptr(
934 & iw(ptrist(step(ison))+xxs),
935 & a, la,
936 & pamaster(step(ison)),
937 & iw(ptrist(step(ison))+xxd),
938 & iw(ptrist(step(ison))+xxr),
939 & son_a, iachk, recsize )
940 DO ii = nrows_already_stacked+1,
941 & nrows_already_stacked+nrows_to_stack_loc
942 irow_son=perm_loc(nbrow(i)+ii-1)
943 indice_pere = map(irow_son)
944 CALL mumps_bloc2_get_islave(
945 & keep,keep8, inode_pere, step, n, slavef,
946 & istep_to_iniv2, tab_pos_in_pere,
947 &
948 & nass_pere,
949 & nfront_pere - nass_pere,
950 & nslaves_pere,
951 & indice_pere,
952 & nosla,
953 & ipos_in_slave )
954 indice_pere = ipos_in_slave
955 IF (packed_cb) THEN
956 IF (nelim.EQ.0) THEN
957 posrow = iachk +
958 & int(irow_son,8)*int(irow_son-1,8)/2_8
959 ELSE
960 posrow = iachk +
961 & int(nelim+irow_son,8)*int(nelim+irow_son-1,8)/2_8
962 ENDIF
963 ELSE
964 posrow = iachk +
965 & int(nelim+irow_son-1,8)*int(nbcols,8)
966 ENDIF
967 IF (keep(50).NE.0) THEN
968 nbcols_eff = nelim + irow_son
969 ELSE
970 nbcols_eff = nbcols
971 ENDIF
972 indice_pere_array_arg(1) = indice_pere
973 IF (cb_is_lr) THEN
974 CALL cmumps_asm_slave_master(n, inode_pere, iw, liw,
975 & a, la, ison, 1, nbcols_eff,
976 & indice_pere_array_arg,
977 & a_temp(1+(ii+panel_beg_offset
978 & -nrows_already_stacked-1)*nbcols),
979 & ptlust, ptrast,
980 & step, pimaster, opassw, iwposcb,
981 & myid, keep,keep8,.false.,nbcols)
982 ELSE
983 CALL cmumps_asm_slave_master(n, inode_pere, iw, liw,
984 & a, la, ison, 1, nbcols_eff, indice_pere_array_arg,
985 & son_a(posrow), ptlust, ptrast,
986 & step, pimaster, opassw, iwposcb,
987 & myid, keep,keep8,.false.,nbcols_eff)
988 ENDIF
989 ENDDO
990 IF (cb_is_lr.AND.nrows_to_stack.GT.0) THEN
991 deallocate(a_temp)
992 CALL mumps_dm_fac_upd_dyn_memcnts(-la_temp,
993 & .false., keep8, iflag, ierror, .true., .true.)
994 nrows_already_stacked = nrows_already_stacked
995 & + nrows_to_stack_loc
996 IF (nrows_already_stacked.LT.nrows_to_stack) THEN
997 GOTO 100
998 ENDIF
999 ENDIF
1000 IF (keep(219).NE.0) THEN
1001 IF(nslaves_pere.GT.0 .AND. keep(50).EQ.2) THEN
1002 IF (cb_is_lr) THEN
1003 CALL cmumps_blr_retrieve_m_array (
1004 & iw(istchk+xxf), m_array)
1005 m_array_retrieved = .true.
1006 ELSE
1007 IF (packed_cb) THEN
1008 posrow = iachk
1009 & + int(nelim+nbrow(1),8)*int(nelim+nbrow(1)-1,8)/2_8
1010 asize = int(lmap_loc+nelim,8)*int(nelim+lmap_loc+1,8)/2_8
1011 & - int(nelim+nbrow(1),8)*int(nelim+nbrow(1)-1,8)/2_8
1012 ELSE
1013 posrow = iachk +
1014 & int(nelim+nbrow(1)-1,8)*int(nbcols,8)
1015 asize = int(lmap_loc-nbrow(1)+1,8) * int(nbcols,8)
1016 ENDIF
1017 CALL cmumps_buf_max_array_minsize(nfs4father,ierr)
1018 IF (ierr .NE.0) THEN
1019 IF (lp > 0) WRITE(lp,*) myid,
1020 & ": PB allocation MAX_ARRAY during CMUMPS_MAPLIG_FILS_NIV1"
1021 iflag=-13
1022 ierror=nfs4father
1023 GOTO 700
1024 ENDIF
1025 IF ( lmap_loc-nbrow(1)+1-keep(253)-nvschur.GT. 0 ) THEN
1026 CALL cmumps_compute_maxpercol(
1027 & son_a(posrow),asize,nbcols,
1028 & lmap_loc-nbrow(1)+1-keep(253)-nvschur,
1029 & buf_max_array,nfs4father,packed_cb,
1030 & nelim+nbrow(1))
1031 ELSE
1032 CALL cmumps_setmaxtozero(buf_max_array,
1033 & nfs4father)
1034 ENDIF
1035 m_array => buf_max_array
1036 m_array_retrieved = .false.
1037 ENDIF
1038 CALL cmumps_asm_max(n, inode_pere, iw, liw,
1039 & a, la, ison, nfs4father,
1040 & m_array(1), ptlust, ptrast,
1041 & step, pimaster, opassw,
1042 & iwposcb,myid, keep,keep8)
1043 IF ( m_array_retrieved )
1044 & CALL cmumps_blr_free_m_array ( iw(istchk+xxf) )
1045 ENDIF
1046 ENDIF
1047 IF (iw(ptrist(step(ison))+xxnbpr) .EQ. 0
1048 & ) THEN
1049 istchk_loc = pimaster(step(ison))
1050 same_proc= istchk_loc .LT. iwposcb
1051 IF (same_proc) THEN
1052 CALL cmumps_restore_indices(n, ison, inode_pere,
1053 & iwposcb, pimaster, ptlust, iw, liw, step,
1054 & keep,keep8)
1055 ENDIF
1056 ENDIF
1057 IF ( iw(ptlust(step(inode_pere))+xxnbpr) .EQ. 0
1058 & ) THEN
1059 CALL cmumps_insert_pool_n( n, ipool, lpool,
1060 & procnode_steps,
1061 & slavef, keep(199), keep(28), keep(76), keep(80),
1062 & keep(47), step, inode_pere+n )
1063 IF (keep(47) .GE. 3) THEN
1064 CALL cmumps_load_pool_upd_new_pool(
1065 & ipool, lpool,
1066 & procnode_steps, keep,keep8, slavef, comm_load,
1067 & myid, step, n, nd, fils )
1068 ENDIF
1069 END IF
1070 DO i = 0, nslaves_pere
1071 pdest = slaves_pere( i )
1072 IF ( pdest .NE. myid ) THEN
1073 nbrows_already_sent = 0
1074 95 CONTINUE
1075 nfront = iw(pimaster(step(ison))+keep(ixsz))
1076 nelim = iw(pimaster(step(ison))+1+keep(ixsz))
1077 desclu = .true.
1078 IF (i == nslaves_pere) THEN
1079 nrows_to_send=lmap_loc-nbrow(i)+1
1080 ELSE
1081 nrows_to_send=nbrow(i+1)-nbrow(i)
1082 ENDIF
1083 IF ( nrows_to_send .EQ. 0) cycle
1084 itype_son = mumps_typenode( procnode_steps(step(ison)),
1085 & keep(199) )
1086 IF (cb_is_lr) THEN
1087 CALL cmumps_buf_send_contrib_type2(nbrows_already_sent,
1088 & desclu, inode_pere,
1089 & nfront_pere, nass_pere, nfs4father,
1090 & nslaves_pere,
1091 & ison, nrows_to_send, lmap_loc,
1092 & map, perm_loc(min(lmap_loc,nbrow(i))),
1093 & iw(pimaster(step(ison))),
1094 & adummy, 1_8,
1095 & i, pdest, pdest_master, comm, ierr,
1096 & keep,keep8, step, n, slavef,
1097 & istep_to_iniv2, tab_pos_in_pere,
1098 & packed_cb, keep(253), nvschur,
1099 & itype_son, myid,
1100 & npiv_check = iw(ptlust(step(ison))+3+keep(ixsz)))
1101 ELSE
1102 CALL cmumps_dm_set_dynptr(
1103 & iw(ptrist(step(ison))+xxs),
1104 & a, la,
1105 & pamaster(step(ison)),
1106 & iw(ptrist(step(ison))+xxd),
1107 & iw(ptrist(step(ison))+xxr),
1108 & son_a, iachk, recsize )
1109 CALL cmumps_buf_send_contrib_type2(nbrows_already_sent,
1110 & desclu, inode_pere,
1111 & nfront_pere, nass_pere, nfs4father,
1112 & nslaves_pere,
1113 & ison, nrows_to_send, lmap_loc,
1114 & map, perm_loc(min(lmap_loc,nbrow(i))),
1115 & iw(pimaster(step(ison))),
1116 & son_a(iachk:iachk+recsize-1_8),
1117 & recsize,
1118 & i, pdest, pdest_master, comm, ierr,
1119 &
1120 & keep,keep8, step, n, slavef,
1121 & istep_to_iniv2, tab_pos_in_pere,
1122 & packed_cb, keep(253), nvschur,
1123 & itype_son, myid)
1124 ENDIF
1125 IF ( ierr .EQ. -2 ) THEN
1126 IF (lp > 0) WRITE(lp,*) myid,
1127 &": FAILURE, SEND BUFFER TOO SMALL DURING CMUMPS_MAPLIG_FILS_NIV1"
1128 iflag = -17
1129 ierror = (nrows_to_send + 3 )* keep( 34 ) +
1130 & nrows_to_send * keep( 35 )
1131 GO TO 700
1132 END IF
1133 IF ( ierr .EQ. -3 ) THEN
1134 IF (lp > 0) WRITE(lp,*) myid,
1135 &": FAILURE, RECV BUFFER TOO SMALL DURING CMUMPS_MAPLIG_FILS_NIV1"
1136 iflag = -20
1137 ierror = (nrows_to_send + 3 )* keep( 34 ) +
1138 & nrows_to_send * keep( 35 )
1139 GO TO 700
1140 ENDIF
1141 IF (keep(219).NE.0) THEN
1142 IF ( ierr .EQ. -4 ) THEN
1143 iflag = -13
1144 ierror = buf_lmax_array
1145 IF (lp > 0) WRITE(lp,*) myid,
1146 &": FAILURE, MAX_ARRAY ALLOC FAILED DURING CMUMPS_MAPLIG_FILS_NIV1"
1147 GO TO 700
1148 ENDIF
1149 ENDIF
1150 IF ( ierr .EQ. -1 ) THEN
1151 blocking = .false.
1152 set_irecv = .true.
1153 message_received = .false.
1154 CALL cmumps_try_recvtreat( comm_load,
1155 & ass_irecv, blocking, set_irecv, message_received,
1156 & mpi_any_source, mpi_any_tag,
1157 & status,
1158 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
1159 & iwpos, iwposcb, iptrlu,
1160 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
1161 & ptlust, ptrfac,
1162 & ptrast, step, pimaster, pamaster, nstk, comp,
1163 & iflag, ierror, comm,
1164 & perm, ipool, lpool, leaf, nbfin, myid, slavef,
1165 & root, opassw, opeliw, itloc, rhs_mumps,
1166 & fils, dad, ptrarw, ptraiw,
1167 & intarr,dblarr,icntl,keep,keep8,dkeep,nd,frere,
1168 & lptrar, nelt, frtptr, frtelt,
1169 & istep_to_iniv2, tab_pos_in_pere, .true.
1170 & , lrgroups
1171 & )
1172 IF ( iflag .LT. 0 ) GOTO 600
1173 GO TO 95
1174 END IF
1175 END IF
1176 END DO
1177 istchk = ptrist(step(ison))
1178 ptrist(step( ison )) = -77777777
1179 IF ( iw(istchk+keep(ixsz)) .GE. 0 ) THEN
1180 WRITE(*,*) 'error 3 in CMUMPS_MAPLIG_FILS_NIV1'
1181 CALL mumps_abort()
1182 ENDIF
1183 CALL mumps_geti8(dynsize,iw(istchk+xxd))
1184 xxg_status = iw(istchk+xxg)
1185 CALL cmumps_free_block_cb_static(.false., myid, n, istchk,
1186 & iw, liw, lrlu, lrlus, iptrlu,
1187 & iwposcb, la, keep,keep8, .false.
1188 & )
1189 IF (dynsize .GT. 0_8) THEN
1190 CALL cmumps_dm_free_block( xxg_status, son_a, dynsize,
1191 & keep(405).EQ.1, keep8 )
1192 ENDIF
1193 GOTO 600
1194 700 CONTINUE
1195 CALL cmumps_bdc_error(myid, slavef, comm, keep )
1196 600 CONTINUE
1197 IF (cb_is_lr) THEN
1198 CALL cmumps_blr_free_cb_lrb(iw(istchk+xxf),
1199 & .false., keep8, keep(34))
1200 IF ((keep(486).EQ.3).OR.keep(486).EQ.0) THEN
1201 CALL cmumps_blr_end_front(iw(istchk+xxf), iflag, keep8,
1202 & keep(34))
1203 ENDIF
1204 ENDIF
1205 IF (allocated(nbrow)) DEALLOCATE(nbrow)
1206 IF (allocated(map)) DEALLOCATE(map)
1207 IF (allocated(perm_loc)) DEALLOCATE(perm_loc)
1208 IF (allocated(slaves_pere)) DEALLOCATE(slaves_pere)
1209 RETURN
1210 END SUBROUTINE cmumps_maplig_fils_niv1
1211 SUBROUTINE cmumps_local_assembly_type2(I, PDEST, MYID,
1212 & PDEST_MASTER, ISON, IFATH, NSLAVES_PERE, NASS_PERE,
1213 & NFRONT_PERE, NFS4FATHER, LMAP_LOC, MAP,
1214 & NBROW, PERM, IS_ofType5or6, IFLAG, IERROR,
1215 & N, SLAVEF, KEEP,
1216 & IPOOL, LPOOL, STEP,
1217 & PROCNODE_STEPS, COMM_LOAD, ISTEP_TO_INIV2,
1218 & TAB_POS_IN_PERE,
1219 & KEEP8, IW, LIW, A, LA, LRLU, LRLUS, IPTRLU, IWPOSCB,
1220 & PTRIST, PTLUST, PTRAST, PAMASTER, PIMASTER, ND,
1221 & NELT, FRTPTR, FRTELT,
1222 & OPASSW, OPELIW,
1223 & ITLOC, RHS_MUMPS, KEEP253_LOC, NVSCHUR,
1224 & FILS, DAD,
1225 & LPTRAR, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL,
1226 & SON_NIV, LRGROUPS)
1227 USE cmumps_buf, ONLY: cmumps_buf_max_array_minsize,
1228 & buf_max_array
1229 USE cmumps_lr_type
1230 USE cmumps_lr_stats
1231 USE cmumps_lr_data_m
1232 USE cmumps_fac_lr, ONLY: cmumps_decompress_panel
1233 USE cmumps_load, ONLY : cmumps_load_pool_upd_new_pool
1234 USE cmumps_dynamic_memory_m, ONLY : cmumps_dm_set_dynptr
1235 & , cmumps_dm_set_ptr, cmumps_dm_free_block
1236 IMPLICIT NONE
1237 INTEGER ICNTL(60)
1238 INTEGER, intent(in) :: I, PDEST, MYID, PDEST_MASTER, IFATH, ISON
1239 INTEGER, intent(in) :: N, SLAVEF
1240 INTEGER, intent(in) :: NSLAVES_PERE, NASS_PERE, NFRONT_PERE
1241 INTEGER, intent(in) :: NFS4FATHER
1242 INTEGER, intent(in) :: KEEP(500), STEP(N)
1243 INTEGER, intent(in) :: LMAP_LOC
1244 INTEGER, intent(in) :: NBROW(0:NSLAVES_PERE)
1245 INTEGER, intent(in) :: MAP(LMAP_LOC), PERM(LMAP_LOC)
1246 INTEGER, intent(inout) :: IFLAG, IERROR
1247 INTEGER(8), intent(inout) :: KEEP8(150)
1248 INTEGER, intent(in) :: LIW, NELT, LPTRAR
1249 INTEGER(8), intent(in) :: LA
1250 INTEGER(8), intent(inout) :: IPTRLU, LRLU, LRLUS
1251 INTEGER, intent(inout) :: IWPOSCB
1252 INTEGER, intent(inout) :: IW(LIW)
1253 COMPLEX, intent(inout) :: A( LA )
1254 INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28))
1255 INTEGER :: PTRIST(KEEP(28)), PIMASTER(KEEP(28)), ND(KEEP(28))
1256 INTEGER :: PTLUST(KEEP(28))
1257 INTEGER, intent(inout) :: ITLOC(N)
1258 INTEGER, intent(in) :: FRTPTR( N+1 ), FRTELT( NELT )
1259 DOUBLE PRECISION, intent(inout) :: OPASSW, OPELIW
1260 COMPLEX :: RHS_MUMPS(KEEP(255))
1261 INTEGER, intent(in) :: KEEP253_LOC, NVSCHUR
1262 INTEGER, intent(in) :: FILS(N), DAD( KEEP(28) )
1263 INTEGER(8), intent(in) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
1264 INTEGER, intent(in) :: PROCNODE_STEPS( KEEP(28) ), COMM_LOAD
1265 INTEGER ISTEP_TO_INIV2(KEEP(71)),
1266 & tab_pos_in_pere(slavef+2,max(1,keep(56)))
1267 COMPLEX DBLARR(KEEP8(26))
1268 INTEGER INTARR(KEEP8(27))
1269 INTEGER LPOOL
1270 INTEGER IPOOL( LPOOL )
1271 LOGICAL, intent(in) :: IS_ofType5or6
1272 INTEGER, intent(in) :: SON_NIV
1273 INTEGER, intent(in) :: LRGROUPS(N)
1274 include 'mumps_headers.h'
1275 include 'mpif.h'
1276 INTEGER :: XXG_STATUS
1277 INTEGER :: ISTCHK, ISTCHK_LOC, NBCOLS,
1278 & nrow, npiv, nslson,
1279 & nfront, lda_son, nrows_to_stack, ii, indice_pere,
1280 & nosla, collist, ipos_in_slave, irow_son, itmp,
1281 & nbcols_eff, decr, nelim
1282 INTEGER :: NB_POSTPONED
1283 LOGICAL :: PACKED_CB, SAME_PROC
1284 INTEGER(8) :: SIZFR, POSROW, SHIFTCB_SON
1285 INTEGER(8) :: IACHK
1286 INTEGER :: SON_XXS
1287 COMPLEX, DIMENSION(:), POINTER :: SON_A
1288 COMPLEX, DIMENSION(:), POINTER :: SON_A_MASTER
1289 INTEGER(8) :: DYN_SIZE
1290 INTEGER :: IERR, LP
1291 INTEGER INDICE_PERE_ARRAY_ARG(1)
1292 INTEGER :: INBPROCFILS_SON
1293 LOGICAL :: CB_IS_LR
1294 REAL, POINTER, DIMENSION(:) :: M_ARRAY
1295 LOGICAL :: M_ARRAY_RETRIEVED
1296 INTEGER(8) :: POSELT
1297 INTEGER :: IOLDPS, PARPIV_T1
1298 LOGICAL :: LR_ACTIVATED
1299 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_ROW, BEGS_BLR_COL,
1300 & BEGS_BLR_STA
1301 INTEGER :: NB_BLR_COLS, NB_BLR_ROWS,
1302 & nb_col_shift, panel2decompress,
1303 & current_panel_size, panel_beg_offset,
1304 & allocok, nrows_already_stacked, nrows_to_stack_loc,
1305 & nb_row_shift, nass_shift, ncol_shift, nrow_shift
1306 INTEGER(8) :: LA_TEMP
1307 COMPLEX, ALLOCATABLE :: A_TEMP(:)
1308 TYPE (LRB_TYPE), POINTER :: CB_LRB(:,:)
1309 lp = icntl(1)
1310 IF (icntl(4) .LE. 0) lp = -1
1311 IF (i == nslaves_pere) THEN
1312 nrows_to_stack = lmap_loc - nbrow(i) + 1
1313 ELSE
1314 nrows_to_stack = nbrow(i+1) - nbrow(i)
1315 ENDIF
1316 decr = 1
1317 IF ( myid .EQ. pdest_master ) THEN
1318 iw(ptlust(step(ifath))+xxnbpr) =
1319 & iw(ptlust(step(ifath))+xxnbpr) - decr
1320 IF ( pdest .EQ. pdest_master .AND. decr .NE. 0) THEN
1321 iw(pimaster(step(ison))+xxnbpr) =
1322 & iw(pimaster(step(ison))+xxnbpr) - decr
1323 ENDIF
1324 ENDIF
1325 istchk = ptrist(step(ison))
1326 nbcols = iw(istchk+keep(ixsz))
1327 nrow = iw(istchk+2+keep(ixsz))
1328 npiv = iw(istchk+3+keep(ixsz))
1329 nslson = iw(istchk+5+keep(ixsz))
1330 nfront = npiv + nbcols
1331 son_xxs = iw(istchk+xxs)
1332 packed_cb = ( son_xxs .EQ. s_cb1comp )
1333 CALL cmumps_dm_set_dynptr(
1334 & son_xxs,
1335 & a, la,
1336 & ptrast(step(ison)),
1337 & iw(ptrist(step(ison))+xxd),
1338 & iw(ptrist(step(ison))+xxr),
1339 & son_a, iachk, sizfr)
1340 cb_is_lr = (iw(istchk+xxlr).EQ.1 .OR.
1341 & iw(istchk+xxlr).EQ.3)
1342 nelim = -9999
1343 IF (cb_is_lr.AND.(son_niv.EQ.1).AND.
1344 & keep(50).NE.0) THEN
1345 istchk_loc = ptlust(step(ison))
1346 nelim = iw(istchk_loc+1+keep(ixsz))
1347 npiv = iw(istchk_loc+3+keep(ixsz))
1348 nfront = iw(istchk_loc+2+keep(ixsz))
1349 nrow = nfront - npiv
1350 nfront = nbcols
1351 npiv = 0
1352 ENDIF
1353 IF (cb_is_lr) THEN
1354 lda_son = nbcols
1355 shiftcb_son = -9999
1356 ELSE
1357 IF (son_xxs.EQ.s_nolcbcontig ) THEN
1358 lda_son = nbcols
1359 shiftcb_son = int(npiv,8)*int(nrow,8)
1360 ELSE IF (iw(istchk+xxs).EQ.s_nolcleaned) THEN
1361 lda_son = nbcols
1362 shiftcb_son = 0_8
1363 ELSE
1364 lda_son = nfront
1365 shiftcb_son = int(npiv,8)
1366 ENDIF
1367 ENDIF
1368 IF (pdest .NE. pdest_master) THEN
1369 IF ( keep(55) .eq. 0 ) THEN
1370 CALL cmumps_asm_slave_to_slave_init
1371 & (n, ifath, iw, liw,
1372 & a, la, nrows_to_stack, nbcols,
1373 & opassw, opeliw, step, ptrist, ptrast,
1374 & itloc, rhs_mumps,
1375 & fils, ptrarw, ptraiw, intarr, dblarr, icntl,
1376 & keep,keep8, myid, lrgroups )
1377 ELSE
1378 CALL cmumps_elt_asm_s_2_s_init(nelt, frtptr, frtelt,
1379 & n, ifath, iw, liw,
1380 & a, la, nrows_to_stack, nbcols,
1381 & opassw, opeliw, step, ptrist, ptrast,
1382 & itloc, rhs_mumps,
1383 & fils, ptrarw, ptraiw, intarr, dblarr, icntl,
1384 & keep, keep8, myid, lrgroups )
1385 ENDIF
1386 ENDIF
1387 nrows_already_stacked = 0
1388 100 CONTINUE
1389 nrows_to_stack_loc = nrows_to_stack
1390 panel_beg_offset = 0
1391 IF (cb_is_lr.AND.nrows_to_stack.GT.0) THEN
1392 CALL cmumps_blr_retrieve_cb_lrb(
1393 & iw(istchk+xxf), cb_lrb)
1394 IF (son_niv.EQ.1) THEN
1395 CALL cmumps_blr_retrieve_begsblr_sta(
1396 & iw(istchk+xxf), begs_blr_row)
1397 CALL cmumps_blr_retrieve_begsblr_dyn(
1398 & iw(istchk+xxf), begs_blr_col)
1399 nb_blr_rows = size(begs_blr_row) - 1
1400 CALL cmumps_blr_retrieve_nb_panels(iw(istchk+xxf),
1401 & nb_col_shift)
1402 nb_row_shift = nb_col_shift
1403 nass_shift = begs_blr_row(nb_row_shift+1)-1
1404 ELSE
1405 CALL cmumps_blr_retrieve_begsblr_sta(
1406 & iw(istchk+xxf), begs_blr_sta)
1407 nb_blr_rows = size(begs_blr_sta) - 2
1408 begs_blr_row => begs_blr_sta(2:nb_blr_rows+2)
1409 CALL cmumps_blr_retrieve_begs_blr_c(
1410 & iw(istchk+xxf), begs_blr_col,
1411 & nb_col_shift)
1412 nb_row_shift = 0
1413 nass_shift = 0
1414 ENDIF
1415 panel2decompress = -1
1416 DO ii=nb_row_shift+1,nb_blr_rows
1417 IF (begs_blr_row(ii+1)-1-nass_shift.GT.
1418 & nrows_already_stacked+nbrow(i)-1) THEN
1419 panel2decompress = ii
1420 EXIT
1421 ENDIF
1422 ENDDO
1423 IF (panel2decompress.EQ.-1) THEN
1424 write(*,*) 'Internal error: PANEL2DECOMPRESS not found'
1425 CALL mumps_abort()
1426 ENDIF
1427 IF (keep(50).EQ.0) THEN
1428 nb_blr_cols = size(begs_blr_col) - 1
1429 ELSEIF (son_niv.EQ.1) THEN
1430 nb_blr_cols = panel2decompress
1431 ELSE
1432 nb_blr_cols = -1
1433 ncol_shift = npiv
1434 nrow_shift = nbcols-nrow
1435 DO ii=nb_col_shift+1,size(begs_blr_col)-1
1436 IF (begs_blr_col(ii+1)-ncol_shift.GT.
1437 & begs_blr_row(panel2decompress+1)-1+nrow_shift) THEN
1438 nb_blr_cols = ii
1439 EXIT
1440 ENDIF
1441 ENDDO
1442 IF (nb_blr_cols.EQ.-1) THEN
1443 write(*,*) 'Internal error: NB_BLR_COLS not found'
1444 CALL mumps_abort()
1445 ENDIF
1446 ENDIF
1447 current_panel_size = begs_blr_row(panel2decompress+1)
1448 & - begs_blr_row(panel2decompress)
1449 panel_beg_offset = nbrow(i) + nrows_already_stacked
1450 & - begs_blr_row(panel2decompress) + nass_shift
1451 nrows_to_stack_loc =
1452 & min(nrows_to_stack-nrows_already_stacked,
1453 & current_panel_size-panel_beg_offset)
1454 la_temp = current_panel_size*nbcols
1455 CALL mumps_dm_fac_upd_dyn_memcnts(la_temp,
1456 & .false., keep8, iflag, ierror, .true., .true.)
1457 allocate(a_temp(la_temp),stat=allocok)
1458 IF (allocok.GT.0) THEN
1459 CALL mumps_seti8toi4(la_temp,ierror)
1460 iflag = -13
1461 RETURN
1462 ENDIF
1463#if defined(BLR_MT)
1464!$omp parallel
1465#endif
1466 CALL cmumps_decompress_panel(a_temp, la_temp, 1_8,
1467 & nbcols, nbcols, .true., 1, 1,
1468 & nb_blr_cols-nb_col_shift,
1469 & cb_lrb(panel2decompress-nb_row_shift,
1470 & 1:nb_blr_cols-nb_col_shift),
1471 & 0, 'V', 6,
1472 & cbasm_tofix_in=.true.,
1473 & only_nelim_in=current_panel_size-panel_beg_offset)
1474#if defined(BLR_MT)
1475!$OMP END PARALLEL
1476#endif
1477 ENDIF
1478 DO ii = nrows_already_stacked+1,
1479 & nrows_already_stacked+nrows_to_stack_loc
1480 irow_son = perm(nbrow(i)+ii-1)
1481 indice_pere=map(irow_son)
1482 CALL mumps_bloc2_get_islave(
1483 & keep,keep8, ifath, step, n, slavef,
1484 & istep_to_iniv2, tab_pos_in_pere,
1485 &
1486 & nass_pere,
1487 & nfront_pere - nass_pere,
1488 & nslaves_pere,
1489 & indice_pere,
1490 & nosla,
1491 & ipos_in_slave )
1492 indice_pere = ipos_in_slave
1493 IF ( packed_cb ) THEN
1494 IF (nbcols - nrow .EQ. 0 ) THEN
1495 itmp = irow_son
1496 posrow = iachk+
1497 & int(itmp,8) * int(itmp-1,8) / 2_8
1498 ELSE
1499 itmp = irow_son + nbcols - nrow
1500 posrow = iachk
1501 & + int(itmp,8) * int(itmp-1,8) / 2_8
1502 & - int(nbcols-nrow,8) * int(nbcols-nrow+1,8)/2_8
1503 ENDIF
1504 ELSE
1505 posrow = iachk + shiftcb_son
1506 & +int(irow_son-1,8)*int(lda_son,8)
1507 ENDIF
1508 IF (pdest == pdest_master) THEN
1509 IF (keep(50).NE.0) THEN
1510 nbcols_eff = irow_son + nbcols - nrow
1511 ELSE
1512 nbcols_eff = nbcols
1513 ENDIF
1514 indice_pere_array_arg(1) = indice_pere
1515 IF ((is_oftype5or6).AND.(keep(50).EQ.0)) THEN
1516 IF (cb_is_lr) THEN
1517 write(*,*) 'Compress CB + Type5or6 fronts not',
1518 & 'coded yet!!!'
1519 CALL mumps_abort()
1520 ENDIF
1521 CALL cmumps_asm_slave_master(n, ifath, iw, liw,
1522 & a, la, ison, nrows_to_stack, nbcols_eff,
1523 & indice_pere_array_arg,
1524 & son_a(posrow), ptlust, ptrast,
1525 & step, pimaster, opassw,
1526 & iwposcb, myid, keep,keep8,
1527 & is_oftype5or6, lda_son
1528 & )
1529 EXIT
1530 ELSE IF ( (keep(50).NE.0) .AND.
1531 & (.NOT.packed_cb).AND.(is_oftype5or6) ) THEN
1532 IF (cb_is_lr) THEN
1533 write(*,*) 'Compress CB + Type5or6 fronts not',
1534 & 'coded yet!!!'
1535 CALL mumps_abort()
1536 ENDIF
1537 CALL cmumps_asm_slave_master(n, ifath, iw, liw,
1538 & a, la, ison, nrows_to_stack,
1539 & nbcols_eff, indice_pere_array_arg,
1540 & son_a(posrow), ptlust, ptrast,
1541 & step, pimaster, opassw,
1542 & iwposcb, myid, keep,keep8,
1543 & is_oftype5or6, lda_son
1544 &)
1545 EXIT
1546 ELSE
1547 IF (cb_is_lr) THEN
1548 CALL cmumps_asm_slave_master(n, ifath, iw, liw,
1549 & a, la, ison, 1, nbcols_eff,
1550 & indice_pere_array_arg,
1551 & a_temp(1+(ii+panel_beg_offset
1552 & -nrows_already_stacked-1)*nbcols),
1553 & ptlust, ptrast,
1554 & step, pimaster, opassw,
1555 & iwposcb, myid, keep,keep8,
1556 & is_oftype5or6, nbcols )
1557 ELSE
1558 CALL cmumps_asm_slave_master(n, ifath, iw, liw,
1559 & a, la, ison, 1, nbcols_eff,
1560 & indice_pere_array_arg,
1561 & son_a(posrow), ptlust, ptrast,
1562 & step, pimaster, opassw,
1563 & iwposcb, myid, keep,keep8,
1564 & is_oftype5or6, lda_son )
1565 ENDIF
1566 ENDIF
1567 ELSE
1568 istchk = ptrist(step(ison))
1569 collist = istchk + 6 + keep(ixsz)
1570 & + iw( istchk + 5 +keep(ixsz)) + nrow + npiv
1571 IF (cb_is_lr.AND.(son_niv.EQ.1).AND.
1572 & keep(50).NE.0) THEN
1573 istchk_loc = ptlust(step(ison))
1574 collist = istchk_loc + 6 + keep(ixsz)
1575 & + iw( istchk + 5 +keep(ixsz))
1576 & + iw(istchk_loc+2+keep(ixsz))
1577 & + iw(istchk_loc+3+keep(ixsz))
1578 ENDIF
1579 IF (keep(50).NE.0) THEN
1580 nbcols_eff = irow_son + nbcols - nrow
1581 IF (cb_is_lr.AND.son_niv.EQ.1)
1582 & nbcols_eff = irow_son + nbcols - (nrow-nelim)
1583 ELSE
1584 nbcols_eff = nbcols
1585 ENDIF
1586 indice_pere_array_arg(1) = indice_pere
1587 IF ( (is_oftype5or6) .AND.
1588 & (
1589 & ( keep(50).EQ.0)
1590 & .OR.
1591 & ( (keep(50).NE.0).and. (.NOT.packed_cb) )
1592 & )
1593 & ) THEN
1594 IF (cb_is_lr) THEN
1595 write(*,*) 'Compress CB + Type5or6 fronts not',
1596 & 'coded yet!!!'
1597 CALL mumps_abort()
1598 ENDIF
1599 CALL cmumps_asm_slave_to_slave(n, ifath,
1600 & iw, liw,
1601 & a, la, nrows_to_stack, nbcols,
1602 & indice_pere_array_arg,
1603 & iw( collist ), son_a(posrow),
1604 & opassw, opeliw, step, ptrist, ptrast,
1605 & itloc, rhs_mumps,
1606 & fils, icntl, keep,keep8,
1607 & myid, is_oftype5or6, lda_son)
1608 iw( ptrist(step(ifath))+xxnbpr) =
1609 & iw( ptrist(step(ifath))+xxnbpr) - nrows_to_stack
1610 EXIT
1611 ELSE
1612 IF (cb_is_lr) THEN
1613 CALL cmumps_asm_slave_to_slave(n, ifath,
1614 & iw, liw,
1615 & a, la, 1, nbcols_eff,
1616 & indice_pere_array_arg,
1617 & iw( collist ),
1618 & a_temp(1+(ii+panel_beg_offset
1619 & -nrows_already_stacked-1)*nbcols),
1620 & opassw, opeliw, step, ptrist, ptrast,
1621 & itloc, rhs_mumps,
1622 & fils, icntl, keep,keep8,
1623 & myid, is_oftype5or6, nbcols)
1624 ELSE
1625 CALL cmumps_asm_slave_to_slave(n, ifath,
1626 & iw, liw,
1627 & a, la, 1, nbcols_eff, indice_pere_array_arg,
1628 & iw( collist ), son_a(posrow),
1629 & opassw, opeliw, step, ptrist, ptrast,
1630 & itloc, rhs_mumps,
1631 & fils, icntl, keep,keep8,
1632 & myid, is_oftype5or6, lda_son)
1633 ENDIF
1634 iw( ptrist(step(ifath))+xxnbpr) =
1635 & iw( ptrist(step(ifath))+xxnbpr) - 1
1636 ENDIF
1637 ENDIF
1638 ENDDO
1639 IF (cb_is_lr.AND.nrows_to_stack.GT.0) THEN
1640 deallocate(a_temp)
1641 CALL mumps_dm_fac_upd_dyn_memcnts(-la_temp,
1642 & .false., keep8, iflag, ierror, .true., .true.)
1643 nrows_already_stacked = nrows_already_stacked
1644 & + nrows_to_stack_loc
1645 IF (nrows_already_stacked.LT.nrows_to_stack) THEN
1646 GOTO 100
1647 ENDIF
1648 ENDIF
1649 IF (pdest.EQ.pdest_master) THEN
1650 IF (keep(219).NE.0) THEN
1651 IF(nslaves_pere.GT.0 .AND. keep(50).EQ.2) THEN
1652 IF (cb_is_lr) THEN
1653 CALL cmumps_blr_retrieve_m_array (
1654 & iw(istchk+xxf), m_array)
1655 m_array_retrieved = .true.
1656 ELSE
1657 IF (packed_cb) THEN
1658 WRITE(*,*) "Error 1 in PARPIV/CMUMPS_MAPLIG"
1659 CALL mumps_abort()
1660 ELSE
1661 posrow = iachk + shiftcb_son+
1662 & int(nbrow(1)-1,8)*int(lda_son,8)
1663 ENDIF
1664 CALL cmumps_buf_max_array_minsize(nfs4father,ierr)
1665 IF (ierr .NE.0) THEN
1666 IF (lp .GT. 0) THEN
1667 WRITE(lp, *) "MAX_ARRAY allocation failed"
1668 ENDIF
1669 iflag=-13
1670 ierror=nfs4father
1671 RETURN
1672 ENDIF
1673 itmp=-9999
1674 IF (lmap_loc-nbrow(1)+1-keep253_loc-nvschur.NE.0)
1675 & THEN
1676 CALL cmumps_compute_maxpercol(
1677 & son_a(posrow),
1678 & sizfr-shiftcb_son-int(nbrow(1)-1,8)*int(lda_son,8),
1679 & lda_son,
1680 & lmap_loc-nbrow(1)+1-keep253_loc-nvschur,
1681 & buf_max_array,nfs4father,packed_cb,itmp)
1682 ELSE
1683 CALL cmumps_setmaxtozero(
1684 & buf_max_array, nfs4father)
1685 ENDIF
1686 m_array => buf_max_array(1:size(buf_max_array))
1687 m_array_retrieved = .false.
1688 ENDIF
1689 CALL cmumps_asm_max(n, ifath, iw, liw,
1690 & a, la, ison, nfs4father,
1691 & m_array(1), ptlust, ptrast,
1692 & step, pimaster,
1693 & opassw,iwposcb,myid, keep,keep8)
1694 IF ( m_array_retrieved )
1695 & CALL cmumps_blr_free_m_array ( iw(istchk+xxf) )
1696 ENDIF
1697 ENDIF
1698 istchk_loc = pimaster(step(ison))
1699 same_proc= istchk_loc .LT. iwposcb
1700 IF ( same_proc ) THEN
1701 inbprocfils_son = ptrist(step(ison))+xxnbpr
1702 WRITE(*,*)
1703 & "Internal error 0 in CMUMPS_LOCAL_ASSEMBLY_TYPE2",
1704 & inbprocfils_son, pimaster(step(ison))
1705 CALL mumps_abort()
1706 ELSE
1707 inbprocfils_son = pimaster(step(ison))+xxnbpr
1708 ENDIF
1709 IF ( iw(inbprocfils_son) .EQ. 0 ) THEN
1710 IF (same_proc) THEN
1711 CALL cmumps_restore_indices(n, ison, ifath,
1712 & iwposcb, pimaster, ptlust, iw, liw, step,
1713 & keep,keep8)
1714 ENDIF
1715 IF (same_proc) THEN
1716 istchk_loc = ptrist(step(ison))
1717 ptrist(step( ison) ) = -99999999
1718 ELSE
1719 pimaster(step( ison )) = -99999999
1720 ENDIF
1721 CALL mumps_geti8(dyn_size, iw(istchk_loc+xxd))
1722 xxg_status = iw(istchk_loc+xxg)
1723 IF (dyn_size .GT. 0_8) THEN
1724 CALL cmumps_dm_set_ptr( pamaster(step(ison)),
1725 & dyn_size, son_a_master )
1726 ENDIF
1727 CALL cmumps_free_block_cb_static(.false., myid, n,
1728 & istchk_loc,
1729 & iw, liw, lrlu, lrlus, iptrlu, iwposcb,
1730 & la, keep,keep8, .false.
1731 & )
1732 IF (dyn_size .GT. 0_8) THEN
1733 CALL cmumps_dm_free_block( xxg_status, son_a_master,
1734 & dyn_size,
1735 & keep(405).EQ.1, keep8 )
1736 ENDIF
1737 ENDIF
1738 IF ( iw(ptlust(step(ifath))+xxnbpr) .EQ. 0
1739 & ) THEN
1740 ioldps = ptlust(step(ifath))
1741 IF (nslaves_pere.EQ.0) THEN
1742 poselt = ptrast(step(ifath))
1743 parpiv_t1 = -999
1744 lr_activated = (iw(ioldps+xxlr).GT.0)
1745 nb_postponed = max(nfront - nd(step(ifath)),0)
1746 CALL cmumps_parpivt1_set_nvschur_max (
1747 & n, ifath, iw, liw, a, la, keep, perm,
1748 & ioldps, poselt,
1749 & nfront_pere, nass_pere, lr_activated, parpiv_t1,
1750 & nb_postponed )
1751 ENDIF
1752 CALL cmumps_insert_pool_n( n, ipool, lpool,
1753 & procnode_steps,
1754 & slavef, keep(199), keep(28), keep(76), keep(80),
1755 & keep(47), step, ifath+n )
1756 IF (keep(47) .GE. 3) THEN
1757 CALL cmumps_load_pool_upd_new_pool(
1758 & ipool, lpool,
1759 & procnode_steps, keep,keep8, slavef, comm_load,
1760 & myid, step, n, nd, fils )
1761 ENDIF
1762 END IF
1763 ELSE
1764 CALL cmumps_asm_slave_to_slave_end
1765 & (n, ifath, iw, liw,
1766 & nbrow(i), step, ptrist, itloc, rhs_mumps,
1767 & keep,keep8)
1768 END IF
1769 RETURN
1770 END SUBROUTINE cmumps_local_assembly_type2
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
cmumps_bdc_error
subroutine cmumps_bdc_error(myid, slavef, comm, keep)
Definition cbcast_int.F:38
header
subroutine header
Definition cblat1.f:91
cmumps_asm_slave_to_slave_end
subroutine cmumps_asm_slave_to_slave_end(n, inode, iw, liw, nbrows, step, ptrist, itloc, rhs_mumps, keep, keep8)
Definition cfac_asm.F:191
cmumps_restore_indices
subroutine cmumps_restore_indices(n, ison, inode, iwposcb, pimaster, ptlust_s, iw, liw, step, keep, keep8)
Definition cfac_asm.F:523
cmumps_asm_slave_to_slave_init
subroutine cmumps_asm_slave_to_slave_init(n, inode, iw, liw, a, la, nbrows, nbcols, opassw, opeliw, step, ptrist, ptrast, itloc, rhs_mumps, fils, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, myid, lrgroups)
Definition cfac_asm.F:132
cmumps_asm_slave_to_slave
subroutine cmumps_asm_slave_to_slave(n, inode, iw, liw, a, la, nbrows, nbcols, rowlist, collist, valson, opassw, opeliw, step, ptrist, ptrast, itloc, rhs_mumps, fils, icntl, keep, keep8, myid, is_oftype5or6, lda_valson)
Definition cfac_asm.F:223
cmumps_asm_max
subroutine cmumps_asm_max(n, inode, iw, liw, a, la, ison, nbcols, valson, ptlust_s, ptrast, step, pimaster, opassw, iwposcb, myid, keep, keep8)
Definition cfac_asm.F:581
cmumps_parpivt1_set_nvschur_max
subroutine cmumps_parpivt1_set_nvschur_max(n, inode, iw, liw, a, la, keep, perm, ioldps, poselt, nfront, nass1, lr_activated, parpiv_t1, nb_postponed)
Definition cfac_asm.F:950
cmumps_asm_slave_master
subroutine cmumps_asm_slave_master(n, inode, iw, liw, a, la, ison, nbrows, nbcols, rowlist, valson, ptlust_s, ptrast, step, pimaster, opassw, iwposcb, myid, keep, keep8, is_oftype5or6, lda_valson)
Definition cfac_asm.F:19
cmumps_elt_asm_s_2_s_init
subroutine cmumps_elt_asm_s_2_s_init(nelt, frt_ptr, frt_elt, n, inode, iw, liw, a, la, nbrows, nbcols, opassw, opeliw, step, ptrist, ptrast, itloc, rhs_mumps, fils, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, myid, lrgroups)
Definition cfac_asm_ELT.F:22
cmumps_free_block_cb_static
subroutine cmumps_free_block_cb_static(ssarbr, myid, n, iposblock, iw, liw, lrlu, lrlus, iptrlu, iwposcb, la, keep, keep8, in_place_stats)
Definition cfac_mem_free_block_cb.F:20
cmumps_treat_descband
recursive subroutine cmumps_treat_descband(inode, comm_load, ass_irecv, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt istep_to_iniv2, tab_pos_in_pere, stack_right_authorized, lrgroups)
Definition cfac_process_band.F:254
cmumps_maplig_fils_niv1
subroutine cmumps_maplig_fils_niv1(comm_load, ass_irecv, bufr, lbufr, lbufr_bytes inode_pere, ison, nslaves_pere, list_slaves_pere, nfront_pere, nass_pere, nfs4father, lmap, trow, procnode_steps, slavef, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk, comp, iflag, ierror, myid, comm, perm, ipool, lpool, leaf, nbfin, icntl, keep, keep8, dkeep, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition cfac_process_maprow.F:644
cmumps_local_assembly_type2
subroutine cmumps_local_assembly_type2(i, pdest, myid, pdest_master, ison, ifath, nslaves_pere, nass_pere, nfront_pere, nfs4father, lmap_loc, map, nbrow, perm, is_oftype5or6, iflag, ierror, n, slavef, keep, ipool, lpool, step, procnode_steps, comm_load, istep_to_iniv2, tab_pos_in_pere, keep8, iw, liw, a, la, lrlu, lrlus, iptrlu, iwposcb, ptrist, ptlust, ptrast, pamaster, pimaster, nd, nelt, frtptr, frtelt, opassw, opeliw, itloc, rhs_mumps, keep253_loc, nvschur, fils, dad, lptrar, ptrarw, ptraiw, intarr, dblarr, icntl, son_niv, lrgroups)
Definition cfac_process_maprow.F:1227
cmumps_maplig
recursive subroutine cmumps_maplig(comm_load, ass_irecv, bufr, lbufr, lbufr_bytes inode_pere, ison, nslaves_pere, list_slaves_pere, nfront_pere, nass_pere, nfs4father, lmap, trow, procnode_steps, slavef, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk, comp, iflag, ierror, myid, comm, perm, ipool, lpool, leaf, nbfin, icntl, keep, keep8, dkeep, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition cfac_process_maprow.F:34
cmumps_try_recvtreat
recursive subroutine cmumps_try_recvtreat(comm_load, ass_irecv, blocking, set_irecv, message_received, msgsou, msgtag, status, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt istep_to_iniv2, tab_pos_in_pere, stack_right_authorized, lrgroups)
Definition cfac_process_message.F:560
cmumps_insert_pool_n
subroutine cmumps_insert_pool_n(n, pool, lpool, procnode, slavef, keep199, k28, k76, k80, k47, step, inode)
Definition cfac_sol_pool.F:27
cmumps_compute_maxpercol
subroutine cmumps_compute_maxpercol(a, asize, ncol, nrow, m_array, nmax, packed_cb, lrow1)
Definition ctools.F:1643
cmumps_setmaxtozero
subroutine cmumps_setmaxtozero(m_array, m_size)
Definition ctools.F:1569
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mumps_bloc2_get_islave
subroutine mumps_bloc2_get_islave(keep, keep8, inode, step, n, slavef, istep_to_iniv2, tab_pos_in_pere nass, ncb, nslaves, position, islave, iposslave)
Definition mumps_type2_blocking.F:479
cmumps_buf
Definition cmumps_comm_buffer.F:14
cmumps_buf::cmumps_buf_send_contrib_type2
subroutine, public cmumps_buf_send_contrib_type2(nbrows_already_sent, desc_in_lu, ipere, nfront_pere, nass_pere, nfs4father, nslaves_pere, ison, nbrow, lmap, maprow, perm, iw_cbson, a_cbson, la_cbson, islave, pdest, pdest_master, comm, ierr, keep, keep8, step, n, slavef, istep_to_iniv2, tab_pos_in_pere, packed_cb, keep253_loc, nvschur, son_niv, myid, npiv_check)
Definition cmumps_comm_buffer.F:1050
cmumps_buf::buf_lmax_array
integer, save, public buf_lmax_array
Definition cmumps_comm_buffer.F:50
cmumps_buf::cmumps_buf_max_array_minsize
subroutine, public cmumps_buf_max_array_minsize(nfs4father, ierr)
Definition cmumps_comm_buffer.F:144
cmumps_buf::buf_max_array
real, dimension(:), allocatable, target, save, public buf_max_array
Definition cmumps_comm_buffer.F:51
cmumps_dynamic_memory_m
Definition cfac_mem_dynamic.F:14
cmumps_dynamic_memory_m::cmumps_dm_free_block
subroutine cmumps_dm_free_block(xxg_status, dynptr, sizfr8, atomic_updates, keep8)
Definition cfac_mem_dynamic.F:433
cmumps_dynamic_memory_m::cmumps_dm_set_ptr
subroutine cmumps_dm_set_ptr(address, sizfr8, cbptr)
Definition cfac_mem_dynamic.F:417
cmumps_dynamic_memory_m::cmumps_dm_set_dynptr
subroutine cmumps_dm_set_dynptr(cb_state, a, la, pamaster_or_ptrast, ixxd, ixxr, son_a, iachk, recsize)
Definition cfac_mem_dynamic.F:19
cmumps_fac_front_aux_m
Definition cfac_front_aux.F:14
cmumps_fac_front_aux_m::cmumps_get_size_schur_in_front
subroutine cmumps_get_size_schur_in_front(n, ncb, size_schur, row_indices, perm, nvschur)
Definition cfac_front_aux.F:2495
cmumps_fac_lr
Definition cfac_lr.F:14
cmumps_fac_lr::cmumps_decompress_panel
subroutine cmumps_decompress_panel(a, la, poselt, lda11, lda21, copy_dense_blocks, begs_blr_diag, begs_blr_first_offdiag, nb_blr, blr_panel, current_blr, dir, decomp_timer, beg_i_in, end_i_in, only_nelim_in, cbasm_tofix_in)
Definition cfac_lr.F:1754
cmumps_load
Definition cmumps_load.F:14
cmumps_load::cmumps_load_pool_upd_new_pool
subroutine, public cmumps_load_pool_upd_new_pool(pool, lpool, procnode, keep, keep8, slavef, comm, myid, step, n, nd, fils)
Definition cmumps_load.F:1820
cmumps_load::myid
integer, save, private myid
Definition cmumps_load.F:57
cmumps_lr_data_m
Definition cmumps_lr_data_m.F:14
cmumps_lr_data_m::cmumps_blr_retrieve_begs_blr_c
subroutine, public cmumps_blr_retrieve_begs_blr_c(iwhandler, begs_blr_col, nb_panels)
Definition cmumps_lr_data_m.F:654
cmumps_lr_data_m::cmumps_blr_free_cb_lrb
subroutine, public cmumps_blr_free_cb_lrb(iwhandler, free_only_struct, keep8, k34)
Definition cmumps_lr_data_m.F:970
cmumps_lr_data_m::cmumps_blr_free_m_array
subroutine, public cmumps_blr_free_m_array(iwhandler)
Definition cmumps_lr_data_m.F:917
cmumps_lr_data_m::cmumps_blr_retrieve_cb_lrb
subroutine, public cmumps_blr_retrieve_cb_lrb(iwhandler, thecb)
Definition cmumps_lr_data_m.F:837
cmumps_lr_data_m::cmumps_blr_retrieve_m_array
subroutine, public cmumps_blr_retrieve_m_array(iwhandler, m_array)
Definition cmumps_lr_data_m.F:902
cmumps_lr_data_m::cmumps_blr_retrieve_nb_panels
subroutine, public cmumps_blr_retrieve_nb_panels(iwhandler, nb_panels)
Definition cmumps_lr_data_m.F:672
cmumps_lr_data_m::cmumps_blr_retrieve_begsblr_sta
subroutine, public cmumps_blr_retrieve_begsblr_sta(iwhandler, begs_blr_static)
Definition cmumps_lr_data_m.F:622
cmumps_lr_data_m::cmumps_blr_end_front
subroutine, public cmumps_blr_end_front(iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
Definition cmumps_lr_data_m.F:342
cmumps_lr_data_m::cmumps_blr_retrieve_begsblr_dyn
subroutine, public cmumps_blr_retrieve_begsblr_dyn(iwhandler, begs_blr_dynamic)
Definition cmumps_lr_data_m.F:638
cmumps_lr_stats
Definition clr_stats.F:14
cmumps_lr_type
Definition clr_type.F:14
cmumps_struc_def
Definition cmumps_struc_def.F:14
mumps_fac_maprow_data_m
Definition fac_maprow_data_m.F:14
mumps_fac_maprow_data_m::mumps_fmrd_save_maprow
subroutine, public mumps_fmrd_save_maprow(iwhandler, inode, ison, nslaves_pere, nfront_pere, nass_pere, lmap, nfs4father, slaves_pere, trow, info)
Definition fac_maprow_data_m.F:102
comp
int comp(int a, int b)
Definition set_surface_lines.cpp:102
mumps_seti8toi4
subroutine mumps_seti8toi4(i8, i)
Definition tools_common.F:843
mumps_typenode
integer function mumps_typenode(procinfo_inode, k199)
Definition tools_common.F:90
mumps_procnode
integer function mumps_procnode(procinfo_inode, k199)
Definition tools_common.F:151
mumps_typesplit
integer function mumps_typesplit(procinfo_inode, k199)
Definition tools_common.F:171
mumps_geti8
subroutine mumps_geti8(i8, int_array)
Definition tools_common.F:888
mumps_dm_fac_upd_dyn_memcnts
subroutine mumps_dm_fac_upd_dyn_memcnts(mem_count_allocated, atomic_updates, keep8, iflag, ierror, k69upd, k71upd)
Definition tools_common.F:1476