OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zfac_process_maprow.F File Reference

Go to the source code of this file.

Functions/Subroutines

recursive subroutine zmumps_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)
subroutine zmumps_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)
subroutine zmumps_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)

Function/Subroutine Documentation

◆ zmumps_local_assembly_type2()

subroutine zmumps_local_assembly_type2 ( integer, intent(in) i,
integer, intent(in) pdest,
integer, intent(in) myid,
integer, intent(in) pdest_master,
integer, intent(in) ison,
integer, intent(in) ifath,
integer, intent(in) nslaves_pere,
integer, intent(in) nass_pere,
integer, intent(in) nfront_pere,
integer, intent(in) nfs4father,
integer, intent(in) lmap_loc,
integer, dimension(lmap_loc), intent(in) map,
integer, dimension(0:nslaves_pere), intent(in) nbrow,
integer, dimension(lmap_loc), intent(in) perm,
logical, intent(in) is_oftype5or6,
integer, intent(inout) iflag,
integer, intent(inout) ierror,
integer, intent(in) n,
integer, intent(in) slavef,
integer, dimension(500), intent(in) keep,
integer, dimension( lpool ) ipool,
integer lpool,
integer, dimension(n), intent(in) step,
integer, dimension( keep(28) ), intent(in) procnode_steps,
integer, intent(in) comm_load,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer(8), dimension(150), intent(inout) keep8,
integer, dimension(liw), intent(inout) iw,
integer, intent(in) liw,
complex(kind=8), dimension( la ), intent(inout) a,
integer(8), intent(in) la,
integer(8), intent(inout) lrlu,
integer(8), intent(inout) lrlus,
integer(8), intent(inout) iptrlu,
integer, intent(inout) iwposcb,
integer, dimension(keep(28)) ptrist,
integer, dimension(keep(28)) ptlust,
integer(8), dimension(keep(28)) ptrast,
integer(8), dimension(keep(28)) pamaster,
integer, dimension(keep(28)) pimaster,
integer, dimension(keep(28)) nd,
integer, intent(in) nelt,
integer, dimension( n+1 ), intent(in) frtptr,
integer, dimension( nelt ), intent(in) frtelt,
double precision, intent(inout) opassw,
double precision, intent(inout) opeliw,
integer, dimension(n), intent(inout) itloc,
complex(kind=8), dimension(keep(255)) rhs_mumps,
integer, intent(in) keep253_loc,
integer, intent(in) nvschur,
integer, dimension(n), intent(in) fils,
integer, dimension( keep(28) ), intent(in) dad,
integer, intent(in) lptrar,
integer(8), dimension( lptrar ), intent(in) ptrarw,
integer(8), dimension( lptrar ), intent(in) ptraiw,
integer, dimension(keep8(27)) intarr,
complex(kind=8), dimension(keep8(26)) dblarr,
integer, dimension(60) icntl,
integer, intent(in) son_niv,
integer, dimension(n), intent(in) lrgroups )

Definition at line 1211 of file zfac_process_maprow.F.

