OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zfac_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 zmumps_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 & ZMUMPS_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 zmumps_load
31 USE zmumps_buf, ONLY : zmumps_buf_alloc_cb, zmumps_buf_deall_cb
32 USE zmumps_fac_s_is_pointers_m, ONLY : s_is_pointers_t
33 USE omp_lib
34 USE mumps_tps_m
35 USE zmumps_tps_m
36 USE zmumps_fac_omp_m
37 USE zmumps_struc_def, ONLY : zmumps_root_struc
38 & , zmumps_l0ompfac_t
39 IMPLICIT NONE
40 include 'mpif.h'
41 TYPE (ZMUMPS_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 ) :: ZMUMPS_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 COMPLEX(kind=8) :: 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 COMPLEX(kind=8) 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(zmumps_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 (ZMUMPS_TPS_T), DIMENSION(:), ALLOCATABLE :: ZMUMPS_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 COMPLEX(kind=8) :: 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 COMPLEX(kind=8), 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 lpok = (lp.GT.0) .AND. (icntl(4).GE.1)
134 mprint = icntl(2)
135 prok = (mprint.GT.0) .AND. (icntl(4).GE.2)
136 uuloc = cntl1
137 pimaster = 1
138 nstk = pimaster + keep(28)
139 ptrast = 1
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)
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 = cmplx(1.0d0,0.0d0, kind=kind(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 IF (keep(400) .GT. 0
184 & ) THEN
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)
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 zmumps_init_pool_last3(pool, lpool, leaf)
201 ENDIF
202 CALL zmumps_load_init_sbtr_struct(pool, lpool,keep,keep8)
203 IF ( keep( 38 ) .NE. 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 IF (keep(400).GT.0
223 & ) THEN
224 keep(405)=1
225 ALLOCATE( mumps_tps_arr( keep(400) ), stat=allocok )
226 IF (allocok .GT. 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( ZMUMPS_TPS_ARR( KEEP(400) ), stat=allocok )
234.GT. IF (allocok 0) THEN
235 WRITE(*,*) "problem allocating zmumps_tps_arr", KEEP(400)
236 CALL MUMPS_ABORT()
237 ENDIF
238 CALL ZMUMPS_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, ZMUMPS_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 zmumps_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 ZMUMPS_BUF_ALLOC_CB( ZMUMPS_LBUF, IERR )
313.NE. IF ( IERR 0 ) THEN
314 INFO(1)= -13
315 INFO(2)= (ZMUMPS_LBUF+KEEP(34)-1)/KEEP(34)
316 IF (LPOK) THEN
317 WRITE(LP,*)
318 & 'Allocation error in ZMUMPS_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(ZMUMPS_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 ZMUMPS_BDC_ERROR( MYID_NODES, SLAVEF, COMM_NODES, KEEP )
352 ENDIF
353 KEEP(398)=NSTEPSDONE
354 CALL ZMUMPS_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, ZMUMPS_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 ZMUMPS_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 ZMUMPS_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 zmumps_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 ZMUMPS_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(ZMUMPS_TPS_ARR)) THEN
435 DEALLOCATE(ZMUMPS_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 WRITE (MPRINT, 99986)
480 & INFO(13), INFO(14), RINFO(2), RINFO(3)
481.NE. IF (KEEP(97) 0) THEN
482 WRITE (MPRINT, 99987) INFO(25)
483 ENDIF
484 ENDIF
485 RETURN
48699980 FORMAT (/' LEAVING FACTORIZATION PHASE WITH ...'/
487 & ' INFO (1) =',I15/
488 & ' --- (2) =',I15/
489 & ' Number of nodes in the tree =',I15/
490 & ' INFO (9) Real space for factors =',I15/
491 & ' --- (10) Integer space for factors =',I15/
492 & ' --- (11) Maximum size of frontal matrices =',I15)
49399982 FORMAT (' --- (12) Number of off diagonal pivots =',I15)
49499986 FORMAT (' --- (13) Number of delayed pivots =',I15/
495 & ' --- (14) Number of memory compresses =',I15/
496 & ' RINFO(2) Operations during node assembly =',1PD10.3/
497 & ' -----(3) Operations during node elimination =',1PD10.3)
49899987 FORMAT (' INFO (25) Number of tiny pivots(static) =',I15)
499 END SUBROUTINE ZMUMPS_FAC_B
500 SUBROUTINE ZMUMPS_FAC_PAR_I(N, IW, LIW, A, LA, NSTK_STEPS,
501 & ND,FILS,STEP, FRERE, DAD, CAND, ISTEP_TO_INIV2,
502 & TAB_POS_IN_PERE, NSTEPSDONE, OPASS, OPELI, NELVA, COMP,
503 & MAXFRT, NMAXNPIV, NTOTPV, NOFFNEGPV, NB22T1, NB22T2, NBTINY,
504 & DET_EXP, DET_MANT, DET_SIGN, PTRIST, PTRAST, PIMASTER, PAMASTER,
505 & PTRARW, PTRAIW, ITLOC, RHS_MUMPS, IPOOL, LPOOL,
506 & L0_OMP_MAPPING, LL0_OMP_MAPPING,
507 & MUMPS_TPS_ARR, ZMUMPS_TPS_ARR, LTPS_ARR,
508 & RINFO, POSFAC ,IWPOS, LRLU, IPTRLU, LRLUS, LEAF, NBROOT, NBRTOT,
509 & NBROOT_UNDER_L0,
510 & UU, ICNTL, PTLUST, PTRFAC, INFO, KEEP, KEEP8,
511 & PROCNODE_STEPS, SLAVEF, MYID, COMM_NODES, MYID_NODES,
512 & BUFR, LBUFR, LBUFR_BYTES, INTARR, DBLARR, root,
513 & PERM, NELT, FRTPTR, FRTELT, LPTRAR, COMM_LOAD, ASS_IRECV,
514 & SEUIL, SEUIL_LDLT_NIV2, MEM_DISTRIB, NE, DKEEP,
515 & PIVNUL_LIST,LPN_LIST, LRGROUPS )
516 USE ZMUMPS_LOAD
517 USE ZMUMPS_OOC
518 USE ZMUMPS_FAC_ASM_MASTER_M
519 USE ZMUMPS_FAC_ASM_MASTER_ELT_M
520 USE ZMUMPS_FAC1_LDLT_M
521 USE ZMUMPS_FAC2_LDLT_M
522 USE ZMUMPS_FAC1_LU_M
523 USE ZMUMPS_FAC2_LU_M
524 USE OMP_LIB
525 USE MUMPS_TPS_M
526 USE ZMUMPS_TPS_M
527 USE ZMUMPS_STRUC_DEF, ONLY : ZMUMPS_ROOT_STRUC
528 USE ZMUMPS_FAC_PAR_M, ONLY : ZMUMPS_FAC_PAR
529 IMPLICIT NONE
530 TYPE (ZMUMPS_ROOT_STRUC) :: root
531 INTEGER N, LIW, LPTRAR, NSTEPSDONE, INFO(80)
532 DOUBLE PRECISION, INTENT(INOUT) :: OPASS, OPELI
533 INTEGER, INTENT(INOUT) :: NELVA, COMP
534 INTEGER, INTENT(INOUT) :: MAXFRT, NTOTPV, NMAXNPIV, NOFFNEGPV
535 INTEGER, INTENT(INOUT) :: NB22T1, NB22T2, NBTINY
536 INTEGER, INTENT(INOUT) :: DET_SIGN, DET_EXP
537 COMPLEX(kind=8), INTENT(INOUT) :: DET_MANT
538 INTEGER(8) :: LA
539 COMPLEX(kind=8) :: A(LA)
540 INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES
541 INTEGER, DIMENSION(0: SLAVEF - 1) :: MEM_DISTRIB
542 INTEGER KEEP(500), ICNTL(60)
543 INTEGER(8) KEEP8(150)
544 INTEGER LPOOL
545 INTEGER PROCNODE_STEPS(KEEP(28))
546 INTEGER ITLOC(N+KEEP(253))
547 COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255))
548 INTEGER IW(LIW), NSTK_STEPS(KEEP(28))
549 INTEGER(8), INTENT(IN) :: PTRARW(LPTRAR), PTRAIW(LPTRAR)
550 INTEGER ND(KEEP(28))
551 INTEGER FILS(N),PTRIST(KEEP(28))
552 INTEGER STEP(N), FRERE(KEEP(28)), DAD(KEEP(28))
553 INTEGER PIMASTER(KEEP(28))
554 INTEGER PTLUST(KEEP(28)), PERM(N)
555 INTEGER CAND(SLAVEF+1,max(1,KEEP(56)))
556 INTEGER ISTEP_TO_INIV2(KEEP(71)),
557 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
558 INTEGER IPOOL(LPOOL)
559 INTEGER NE(KEEP(28))
560 DOUBLE PRECISION RINFO(40)
561 INTEGER(8) :: PAMASTER(KEEP(28)), PTRAST(KEEP(28))
562 INTEGER(8) :: PTRFAC(KEEP(28))
563 INTEGER(8) :: POSFAC, LRLU, LRLUS, IPTRLU
564 INTEGER IWPOS, LEAF, NBROOT, NBRTOT
565 INTEGER, INTENT(in) :: NBROOT_UNDER_L0
566 INTEGER COMM_LOAD, ASS_IRECV
567 DOUBLE PRECISION UU, SEUIL, SEUIL_LDLT_NIV2
568 INTEGER NELT
569 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
570 INTEGER LBUFR, LBUFR_BYTES
571 INTEGER BUFR( LBUFR )
572 COMPLEX(kind=8) DBLARR( KEEP8(26) )
573 INTEGER INTARR( KEEP8(27) )
574 INTEGER LPN_LIST
575 INTEGER PIVNUL_LIST(LPN_LIST)
576 DOUBLE PRECISION DKEEP(230)
577 INTEGER LRGROUPS(N)
578 INTEGER, INTENT( IN ) :: LTPS_ARR, LL0_OMP_MAPPING
579 TYPE (MUMPS_TPS_T) :: MUMPS_TPS_ARR(LTPS_ARR)
580 TYPE (ZMUMPS_TPS_T) :: ZMUMPS_TPS_ARR(LTPS_ARR)
581 INTEGER, INTENT( IN ) :: L0_OMP_MAPPING( LL0_OMP_MAPPING )
582 CALL ZMUMPS_FAC_PAR( N, IW, LIW, A, LA, NSTK_STEPS,
583 & ND,FILS,STEP, FRERE, DAD, CAND, ISTEP_TO_INIV2, TAB_POS_IN_PERE,
584 & NSTEPSDONE, OPASS, OPELI, NELVA, COMP, MAXFRT, NMAXNPIV, NTOTPV,
585 & NOFFNEGPV, NB22T1, NB22T2, NBTINY, DET_EXP, DET_MANT, DET_SIGN,
586 & PTRIST, PTRAST, PIMASTER, PAMASTER, PTRARW, PTRAIW,
587 & ITLOC, RHS_MUMPS, IPOOL, LPOOL,
588 & L0_OMP_MAPPING, LL0_OMP_MAPPING,
589 & MUMPS_TPS_ARR, ZMUMPS_TPS_ARR, LTPS_ARR,
590 & RINFO, POSFAC ,IWPOS, LRLU, IPTRLU, LRLUS, LEAF, NBROOT, NBRTOT,
591 & NBROOT_UNDER_L0,
592 & UU, ICNTL, PTLUST, PTRFAC, INFO, KEEP,KEEP8,
593 & PROCNODE_STEPS,SLAVEF,MYID, COMM_NODES, MYID_NODES,
594 & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR,root, PERM, NELT,
595 & FRTPTR, FRTELT, LPTRAR, COMM_LOAD, ASS_IRECV,
596 & SEUIL, SEUIL_LDLT_NIV2, MEM_DISTRIB, NE, DKEEP,
597 & PIVNUL_LIST,LPN_LIST, LRGROUPS )
598 RETURN
599 END SUBROUTINE ZMUMPS_FAC_PAR_I
cmplx
float cmplx[2]
Definition pblas.h:136
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
mumps_tps_m
Definition omp_tps_common_m.F:14
zmumps_buf
Definition zmumps_comm_buffer.F:14
zmumps_buf::zmumps_buf_alloc_cb
subroutine, public zmumps_buf_alloc_cb(size, ierr)
Definition zmumps_comm_buffer.F:115
zmumps_buf::zmumps_buf_deall_cb
subroutine, public zmumps_buf_deall_cb(ierr)
Definition zmumps_comm_buffer.F:160
zmumps_fac_omp_m
Definition zfac_omp_m.F:14
zmumps_fac_s_is_pointers_m
Definition zfac_sispointers_m.F:14
zmumps_load
Definition zmumps_load.F:14
zmumps_load::zmumps_load_init_sbtr_struct
subroutine, public zmumps_load_init_sbtr_struct(pool, lpool, keep, keep8)
Definition zmumps_load.F:5543
zmumps_struc_def
Definition zmumps_struc_def.F:14
zmumps_tps_m
Definition zomp_tps_m.F:14
zmumps_fac_s_is_pointers_m::s_is_pointers_t
Definition zfac_sispointers_m.F:19
mumps_init_pool_dist
subroutine mumps_init_pool_dist(n, leaf, myid_nodes, k199, na, lna, keep, keep8, step, procnode_steps, ipool, lpool)
Definition tools_common.F:587
mumps_init_nroot_dist
subroutine mumps_init_nroot_dist(n, nbroot, nroot_loc, myid_nodes, slavef, na, lna, keep, step, procnode_steps)
Definition tools_common.F:639
zmumps_fac_b
subroutine zmumps_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, zmumps_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 zfac_b.F:30
zmumps_init_pool_last3
subroutine zmumps_init_pool_last3(ipool, lpool, leaf)
Definition zfac_sol_pool.F:15