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

Go to the source code of this file.

Functions/Subroutines

recursive subroutine dmumps_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 dmumps_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 dmumps_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

◆ dmumps_local_assembly_type2()

subroutine dmumps_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,
double precision, 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,
double precision, 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,
double precision, 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 dfac_process_maprow.F.

1227 USE dmumps_buf, ONLY: dmumps_buf_max_array_minsize,
1228 & buf_max_array
1229 USE dmumps_lr_type
1230 USE dmumps_lr_stats
1231 USE dmumps_lr_data_m
1232 USE dmumps_fac_lr, ONLY: dmumps_decompress_panel
1233 USE dmumps_load, ONLY : dmumps_load_pool_upd_new_pool
1234 USE dmumps_dynamic_memory_m, ONLY : dmumps_dm_set_dynptr
1235 & , dmumps_dm_set_ptr, dmumps_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 DOUBLE PRECISION, 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 DOUBLE PRECISION :: 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 DOUBLE PRECISION 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 DOUBLE PRECISION, DIMENSION(:), POINTER :: SON_A
1288 DOUBLE PRECISION, 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 DOUBLE PRECISION, 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 dmumps_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 dmumps_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 dmumps_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 dmumps_blr_retrieve_cb_lrb(
1393 & iw(istchk+xxf), cb_lrb)
1394 IF (son_niv.EQ.1) THEN
1395 CALL dmumps_blr_retrieve_begsblr_sta(
1396 & iw(istchk+xxf), begs_blr_row)
1397 CALL dmumps_blr_retrieve_begsblr_dyn(
1398 & iw(istchk+xxf), begs_blr_col)
1399 nb_blr_rows = size(begs_blr_row) - 1
1400 CALL dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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/DMUMPS_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 DMUMPS_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 dmumps_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 dmumps_dm_set_ptr( pamaster(step(ison)),
1725 & dyn_size, son_a_master )
1726 ENDIF
1727 CALL dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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
dmumps_asm_slave_to_slave_end
subroutine dmumps_asm_slave_to_slave_end(n, inode, iw, liw, nbrows, step, ptrist, itloc, rhs_mumps, keep, keep8)
Definition dfac_asm.F:191
dmumps_parpivt1_set_nvschur_max
subroutine dmumps_parpivt1_set_nvschur_max(n, inode, iw, liw, a, la, keep, perm, ioldps, poselt, nfront, nass1, lr_activated, parpiv_t1, nb_postponed)
Definition dfac_asm.F:950
dmumps_asm_slave_master
subroutine dmumps_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 dfac_asm.F:19
dmumps_asm_max
subroutine dmumps_asm_max(n, inode, iw, liw, a, la, ison, nbcols, valson, ptlust_s, ptrast, step, pimaster, opassw, iwposcb, myid, keep, keep8)
Definition dfac_asm.F:581
dmumps_asm_slave_to_slave_init
subroutine dmumps_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 dfac_asm.F:132
dmumps_asm_slave_to_slave
subroutine dmumps_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 dfac_asm.F:223
dmumps_restore_indices
subroutine dmumps_restore_indices(n, ison, inode, iwposcb, pimaster, ptlust_s, iw, liw, step, keep, keep8)
Definition dfac_asm.F:523
dmumps_elt_asm_s_2_s_init
subroutine dmumps_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 dfac_asm_ELT.F:22
dmumps_free_block_cb_static
subroutine dmumps_free_block_cb_static(ssarbr, myid, n, iposblock, iw, liw, lrlu, lrlus, iptrlu, iwposcb, la, keep, keep8, in_place_stats)
Definition dfac_mem_free_block_cb.F:20
dmumps_insert_pool_n
subroutine dmumps_insert_pool_n(n, pool, lpool, procnode, slavef, keep199, k28, k76, k80, k47, step, inode)
Definition dfac_sol_pool.F:27
dmumps_compute_maxpercol
subroutine dmumps_compute_maxpercol(a, asize, ncol, nrow, m_array, nmax, packed_cb, lrow1)
Definition dtools.F:1643
dmumps_setmaxtozero
subroutine dmumps_setmaxtozero(m_array, m_size)
Definition dtools.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
dmumps_buf
Definition dmumps_comm_buffer.F:14
dmumps_buf::dmumps_buf_max_array_minsize
subroutine, public dmumps_buf_max_array_minsize(nfs4father, ierr)
Definition dmumps_comm_buffer.F:144
dmumps_buf::buf_max_array
double precision, dimension(:), allocatable, target, save, public buf_max_array
Definition dmumps_comm_buffer.F:51
dmumps_dynamic_memory_m
Definition dfac_mem_dynamic.F:14
dmumps_dynamic_memory_m::dmumps_dm_free_block
subroutine dmumps_dm_free_block(xxg_status, dynptr, sizfr8, atomic_updates, keep8)
Definition dfac_mem_dynamic.F:433
dmumps_dynamic_memory_m::dmumps_dm_set_dynptr
subroutine dmumps_dm_set_dynptr(cb_state, a, la, pamaster_or_ptrast, ixxd, ixxr, son_a, iachk, recsize)
Definition dfac_mem_dynamic.F:19
dmumps_dynamic_memory_m::dmumps_dm_set_ptr
subroutine dmumps_dm_set_ptr(address, sizfr8, cbptr)
Definition dfac_mem_dynamic.F:417
dmumps_fac_lr
Definition dfac_lr.F:14
dmumps_fac_lr::dmumps_decompress_panel
subroutine dmumps_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 dfac_lr.F:1754
dmumps_load
Definition dmumps_load.F:14
dmumps_load::dmumps_load_pool_upd_new_pool
subroutine, public dmumps_load_pool_upd_new_pool(pool, lpool, procnode, keep, keep8, slavef, comm, myid, step, n, nd, fils)
Definition dmumps_load.F:1820
dmumps_load::myid
integer, save, private myid
Definition dmumps_load.F:57
dmumps_lr_data_m
Definition dmumps_lr_data_m.F:14
dmumps_lr_data_m::dmumps_blr_free_m_array
subroutine, public dmumps_blr_free_m_array(iwhandler)
Definition dmumps_lr_data_m.F:917
dmumps_lr_data_m::dmumps_blr_retrieve_begs_blr_c
subroutine, public dmumps_blr_retrieve_begs_blr_c(iwhandler, begs_blr_col, nb_panels)
Definition dmumps_lr_data_m.F:654
dmumps_lr_data_m::dmumps_blr_retrieve_nb_panels
subroutine, public dmumps_blr_retrieve_nb_panels(iwhandler, nb_panels)
Definition dmumps_lr_data_m.F:672
dmumps_lr_data_m::dmumps_blr_retrieve_begsblr_dyn
subroutine, public dmumps_blr_retrieve_begsblr_dyn(iwhandler, begs_blr_dynamic)
Definition dmumps_lr_data_m.F:638
dmumps_lr_data_m::dmumps_blr_retrieve_begsblr_sta
subroutine, public dmumps_blr_retrieve_begsblr_sta(iwhandler, begs_blr_static)
Definition dmumps_lr_data_m.F:622
dmumps_lr_data_m::dmumps_blr_retrieve_cb_lrb
subroutine, public dmumps_blr_retrieve_cb_lrb(iwhandler, thecb)
Definition dmumps_lr_data_m.F:837
dmumps_lr_data_m::dmumps_blr_retrieve_m_array
subroutine, public dmumps_blr_retrieve_m_array(iwhandler, m_array)
Definition dmumps_lr_data_m.F:902
dmumps_lr_stats
Definition dlr_stats.F:14
dmumps_lr_type
Definition dlr_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