1227 USE zmumps_buf, ONLY: zmumps_buf_max_array_minsize,
1228 & buf_max_array
1229 USE zmumps_lr_type
1230 USE zmumps_lr_stats
1231 USE zmumps_lr_data_m
1232 USE zmumps_fac_lr, ONLY: zmumps_decompress_panel
1233 USE zmumps_load, ONLY : zmumps_load_pool_upd_new_pool
1234 USE zmumps_dynamic_memory_m, ONLY : zmumps_dm_set_dynptr
1235 & , zmumps_dm_set_ptr, zmumps_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(kind=8), 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(kind=8) :: 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(kind=8) 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(kind=8), DIMENSION(:), POINTER :: SON_A
1288 COMPLEX(kind=8), 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 DOUBLE PRECISION, 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(kind=8), 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 zmumps_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 zmumps_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 zmumps_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 zmumps_blr_retrieve_cb_lrb(
1393 & iw(istchk+xxf), cb_lrb)
1394 IF (son_niv.EQ.1) THEN
1395 CALL zmumps_blr_retrieve_begsblr_sta(
1396 & iw(istchk+xxf), begs_blr_row)
1397 CALL zmumps_blr_retrieve_begsblr_dyn(
1398 & iw(istchk+xxf), begs_blr_col)
1399 nb_blr_rows = size(begs_blr_row) - 1
1400 CALL zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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/ZMUMPS_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 ZMUMPS_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 zmumps_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 zmumps_dm_set_ptr( pamaster(step(ison)),
1725 & dyn_size, son_a_master )
1726 ENDIF
1727 CALL zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
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
zmumps_buf
Definition zmumps_comm_buffer.F:14
zmumps_buf::zmumps_buf_max_array_minsize
subroutine, public zmumps_buf_max_array_minsize(nfs4father, ierr)
Definition zmumps_comm_buffer.F:144
zmumps_buf::buf_max_array
double precision, dimension(:), allocatable, target, save, public buf_max_array
Definition zmumps_comm_buffer.F:51
zmumps_dynamic_memory_m
Definition zfac_mem_dynamic.F:14
zmumps_dynamic_memory_m::zmumps_dm_set_dynptr
subroutine zmumps_dm_set_dynptr(cb_state, a, la, pamaster_or_ptrast, ixxd, ixxr, son_a, iachk, recsize)
Definition zfac_mem_dynamic.F:19
zmumps_dynamic_memory_m::zmumps_dm_set_ptr
subroutine zmumps_dm_set_ptr(address, sizfr8, cbptr)
Definition zfac_mem_dynamic.F:417
zmumps_dynamic_memory_m::zmumps_dm_free_block
subroutine zmumps_dm_free_block(xxg_status, dynptr, sizfr8, atomic_updates, keep8)
Definition zfac_mem_dynamic.F:433
zmumps_fac_lr
Definition zfac_lr.F:14
zmumps_fac_lr::zmumps_decompress_panel
subroutine zmumps_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 zfac_lr.F:1754
zmumps_load
Definition zmumps_load.F:14
zmumps_load::myid
integer, save, private myid
Definition zmumps_load.F:57
zmumps_load::zmumps_load_pool_upd_new_pool
subroutine, public zmumps_load_pool_upd_new_pool(pool, lpool, procnode, keep, keep8, slavef, comm, myid, step, n, nd, fils)
Definition zmumps_load.F:1820
zmumps_lr_data_m
Definition zmumps_lr_data_m.F:14
zmumps_lr_data_m::zmumps_blr_retrieve_m_array
subroutine, public zmumps_blr_retrieve_m_array(iwhandler, m_array)
Definition zmumps_lr_data_m.F:902
zmumps_lr_data_m::zmumps_blr_retrieve_begsblr_sta
subroutine, public zmumps_blr_retrieve_begsblr_sta(iwhandler, begs_blr_static)
Definition zmumps_lr_data_m.F:622
zmumps_lr_data_m::zmumps_blr_free_m_array
subroutine, public zmumps_blr_free_m_array(iwhandler)
Definition zmumps_lr_data_m.F:917
zmumps_lr_data_m::zmumps_blr_retrieve_cb_lrb
subroutine, public zmumps_blr_retrieve_cb_lrb(iwhandler, thecb)
Definition zmumps_lr_data_m.F:837
zmumps_lr_data_m::zmumps_blr_retrieve_nb_panels
subroutine, public zmumps_blr_retrieve_nb_panels(iwhandler, nb_panels)
Definition zmumps_lr_data_m.F:672
zmumps_lr_data_m::zmumps_blr_retrieve_begsblr_dyn
subroutine, public zmumps_blr_retrieve_begsblr_dyn(iwhandler, begs_blr_dynamic)
Definition zmumps_lr_data_m.F:638
zmumps_lr_data_m::zmumps_blr_retrieve_begs_blr_c
subroutine, public zmumps_blr_retrieve_begs_blr_c(iwhandler, begs_blr_col, nb_panels)
Definition zmumps_lr_data_m.F:654
zmumps_lr_stats
Definition zlr_stats.F:14
zmumps_lr_type
Definition zlr_type.F:14
mumps_seti8toi4
subroutine mumps_seti8toi4(i8, i)
Definition tools_common.F:843
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
zmumps_asm_slave_to_slave_end
subroutine zmumps_asm_slave_to_slave_end(n, inode, iw, liw, nbrows, step, ptrist, itloc, rhs_mumps, keep, keep8)
Definition zfac_asm.F:191
zmumps_parpivt1_set_nvschur_max
subroutine zmumps_parpivt1_set_nvschur_max(n, inode, iw, liw, a, la, keep, perm, ioldps, poselt, nfront, nass1, lr_activated, parpiv_t1, nb_postponed)
Definition zfac_asm.F:950
zmumps_asm_slave_to_slave
subroutine zmumps_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 zfac_asm.F:223
zmumps_asm_slave_master
subroutine zmumps_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 zfac_asm.F:19
zmumps_asm_slave_to_slave_init
subroutine zmumps_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 zfac_asm.F:132
zmumps_asm_max
subroutine zmumps_asm_max(n, inode, iw, liw, a, la, ison, nbcols, valson, ptlust_s, ptrast, step, pimaster, opassw, iwposcb, myid, keep, keep8)
Definition zfac_asm.F:581
zmumps_restore_indices
subroutine zmumps_restore_indices(n, ison, inode, iwposcb, pimaster, ptlust_s, iw, liw, step, keep, keep8)
Definition zfac_asm.F:523
zmumps_elt_asm_s_2_s_init
subroutine zmumps_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 zfac_asm_ELT.F:22
zmumps_free_block_cb_static
subroutine zmumps_free_block_cb_static(ssarbr, myid, n, iposblock, iw, liw, lrlu, lrlus, iptrlu, iwposcb, la, keep, keep8, in_place_stats)
Definition zfac_mem_free_block_cb.F:20
zmumps_insert_pool_n
subroutine zmumps_insert_pool_n(n, pool, lpool, procnode, slavef, keep199, k28, k76, k80, k47, step, inode)
Definition zfac_sol_pool.F:27
zmumps_compute_maxpercol
subroutine zmumps_compute_maxpercol(a, asize, ncol, nrow, m_array, nmax, packed_cb, lrow1)
Definition ztools.F:1643
zmumps_setmaxtozero
subroutine zmumps_setmaxtozero(m_array, m_size)
Definition ztools.F:1569

