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 & SMUMPS_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 (SMUMPS_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
47 INTEGER,
INTENT( IN ) :: LBUFR, LBUFR_BYTES
48 INTEGER :: BUFR( LBUFR )
49 INTEGER,
INTENT( IN ) :: SMUMPS_LBUF
50 INTEGER,
DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB
52 INTEGER FRTPTR(*), FRTELT(*)
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)), (N+KEEP(253)), POOL(LPOOL)
68 REAL :: RHS_MUMPS(KEEP(255))
69 INTEGER(8) :: (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 REAL DBLARR(KEEP8(26))
75 INTEGER INTARR(KEEP8(27))
76 REAL SEUIL, SEUIL_LDLT_NIV2
78 INTEGER PIVNUL_LIST(LPN_LIST)
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(smumps_l0ompfac_t),
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
108 INTEGER PIMASTER, PAMASTER
110 REAL,
PARAMETER :: ZERO = 0.0e0
113 TYPE (MUMPS_TPS_T),
DIMENSION(:),
ALLOCATABLE :: MUMPS_TPS_ARR
114 TYPE (SMUMPS_TPS_T),
DIMENSION(:),
ALLOCATABLE :: SMUMPS_TPS_ARR
115 INTEGER NBROOT_UNDER_L0
116 INTEGER :: NSTEPSDONE
117 DOUBLE PRECISION :: OPASS, OPELI
118 INTEGER :: NELVA, COMP
119 INTEGER :: MAXFRT, , NMAXNPIV, NOFFNEGPV
120 INTEGER :: NB22T1, NB22T2, NBTINY, DET_EXP, DET_SIGN
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 REAL,
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( smumps_tps_arr( keep(400) ), stat=allocok )
234 IF (allocok .GT. 0)
THEN
235 WRITE(*,*)
"Problem allocating SMUMPS_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, smumps_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 SMUMPS_FAC_B IW"
286.GE.
IF (INFO(1) 0 ) THEN
287 ALLOCATE(S_IS_POINTERS%IW(LIW), stat=allocok)
288.GT.
IF (allocok 0) THEN
293 & 'Allocation error for id%IS(
',LIW,') on worker
',
298.GE.
IF (INFO(1) 0) THEN
299.NOT.
IF ( associated(S_IS_POINTERS%A)) THEN
300 ALLOCATE(S_IS_POINTERS%A(LA), stat=allocok)
301.GT.
IF (allocok 0) THEN
303 CALL MUMPS_SETI8TOI4(LA, INFO(2))
304 DEALLOCATE(S_IS_POINTERS%IW); NULLIFY(S_IS_POINTERS%IW)
311.GE.
IF (INFO(1) 0) THEN
312 CALL SMUMPS_BUF_ALLOC_CB( SMUMPS_LBUF, IERR )
313.NE.
IF ( IERR 0 ) THEN
315 INFO(2)= (SMUMPS_LBUF+KEEP(34)-1)/KEEP(34)
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)
328 ALLOCATE( MUMPS_TPS_ARR(1))
329 ALLOCATE(SMUMPS_TPS_ARR(1))
335.GE.
IF (INFO(1) 0) THEN
336 LIW_ARG_FAC_PAR = LIW
341.NOT.
IF ( associated(S_IS_POINTERS%IW)) THEN
342 S_IS_POINTERS%IW => IDUMMY
345.NOT.
IF ( associated(S_IS_POINTERS%A)) THEN
346 S_IS_POINTERS%A => CDUMMY
350.LT.
IF ( INFO(1) 0 ) THEN
351 CALL SMUMPS_BDC_ERROR( MYID_NODES, SLAVEF, COMM_NODES, KEEP )
354 CALL SMUMPS_FAC_PAR_I(N,S_IS_POINTERS%IW(1),LIW_ARG_FAC_PAR,
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, SMUMPS_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 )
378 CALL SMUMPS_BUF_DEALL_CB( IERR )
379 RINFO(2) = real(OPASS)
380 RINFO(3) = real(OPELI)
383 KEEP(33) = MAXFRT; INFO(11) = MAXFRT
385 KEEP(89) = NTOTPV; INFO(23) = NTOTPV
390.NE.
IF (KEEP(258) 0) THEN
391 KEEP(260) = KEEP(260) * DET_SIGN
392 KEEP(259) = KEEP(259) + DET_EXP
393 CALL SMUMPS_UPDATEDETER( DET_MANT, DKEEP(6), KEEP(259) )
397.NE.
IF (LL0_OMP_FACTORSKEEP(400)) THEN
398 WRITE(*,*) "Internal error in SMUMPS_FAC_B, KEEP(400), L..=",
399 & KEEP(400), LL0_OMP_FACTORS
402.GE.
IF ( INFO(1) 0 ) THEN
403 CALL SMUMPS_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(SMUMPS_TPS_ARR)) THEN
435 DEALLOCATE(SMUMPS_TPS_ARR)
439.LE.
IF (KEEP(201)0) THEN
440.EQ..AND..LT.
IF (KEEP(201) -1 INFO(1) 0) THEN
446 RINFO(6) = real(KEEP8(31)*int(KEEP(35),8))/1E6
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 e
',1PD10.3)
50299987 FORMAT (' INFO (25) Number of tiny pivots(static) =
',I15)
subroutine smumps_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, smumps_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)
subroutine smumps_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, smumps_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)