15 & NA, LNA, NE_STEPS, NFSIZ, FILS, STEP, FRERE, DAD, CAND,
16 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PTRAR, LDPTRAR, PTRIST,
17 & PTLUST_S, PTRFAC, IW1, IW2, ITLOC, RHS_MUMPS, POOL, LPOOL,
18 & CNTL1, ICNTL, INFO, RINFO, KEEP, KEEP8, PROCNODE_STEPS, SLAVEF,
19 & COMM_NODES, MYID, MYID_NODES, BUFR, LBUFR, LBUFR_BYTES,
20 & DMUMPS_LBUF, INTARR, DBLARR, root, NELT, FRTPTR, FRTELT,
21 & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, MEM_DISTRIB,
22 & DKEEP, PIVNUL_LIST, LPN_LIST, LRGROUPS
23 & ,IPOOL_B_L0_OMP, LPOOL_B_L0_OMP, IPOOL_A_L0_OMP,
24 & LPOOL_A_L0_OMP, L_VIRT_L0_OMP, VIRT_L0_OMP,
25 & VIRT_L0_OMP_MAPPING, L_PHYS_L0_OMP, PHYS_L0_OMP, PERM_L0_OMP,
26 & PTR_LEAFS_L0_OMP, L0_OMP_MAPPING, LL0_OMP_MAPPING, THREAD_LA,
27 & L0_OMP_FACTORS, LL0_OMP_FACTORS, I4_L0_OMP, NBSTATS_I4,
28 & NBCOLS_I4, I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
41 TYPE (DMUMPS_ROOT_STRUC) :: root
43 INTEGER N,LIW,LPOOL,SLAVEF,COMM_NODES
44 INTEGER MYID, MYID_NODES,LNA
45 TYPE (S_IS_POINTERS_T) :: S_IS_POINTERS
46 DOUBLE PRECISION RINFO(40)
47 INTEGER,
INTENT( IN ) :: LBUFR, LBUFR_BYTES
48 INTEGER :: BUFR( LBUFR )
49 INTEGER,
INTENT( IN ) :: DMUMPS_LBUF
50 INTEGER,
DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB
52 INTEGER FRTPTR(*), FRTELT(*)
54 DOUBLE PRECISION CNTL1
56 INTEGER INFO(80), KEEP(500)
58 INTEGER SYM_PERM(N), NA(LNA),
59 & ne_steps(keep(28)), fils(n),
60 & frere(keep(28)), nfsiz(keep(28)),
62 INTEGER CAND(SLAVEF+1, max(1,KEEP(56)))
64 INTEGER(8),
INTENT(IN) :: PTRAR(LDPTRAR,2)
65 INTEGER(8) :: PTRFAC(KEEP(28))
66 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28))
67 INTEGER IW1(2*KEEP(28)), ITLOC(N+KEEP(253)), POOL(LPOOL)
68 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
69 INTEGER(8) :: IW2(2*KEEP(28))
70 INTEGER PROCNODE_STEPS(KEEP(28))
71 INTEGER COMM_LOAD, ASS_IRECV
72 INTEGER ISTEP_TO_INIV2(KEEP(71)),
73 & tab_pos_in_pere(slavef+2,max(1,keep(56)))
74 DOUBLE PRECISION DBLARR(KEEP8(26))
75 INTEGER INTARR(KEEP8(27))
76 DOUBLE PRECISION SEUIL, SEUIL_LDLT_NIV2
78 INTEGER PIVNUL_LIST(LPN_LIST)
79 DOUBLE PRECISION DKEEP(230)
80 INTEGER,
INTENT (IN) :: LPOOL_B_L0_OMP
81 INTEGER,
INTENT (IN) :: IPOOL_B_L0_OMP( LPOOL_B_L0_OMP )
82 INTEGER,
INTENT (IN) :: LPOOL_A_L0_OMP
83 INTEGER,
INTENT (IN) :: IPOOL_A_L0_OMP( LPOOL_A_L0_OMP )
84 INTEGER,
INTENT (IN) :: L_PHYS_L0_OMP
85 INTEGER,
INTENT (IN) :: PHYS_L0_OMP( L_PHYS_L0_OMP )
86 INTEGER,
INTENT (IN) :: L_VIRT_L0_OMP
87 INTEGER,
INTENT (IN) :: VIRT_L0_OMP( L_VIRT_L0_OMP )
88 INTEGER,
INTENT (IN) :: VIRT_L0_OMP_MAPPING( L_VIRT_L0_OMP )
89 INTEGER,
INTENT (IN) :: PERM_L0_OMP( L_PHYS_L0_OMP )
90 INTEGER,
INTENT (IN) :: PTR_LEAFS_L0_OMP( L_PHYS_L0_OMP + 1)
91 INTEGER,
INTENT (IN) :: LL0_OMP_MAPPING
92 INTEGER,
INTENT (OUT):: L0_OMP_MAPPING( LL0_OMP_MAPPING )
93 INTEGER,
INTENT (IN) :: LL0_OMP_FACTORS
94 TYPE(),
INTENT (OUT) :: L0_OMP_FACTORS(
96 INTEGER,
INTENT (IN) :: NBSTATS_I4, NBSTATS_I8
97 INTEGER,
INTENT (IN) :: NBCOLS_I4, NBCOLS_I8
98 INTEGER,
INTENT (IN) :: I4_L0_OMP(NBSTATS_I4, NBCOLS_I4)
99 INTEGER(8),
INTENT (IN) :: I8_L0_OMP(NBSTATS_I8, NBCOLS_I8)
100 INTEGER(8),
INTENT ( IN ) :: THREAD_LA
101 INTEGER,
EXTERNAL :: MUMPS_PROCNODE
103 DOUBLE PRECISION UULOC
108 INTEGER PIMASTER, PAMASTER
110 DOUBLE PRECISION,
PARAMETER :: ZERO = 0.0d0
113 TYPE (MUMPS_TPS_T),
DIMENSION(:),
ALLOCATABLE :: MUMPS_TPS_ARR
114 TYPE (DMUMPS_TPS_T),
DIMENSION(:),
ALLOCATABLE :: DMUMPS_TPS_ARR
115 INTEGER NBROOT_UNDER_L0
116 INTEGER :: NSTEPSDONE
117 DOUBLE PRECISION :: , OPELI
118 INTEGER :: NELVA, COMP
119 INTEGER :: MAXFRT, NTOTPV, NMAXNPIV, NOFFNEGPV
120 INTEGER :: NB22T1, NB22T2, NBTINY, DET_EXP, DET_SIGN
121 DOUBLE PRECISION :: DET_MANT
123 INTEGER(8) :: POSFAC, LRLU, IPTRLU, LRLUS
124 INTEGER IWPOS, LEAF, NBROOT, NROOT
125 INTEGER :: LIW_ARG_FAC_PAR
126 INTEGER(8) :: LA_ARG_FAC_PAR
127 DOUBLE PRECISION,
TARGET:: CDUMMY(1)
128 INTEGER,
TARGET :: IDUMMY(1)
129 LOGICAL :: IW_DUMMY, A_DUMMY
133 lpok = (lp.GT.0) .AND. (icntl(4).GE.1)
135 prok = (mprint.GT.0) .AND. (icntl(4).GE.2)
138 nstk = pimaster + keep(28)
140 pamaster = 1 + keep(28)
141 IF (keep(4).LE.0) keep(4)=32
142 IF (keep(5).LE.0) keep(5)=16
143 IF (keep(5).GT.keep(4)) keep(5) = keep(4)
144 IF (keep(6).LE.0) keep(6)=24
145 IF (keep(3).LE.keep(4)) keep(3)=keep(4)*2
146 IF (keep(6).GT.keep(3)) keep(6) = keep(3)
177 iw1(nstk:nstk+keep(28)-1) = ne_steps(1:keep(28))
185 IF (lpool .NE. lpool_a_l0_omp)
THEN
186 WRITE(*,*)
"Check LPOOL vs. LPOOL_A_L0_OMP",
187 & lpool, lpool_a_l0_omp, keep(28)
191 pool(i) = ipool_a_l0_omp(i)
203 IF ( keep( 38 ) .NE. 0 )
THEN
204 nbroot = nbroot + root%NPROW * root%NPCOL - 1
207 IF ( mumps_procnode( procnode_steps(step(keep(38))),
209 & .NE. myid_nodes )
THEN
214 ptlust_s(1:keep(28))=0
215 ptrfac(1:keep(28))=-99999_8
216 iw2(ptrast:ptrast+keep(28)-1)=0_8
217 iw1(pimaster:pimaster+keep(28)-1)=-99999_8
225 ALLOCATE( mumps_tps_arr( keep(400) ), stat=allocok )
226 IF (allocok .GT. 0)
THEN
228 WRITE(lp,*)
"Problem allocating MUMPS_TPS_ARR",
233 ALLOCATE( dmumps_tps_arr( keep(400) ), stat=allocok )
234 IF (allocok .GT. 0)
THEN
235 WRITE(*,*)
"Problem allocating DMUMPS_TPS_ARR", keep(400)
239 & fils,step, frere, dad, istep_to_iniv2, tab_pos_in_pere, ptrist,
240 & iw2(ptrast), iw1(pimaster), iw2(pamaster), ptrar(1,2),
242 & itloc, rhs_mumps, rinfo, nroot, nbroot, nbroot_under_l0,
243 & uuloc, icntl, ptlust_s, ptrfac, info, keep, keep8,
244 & procnode_steps,slavef, comm_nodes, myid_nodes, bufr,
245 & lbufr,lbufr_bytes,intarr,dblarr,root, sym_perm, nelt, frtptr,
246 & frtelt, ldptrar, comm_load, ass_irecv, seuil, seuil_ldlt_niv2,
247 & mem_distrib, ne_steps, dkeep,pivnul_list,lpn_list,
248 & lpool_b_l0_omp, ipool_b_l0_omp, l_virt_l0_omp,
249 & virt_l0_omp, virt_l0_omp_mapping, l_phys_l0_omp, phys_l0_omp,
250 & perm_l0_omp, ptr_leafs_l0_omp, l0_omp_mapping, ll0_omp_mapping,
251 & thread_la, mumps_tps_arr, dmumps_tps_arr, nstepsdone,
252 & opass, opeli, nelva, comp, maxfrt, nmaxnpiv, ntotpv, noffnegpv,
253 & nb22t1, nbtiny, det_exp, det_mant, det_sign,
254 & lrgroups(1), l0_omp_factors, ll0_omp_factors,
255 & i4_l0_omp, nbstats_i4, nbcols_i4,
256 & i8_l0_omp, nbstats_i8, nbcols_i8 )
261 keep8(62) = keep8(74)-keep8(62)
262 IF (info(1) .LT. 0)
THEN
263 keep8(69) = keep8(73)
265 keep8(74) = keep8(73)
266 IF ((info(1).GE.0).AND.(keep8(74).GT.keep8(75)))
THEN
269 & keep8(74)-keep8(75), info(2))
271 WRITE(lp,
'(/A/,A,I8,A,I10/,A/,A/)')
272 &
'** ERROR: memory allowed (ICNTL(23)) is not large enough:',
273 &
' INFO(1)=', info(1),
' INFO(2)=', info(2),
274 &
' memory used at the end of the treatment of L0 thread ',
275 &
' does not enable processing nodes above L0 thread '
278 keep8(66) = keep8(68)
279 keep8(65) = keep8(64) + keep8(71)
282 IF (
associated(s_is_pointers%IW))
THEN
283 WRITE(*,*)
" Internal error DMUMPS_FAC_B IW"
286 IF (info(1) .GE. 0 )
THEN
287 ALLOCATE(s_is_pointers%IW(liw), stat=allocok)
288 IF (allocok .GT.0)
THEN
293 &
'Allocation error for id%IS(',liw,
') on worker',
298 IF (info(1) .GE. 0)
THEN
299 IF (.NOT.
associated(s_is_pointers%A))
THEN
300 ALLOCATE(s_is_pointers%A(la), stat=allocok)
301 IF (allocok .GT. 0)
THEN
304 DEALLOCATE(s_is_pointers%IW);
NULLIFY(s_is_pointers%IW)
311 IF (info(1) .GE. 0)
THEN
313 IF ( ierr .NE. 0 )
THEN
315 info(2)= (dmumps_lbuf+keep(34)-1)/keep(34)
318 &
'Allocation error in DMUMPS_BUF_ALLOC_CB'
319 & ,info(2),
' on worker', myid_nodes
321 DEALLOCATE(s_is_pointers%IW);
NULLIFY(s_is_pointers%IW)
322 DEALLOCATE(s_is_pointers%A);
NULLIFY(s_is_pointers%A)
325 IF ( keep(400) .EQ. 0
328 ALLOCATE( mumps_tps_arr(1))
329 ALLOCATE(dmumps_tps_arr(1))
335 IF (info(1) .GE. 0)
THEN
336 liw_arg_fac_par = liw
341 IF (.NOT.
associated(s_is_pointers%IW))
THEN
342 s_is_pointers%IW => idummy
345 IF (.NOT.
associated(s_is_pointers%A))
THEN
346 s_is_pointers%A => cdummy
350 IF ( info(1) .LT. 0 )
THEN
355 & s_is_pointers%A(1),la_arg_fac_par,iw1(nstk),
356 & nfsiz,fils,step,frere,dad,cand,istep_to_iniv2, tab_pos_in_pere,
357 & nstepsdone, opass, opeli, nelva, comp, maxfrt, nmaxnpiv, ntotpv,
358 & noffnegpv, nb22t1, nb22t2, nbtiny, det_exp, det_mant, det_sign,
359 & ptrist, iw2(ptrast), iw1(pimaster), iw2(pamaster),
360 & ptrar(1,2), ptrar(1,1),
361 & itloc, rhs_mumps, pool, lpool,
362 & l0_omp_mapping, ll0_omp_mapping,
363 & mumps_tps_arr, dmumps_tps_arr, ltps_arr,
364 & rinfo, posfac, iwpos, lrlu, iptrlu, lrlus, leaf, nroot, nbroot,
366 & uuloc, icntl, ptlust_s, ptrfac, info, keep, keep8,
367 & procnode_steps,slavef,myid,comm_nodes, myid_nodes, bufr, lbufr,
368 & lbufr_bytes, intarr, dblarr, root, sym_perm, nelt, frtptr,
369 & frtelt, ldptrar, comm_load, ass_irecv, seuil, seuil_ldlt_niv2,
370 & mem_distrib,ne_steps, dkeep(1),pivnul_list(1),lpn_list,
373 NULLIFY( s_is_pointers%IW )
376 NULLIFY( s_is_pointers%A )
379 rinfo(2) = dble(opass)
380 rinfo(3) = dble(opeli)
383 keep(33) = maxfrt; info(11) = maxfrt
385 keep(89) = ntotpv; info(23) = ntotpv
390 IF (keep(258) .NE. 0)
THEN
391 keep(260) = keep(260) * det_sign
392 keep(259) = keep(259) + det_exp
397 IF (ll0_omp_factors.NE.keep(400))
THEN
398 WRITE(*,*) "internal error in
dmumps_fac_b, keep(400), l..=
",
399 & KEEP(400), LL0_OMP_FACTORS
402.GE.
IF ( INFO(1) 0 ) THEN
403 CALL DMUMPS_L0OMP_COPY_IW(S_IS_POINTERS%IW,
404 & LIW, IWPOS, MUMPS_TPS_ARR, KEEP, PTLUST_S,
409.LT.
IF (INFO(1) 0) THEN
410 IF ( associated( L0_OMP_FACTORS(I)%A ) ) THEN
411 DEALLOCATE( L0_OMP_FACTORS(I)%A )
412 NULLIFY ( L0_OMP_FACTORS(I)%A )
413 CALL MUMPS_DM_FAC_UPD_DYN_MEMCNTS(
414 & -L0_OMP_FACTORS(I)%LA, .TRUE.,
415 & KEEP8, INFO(1), INFO(2), .TRUE., .FALSE. )
417 L0_OMP_FACTORS(I)%LA = -99999_8
419 IF (associated(MUMPS_TPS_ARR(I)%IW)) THEN
420 DEALLOCATE(MUMPS_TPS_ARR(I)%IW)
421 NULLIFY(MUMPS_TPS_ARR(I)%IW)
422 CALL MUMPS_DM_FAC_UPD_DYN_MEMCNTS(
423 & -((int(MUMPS_TPS_ARR(I)%LIW,8) * int(KEEP(34),8))
424 & / int(KEEP(35),8)),
426 & KEEP8, INFO(1), INFO(2), .TRUE., .FALSE. )
431 IF (allocated(MUMPS_TPS_ARR)) THEN
432 DEALLOCATE(MUMPS_TPS_ARR)
434 IF (allocated(DMUMPS_TPS_ARR)) THEN
435 DEALLOCATE(DMUMPS_TPS_ARR)
439.LE.
IF (KEEP(201)0) THEN
440.EQ..AND..LT.
IF (KEEP(201) -1 INFO(1) 0) THEN
446 RINFO(6) = dble(KEEP8(31)*int(KEEP(35),8))/1D6
448 KEEP8(48) = KEEP8(31)+KEEP8(71)+KEEP8(64)
450 CALL MUMPS_SETI8TOI4(KEEP8(48), INFO(9))
452 KEEP8(67) = LA - KEEP8(67)
453 CALL MPI_ALLREDUCE(NTOTPV, NTOTPVTOT, 1, MPI_INTEGER, MPI_SUM,
455.EQ..OR..EQ.
IF ( ( (INFO(1)-10 INFO(1)-40)
456.AND..EQ.
& (NTOTPVTOTN) )
457.OR..GT.
& ( NTOTPVTOTN ) ) THEN
458 write(*,*) ' Error 1 NTOTPVTOT=', NTOTPVTOT,N
461.NE..AND..NE..AND.
IF ( (KEEP(19)0 ) (NTOTPVTOTN)
462.GE.
& (INFO(1)0) ) THEN
463 write(*,*) ' Error 2 NTOTPVTOT=', NTOTPVTOT
466.GE.
IF ( (INFO(1) 0 )
467.AND..NE.
& (NTOTPVTOTN) ) THEN
470.EQ.
IF (INFO(1)-10) THEN
474 WRITE (MPRINT,99980) INFO(1), INFO(2),
475 & KEEP(28), KEEP8(48), INFO(10), INFO(11)
476.EQ.
IF(KEEP(50) 0) THEN
477 WRITE(MPRINT,99982) INFO(12)
479.NE.
IF (KEEP(50) 0) THEN
480 WRITE(MPRINT,99984) INFO(12)
482 WRITE (MPRINT, 99986)
483 & INFO(13), INFO(14), RINFO(2), RINFO(3)
484.NE.
IF (KEEP(97) 0) THEN
485 WRITE (MPRINT, 99987) INFO(25)
48999980 FORMAT (/' LEAVING FACTORIZATION PHASE WITH ...'/
492 & ' Number of nodes in the tree =',I15/
493 & ' INFO (9) Real space for factors =',I15/
494 & ' --- (10) Integer space for factors =',I15/
495 & ' --- (11) Maximum size of frontal matrices =',I15)
49699982 FORMAT (' --- (12) Number of off diagonal pivots =',I15)
49799984 FORMAT (' --- (12) Number of negative pivots =',I15)
49899986 FORMAT (' --- (13) Number of delayed pivots =',I15/
499 & ' --- (14) Number of memory compresses =',I15/
500 & ' RINFO(2) Operations during node assembly =',1PD10.3/
501 & ' -----(3) Operations during node elimination =',1PD10.3)
50299987 FORMAT (' INFO (25) Number of tiny pivots(static) =',I15)
subroutine dmumps_fac_b(n, s_is_pointers, la, liw, sym_perm, na, lna, ne_steps, nfsiz, fils, step, frere, dad, cand, istep_to_iniv2, tab_pos_in_pere, ptrar, ldptrar, ptrist, ptlust_s, ptrfac, iw1, iw2, itloc, rhs_mumps, pool, lpool, cntl1, icntl, info, rinfo, keep, keep8, procnode_steps, slavef, comm_nodes, myid, myid_nodes, bufr, lbufr, lbufr_bytes, dmumps_lbuf, intarr, dblarr, root, nelt, frtptr, frtelt, comm_load, ass_irecv, seuil, seuil_ldlt_niv2, mem_distrib, dkeep, pivnul_list, lpn_list, lrgroups, ipool_b_l0_omp, lpool_b_l0_omp, ipool_a_l0_omp, lpool_a_l0_omp, l_virt_l0_omp, virt_l0_omp, virt_l0_omp_mapping, l_phys_l0_omp, phys_l0_omp, perm_l0_omp, ptr_leafs_l0_omp, l0_omp_mapping, ll0_omp_mapping, thread_la, l0_omp_factors, ll0_omp_factors, i4_l0_omp, nbstats_i4, nbcols_i4, i8_l0_omp, nbstats_i8, nbcols_i8)
subroutine dmumps_fac_par_i(n, iw, liw, a, la, nstk_steps, nd, fils, step, frere, dad, cand, istep_to_iniv2, tab_pos_in_pere, nstepsdone, opass, opeli, nelva, comp, maxfrt, nmaxnpiv, ntotpv, noffnegpv, nb22t1, nb22t2, nbtiny, det_exp, det_mant, det_sign, ptrist, ptrast, pimaster, pamaster, ptrarw, ptraiw, itloc, rhs_mumps, ipool, lpool, l0_omp_mapping, ll0_omp_mapping, mumps_tps_arr, dmumps_tps_arr, ltps_arr, rinfo, posfac, iwpos, lrlu, iptrlu, lrlus, leaf, nbroot, nbrtot, nbroot_under_l0, uu, icntl, ptlust, ptrfac, info, keep, keep8, procnode_steps, slavef, myid, comm_nodes, myid_nodes, bufr, lbufr, lbufr_bytes, intarr, dblarr, root, perm, nelt, frtptr, frtelt, lptrar, comm_load, ass_irecv, seuil, seuil_ldlt_niv2, mem_distrib, ne, dkeep, pivnul_list, lpn_list, lrgroups)
subroutine dmumps_fac_l0_omp(n, liw, nstk_steps, nd, fils, step, frere, dad, istep_to_iniv2, tab_pos_in_pere, ptrist, ptrast, pimaster, pamaster, ptrarw, ptraiw, itloc, rhs_mumps, rinfo, nbroot, nbrtot, nbroot_under_l0, uu, icntl, ptlust_s, ptrfac, info, keep, keep8, procnode_steps, slavef, comm_nodes, myid_nodes, bufr, lbufr, lbufr_bytes, intarr, dblarr, root, perm, nelt, frtptr, frtelt, lptrar, comm_load, ass_irecv, seuil, seuil_ldlt_niv2, mem_distrib, ne, dkeep, pivnul_list, lpn_list, lpool_b_l0_omp, ipool_b_l0_omp, l_virt_l0_omp, virt_l0_omp, virt_l0_omp_mapping, l_phys_l0_omp, phys_l0_omp, perm_l0_omp, ptr_leafs_l0_omp, l0_omp_mapping, ll0_omp_mapping, thread_la, mumps_tps_arr, dmumps_tps_arr, nstepsw, opassw, opeliw, nelvaw, comp, maxfrw, nmaxnpivw, npvw, noffnegw, nb22t1w, nbtinyw, det_expw, det_mantw, det_signw, lrgroups, l0_omp_factors, ll0_omp_factors, i4_l0_omp, nbstats_i4, nbcols_i4, i8_l0_omp, nbstats_i8, nbcols_i8)