◆ zmumps_maplig()

recursive subroutine zmumps_maplig ( integer comm_load,
integer ass_irecv,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer inode_pere,
integer ison,
integer nslaves_pere,
integer, dimension( * ) list_slaves_pere,
integer nfront_pere,
integer nass_pere,
integer nfs4father,
integer lmap,
integer, dimension( lmap ) trow,
integer, dimension( keep(28) ) procnode_steps,
integer slavef,
integer(8) posfac,
integer iwpos,
integer iwposcb,
integer(8) iptrlu,
integer(8) lrlu,
integer(8) lrlus,
integer n,
integer, dimension( liw ) iw,
integer liw,
complex(kind=8), dimension( la ) a,
integer(8) la,
integer, dimension(keep(28)) ptrist,
integer, dimension(keep(28)) ptlust,
integer(8), dimension(keep(28)) ptrfac,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer, dimension( keep(28) ) nstk,
integer comp,
integer iflag,
integer ierror,
integer myid,
integer comm,
integer, dimension(n) perm,
integer, dimension( lpool ) ipool,
integer lpool,
integer leaf,
integer nbfin,
integer, dimension( 60 ) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
double precision, dimension(230) dkeep,
type (zmumps_root_struc ) root,
double precision opassw,
double precision opeliw,
integer, dimension( n+keep(253) ) itloc,
complex(kind=8), dimension(keep(255)) rhs_mumps,
integer, dimension( n ) fils,
integer, dimension( keep(28) ) dad,
integer(8), dimension( lptrar ), intent(in) ptrarw,
integer(8), dimension( lptrar ), intent(in) ptraiw,
integer, dimension(keep8(27)) intarr,
complex(kind=8), dimension(keep8(26)) dblarr,
integer, dimension( keep(28) ) nd,
integer, dimension( keep(28) ) frere,
integer lptrar,
integer nelt,
integer, dimension( n+1 ) frtptr,
integer, dimension( nelt ) frtelt,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer, dimension(n), intent(in) lrgroups )

