OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dfac_b.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, University of Bordeaux.
8C
9C This version of MUMPS is provided to you free of charge. It is
10C released under the CeCILL-C license
11C (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14 SUBROUTINE dmumps_fac_b( N, S_IS_POINTERS, LA, LIW, SYM_PERM,
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
29 & )
30 USE dmumps_load
31 USE dmumps_buf, ONLY : dmumps_buf_alloc_cb, dmumps_buf_deall_cb
32 USE dmumps_fac_s_is_pointers_m, ONLY : s_is_pointers_t
33 USE omp_lib
34 USE mumps_tps_m
35 USE dmumps_tps_m
36 USE dmumps_fac_omp_m
37 USE dmumps_struc_def, ONLY : dmumps_root_struc
38 & , dmumps_l0ompfac_t
39 IMPLICIT NONE
40 include 'mpif.h'
41 TYPE (DMUMPS_ROOT_STRUC) :: root
42 INTEGER(8) :: LA
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
51 INTEGER NELT, LDPTRAR
52 INTEGER FRTPTR(*), FRTELT(*)
53 INTEGER LRGROUPS(N)
54 DOUBLE PRECISION CNTL1
55 INTEGER ICNTL(60)
56 INTEGER INFO(80), KEEP(500)
57 INTEGER(8) KEEP8(150)
58 INTEGER SYM_PERM(N), NA(LNA),
59 & NE_STEPS(KEEP(28)), FILS(N),
60 & FRERE(KEEP(28)), NFSIZ(KEEP(28)),
61 & DAD(KEEP(28))
62 INTEGER CAND(SLAVEF+1, max(1,KEEP(56)))
63 INTEGER STEP(N)
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
77 INTEGER LPN_LIST
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(DMUMPS_L0OMPFAC_T), INTENT (OUT) :: L0_OMP_FACTORS(
95 & LL0_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
102 INTEGER allocok
103 DOUBLE PRECISION UULOC
104 INTEGER IERR
105 INTEGER LP, MPRINT
106 LOGICAL LPOK
107 INTEGER NSTK,PTRAST
108 INTEGER PIMASTER, PAMASTER
109 LOGICAL PROK
110 DOUBLE PRECISION,PARAMETER :: ZERO = 0.0D0
111 INTEGER I
112 INTEGER LTPS_ARR
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 :: OPASS, 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
122 INTEGER :: NTOTPVTOT
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
130 KEEP(41)=0
131 KEEP(42)=0
132 LP = ICNTL(1)
133.GT..AND..GE. LPOK = (LP0) (ICNTL(4)1)
134 MPRINT = ICNTL(2)
135.GT..AND..GE. PROK = (MPRINT0) (ICNTL(4)2)
136 UULOC = CNTL1
137 PIMASTER = 1
138 NSTK = PIMASTER + KEEP(28)
139 PTRAST = 1
140 PAMASTER = 1 + KEEP(28)
141.LE. IF (KEEP(4)0) KEEP(4)=32
142.LE. IF (KEEP(5)0) KEEP(5)=16
143.GT. IF (KEEP(5)KEEP(4)) KEEP(5) = KEEP(4)
144.LE. IF (KEEP(6)0) KEEP(6)=24
145.LE. IF (KEEP(3)KEEP(4)) KEEP(3)=KEEP(4)*2
146.GT. IF (KEEP(6)KEEP(3)) KEEP(6) = KEEP(3)
147 POSFAC = 1_8
148 IWPOS = 1
149 LRLU = LA
150 LRLUS = LRLU
151 KEEP8(63) = 0_8
152 KEEP8(64) = 0_8
153 KEEP8(65) = 0_8
154 KEEP8(66) = 0_8
155 KEEP8(68) = 0_8
156 KEEP8(69) = 0_8
157 KEEP8(70) = 0_8
158 KEEP8(71) = 0_8
159 KEEP8(73) = 0_8
160 KEEP8(74) = 0_8
161 IPTRLU = LRLU
162 NSTEPSDONE = 0
163 OPASS = 0.0D0
164 OPELI = 0.0D0
165 NELVA = 0
166 COMP = 0
167 MAXFRT = 0
168 NMAXNPIV = 0
169 NTOTPV = 0
170 NOFFNEGPV = 0
171 NB22T1 = 0
172 NB22T2 = 0
173 NBTINY = 0
174 DET_EXP = 0
175 DET_SIGN = 1
176 DET_MANT = 1.0D0
177 IW1(NSTK:NSTK+KEEP(28)-1) = NE_STEPS(1:KEEP(28))
178 CALL MUMPS_INIT_NROOT_DIST(N, NBROOT, NROOT,
179 & MYID_NODES,
180 & SLAVEF, NA, LNA,
181 & KEEP, STEP,
182 & PROCNODE_STEPS)
183.GT. IF (KEEP(400) 0
184 & ) THEN
185.NE. IF (LPOOL LPOOL_A_L0_OMP) THEN
186 WRITE(*,*) "Check LPOOL vs. LPOOL_A_L0_OMP",
187 & LPOOL, LPOOL_A_L0_OMP, KEEP(28)
188 CALL MUMPS_ABORT()
189 ENDIF
190 DO I = 1, LPOOL
191 POOL(I) = IPOOL_A_L0_OMP(I)
192 ENDDO
193 ELSE
194 CALL MUMPS_INIT_POOL_DIST(N, LEAF,
195 & MYID_NODES,
196 & SLAVEF, NA, LNA,
197 & KEEP,KEEP8, STEP,
198 & PROCNODE_STEPS,
199 & POOL, LPOOL)
200 CALL DMUMPS_INIT_POOL_LAST3(POOL, LPOOL, LEAF)
201 ENDIF
202 CALL DMUMPS_LOAD_INIT_SBTR_STRUCT(POOL, LPOOL,KEEP,KEEP8)
203.NE. IF ( KEEP( 38 ) 0 ) THEN
204 NBROOT = NBROOT + root%NPROW * root%NPCOL - 1
205 END IF
206 IF ( root%yes ) THEN
207 IF ( MUMPS_PROCNODE( PROCNODE_STEPS(STEP(KEEP(38))),
208 & KEEP(199) )
209.NE. & MYID_NODES ) THEN
210 NROOT = NROOT + 1
211 END IF
212 END IF
213 PTRIST(1:KEEP(28))=0
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
218 KEEP(405) = 0
219 DKEEP(95)=0.0D0
220 DKEEP(96)=0.0D0
221 NBROOT_UNDER_L0 = 0
222.GT. IF (KEEP(400)0
223 & ) THEN
224 KEEP(405)=1
225 ALLOCATE( MUMPS_TPS_ARR( KEEP(400) ), stat=allocok )
226.GT. IF (allocok 0) THEN
227 IF (LPOK) THEN
228 WRITE(LP,*) "Problem allocating MUMPS_TPS_ARR",
229 & KEEP(400)
230 ENDIF
231 CALL MUMPS_ABORT()
232 ENDIF
233 ALLOCATE( DMUMPS_TPS_ARR( KEEP(400) ), stat=allocok )
234.GT. IF (allocok 0) THEN
235 WRITE(*,*) "Problem allocating DMUMPS_TPS_ARR", KEEP(400)
236 CALL MUMPS_ABORT()
237 ENDIF
238 CALL DMUMPS_FAC_L0_OMP(N,LIW, IW1(NSTK), NFSIZ,
239 & FILS,STEP, FRERE, DAD, ISTEP_TO_INIV2, TAB_POS_IN_PERE, PTRIST,
240 & IW2(PTRAST), IW1(PIMASTER), IW2(PAMASTER), PTRAR(1,2),
241 & PTRAR(1,1),
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 )
257 KEEP(405)=0
258 DKEEP(16) = OPELI
259 KEEP8(75)=KEEP8(76)
260 KEEP8(63)=KEEP8(74)
261 KEEP8(62) = KEEP8(74)-KEEP8(62)
262.LT. IF (INFO(1) 0) THEN
263 KEEP8(69) = KEEP8(73)
264 ENDIF
265 KEEP8(74) = KEEP8(73)
266.GE..AND..GT. IF ((INFO(1)0)(KEEP8(74)KEEP8(75))) THEN
267 INFO(1) = -19
268 CALL MUMPS_SET_IERROR (
269 & KEEP8(74)-KEEP8(75), INFO(2))
270 IF (LPOK) THEN
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 '
276 ENDIF
277 ENDIF
278 KEEP8(66) = KEEP8(68)
279 KEEP8(65) = KEEP8(64) + KEEP8(71)
280 ENDIF
281 KEEP8(67) = LRLUS
282 IF (associated(S_IS_POINTERS%IW)) THEN
283 WRITE(*,*) " Internal error DMUMPS_FAC_B IW"
284 CALL MUMPS_ABORT()
285 ENDIF
286.GE. IF (INFO(1) 0 ) THEN
287 ALLOCATE(S_IS_POINTERS%IW(LIW), stat=allocok)
288.GT. IF (allocok 0) THEN
289 INFO(1) = -13
290 INFO(2) = LIW
291 IF (LPOK) THEN
292 WRITE(LP,*)
293 & 'Allocation error for id%IS(',LIW,') on worker',
294 & MYID_NODES
295 ENDIF
296 ENDIF
297 ENDIF
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
302 INFO(1) = -13
303 CALL MUMPS_SETI8TOI4(LA, INFO(2))
304 DEALLOCATE(S_IS_POINTERS%IW); NULLIFY(S_IS_POINTERS%IW)
305 KEEP8(23)=0_8
306 ELSE
307 KEEP8(23)=LA
308 ENDIF
309 ENDIF
310 ENDIF
311.GE. IF (INFO(1) 0) THEN
312 CALL DMUMPS_BUF_ALLOC_CB( DMUMPS_LBUF, IERR )
313.NE. IF ( IERR 0 ) THEN
314 INFO(1)= -13
315 INFO(2)= (DMUMPS_LBUF+KEEP(34)-1)/KEEP(34)
316 IF (LPOK) THEN
317 WRITE(LP,*)
318 & 'Allocation error in DMUMPS_BUF_ALLOC_CB'
319 & ,INFO(2), ' on worker', MYID_NODES
320 ENDIF
321 DEALLOCATE(S_IS_POINTERS%IW); NULLIFY(S_IS_POINTERS%IW)
322 DEALLOCATE(S_IS_POINTERS%A); NULLIFY(S_IS_POINTERS%A)
323 END IF
324 ENDIF
325.EQ. IF ( KEEP(400) 0
326 & ) THEN
327 LTPS_ARR = 1
328 ALLOCATE( MUMPS_TPS_ARR(1))
329 ALLOCATE(DMUMPS_TPS_ARR(1))
330 ELSE
331 LTPS_ARR = KEEP(400)
332 ENDIF
333 IW_DUMMY = .FALSE.
334 A_DUMMY = .FALSE.
335.GE. IF (INFO(1) 0) THEN
336 LIW_ARG_FAC_PAR = LIW
337 LA_ARG_FAC_PAR = LA
338 ELSE
339 LIW_ARG_FAC_PAR = 1
340 LA_ARG_FAC_PAR = 1_8
341.NOT. IF ( associated(S_IS_POINTERS%IW)) THEN
342 S_IS_POINTERS%IW => IDUMMY
343 IW_DUMMY = .TRUE.
344 ENDIF
345.NOT. IF ( associated(S_IS_POINTERS%A)) THEN
346 S_IS_POINTERS%A => CDUMMY
347 A_DUMMY = .TRUE.
348 ENDIF
349 ENDIF
350.LT. IF ( INFO(1) 0 ) THEN
351 CALL DMUMPS_BDC_ERROR( MYID_NODES, SLAVEF, COMM_NODES, KEEP )
352 ENDIF
353 KEEP(398)=NSTEPSDONE
354 CALL DMUMPS_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, DMUMPS_TPS_ARR, LTPS_ARR,
364 & RINFO, POSFAC, IWPOS, LRLU, IPTRLU, LRLUS, LEAF, NROOT, NBROOT,
365 & NBROOT_UNDER_L0,
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,
371 & LRGROUPS(1) )
372 IF (IW_DUMMY) THEN
373 NULLIFY( S_IS_POINTERS%IW )
374 ENDIF
375 IF (A_DUMMY) THEN
376 NULLIFY( S_IS_POINTERS%A )
377 ENDIF
378 CALL DMUMPS_BUF_DEALL_CB( IERR )
379 RINFO(2) = dble(OPASS)
380 RINFO(3) = dble(OPELI)
381 INFO(13) = NELVA
382 INFO(14) = COMP
383 KEEP(33) = MAXFRT; INFO(11) = MAXFRT
384 KEEP(246) = NMAXNPIV
385 KEEP(89) = NTOTPV; INFO(23) = NTOTPV
386 INFO(12) = NOFFNEGPV
387 KEEP(103) = NB22T1
388 KEEP(105) = NB22T2
389 KEEP(98) = NBTINY
390.NE. IF (KEEP(258) 0) THEN
391 KEEP(260) = KEEP(260) * DET_SIGN
392 KEEP(259) = KEEP(259) + DET_EXP
393 CALL DMUMPS_UPDATEDETER( DET_MANT, DKEEP(6), KEEP(259) )
394 ENDIF
395.GT. IF (KEEP(400) 0
396 & ) THEN
397.NE. IF (LL0_OMP_FACTORSKEEP(400)) THEN
398 WRITE(*,*) "Internal error in DMUMPS_FAC_B, KEEP(400), L..=",
399 & KEEP(400), LL0_OMP_FACTORS
400 CALL MUMPS_ABORT()
401 ENDIF
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,
405 & ICNTL, INFO)
406 ENDIF
407!$OMP PARALLEL DO
408 DO I=1, KEEP(400)
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. )
416 ENDIF
417 L0_OMP_FACTORS(I)%LA = -99999_8
418 ENDIF
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)),
425 & .TRUE.,
426 & KEEP8, INFO(1), INFO(2), .TRUE., .FALSE. )
427 ENDIF
428 ENDDO
429!$OMP END PARALLEL DO
430 ENDIF
431 IF (allocated(MUMPS_TPS_ARR)) THEN
432 DEALLOCATE(MUMPS_TPS_ARR)
433 ENDIF
434 IF (allocated(DMUMPS_TPS_ARR)) THEN
435 DEALLOCATE(DMUMPS_TPS_ARR)
436 ENDIF
437 POSFAC = POSFAC -1_8
438 IWPOS = IWPOS -1
439.LE. IF (KEEP(201)0) THEN
440.EQ..AND..LT. IF (KEEP(201) -1 INFO(1) 0) THEN
441 POSFAC = 0_8
442 ENDIF
443 KEEP8(31) = POSFAC
444 RINFO(6) = ZERO
445 ELSE
446 RINFO(6) = dble(KEEP8(31)*int(KEEP(35),8))/1D6
447 ENDIF
448 KEEP8(48) = KEEP8(31)+KEEP8(71)+KEEP8(64)
449 KEEP(32) = IWPOS
450 CALL MUMPS_SETI8TOI4(KEEP8(48), INFO(9))
451 INFO(10) = KEEP(32)
452 KEEP8(67) = LA - KEEP8(67)
453 CALL MPI_ALLREDUCE(NTOTPV, NTOTPVTOT, 1, MPI_INTEGER, MPI_SUM,
454 & COMM_NODES, IERR)
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
459 CALL MUMPS_ABORT()
460 ENDIF
461.NE..AND..NE..AND. IF ( (KEEP(19)0 ) (NTOTPVTOTN)
462.GE. & (INFO(1)0) ) THEN
463 write(*,*) ' Error 2 NTOTPVTOT=', NTOTPVTOT
464 CALL MUMPS_ABORT()
465 ENDIF
466.GE. IF ( (INFO(1) 0 )
467.AND..NE. & (NTOTPVTOTN) ) THEN
468 INFO(1) = -10
469 ENDIF
470.EQ. IF (INFO(1)-10) THEN
471 INFO(2) = NTOTPVTOT
472 ENDIF
473 IF (PROK) 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)
478 ENDIF
479.NE. IF (KEEP(50) 0) THEN
480 WRITE(MPRINT,99984) INFO(12)
481 ENDIF
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)
486 ENDIF
487 ENDIF
488 RETURN
48999980 FORMAT (/' LEAVING FACTORIZATION PHASE WITH ...'/
490 & ' INFO (1) =',I15/
491 & ' --- (2) =',I15/
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)
503 END SUBROUTINE DMUMPS_FAC_B
504 SUBROUTINE DMUMPS_FAC_PAR_I(N, IW, LIW, A, LA, NSTK_STEPS,
505 & ND,FILS,STEP, FRERE, DAD, CAND, ISTEP_TO_INIV2,
506 & TAB_POS_IN_PERE, NSTEPSDONE, OPASS, OPELI, NELVA, COMP,
507 & MAXFRT, NMAXNPIV, NTOTPV, NOFFNEGPV, NB22T1, NB22T2, NBTINY,
508 & DET_EXP, DET_MANT, DET_SIGN, PTRIST, PTRAST, PIMASTER, PAMASTER,
509 & PTRARW, PTRAIW, ITLOC, RHS_MUMPS, IPOOL, LPOOL,
510 & L0_OMP_MAPPING, LL0_OMP_MAPPING,
511 & MUMPS_TPS_ARR, DMUMPS_TPS_ARR, LTPS_ARR,
512 & RINFO, POSFAC ,IWPOS, LRLU, IPTRLU, LRLUS, LEAF, NBROOT, NBRTOT,
513 & NBROOT_UNDER_L0,
514 & UU, ICNTL, PTLUST, PTRFAC, INFO, KEEP, KEEP8,
515 & PROCNODE_STEPS, SLAVEF, MYID, COMM_NODES, MYID_NODES,
516 & BUFR, LBUFR, LBUFR_BYTES, INTARR, DBLARR, root,
517 & PERM, NELT, FRTPTR, FRTELT, LPTRAR, COMM_LOAD, ASS_IRECV,
518 & SEUIL, SEUIL_LDLT_NIV2, MEM_DISTRIB, NE, DKEEP,
519 & PIVNUL_LIST,LPN_LIST, LRGROUPS )
520 USE DMUMPS_LOAD
521 USE DMUMPS_OOC
522 USE DMUMPS_FAC_ASM_MASTER_M
523 USE DMUMPS_FAC_ASM_MASTER_ELT_M
524 USE DMUMPS_FAC1_LDLT_M
525 USE DMUMPS_FAC2_LDLT_M
526 USE DMUMPS_FAC1_LU_M
527 USE DMUMPS_FAC2_LU_M
528 USE OMP_LIB
529 USE MUMPS_TPS_M
530 USE DMUMPS_TPS_M
531 USE DMUMPS_STRUC_DEF, ONLY : DMUMPS_ROOT_STRUC
532 USE DMUMPS_FAC_PAR_M, ONLY : DMUMPS_FAC_PAR
533 IMPLICIT NONE
534 TYPE (DMUMPS_ROOT_STRUC) :: root
535 INTEGER N, LIW, LPTRAR, NSTEPSDONE, INFO(80)
536 DOUBLE PRECISION, INTENT(INOUT) :: OPASS, OPELI
537 INTEGER, INTENT(INOUT) :: NELVA, COMP
538 INTEGER, INTENT(INOUT) :: MAXFRT, NTOTPV, NMAXNPIV, NOFFNEGPV
539 INTEGER, INTENT(INOUT) :: NB22T1, NB22T2, NBTINY
540 INTEGER, INTENT(INOUT) :: DET_SIGN, DET_EXP
541 DOUBLE PRECISION, INTENT(INOUT) :: DET_MANT
542 INTEGER(8) :: LA
543 DOUBLE PRECISION :: A(LA)
544 INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES
545 INTEGER, DIMENSION(0: SLAVEF - 1) :: MEM_DISTRIB
546 INTEGER KEEP(500), ICNTL(60)
547 INTEGER(8) KEEP8(150)
548 INTEGER LPOOL
549 INTEGER PROCNODE_STEPS(KEEP(28))
550 INTEGER ITLOC(N+KEEP(253))
551 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
552 INTEGER IW(LIW), NSTK_STEPS(KEEP(28))
553 INTEGER(8), INTENT(IN) :: PTRARW(LPTRAR), PTRAIW(LPTRAR)
554 INTEGER ND(KEEP(28))
555 INTEGER FILS(N),PTRIST(KEEP(28))
556 INTEGER STEP(N), FRERE(KEEP(28)), DAD(KEEP(28))
557 INTEGER PIMASTER(KEEP(28))
558 INTEGER PTLUST(KEEP(28)), PERM(N)
559 INTEGER CAND(SLAVEF+1,max(1,KEEP(56)))
560 INTEGER ISTEP_TO_INIV2(KEEP(71)),
561 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
562 INTEGER IPOOL(LPOOL)
563 INTEGER NE(KEEP(28))
564 DOUBLE PRECISION RINFO(40)
565 INTEGER(8) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28))
566 INTEGER(8) :: PTRFAC(KEEP(28))
567 INTEGER(8) :: POSFAC, LRLU, LRLUS, IPTRLU
568 INTEGER IWPOS, LEAF, NBROOT, NBRTOT
569 INTEGER, INTENT(in) :: NBROOT_UNDER_L0
570 INTEGER COMM_LOAD, ASS_IRECV
571 DOUBLE PRECISION UU, SEUIL, SEUIL_LDLT_NIV2
572 INTEGER NELT
573 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
574 INTEGER LBUFR, LBUFR_BYTES
575 INTEGER BUFR( LBUFR )
576 DOUBLE PRECISION DBLARR( KEEP8(26) )
577 INTEGER INTARR( KEEP8(27) )
578 INTEGER LPN_LIST
579 INTEGER PIVNUL_LIST(LPN_LIST)
580 DOUBLE PRECISION DKEEP(230)
581 INTEGER LRGROUPS(N)
582 INTEGER, INTENT( IN ) :: LTPS_ARR, LL0_OMP_MAPPING
583 TYPE (MUMPS_TPS_T) :: MUMPS_TPS_ARR(LTPS_ARR)
584 TYPE (DMUMPS_TPS_T) :: DMUMPS_TPS_ARR(LTPS_ARR)
585 INTEGER, INTENT( IN ) :: L0_OMP_MAPPING( LL0_OMP_MAPPING )
586 CALL DMUMPS_FAC_PAR( N, IW, LIW, A, LA, NSTK_STEPS,
587 & ND,FILS,STEP, FRERE, DAD, CAND, ISTEP_TO_INIV2, TAB_POS_IN_PERE,
588 & NSTEPSDONE, OPASS, OPELI, NELVA, COMP, MAXFRT, NMAXNPIV, NTOTPV,
589 & NOFFNEGPV, NB22T1, NB22T2, NBTINY, DET_EXP, DET_MANT, DET_SIGN,
590 & PTRIST, PTRAST, PIMASTER, PAMASTER, PTRARW, PTRAIW,
591 & ITLOC, RHS_MUMPS, IPOOL, LPOOL,
592 & L0_OMP_MAPPING, LL0_OMP_MAPPING,
593 & MUMPS_TPS_ARR, DMUMPS_TPS_ARR, LTPS_ARR,
594 & RINFO, POSFAC ,IWPOS, LRLU, IPTRLU, LRLUS, LEAF, NBROOT, NBRTOT,
595 & NBROOT_UNDER_L0,
596 & UU, ICNTL, PTLUST, PTRFAC, INFO, KEEP,KEEP8,
597 & PROCNODE_STEPS,SLAVEF,MYID, COMM_NODES, MYID_NODES,
598 & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR,root, PERM, NELT,
599 & FRTPTR, FRTELT, LPTRAR, COMM_LOAD, ASS_IRECV,
600 & SEUIL, SEUIL_LDLT_NIV2, MEM_DISTRIB, NE, DKEEP,
601 & PIVNUL_LIST,LPN_LIST, LRGROUPS )
602 RETURN
603 END SUBROUTINE DMUMPS_FAC_PAR_I
dmumps_fac_b
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)
Definition dfac_b.F:30
the
end diagonal values have been computed in the(sparse) matrix id.SOL
dmumps_buf
Definition dmumps_comm_buffer.F:14
dmumps_buf::dmumps_buf_alloc_cb
subroutine, public dmumps_buf_alloc_cb(size, ierr)
Definition dmumps_comm_buffer.F:115
dmumps_buf::dmumps_buf_deall_cb
subroutine, public dmumps_buf_deall_cb(ierr)
Definition dmumps_comm_buffer.F:160
dmumps_fac_omp_m
Definition dfac_omp_m.F:14
dmumps_fac_s_is_pointers_m
Definition dfac_sispointers_m.F:14
dmumps_load
Definition dmumps_load.F:14
dmumps_struc_def
Definition dmumps_struc_def.F:14
dmumps_tps_m
Definition domp_tps_m.F:14
mumps_tps_m
Definition omp_tps_common_m.F:14
dmumps_fac_s_is_pointers_m::s_is_pointers_t
Definition dfac_sispointers_m.F:19