◆ dmumps_maplig()

recursive subroutine dmumps_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,
double precision, 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 (dmumps_root_struc ) root,
double precision opassw,
double precision opeliw,
integer, dimension( n+keep(253) ) itloc,
double precision, 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,
double precision, 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 dfac_process_maprow.F.

34 USE dmumps_buf
35 USE dmumps_load
36 USE dmumps_lr_data_m
37 USE dmumps_dynamic_memory_m, ONLY : dmumps_dm_set_dynptr
38 USE dmumps_fac_front_aux_m, ONLY : dmumps_get_size_schur_in_front
39#if ! defined(NO_FDM_MAPROW)
40 USE mumps_fac_maprow_data_m
41#endif
42 USE dmumps_struc_def, ONLY : dmumps_root_struc
43 IMPLICIT NONE
44#if ! defined(NO_FDM_MAPROW)
45#endif
46 TYPE (DMUMPS_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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION :: 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 DOUBLE PRECISION :: ADummy(1)
113 DOUBLE PRECISION, 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 DMUMPS_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 DMUMPS_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 DMUMPS_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 dmumps_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 dmumps_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 DMUMPS_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_blr_end_front(iwxxf_handler, iflag, keep8,
593 & keep(34))
594 ENDIF
595 ENDIF
596 IF (keep(214) .EQ. 2) THEN
597 CALL dmumps_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 dmumps_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 dmumps_bdc_error( myid, slavef, comm, keep )
622 ENDIF
623 RETURN
dmumps_bdc_error
subroutine dmumps_bdc_error(myid, slavef, comm, keep)
Definition dbcast_int.F:38
dmumps_treat_descband
recursive subroutine dmumps_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 dfac_process_band.F:254
dmumps_local_assembly_type2
subroutine dmumps_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 dfac_process_maprow.F:1227
dmumps_try_recvtreat
recursive subroutine dmumps_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 dfac_process_message.F:560
dmumps_stack_band
subroutine dmumps_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 dtools.F:219
dmumps_free_band
subroutine dmumps_free_band(n, ison, ptrist, ptrast, iw, liw, a, la, lrlu, lrlus, iwposcb, iptrlu, step, myid, keep, keep8, type_son)
Definition dtools.F:461
dmumps_buf::dmumps_buf_send_contrib_type2
subroutine, public dmumps_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 dmumps_comm_buffer.F:1050
dmumps_fac_front_aux_m
Definition dfac_front_aux.F:14
dmumps_fac_front_aux_m::dmumps_get_size_schur_in_front
subroutine dmumps_get_size_schur_in_front(n, ncb, size_schur, row_indices, perm, nvschur)
Definition dfac_front_aux.F:2505
dmumps_lr_data_m::dmumps_blr_end_front
subroutine, public dmumps_blr_end_front(iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
Definition dmumps_lr_data_m.F:342
dmumps_lr_data_m::dmumps_blr_free_cb_lrb
subroutine, public dmumps_blr_free_cb_lrb(iwhandler, free_only_struct, keep8, k34)
Definition dmumps_lr_data_m.F:970
dmumps_struc_def
Definition dmumps_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_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

◆ dmumps_maplig_fils_niv1()

subroutine dmumps_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,
double precision, 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 (dmumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension( n+keep(253) ) itloc,
double precision, 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,
double precision, 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 dfac_process_maprow.F.

644 USE dmumps_buf
645 USE dmumps_load
646 USE dmumps_lr_type
647 USE dmumps_lr_stats
648 USE dmumps_fac_lr, ONLY: dmumps_decompress_panel
649 USE dmumps_fac_front_aux_m, ONLY : dmumps_get_size_schur_in_front
650 USE dmumps_lr_data_m
651 USE dmumps_struc_def, ONLY : dmumps_root_struc
652 USE dmumps_dynamic_memory_m, ONLY : dmumps_dm_set_dynptr
653 & , dmumps_dm_free_block
654 IMPLICIT NONE
655 TYPE (DMUMPS_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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION :: 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 DOUBLE PRECISION, 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 DOUBLE PRECISION :: ADummy(1)
727 DOUBLE PRECISION, 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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 dmumps_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 dmumps_blr_retrieve_cb_lrb(
879 & iw(istchk+xxf), cb_lrb)
880 CALL dmumps_blr_retrieve_begsblr_sta(
881 & iw(istchk+xxf), begs_blr)
882 nb_blr_rows = size(begs_blr) - 1
883 CALL dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 DMUMPS_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 dmumps_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 dmumps_setmaxtozero(buf_max_array,
1033 & nfs4father)
1034 ENDIF
1035 m_array => buf_max_array
1036 m_array_retrieved = .false.
1037 ENDIF
1038 CALL dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 dmumps_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 DMUMPS_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 DMUMPS_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 DMUMPS_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 dmumps_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 DMUMPS_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 dmumps_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 dmumps_dm_free_block( xxg_status, son_a, dynsize,
1191 & keep(405).EQ.1, keep8 )
1192 ENDIF
1193 GOTO 600
1194 700 CONTINUE
1195 CALL dmumps_bdc_error(myid, slavef, comm, keep )
1196 600 CONTINUE
1197 IF (cb_is_lr) THEN
1198 CALL dmumps_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 dmumps_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
dmumps_buf::buf_lmax_array
integer, save, public buf_lmax_array
Definition dmumps_comm_buffer.F:50