Definition at line 14 of file zfac_process_maprow.F.

34 USE zmumps_buf
35 USE zmumps_load
36 USE zmumps_lr_data_m
37 USE zmumps_dynamic_memory_m, ONLY : zmumps_dm_set_dynptr
38 USE zmumps_fac_front_aux_m, ONLY : zmumps_get_size_schur_in_front
39#if ! defined(NO_FDM_MAPROW)
40 USE mumps_fac_maprow_data_m
41#endif
42 USE zmumps_struc_def, ONLY : zmumps_root_struc
43 IMPLICIT NONE
44#if ! defined(NO_FDM_MAPROW)
45#endif
46 TYPE (ZMUMPS_ROOT_STRUC ) :: root
47 INTEGER LBUFR, LBUFR_BYTES
48 INTEGER ICNTL( 60 ), KEEP(500)
49 INTEGER(8) KEEP8(150)
50 DOUBLE PRECISION 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(kind=8) 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(kind=8) 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(kind=8) :: 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(kind=8) :: ADummy(1)
113 COMPLEX(kind=8), 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 ZMUMPS_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 ZMUMPS_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 ZMUMPS_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 zmumps_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 zmumps_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 ZMUMPS_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 IF ((keep(114).EQ.1) .AND. (keep(50).EQ.2) .AND.
331 & (keep(116).GT.0) .AND. ((lmap_loc-keep253_loc).GT.0)
332 & ) THEN
333 IF (itype_son.EQ.1) 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 zmumps_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 IF (slaves_pere(i) .EQ. myid) THEN
358 i_posmyidin_pere = i
359 local_assembly_to_be_done = .true.
360#if ! defined(NO_FDM_DESCBAND)
361 IF (ptrist(step(inode_pere)) .EQ. 0
362 & .AND. myid .NE. pdest_master) THEN
363 CALL zmumps_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 IF ( iflag .LT. 0 ) THEN
381 is_error_broadcasted = .true.
382 GOTO 600
383 ENDIF
384 ENDIF
385#endif
386 ENDIF
387 END DO
388 IF (keep(120).NE.0 .AND. local_assembly_to_be_done) THEN
389 CALL zmumps_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 IF ( pdest .NE. 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 packed_cb=(iw(ptrist(step(ison))+xxs).EQ.s_cb1comp)
420 ierr = -1
421 DO WHILE (ierr .EQ. -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 IF (nrows_to_send .EQ. 0 .AND. pdest.NE.pdest_master) THEN
435 ierr = 0
436 cycle
437 ENDIF
438 IF (cb_is_lr) THEN
439 CALL zmumps_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 zmumps_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 zmumps_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 IF ( ierr .EQ. -2 ) THEN
480 iflag = -17
481 IF (lp .GT. 0) THEN
482 WRITE(lp,*)
483 & "FAILURE: SEND BUFFER TOO SMALL IN ZMUMPS_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 IF ( ierr .EQ. -3 ) THEN
491 IF (lp .GT. 0) THEN
492 WRITE(lp,*)
493 & "FAILURE: RECV BUFFER TOO SMALL IN ZMUMPS_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 IF (keep(219).NE.0) THEN
502 IF ( ierr .EQ. -4 ) THEN
503 iflag = -13
504 ierror = nfs4father
505 IF (lp .GT. 0) THEN
506 WRITE(lp, *)
507 & "FAILURE: MAX_ARRAY allocation failed IN ZMUMPS_MAPLIG"
508 ENDIF
509 GO TO 600
510 END IF
511 END IF
512 IF ( ierr .EQ. -1 ) THEN
513 IF (local_assembly_to_be_done) THEN
514 CALL zmumps_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 zmumps_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 IF ( iflag .LT. 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 zmumps_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 zmumps_blr_free_cb_lrb(iwxxf_handler,
590 & .false., keep8, keep(34))
591 IF ((keep(486).EQ.3).OR.keep(486).EQ.0) THEN
592 CALL zmumps_blr_end_front(iwxxf_handler, iflag, keep8,
593 & keep(34))
594 ENDIF
595 ENDIF
596 IF (keep(214) .EQ. 2) THEN
597 CALL zmumps_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 IF (iflag .LT. 0) THEN
604 is_error_broadcasted = .true.
605 GOTO 600
606 ENDIF
607 ENDIF
608 CALL zmumps_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 IF (iflag .LT. 0 .AND. .NOT. is_error_broadcasted) THEN
621 CALL zmumps_bdc_error( myid, slavef, comm, keep )
622 ENDIF
623 RETURN
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
zmumps_buf::zmumps_buf_send_contrib_type2
subroutine, public zmumps_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 zmumps_comm_buffer.F:1050
zmumps_fac_front_aux_m
Definition zfac_front_aux.F:14
zmumps_fac_front_aux_m::zmumps_get_size_schur_in_front
subroutine zmumps_get_size_schur_in_front(n, ncb, size_schur, row_indices, perm, nvschur)
Definition zfac_front_aux.F:2495
zmumps_lr_data_m::zmumps_blr_end_front
subroutine, public zmumps_blr_end_front(iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
Definition zmumps_lr_data_m.F:342
zmumps_lr_data_m::zmumps_blr_free_cb_lrb
subroutine, public zmumps_blr_free_cb_lrb(iwhandler, free_only_struct, keep8, k34)
Definition zmumps_lr_data_m.F:970
zmumps_struc_def
Definition zmumps_struc_def.F:14
comp
int comp(int a, int b)
Definition set_surface_lines.cpp:102
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
zmumps_bdc_error
subroutine zmumps_bdc_error(myid, slavef, comm, keep)
Definition zbcast_int.F:38
zmumps_treat_descband
recursive subroutine zmumps_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 zfac_process_band.F:254
zmumps_local_assembly_type2
subroutine zmumps_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 zfac_process_maprow.F:1227
zmumps_try_recvtreat
recursive subroutine zmumps_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 zfac_process_message.F:560
zmumps_free_band
subroutine zmumps_free_band(n, ison, ptrist, ptrast, iw, liw, a, la, lrlu, lrlus, iwposcb, iptrlu, step, myid, keep, keep8, type_son)
Definition ztools.F:461
zmumps_stack_band
subroutine zmumps_stack_band(n, ison, ptrist, ptrast, ptlust_s, ptrfac, iw, liw, a, la, lrlu, lrlus, iwpos, iwposcb, posfac, comp, iptrlu, opeliw, step, pimaster, pamaster, iflag, ierror, slavef, procnode_steps, dad, myid, comm, keep, keep8, dkeep, type_son)
Definition ztools.F:219

◆ zmumps_maplig_fils_niv1()

subroutine zmumps_maplig_fils_niv1 ( integer comm_load,
integer ass_irecv,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer inode_pere,
integer ison,
integer nslaves_pere,
integer, dimension(nslaves_pere) list_slaves_pere,
integer nfront_pere,
integer nass_pere,
integer nfs4father,
integer lmap,
integer, dimension( lmap ) trow,
integer, dimension( keep(28) ) procnode_steps,
integer slavef,
integer(8) posfac,
integer iwpos,
integer iwposcb,
integer(8) iptrlu,
integer(8) lrlu,
integer(8) lrlus,
integer n,
integer, dimension( liw ) iw,
integer liw,
complex(kind=8), dimension( la ) a,
integer(8) la,
integer, dimension(keep(28)) ptrist,
integer, dimension(keep(28)) ptlust,
integer(8), dimension(keep(28)) ptrfac,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer, dimension( keep(28) ) nstk,
integer comp,
integer iflag,
integer ierror,
integer myid,
integer comm,
integer, dimension(n) perm,
integer, dimension( lpool ) ipool,
integer lpool,
integer leaf,
integer nbfin,
integer, dimension( 60 ) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
double precision, dimension(230) dkeep,
type (zmumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension( n+keep(253) ) itloc,
complex(kind=8), dimension(keep(255)) rhs_mumps,
integer, dimension( n ) fils,
integer, dimension( keep(28) ) dad,
integer(8), dimension( lptrar ), intent(in) ptrarw,
integer(8), dimension( lptrar ), intent(in) ptraiw,
integer, dimension(keep8(27)) intarr,
complex(kind=8), dimension(keep8(26)) dblarr,
integer, dimension( keep(28) ) nd,
integer, dimension( keep(28) ) frere,
integer lptrar,
integer nelt,
integer, dimension( n+1 ) frtptr,
integer, dimension( nelt ) frtelt,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer, dimension(n), intent(in) lrgroups )

Definition at line 625 of file zfac_process_maprow.F.

644 USE zmumps_buf
645 USE zmumps_load
646 USE zmumps_lr_type
647 USE zmumps_lr_stats
648 USE zmumps_fac_lr, ONLY: zmumps_decompress_panel
649 USE zmumps_fac_front_aux_m, ONLY : zmumps_get_size_schur_in_front
650 USE zmumps_lr_data_m
651 USE zmumps_struc_def, ONLY : zmumps_root_struc
652 USE zmumps_dynamic_memory_m, ONLY : zmumps_dm_set_dynptr
653 & , zmumps_dm_free_block
654 IMPLICIT NONE
655 TYPE (ZMUMPS_ROOT_STRUC) :: root
656 INTEGER COMM_LOAD, ASS_IRECV
657 INTEGER ICNTL( 60 ), KEEP(500)
658 INTEGER(8) KEEP8(150)
659 DOUBLE PRECISION 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(kind=8) 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 DOUBLE PRECISION, 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(kind=8) 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(kind=8) :: 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(kind=8), 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(kind=8) :: ADummy(1)
727 COMPLEX(kind=8), 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 IF (icntl(4) .LE. 0) lp = -1
739 if (nslaves_pere.le.0) 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 IF (allocok .GT. 0) THEN
745 IF (lp > 0)
746 & write(lp,*) myid,
747 & ' : PB allocation NBROW in ZMUMPS_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 IF ( allocok .GT. 0 ) THEN
754 IF (lp > 0) write(lp,*) myid,
755 & ' : PB allocation SLAVES_PERE in ZMUMPS_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 if (allocok .GT. 0) THEN
767 IF (lp > 0) write(lp,*) myid,
768 & ' : PB allocation LMAP in ZMUMPS_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 if (allocok .GT. 0) THEN
800 IF (lp > 0) THEN
801 write(lp,*) myid,
802 & ': PB allocation PERM_LOC in ZMUMPS_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 IF ( slaves_pere(0) .NE. 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 ZMUMPS_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 zmumps_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 zmumps_blr_retrieve_cb_lrb(
879 & iw(istchk+xxf), cb_lrb)
880 CALL zmumps_blr_retrieve_begsblr_sta(
881 & iw(istchk+xxf), begs_blr)
882 nb_blr_rows = size(begs_blr) - 1
883 CALL zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 ZMUMPS_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 zmumps_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 zmumps_setmaxtozero(buf_max_array,
1033 & nfs4father)
1034 ENDIF
1035 m_array => buf_max_array
1036 m_array_retrieved = .false.
1037 ENDIF
1038 CALL zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 zmumps_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 ZMUMPS_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 ZMUMPS_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 ZMUMPS_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 zmumps_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 ZMUMPS_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 zmumps_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 zmumps_dm_free_block( xxg_status, son_a, dynsize,
1191 & keep(405).EQ.1, keep8 )
1192 ENDIF
1193 GOTO 600
1194 700 CONTINUE
1195 CALL zmumps_bdc_error(myid, slavef, comm, keep )
1196 600 CONTINUE
1197 IF (cb_is_lr) THEN
1198 CALL zmumps_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 zmumps_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
zmumps_buf::buf_lmax_array
integer, save, public buf_lmax_array
Definition zmumps_comm_buffer.F:50