OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dtools.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_compress_lu(SIZE_INPLACE,
15 &MYID,N,IOLDPS,TYPE,IW, LIW, A, LA,
16 &POSFAC, LRLU, LRLUS, IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8,
17 &SSARBR,INODE,IERR
18 & , LRGROUPS, NASS
19 &)
20 USE dmumps_load
21 USE dmumps_ooc
22!$ USE OMP_LIB
23 USE dmumps_lr_core
24 IMPLICIT NONE
25 INTEGER MYID
26 INTEGER IOLDPS, TYPE, LIW, N, KEEP(500)
27 INTEGER(8) :: SIZE_INPLACE, LA, POSFAC, LRLU, LRLUS
28 INTEGER(8) :: PTRAST(KEEP(28))
29 INTEGER(8) KEEP8(150)
30 INTEGER IW( LIW )
31 DOUBLE PRECISION A( LA )
32 INTEGER IWPOS
33 INTEGER STEP( N )
34 INTEGER (8) :: PTRFAC(KEEP(28))
35 LOGICAL SSARBR
36 INTEGER IOLDSHIFT, IPSSHIFT
37 INTEGER LRGROUPS(N), NASS
38 include 'mumps_headers.h'
39 INTEGER LCONT, NELIM, NROW, NPIV, INTSIZ
40 INTEGER NFRONT, NSLAVES
41 INTEGER IPS, IPSIZE
42 INTEGER(8) :: SIZELU, SIZECB, IAPOS, I, SIZESHIFT, ITMP8
43 INTEGER(8) :: SIZEXXR
44 LOGICAL MOVEPTRAST
45 LOGICAL LRCOMPRESS_PANEL
46 INTEGER INODE
47 INTEGER IERR
48 ierr=0
49 ioldshift = ioldps + keep(ixsz)
50 IF ( iw( ioldshift ) < 0 ) THEN
51 write(*,*) ' ERROR 1 compressLU:Should not point to a band.'
52 CALL mumps_abort()
53 ELSE IF ( iw( ioldshift + 2 ) < 0 ) THEN
54 write(*,*) ' ERROR 2 compressLU:Stack not performed yet',
55 & iw(ioldshift + 2)
56 CALL mumps_abort()
57 ENDIF
58 lcont = iw( ioldshift )
59 nelim = iw( ioldshift + 1 )
60 nrow = iw( ioldshift + 2 )
61 npiv = iw( ioldshift + 3 )
62 iapos = ptrfac(iw( ioldshift + 4 ))
63 nslaves= iw( ioldshift + 5 )
64 nfront = lcont + npiv
65 intsiz = iw(ioldps+xxi)
66 lrcompress_panel = (iw(ioldps+xxlr).GE.2)
67 IF ( (nslaves > 0 .AND. TYPE .NE. 2) .OR.
68 & (nslaves .eq. 0 .AND. TYPE .EQ. 2 ) ) then
69 WRITE(*,*) ' ERROR 3 compressLU: problem with level of inode'
70 CALL mumps_abort()
71 END IF
72 IF ( keep(50) .EQ. 0 ) THEN
73 sizelu = int(lcont + nrow, 8) * int(npiv,8)
74 ELSE
75 IF ( keep(459) .GT. 1 ) THEN
76 CALL mumps_ldltpanel_storage( npiv, keep,
77 & iw(ioldshift+6+nslaves+nfront), sizelu)
78 sizelu = sizelu + int( nrow - npiv, 8 ) * int( npiv, 8 )
79 ELSE
80 sizelu = int(nrow,8) * int(npiv,8)
81 ENDIF
82 ENDIF
83 CALL mumps_geti8(sizexxr, iw(ioldps+xxr))
84 sizecb = sizexxr - sizelu
85 CALL mumps_subtri8toarray( iw(ioldps+xxr), sizecb )
86 IF ((keep(201).NE.0)
87 & .OR.(lrcompress_panel.AND.keep(486).EQ.2)
88 & ) THEN
89 sizeshift = sizelu
90 ELSE
91 sizeshift = 0_8
92 IF (sizecb.EQ.0_8) THEN
93 GOTO 500
94 ENDIF
95 ENDIF
96 IF (keep(201).EQ.2) THEN
97 IF (keep(405) .EQ. 0) THEN
98 keep8(31)=keep8(31)+sizelu
99 CALL dmumps_new_factor(inode,ptrfac,keep,keep8,
100 & a,la,sizelu, ierr)
101 ELSE
102!$OMP CRITICAL(critical_old_ooc)
103 keep8(31)=keep8(31)+sizelu
104 CALL dmumps_new_factor(inode,ptrfac,keep,keep8,
105 & a,la,sizelu, ierr)
106!$OMP END CRITICAL(critical_old_ooc)
107 ENDIF
108 IF(ierr.LT.0)THEN
109 WRITE(*,*)myid,': Internal error in DMUMPS_NEW_FACTOR'
110 CALL mumps_abort()
111 ENDIF
112 ENDIF
113 IF ( ioldps + intsiz .NE. iwpos ) THEN
114 ips = ioldps + intsiz
115 moveptrast = .false.
116 DO WHILE ( ips .NE. iwpos )
117 ipsize = iw(ips+xxi)
118 ipsshift = ips + keep(ixsz)
119 IF ( ipsize .LE. 0 .OR. ips .GT. iwpos ) THEN
120 WRITE(*,*) " Internal error 1 DMUMPS_COMPRESS_LU"
121 WRITE(*,*) " IOLDPS, INTSIZ, IWPOS, LIW=",
122 & ioldps, intsiz, iwpos, liw
123 WRITE(*,*) " IWPOS, IPS, IPSIZE =", iwpos, ips, ipsize
124 WRITE(*,*) " Header at IOLDPS =",
125 & iw(ioldps:ioldps+keep(ixsz)+5)
126 WRITE(*,*) " Header at IPS =",
127 & iw(ips:ips+keep(ixsz)+5)
128 CALL mumps_abort()
129 ENDIF
130 IF (ips+ipsize .GT. iwpos) THEN
131 WRITE(*,*) " Internal error 2 DMUMPS_COMPRESS_LU"
132 WRITE(*,*) " IOLDPS, INTSIZ, IWPOS, LIW=",
133 & ioldps, intsiz, iwpos, liw
134 WRITE(*,*) " IWPOS, IPS, IPSIZE =", iwpos, ips, ipsize
135 WRITE(*,*) " Header at IOLDPS =",
136 & iw(ioldps:ioldps+keep(ixsz)+5)
137 WRITE(*,*) " Header at IOLDPS+INTSIZ =",
138 & iw(ioldps+intsiz:ioldps+intsiz+keep(ixsz)+5)
139 WRITE(*,*) " Header at IPS =",
140 & iw(ips:ips+keep(ixsz)+5)
141 WRITE(*,*) " ========================== "
142 WRITE(*,*) " Headers starting at IOLDPS:"
143 ips = ioldps
144 DO WHILE (ips .LE. iwpos)
145 WRITE(*,*) " -> new IW header at position" , ips, ":",
146 & iw(ips:ips+keep(ixsz)+5)
147 ips = ips + iw(ips+xxi)
148 ENDDO
149 CALL mumps_abort()
150 ENDIF
151 IF ( iw( ipsshift + 2 ) < 0 ) THEN
152 nfront = iw( ipsshift )
153 IF (iw(ipsshift+4) .LT. 0) THEN
154 WRITE(*,*) " Internal error 3 DMUMPS_COMPRESS_LU"
155 WRITE(*,*) " IPS,IPSSHIFT,IWPOS=" ,ips,ipsshift,iwpos
156 WRITE(*,*) " Header at IPS =", iw(ips:ips+keep(ixsz)+5)
157 ENDIF
158 ptrfac(iw(ipsshift+4))=ptrfac(iw(ipsshift+4)) -
159 & sizecb - sizeshift
160 moveptrast = .true.
161 ptrast(iw(ipsshift+4))=ptrast(iw(ipsshift+4))-sizecb
162 & - sizeshift
163 ELSE IF ( iw( ipsshift ) < 0 ) THEN
164 IF (iw(ipsshift+3) .LT. 0) THEN
165 WRITE(*,*) " Internal error 4 DMUMPS_COMPRESS_LU"
166 WRITE(*,*) " IPS,IPSSHIFT,IWPOS=" ,ips,ipsshift,iwpos
167 WRITE(*,*) " Header at IPS =", iw(ips:ips+keep(ixsz)+5)
168 ENDIF
169 ptrfac(iw(ipsshift+3)) = ptrfac(iw(ipsshift+3))
170 & -sizecb-sizeshift
171 ELSE
172 nfront = iw( ipsshift ) + iw( ipsshift + 3 )
173 IF (iw(ipsshift+4) .LT. 0) THEN
174 WRITE(*,*) " Internal error 4 DMUMPS_COMPRESS_LU"
175 WRITE(*,*) " IPS,IPSSHIFT,IWPOS=" ,ips,ipsshift,iwpos
176 WRITE(*,*) " Header at IPS =", iw(ips:ips+keep(ixsz)+5)
177 ENDIF
178 ptrfac(iw( ipsshift + 4 )) =
179 & ptrfac(iw( ipsshift + 4 )) - sizecb - sizeshift
180 END IF
181 ips = ips + ipsize
182 END DO
183 IF (sizecb+sizeshift .NE. 0_8) THEN
184 DO i=iapos+sizelu-sizeshift, posfac-sizecb-sizeshift-1_8
185 a( i ) = a( i + sizecb + sizeshift)
186 END DO
187 END IF
188 ENDIF
189 posfac = posfac - (sizecb+sizeshift)
190 lrlu = lrlu + (sizecb+sizeshift)
191 itmp8 = (sizecb+sizeshift) - size_inplace
192 lrlus = lrlus + itmp8
193 IF (keep(405) .EQ. 0) THEN
194 keep8(69) = keep8(69) - itmp8
195 ELSE
196!$OMP ATOMIC UPDATE
197 keep8(69) = keep8(69) - itmp8
198!$OMP END ATOMIC
199 ENDIF
200 500 CONTINUE
201 IF (lrcompress_panel.AND.keep(486).EQ.2) THEN
202 CALL dmumps_load_mem_update(ssarbr,.false.,
203 & la-lrlus,sizelu-sizeshift,-(sizecb+sizeshift)+size_inplace,
204 & keep,keep8,lrlus)
205 ELSE
206 CALL dmumps_load_mem_update(ssarbr,.false.,
207 & la-lrlus,sizelu,-sizecb+size_inplace,
208 & keep,keep8,lrlus)
209 ENDIF
210 RETURN
211 END SUBROUTINE dmumps_compress_lu
212 SUBROUTINE dmumps_stack_band( N, ISON,
213 & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
214 & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,
215 & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER,
216 & IFLAG, IERROR, SLAVEF, PROCNODE_STEPS, DAD, MYID, COMM,
217 & KEEP, KEEP8, DKEEP, TYPE_SON
218 & )
219!$ USE OMP_LIB
220 USE dmumps_ooc
221 USE dmumps_load
222 USE dmumps_dynamic_memory_m, ONLY : dmumps_dm_set_dynptr
223 IMPLICIT NONE
224 INTEGER(8) :: LA, LRLU, LRLUS, POSFAC, IPTRLU
225 INTEGER N, ISON, LIW, IWPOS, IWPOSCB,
226 & COMP, IFLAG, IERROR, SLAVEF, MYID, COMM,
227 & TYPE_SON
228 INTEGER KEEP(500)
229 INTEGER(8) KEEP8(150)
230 DOUBLE PRECISION DKEEP(230)
231 INTEGER, INTENT(IN) :: PROCNODE_STEPS(KEEP(28)), DAD(KEEP(28))
232 INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28))
233 INTEGER PTRIST(KEEP(28)), STEP(N),
234 & pimaster(keep(28)), iw(liw)
235 INTEGER PTLUST_S(KEEP(28))
236 INTEGER(8) :: PTRFAC(KEEP(28))
237 DOUBLE PRECISION OPELIW
238 DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE
239 DOUBLE PRECISION A( LA )
240 INTEGER(8) :: LREQA, POSA, POSALOC, OLDPOS, JJ
241 INTEGER NFRONT, NCOL_L, NROW_L, LREQI, NSLAVES_L,
242 & posi, i, irow_l, icol_l, lda_band, nass
243 LOGICAL NONEED_TO_COPY_FACTORS
244 INTEGER(8) :: LREQA_HEADER
245 INTEGER LIWFAC, STRAT, TYPEFile, NextPivDummy,
246 & ioldps_cb
247 LOGICAL LAST_CALL
248 TYPE(io_block) :: MonBloc
249 INTEGER LRSTATUS
250 include 'mumps_headers.h'
251 DOUBLE PRECISION ZERO
252 parameter(zero=0.0d0)
253 DOUBLE PRECISION, POINTER, DIMENSION(:) :: SON_A
254 INTEGER(8) :: IACHK, SIZFR_SON_A, ITMP8
255 flop1 = zero
256 ncol_l = iw( ptrist(step( ison )) + 3 + keep(ixsz) )
257 nrow_l = iw( ptrist(step( ison )) + 2 + keep(ixsz) )
258 nslaves_l = iw( ptrist(step( ison )) + 5 + keep(ixsz) )
259 lrstatus = iw( ptrist(step( ison )) + xxlr)
260 lda_band = ncol_l + iw( ptrist(step( ison )) + keep(ixsz) )
261 IF ( keep(50) .eq. 0 ) THEN
262 nfront = lda_band
263 ELSE
264 nfront = iw( ptrist(step( ison )) + 7 + keep(ixsz) )
265 END IF
266 IF (keep(201).EQ.1) THEN
267 ioldps_cb = ptrist(step( ison ))
268 liwfac = iw(ioldps_cb+xxi)
269 typefile = typef_l
270 nextpivdummy = -8888
271 monbloc%INODE = ison
272 monbloc%MASTER = .false.
273 monbloc%Typenode = 2
274 monbloc%NROW = nrow_l
275 monbloc%NCOL = lda_band
276 monbloc%NFS = iw(ioldps_cb+1+keep(ixsz))
277 monbloc%LastPiv = ncol_l
278 monbloc%LastPanelWritten_L=-9999
279 monbloc%LastPanelWritten_U=-9999
280 NULLIFY(monbloc%INDICES)
281 strat = strat_write_max
282 last_call = .true.
283 monbloc%Last = .true.
284 CALL dmumps_dm_set_dynptr(iw(ptrist(step(ison))+xxs),
285 & a, la, ptrast(step(ison)),
286 & iw(ptrist(step(ison))+xxd),
287 & iw(ptrist(step(ison))+xxr),
288 & son_a, iachk, sizfr_son_a)
289 CALL dmumps_ooc_io_lu_panel_i
290 & ( strat, typefile,
291 & son_a(iachk), sizfr_son_a, monbloc,
292 & nextpivdummy, nextpivdummy,
293 & iw(ioldps_cb), liwfac,
294 & myid, keep8(31), iflag,last_call )
295 IF ((ncol_l.EQ.0).OR.(nrow_l.EQ.0)) THEN
296 ENDIF
297 ENDIF
298 noneed_to_copy_factors = ((keep(201).EQ.1) .OR. (keep(201).EQ.-1)
299 & .OR. (lrstatus.GE.2.AND.keep(486).EQ.2)
300 & )
301 IF ((ncol_l.EQ.0).OR.(nrow_l.EQ.0)) THEN
302 GOTO 80
303 ENDIF
304 lreqi = 4 + ncol_l + nrow_l + keep(ixsz)
305 lreqa_header = int(ncol_l,8) * int(nrow_l,8)
306 IF (noneed_to_copy_factors) THEN
307 lreqa = 0_8
308 ELSE
309 lreqa = lreqa_header
310 ENDIF
311 IF ( lrlu .LT. lreqa .OR.
312 & iwpos + lreqi - 1 .GT. iwposcb ) THEN
313 IF ( lrlus .LT. lreqa ) THEN
314 iflag = -9
315 CALL mumps_set_ierror(lreqa - lrlus, ierror)
316 GO TO 700
317 END IF
318 CALL dmumps_compre_new( n, keep, iw, liw, a, la,
319 & lrlu, iptrlu,
320 & iwpos,iwposcb, ptrist, ptrast,
321 & step, pimaster, pamaster, lrlus,
322 & keep(ixsz), comp, dkeep(97),
323 & myid, slavef, procnode_steps, dad )
324 IF ( lrlu .NE. lrlus ) THEN
325 WRITE(*,*) 'PB compress DMUMPS_STACK_BAND:LRLU,LRLUS=',
326 & lrlu, lrlus
327 iflag = -9
328 CALL mumps_set_ierror(lreqa - lrlus, ierror)
329 GOTO 700
330 END IF
331 IF ( iwpos + lreqi - 1 .GT. iwposcb ) THEN
332 iflag = -8
333 ierror = iwpos + lreqi - 1 - iwposcb
334 GOTO 700
335 END IF
336 END IF
337 IF (.NOT. noneed_to_copy_factors) THEN
338 posa = posfac
339 posfac = posfac + lreqa
340 lrlu = lrlu - lreqa
341 lrlus = lrlus - lreqa
342 keep8(67) = min(lrlus, keep8(67))
343 keep8(69) = keep8(69) + lreqa
344 keep8(68) = max(keep8(69), keep8(68))
345 IF(keep(201).NE.2)THEN
346 CALL dmumps_load_mem_update(.false.,.false.,
347 & la-lrlus,lreqa,lreqa,keep,keep8,lrlus)
348 ELSE
349 CALL dmumps_load_mem_update(.false.,.false.,
350 & la-lrlus,0_8,lreqa,keep,keep8,lrlus)
351 ENDIF
352 ENDIF
353 posi = iwpos
354 iwpos = iwpos + lreqi
355 ptlust_s(step( ison )) = posi
356 iw(posi:posi+keep(ixsz)-1)=-99999
357 iw(posi+xxs)=-9999
358 iw(posi+xxi)=lreqi
359 CALL mumps_storei8(0_8, iw(posi+xxd))
360 CALL mumps_storei8(lreqa, iw(posi+xxr))
361 CALL mumps_storei8(lreqa_header, iw(posi+xxr))
362 iw(posi+xxlr) = lrstatus
363 iw(posi+xxf) = iw(ptrist(step(ison))+xxf)
364 posi=posi+keep(ixsz)
365 iw( posi ) = - ncol_l
366 iw( posi + 1 ) = nrow_l
367 iw( posi + 2 ) = nfront - ncol_l
368 iw( posi + 3 ) = step(ison)
369 IF (.NOT. noneed_to_copy_factors) THEN
370 ptrfac(step(ison)) = posa
371 ELSE
372 ptrfac(step(ison)) = -77777_8
373 ENDIF
374 irow_l = ptrist(step(ison)) + 6 + nslaves_l + keep(ixsz)
375 icol_l = ptrist(step(ison)) + 6 + nrow_l + nslaves_l + keep(ixsz)
376 DO i = 1, nrow_l
377 iw( posi+3+i ) = iw( irow_l+i-1 )
378 ENDDO
379 DO i = 1, ncol_l
380 iw( posi+nrow_l+3+i) = iw( icol_l+i-1 )
381 ENDDO
382 IF (.NOT.noneed_to_copy_factors) THEN
383 CALL dmumps_dm_set_dynptr(iw(ptrist(step(ison))+xxs),
384 & a, la, ptrast(step(ison)),
385 & iw(ptrist(step(ison))+xxd),
386 & iw(ptrist(step(ison))+xxr),
387 & son_a, iachk, sizfr_son_a)
388 posaloc = posa
389 DO i = 1, nrow_l
390 oldpos = iachk + int(i-1,8)*int(lda_band,8)
391 DO jj = 0_8, int(ncol_l-1,8)
392 a( posaloc+jj ) = son_a( oldpos+jj )
393 ENDDO
394 posaloc = posaloc + int(ncol_l,8)
395 END DO
396 ENDIF
397 IF (keep(201).EQ.2) THEN
398 keep8(31)=keep8(31)+lreqa
399 ENDIF
400 itmp8 = int(ncol_l,8) * int(nrow_l,8)
401 IF (keep(405) .EQ.1) THEN
402!$OMP ATOMIC UPDATE
403 keep8(10) = keep8(10) + itmp8
404!$OMP END ATOMIC
405 ELSE
406 keep8(10) = keep8(10) + itmp8
407 ENDIF
408 IF (keep(201).EQ.2) THEN
409 CALL dmumps_new_factor(ison,ptrfac,keep,keep8,a,la,lreqa,iflag)
410 IF(iflag.LT.0)THEN
411 WRITE(*,*)myid,': Internal error in DMUMPS_NEW_FACTOR'
412 ierror=0
413 GOTO 700
414 ENDIF
415 posfac = posfac - lreqa
416 lrlu = lrlu + lreqa
417 lrlus = lrlus + lreqa
418!$OMP ATOMIC UPDATE
419 keep8(69) = keep8(69) - lreqa
420!$OMP END ATOMIC
421 CALL dmumps_load_mem_update(.false.,.false.,
422 & la-lrlus,lreqa,0_8,keep,keep8,lrlus)
423 ENDIF
424 80 CONTINUE
425 IF (type_son == 1) THEN
426 GOTO 90
427 ENDIF
428 IF ( keep(50) .eq. 0 ) THEN
429 flop1 = dble( ncol_l * nrow_l) +
430 & dble(nrow_l*ncol_l)*dble(2*nfront-ncol_l-1)
431 ELSE
432 flop1 = dble( ncol_l ) * dble( nrow_l )
433 & * dble( 2 * lda_band - nrow_l - ncol_l + 1)
434 END IF
435 opeliw = opeliw + flop1
436 flop1_effective = flop1
437 nass = iw( ptrist(step( ison )) + 4 + keep(ixsz) )
438 IF ( ncol_l .NE. nass ) THEN
439 IF ( keep(50).eq.0 ) THEN
440 flop1 = dble( nass * nrow_l) +
441 & dble(nrow_l*nass)*dble(2*nfront-nass-1)
442 ELSE
443 flop1 = dble( nass ) * dble( nrow_l ) *
444 & dble( 2 * lda_band - nrow_l - nass + 1)
445 END IF
446 END IF
447 CALL dmumps_load_update(1,.false.,flop1_effective-flop1,
448 & keep,keep8)
449 CALL dmumps_load_update(2,.false.,-flop1,keep,keep8)
450 90 CONTINUE
451 RETURN
452 700 CONTINUE
453 CALL dmumps_bdc_error( myid, slavef, comm, keep )
454 RETURN
455 END SUBROUTINE dmumps_stack_band
456 SUBROUTINE dmumps_free_band( N, ISON,
457 & PTRIST, PTRAST, IW, LIW, A, LA,
458 & LRLU, LRLUS, IWPOSCB,
459 & IPTRLU, STEP, MYID, KEEP, KEEP8, TYPE_SON
460 & )
461 USE dmumps_dynamic_memory_m, ONLY : dmumps_dm_set_ptr,
462 & dmumps_dm_free_block
463 IMPLICIT NONE
464 INTEGER(8) :: LRLU, LRLUS, IPTRLU, LA
465 INTEGER ISON, MYID, N, IWPOSCB, TYPE_SON
466 INTEGER KEEP(500), STEP(N)
467 INTEGER(8) KEEP8(150)
468 INTEGER(8) :: PTRAST(KEEP(28))
469 INTEGER PTRIST(KEEP(28))
470 INTEGER LIW
471 INTEGER IW(LIW)
472 DOUBLE PRECISION A(LA)
473 INTEGER ISTCHK
474 INTEGER(8) :: DYN_SIZE
475 DOUBLE PRECISION, DIMENSION(:), POINTER :: FORTRAN_POINTER
476 INTEGER :: XXG_STATUS
477 INCLUDE 'mumps_headers.h'
478 ISTCHK = PTRIST(STEP(ISON))
479 CALL MUMPS_GETI8( DYN_SIZE, IW(ISTCHK+XXD) )
480 XXG_STATUS = IW(ISTCHK+XXG)
481.GT. IF (DYN_SIZE 0_8) THEN
482 CALL DMUMPS_DM_SET_PTR( PTRAST(STEP(ISON)),
483 & DYN_SIZE, FORTRAN_POINTER )
484 ENDIF
485 CALL DMUMPS_FREE_BLOCK_CB_STATIC(.FALSE.,MYID, N, ISTCHK,
486 & IW, LIW, LRLU, LRLUS, IPTRLU,
487 & IWPOSCB, LA, KEEP,KEEP8, .FALSE.
488 & )
489.GT. IF (DYN_SIZE 0_8) THEN
490 CALL DMUMPS_DM_FREE_BLOCK(XXG_STATUS, FORTRAN_POINTER, DYN_SIZE,
491.EQ. & KEEP(405)1, KEEP8 )
492 ENDIF
493 PTRIST(STEP( ISON )) = -9999888
494 PTRAST(STEP( ISON )) = -9999888_8
495 RETURN
496 END SUBROUTINE DMUMPS_FREE_BAND
497 SUBROUTINE DMUMPS_MEM_ESTIM_BLR_ALL( SUM_OF_PEAKS, KEEP, KEEP8,
498 & MYID, COMM, N, NELT, NA, LNA, NNZ8, NA_ELT8, NSLAVES,
499 & INFO, INFOG, PROK, MP, PROKG, MPG
500 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
501 & )
502 IMPLICIT NONE
503 LOGICAL, INTENT(IN) :: PROK, PROKG, SUM_OF_PEAKS
504 INTEGER , INTENT(IN) :: MYID, COMM, N, NELT, NSLAVES,
505 & LNA, MP, MPG
506 INTEGER(8), INTENT(IN):: NA_ELT8, NNZ8
507 INTEGER, INTENT(IN):: NA(LNA)
508 INTEGER :: KEEP(500), INFO(80), INFOG(80)
509 INTEGER(8) :: KEEP8(150)
510 INTEGER, INTENT(IN) :: NBSTATS_I8, NBCOLS_I8
511 INTEGER(8), INTENT(IN) :: I8_L0_OMP (NBSTATS_I8, NBCOLS_I8)
512 INTEGER, PARAMETER :: MASTER = 0
513 INTEGER :: OOC_STAT, BLR_STRAT, BLR_CASE
514 INTEGER :: IRANK
515 LOGICAL :: EFF, PERLU_ON, COMPUTE_MAXAVG
516 INTEGER(8) :: TOTAL_BYTES
517 INTEGER :: TOTAL_MBYTES
518 INTEGER(8) :: TOTAL_BYTES_UNDER_L0
519 INTEGER :: TOTAL_MBYTES_UNDER_L0
520 INTEGER, DIMENSION(3) :: LRLU_UD, OOC_LRLU_UD
521 PERLU_ON = .TRUE.
522 EFF = .FALSE.
523.NOT..EQ..AND..EQ. COMPUTE_MAXAVG = (NSLAVES1 KEEP(46)1)
524.AND. IF ( PROKGSUM_OF_PEAKS) THEN
525 WRITE( MPG,'(A)')
526 & ' Estimations with BLR compression of LU factors:'
527 WRITE( MPG,'(A,I6,A) ')
528 & ' ICNTL(38) Estimated compression rate of LU factors =',
529 & KEEP(464), '/1000'
530 ENDIF
531 OOC_STAT = 0
532 BLR_STRAT = 1
533 BLR_CASE = 1
534 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
535 & MYID, N, NELT, NA(1), LNA, KEEP8(28),
536 & KEEP8(30), NSLAVES, TOTAL_MBYTES, EFF,
537 & OOC_STAT, BLR_STRAT, PERLU_ON, TOTAL_BYTES,
538 & BLR_CASE, SUM_OF_PEAKS, .FALSE. ,
539 & .FALSE.
540 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
541 & )
542.GT. IF (KEEP(400) 0 ) THEN
543 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
544 & MYID, N, NELT, NA(1), LNA, KEEP8(28),
545 & KEEP8(30), NSLAVES, TOTAL_MBYTES_UNDER_L0, EFF,
546 & OOC_STAT, BLR_STRAT, PERLU_ON, TOTAL_BYTES_UNDER_L0,
547 & BLR_CASE, SUM_OF_PEAKS, .FALSE. ,
548 & .TRUE.
549 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
550 & )
551 TOTAL_MBYTES = max (TOTAL_MBYTES,TOTAL_MBYTES_UNDER_L0)
552 TOTAL_BYTES = max (TOTAL_BYTES, TOTAL_BYTES_UNDER_L0)
553 ENDIF
554 CALL MUMPS_MEM_CENTRALIZE( MYID, COMM,
555 & TOTAL_MBYTES, LRLU_UD, IRANK )
556 IF (SUM_OF_PEAKS) THEN
557 INFO(30) = TOTAL_MBYTES
558.EQ. IF (MYIDMASTER) THEN
559 INFOG(36) = LRLU_UD(1)
560 INFOG(37) = LRLU_UD(2)
561 ENDIF
562 ENDIF
563.EQ. IF (MYIDMASTER) THEN
564.eq. IF ( KEEP(46) 0 ) THEN
565 LRLU_UD(3) = (LRLU_UD(2)-TOTAL_MBYTES)/NSLAVES
566 ELSE
567 LRLU_UD(3) = LRLU_UD(2)/NSLAVES
568 ENDIF
569 ENDIF
570.AND. IF ( PROKGSUM_OF_PEAKS ) THEN
571 IF (COMPUTE_MAXAVG) THEN
572 WRITE( MPG,'(a,i12) ')
573 & ' maximum estim. space in mbytes, ic facto. (infog(36)):',
574 & INFOG(36)
575 ENDIF
576 WRITE(MPG,'(a,i12) ')
577 & ' total space in mbytes, ic factorization(infog(37)):'
578 & ,INFOG(37)
579 END IF
580 OOC_STAT = 1
581 BLR_STRAT = 1
582 BLR_CASE = 1
583 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
584 & MYID, N, NELT, NA(1), LNA, KEEP8(28),
585 & KEEP8(30), NSLAVES, TOTAL_MBYTES, EFF,
586 & OOC_STAT, BLR_STRAT, PERLU_ON, TOTAL_BYTES,
587 & BLR_CASE, SUM_OF_PEAKS, .FALSE. ,
588 & .FALSE.
589 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
590 & )
591.GT. IF (KEEP(400) 0 ) THEN
592 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
593 & MYID, N, NELT, NA(1), LNA, KEEP8(28),
594 & KEEP8(30), NSLAVES, TOTAL_MBYTES_UNDER_L0, EFF,
595 & OOC_STAT, BLR_STRAT, PERLU_ON, TOTAL_BYTES_UNDER_L0,
596 & BLR_CASE, SUM_OF_PEAKS, .FALSE. ,
597 & .TRUE.
598 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
599 & )
600 TOTAL_MBYTES = max (TOTAL_MBYTES,TOTAL_MBYTES_UNDER_L0)
601 TOTAL_BYTES = max (TOTAL_BYTES, TOTAL_BYTES_UNDER_L0)
602 ENDIF
603 CALL MUMPS_MEM_CENTRALIZE( MYID, COMM,
604 & TOTAL_MBYTES, OOC_LRLU_UD, IRANK )
605 IF (SUM_OF_PEAKS) THEN
606 INFO(31) = TOTAL_MBYTES
607.EQ. IF (MYIDMASTER) THEN
608 INFOG(38)= OOC_LRLU_UD(1)
609 INFOG(39)= OOC_LRLU_UD(2)
610 ENDIF
611 ENDIF
612.EQ. IF (MYIDMASTER) THEN
613.eq. IF ( KEEP(46) 0 ) THEN
614 OOC_LRLU_UD(3) = (OOC_LRLU_UD(2)-TOTAL_MBYTES)/NSLAVES
615 ELSE
616 OOC_LRLU_UD(3) = OOC_LRLU_UD(2)/NSLAVES
617 ENDIF
618 ENDIF
619.AND. IF ( PROKGSUM_OF_PEAKS ) THEN
620 IF (COMPUTE_MAXAVG) THEN
621 WRITE( MPG,'(a,i12) ')
622 & ' maximum estim. space in mbytes, ooc facto. (infog(38)):',
623 & INFOG(38)
624 ENDIF
625 WRITE(MPG,'(a,i12) ')
626 & ' total space in mbytes, ooc factorization(infog(39)):'
627 & ,INFOG(39)
628 END IF
629 END SUBROUTINE DMUMPS_MEM_ESTIM_BLR_ALL
630 SUBROUTINE DMUMPS_MAX_MEM( KEEP, KEEP8,
631 & MYID, N, NELT, NA, LNA, NNZ8, NA_ELT8, NSLAVES,
632 & MEMORY_MBYTES, EFF, OOC_STRAT, BLR_STRAT, PERLU_ON,
633 & MEMORY_BYTES,
634 & BLR_CASE, SUM_OF_PEAKS, MEM_EFF_ALLOCATED,
635 & UNDER_L0_OMP
636 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
637 & )
638 IMPLICIT NONE
639 LOGICAL, INTENT(IN) :: EFF, PERLU_ON, UNDER_L0_OMP
640 INTEGER, INTENT(IN) :: OOC_STRAT, BLR_STRAT
641 INTEGER, INTENT(IN) :: KEEP(500)
642 INTEGER(8), INTENT(IN) :: KEEP8(150)
643 INTEGER, INTENT(IN) :: MYID, N, NELT, NSLAVES, LNA
644 INTEGER(8), INTENT(IN) :: NA_ELT8, NNZ8
645 INTEGER, INTENT(IN) :: NA(LNA)
646 INTEGER(8), INTENT(OUT):: MEMORY_BYTES
647 INTEGER, INTENT(OUT) :: MEMORY_MBYTES
648 INTEGER, INTENT(IN) :: BLR_CASE
649 LOGICAL, INTENT(IN) :: SUM_OF_PEAKS
650 LOGICAL, INTENT(IN) :: MEM_EFF_ALLOCATED
651 INTEGER, INTENT(IN) :: NBSTATS_I8, NBCOLS_I8
652 INTEGER(8), INTENT(IN) :: I8_L0_OMP (NBSTATS_I8, NBCOLS_I8)
653 INTEGER :: MUMPS_GET_POOL_LENGTH
654 EXTERNAL :: MUMPS_GET_POOL_LENGTH
655 INTEGER(8) :: MemEstimGlobal
656 LOGICAL :: I_AM_SLAVE, I_AM_MASTER
657 INTEGER :: PERLU, NBRECORDS
658 INTEGER(8) :: NB_REAL
659 INTEGER(8) :: TEMP, NB_BYTES, NB_INT
660 INTEGER :: DMUMPS_LBUF_INT
661 INTEGER(8) :: DMUMPS_LBUFR_BYTES8, DMUMPS_LBUF8
662 INTEGER :: NBUFS
663 INTEGER(8) :: TEMPI
664 INTEGER(8) :: TEMPR
665 INTEGER :: MIN_PERLU
666 INTEGER(8) :: BUF_OOC, BUF_OOC_PANEL, BUF_OOC_NOPANEL
667 INTEGER(8) :: OOC_NB_FILE_TYPE
668 INTEGER(8) :: NSTEPS8, N8, NELT8
669 INTEGER(8) :: I8OVERI
670 INTEGER(8) :: SUM_NRLADU_underL0,
671 & SUM_NRLADU_if_LR_LU_underL0,
672 & SUM_NRLADULR_UD_underL0,
673 & SUM_NRLADULR_WC_underL0
674 INTEGER(4) :: I4
675 INTEGER(8) :: MIN_NRLADU_underL0, MIN_NRLADU_if_LR_LU_underL0
676 INTEGER :: ITH, ITHMIN, ITHMIN_if_LRLU
677 INTEGER(8) :: I8_L0_OMP_2, I8_L0_OMP_3,
678 & I8_L0_OMP_5, I8_L0_OMP_6, I8_L0_OMP_7,
679 & I8_L0_OMP_8, I8_L0_OMP_9, I8_L0_OMP_10,
680 & I8_L0_OMP_11, I8_L0_OMP_12, I8_L0_OMP_13
681 I8OVERI = int(KEEP(10),8)
682 PERLU = KEEP(12)
683 NSTEPS8 = int(KEEP(28),8)
684 N8 = int(N,8)
685 NELT8 = int(NELT,8)
686.NOT. IF (PERLU_ON) PERLU = 0
687.eq. I_AM_MASTER = ( MYID 0 )
688.eq..or..ne. I_AM_SLAVE = ( KEEP(46) 1 MYID 0 )
689 TEMP = 0_8
690 NB_REAL = 0_8
691 NB_BYTES = 0_8
692 NB_INT = 0_8
693.NE..OR..NE. IF (KEEP(235) 0 KEEP(237) 0) THEN
694 NB_INT = NB_INT + NSTEPS8
695 ENDIF
696 NB_INT = NB_INT + 5_8 * NSTEPS8
697 NB_INT = NB_INT + NSTEPS8 + int(KEEP(56),8)*int(NSLAVES+2,8)
698 NB_INT = NB_INT + 3_8 * N8
699.ne..and. IF (KEEP(23)0 I_AM_MASTER) NB_INT=NB_INT + N8
700.eq. IF (KEEP(55)0) THEN
701 NB_INT = NB_INT + 2_8 * N8 * I8OVERI
702 ELSE
703 NB_INT = NB_INT + 2_8 * ( NELT8 + 1_8 ) * I8OVERI
704 ENDIF
705.ne. IF (KEEP(55) 0 ) THEN
706 NB_INT = NB_INT + N8 + 1_8 + NELT8
707 END IF
708 NB_INT = NB_INT + int(LNA,8)
709.NOT. IF ( EFF ) THEN
710 IF (I_AM_SLAVE) THEN
711 IF (UNDER_L0_OMP) THEN
712 I8_L0_OMP_2 = 0_8
713 I8_L0_OMP_3 = 0_8
714 MIN_NRLADU_if_LR_LU_underL0 = I8_L0_OMP(4,1)
715 MIN_NRLADU_underL0 = I8_L0_OMP(1,1)
716 ITHMIN = 1
717 ITHMIN_if_LRLU = 1
718 DO ITH=1, KEEP(400)
719.LT. IF (I8_L0_OMP(1,ITH)MIN_NRLADU_underL0)
720 & THEN
721 MIN_NRLADU_underL0 = I8_L0_OMP(1,ITH)
722 ITHMIN = ITH
723 ENDIF
724.LT. IF (I8_L0_OMP(4,ITH)MIN_NRLADU_if_LR_LU_underL0)
725 & THEN
726 MIN_NRLADU_if_LR_LU_underL0 = I8_L0_OMP(4,ITH)
727 ITHMIN_if_LRLU = ITH
728 ENDIF
729 I8_L0_OMP_2=I8_L0_OMP_2 + I8_L0_OMP(2,ITH)
730 I8_L0_OMP_3=I8_L0_OMP_3 + I8_L0_OMP(3,ITH)
731 ENDDO
732.AND..GT. IF (SUM_OF_PEAKSBLR_STRAT0) THEN
733 I8_L0_OMP_5 = 0_8
734 I8_L0_OMP_6 = 0_8
735 I8_L0_OMP_7 = 0_8
736 I8_L0_OMP_8 = 0_8
737 I8_L0_OMP_9 = 0_8
738 I8_L0_OMP_10= 0_8
739 I8_L0_OMP_11= 0_8
740 I8_L0_OMP_12= 0_8
741 I8_L0_OMP_13= 0_8
742 DO ITH=1, KEEP(400)
743 I8_L0_OMP_5 = I8_L0_OMP_5 + I8_L0_OMP(5,ITH)
744 I8_L0_OMP_6 = I8_L0_OMP_6 + I8_L0_OMP(6,ITH)
745 I8_L0_OMP_7 = I8_L0_OMP_7 + I8_L0_OMP(7,ITH)
746 I8_L0_OMP_8 = I8_L0_OMP_8 + I8_L0_OMP(8,ITH)
747 I8_L0_OMP_9 = I8_L0_OMP_9 + I8_L0_OMP(9,ITH)
748 I8_L0_OMP_10= I8_L0_OMP_10+ I8_L0_OMP(10,ITH)
749 I8_L0_OMP_11= I8_L0_OMP_11+ I8_L0_OMP(11,ITH)
750 I8_L0_OMP_12= I8_L0_OMP_12+ I8_L0_OMP(12,ITH)
751 I8_L0_OMP_13= I8_L0_OMP_13+ I8_L0_OMP(13,ITH)
752 ENDDO
753 ENDIF
754 CALL DMUMPS_SET_MEMESTIMGLOBAL (
755 & OOC_STRAT, BLR_STRAT, BLR_CASE, SUM_OF_PEAKS,
756 & KEEP8,
757 & 0_8, 0_8, 0_8, 0_8,
758 & I8_L0_OMP_2,
759 & I8_L0_OMP_3,
760 & I8_L0_OMP_5,
761 & I8_L0_OMP_6,
762 & I8_L0_OMP_7,
763 & I8_L0_OMP_8,
764 & I8_L0_OMP_9,
765 & I8_L0_OMP_10,
766 & I8_L0_OMP_11,
767 & I8_L0_OMP_12,
768 & I8_L0_OMP_13,
769 & MemEstimGlobal
770 & )
771.EQ. IF (BLR_STRAT0) THEN
772.LE..AND..NE. IF ( OOC_STRAT 0 OOC_STRAT -1 ) THEN
773 MemEstimGlobal = MemEstimGlobal +
774 & I8_L0_OMP(1,ITHMIN) +
775 & I8_L0_OMP(23, ITHMIN)
776 ELSE
777 MemEstimGlobal = MemEstimGlobal +
778 & I8_L0_OMP(23, ITHMIN)
779 ENDIF
780 ELSE
781.LE..AND..NE. IF ( OOC_STRAT 0 OOC_STRAT -1 ) THEN
782 MemEstimGlobal = MemEstimGlobal +
783 & I8_L0_OMP(4,ITHMIN_if_LRLU) +
784 & I8_L0_OMP(23, ITHMIN_if_LRLU)
785 ELSE
786 MemEstimGlobal = MemEstimGlobal +
787 & I8_L0_OMP(23, ITHMIN_if_LRLU)
788 ENDIF
789 ENDIF
790 NB_REAL = NB_REAL + MemEstimGlobal +
791 & int(PERLU,8)*(MemEstimGlobal / 100_8 + 1_8 )
792 ELSE
793.EQ. IF ( KEEP8(24)0_8 ) THEN
794 SUM_NRLADU_underL0 = 0_8
795 SUM_NRLADU_if_LR_LU_underL0 = 0_8
796 SUM_NRLADULR_UD_underL0 = 0_8
797 SUM_NRLADULR_WC_underL0 = 0_8
798.GT. IF (KEEP(400) 0 ) THEN
799 DO ITH=1, KEEP(400)
800 SUM_NRLADU_underL0 =
801 & SUM_NRLADU_underL0 + I8_L0_OMP(1,ITH)
802 SUM_NRLADU_if_LR_LU_underL0 =
803 & SUM_NRLADU_if_LR_LU_underL0 + I8_L0_OMP(4,ITH)
804 SUM_NRLADULR_UD_underL0 =
805 & SUM_NRLADULR_UD_underL0 + I8_L0_OMP(9,ITH)
806 SUM_NRLADULR_WC_underL0 =
807 & SUM_NRLADULR_WC_underL0 + I8_L0_OMP(10,ITH)
808 ENDDO
809 ENDIF
810 CALL DMUMPS_SET_MEMESTIMGLOBAL (
811 & OOC_STRAT, BLR_STRAT, BLR_CASE, SUM_OF_PEAKS,
812 & KEEP8,
813 & SUM_NRLADU_underL0, SUM_NRLADU_if_LR_LU_underL0,
814 & SUM_NRLADULR_UD_underL0, SUM_NRLADULR_WC_underL0,
815 & KEEP8(53),
816 & KEEP8(54),
817 & KEEP8(33),
818 & KEEP8(34),
819 & KEEP8(35),
820 & KEEP8(50),
821 & KEEP8(36),
822 & KEEP8(47),
823 & KEEP8(37),
824 & KEEP8(38),
825 & KEEP8(39),
826 & MemEstimGlobal
827 & )
828.LE. IF (KEEP(400)0) THEN
829 NB_REAL = NB_REAL + MemEstimGlobal +
830 & int(PERLU,8)*(MemEstimGlobal / 100_8 + 1_8 )
831.EQ. ELSE IF (BLR_STRAT0) THEN
832.GT..OR..EQ. IF ( OOC_STRAT 0 OOC_STRAT -1 ) THEN
833 NB_REAL = NB_REAL + MemEstimGlobal +
834 & int(PERLU,8)*(KEEP8(14) / 100_8 + 1_8 )
835 ELSE
836 NB_REAL = NB_REAL + MemEstimGlobal +
837 & int(PERLU,8)*(KEEP8(12) / 100_8 + 1_8 )
838 ENDIF
839 ELSE
840 NB_REAL = NB_REAL + MemEstimGlobal +
841 & int(PERLU,8)*(MemEstimGlobal / 100_8 + 1_8 )
842 ENDIF
843 ENDIF
844 ENDIF
845 ELSE
846 NB_REAL = NB_REAL + 1_8
847 ENDIF
848 ELSE IF (I_AM_SLAVE) THEN
849 IF (UNDER_L0_OMP) THEN
850 IF (MEM_EFF_ALLOCATED) THEN
851 NB_REAL = NB_REAL + KEEP8(63)
852 ELSE
853 NB_REAL = NB_REAL + KEEP8(62)
854 ENDIF
855 ELSE
856 IF (MEM_EFF_ALLOCATED) THEN
857 NB_REAL = NB_REAL + KEEP8(23) + KEEP8(74)
858 ELSE
859 NB_REAL = NB_REAL + KEEP8(67) + KEEP8(74)
860 ENDIF
861 ENDIF
862 ENDIF
863.GT..AND. IF ( OOC_STRAT 0 I_AM_SLAVE ) THEN
864 BUF_OOC_NOPANEL = 2_8 * KEEP8(119)
865.EQ. IF (KEEP(50)0)THEN
866 BUF_OOC_PANEL = 8_8 * int(KEEP(226),8)
867 ELSE
868 BUF_OOC_PANEL = 4_8 * int(KEEP(226),8)
869 ENDIF
870.EQ. IF (OOC_STRAT 2) THEN
871 BUF_OOC = BUF_OOC_NOPANEL
872 ELSE
873 BUF_OOC = BUF_OOC_PANEL
874 ENDIF
875 NB_REAL = NB_REAL + min(BUF_OOC + int(max(PERLU,0),8) *
876 & (BUF_OOC/100_8+1_8),12000000_8)
877.EQ. IF (OOC_STRAT 2) THEN
878 OOC_NB_FILE_TYPE = 1_8
879 ELSE
880.EQ. IF (KEEP(50)0) THEN
881 OOC_NB_FILE_TYPE = 2_8
882 ELSE
883 OOC_NB_FILE_TYPE = 1_8
884 ENDIF
885 ENDIF
886 NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI
887 NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI
888 NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8
889 ENDIF
890 NB_REAL = NB_REAL + KEEP8(26)
891.EQ..AND..NOT. IF (KEEP(252)1 I_AM_MASTER) THEN
892 NB_REAL = NB_REAL + N8
893 ENDIF
894.not..and..and..eq. IF ( ( I_AM_SLAVE I_AM_MASTER KEEP(52) 0
895.and..ne. & KEEP(55) 0 ) ) THEN
896 NB_INT = NB_INT + KEEP8(27)
897 END IF
898.and..ne. IF ( I_AM_SLAVE KEEP(38) 0 ) THEN
899 NB_INT = NB_INT + 2_8 * N8
900 END IF
901 TEMPI= 0_8
902 TEMPR = 0_8
903 NBRECORDS = KEEP(39)
904.eq. IF (KEEP(55)0) THEN
905 IF (NNZ8 < int(NBRECORDS,8)) THEN
906 NBRECORDS=int(NNZ8)
907 ENDIF
908 ELSE
909 IF (NA_ELT8 < int(NBRECORDS,8)) THEN
910 NBRECORDS=int(NA_ELT8)
911 ENDIF
912 ENDIF
913.eq. IF ( KEEP(54) 0 ) THEN
914 IF ( I_AM_MASTER ) THEN
915.eq. IF ( KEEP(46) 0 ) THEN
916 NBUFS = NSLAVES
917 ELSE
918 NBUFS = NSLAVES - 1
919.eq. IF (KEEP(55) 0 )
920 & TEMPI = TEMPI + 2_8 * N8
921 END IF
922 TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) * int(NBUFS,8)
923 TEMPR = TEMPR + int(NBRECORDS,8) * int(NBUFS,8)
924 ELSE
925.eq. IF ( KEEP(55) 0 )THEN
926 TEMPI = TEMPI + 2_8 * int(NBRECORDS,8)
927 TEMPR = TEMPR + int(NBRECORDS,8)
928 END IF
929 END IF
930 ELSE
931 IF ( I_AM_SLAVE ) THEN
932 TEMPI = TEMPI + int(1+4*NSLAVES,8) * int(NBRECORDS,8)
933 TEMPR = TEMPR + int(1+2*NSLAVES,8) * int(NBRECORDS,8)
934 END IF
935 END IF
936 TEMP = max( NB_BYTES + (NB_INT + TEMPI) * int(KEEP(34),8)
937 & + (NB_REAL+TEMPR) * int(KEEP(35),8)
938 & , TEMP )
939 IF ( I_AM_SLAVE ) THEN
940.NE. IF (BLR_STRAT0) THEN
941 DMUMPS_LBUFR_BYTES8 = int(KEEP(380),8) * int(KEEP(35),8)
942 ELSE
943 DMUMPS_LBUFR_BYTES8 = int(KEEP(44),8) * int(KEEP(35),8)
944 ENDIF
945 DMUMPS_LBUFR_BYTES8 = max( DMUMPS_LBUFR_BYTES8,
946 & 100000_8 )
947.EQ. IF (KEEP(48)5) THEN
948 MIN_PERLU=2
949 ELSE
950 MIN_PERLU=0
951 ENDIF
952 DMUMPS_LBUFR_BYTES8 = DMUMPS_LBUFR_BYTES8
953 & + int( 2.0D0 * dble(max(PERLU,MIN_PERLU))*
954 & dble(DMUMPS_LBUFR_BYTES8)/100D0,8)
955 DMUMPS_LBUFR_BYTES8 = min(DMUMPS_LBUFR_BYTES8,
956 & int(huge (I4)-100,8))
957 NB_BYTES = NB_BYTES + DMUMPS_LBUFR_BYTES8
958.NOT. IF (UNDER_L0_OMP) THEN
959.NE. IF (BLR_STRAT0) THEN
960 DMUMPS_LBUF8 = int( dble(KEEP(213)) / 100.0D0
961 & * dble(KEEP( 379 ) * KEEP( 35 )), 8 )
962 ELSE
963 DMUMPS_LBUF8 = int( dble(KEEP(213)) / 100.0D0
964 & * dble(KEEP( 43 ) * KEEP( 35 )), 8 )
965 ENDIF
966 DMUMPS_LBUF8 = max( DMUMPS_LBUF8, 100000_8 )
967 DMUMPS_LBUF8 = DMUMPS_LBUF8
968 & + int( 2.0D0 * dble(max(PERLU,MIN_PERLU))*
969 & dble(DMUMPS_LBUF8)/100D0, 8)
970 DMUMPS_LBUF8 = min(DMUMPS_LBUF8, int(huge(I4)-100,8))
971 DMUMPS_LBUF8 = max(DMUMPS_LBUF8, DMUMPS_LBUFR_BYTES8+
972 & 3_8*int(KEEP(34),8))
973 NB_BYTES = NB_BYTES + DMUMPS_LBUF8
974 ENDIF
975 DMUMPS_LBUF_INT = ( KEEP(56) +
976 & NSLAVES * NSLAVES ) * 5
977 & * KEEP(34)
978 NB_BYTES = NB_BYTES + int(DMUMPS_LBUF_INT,8)
979.NOT. IF (EFF) THEN
980 IF (UNDER_L0_OMP) THEN
981 NB_INT = NB_INT + N8*int(KEEP(400),8)
982 NB_INT = NB_INT +
983 & int(MUMPS_GET_POOL_LENGTH(NA(1), KEEP, KEEP8),8)*
984 & int(KEEP(400),8)
985 ELSE
986.GT. IF (KEEP(400)0) THEN
987 NB_INT = NB_INT +
988 & int(MUMPS_GET_POOL_LENGTH(NA(1), KEEP, KEEP8),8)*
989 & int(KEEP(400),8)
990 ENDIF
991 ENDIF
992.GT. IF (OOC_STRAT 0) THEN
993 NB_INT = NB_INT + int(
994 & KEEP(138) + 3 * max(PERLU,10) *
995 & ( KEEP(138) / 100 + 1 )
996 & ,8)
997 ELSE
998 NB_INT = NB_INT + int(
999 & KEEP(137) + 3 * max(PERLU,10) *
1000 & ( KEEP(137) / 100 + 1 )
1001 & ,8)
1002 ENDIF
1003 ENDIF
1004.NOT. IF (UNDER_L0_OMP) THEN
1005.GT. IF (OOC_STRAT 0) THEN
1006 NB_INT = NB_INT + int(
1007 & KEEP(225) + 2 * max(PERLU,10) *
1008 & ( KEEP(225) / 100 + 1 )
1009 & ,8)
1010 ELSE
1011 NB_INT = NB_INT + int(
1012 & KEEP(15) + 2 * max(PERLU,10) *
1013 & ( KEEP(15) / 100 + 1 )
1014 & ,8)
1015 ENDIF
1016 ENDIF
1017 NB_INT = NB_INT + NSTEPS8
1018 NB_INT = NB_INT + NSTEPS8 * I8OVERI
1019 NB_INT = NB_INT + N8 + 4_8 * NSTEPS8 +
1020 & int(MUMPS_GET_POOL_LENGTH(NA(1), KEEP, KEEP8),8)
1021 NB_INT = NB_INT + 2_8 * NSTEPS8 * I8OVERI
1022.NE. IF (KEEP(494)0) THEN
1023 NB_INT = NB_INT + N8
1024 ENDIF
1025 ENDIF
1026 MEMORY_BYTES = NB_BYTES + NB_INT * int(KEEP(34),8) +
1027 & NB_REAL * int(KEEP(35),8)
1028 MEMORY_BYTES = max( MEMORY_BYTES, TEMP )
1029 MEMORY_MBYTES = nint( dble(MEMORY_BYTES) / dble(1000000) )
1030 RETURN
1031 END SUBROUTINE DMUMPS_MAX_MEM
1032 SUBROUTINE DMUMPS_SET_MEMESTIMGLOBAL (
1033 & OOC_STRAT, BLR_STRAT, BLR_CASE, SUM_OF_PEAKS,
1034 & KEEP8,
1035 & SUM_NRLADU_underL0, SUM_NRLADU_if_LR_LU_underL0,
1036 & SUM_NRLADULR_UD_underL0, SUM_NRLADULR_WC_underL0,
1037 & PEAK_FR,
1038 & PEAK_FR_OOC,
1039 & NRLNEC_if_LR_LU,
1040 & NRLNEC_if_LR_LUCB,
1041 & NRLNECOOC_if_LR_LUCB,
1042 & NRLNEC_if_LR_CB,
1043 & NRLADULR_UD,
1044 & NRLADULR_WC,
1045 & NRLNECLR_CB_UD,
1046 & NRLNECLR_LUCB_UD,
1047 & NRLNECLR_LUCB_WC,
1048 & MemEstimGlobal
1049 & )
1050 INTEGER, INTENT(IN) :: OOC_STRAT, BLR_STRAT
1051 INTEGER, INTENT(IN) :: BLR_CASE
1052 LOGICAL, INTENT(IN) :: SUM_OF_PEAKS
1053 INTEGER(8), INTENT(IN) :: KEEP8(150)
1054 INTEGER(8), INTENT(IN) :: SUM_NRLADU_underL0,
1055 & SUM_NRLADU_if_LR_LU_underL0,
1056 & SUM_NRLADULR_UD_underL0,
1057 & SUM_NRLADULR_WC_underL0
1058 INTEGER(8), INTENT(IN) ::
1059 & PEAK_FR,
1060 & PEAK_FR_OOC,
1061 & NRLNEC_if_LR_LU,
1062 & NRLNEC_if_LR_LUCB,
1063 & NRLNECOOC_if_LR_LUCB,
1064 & NRLNEC_if_LR_CB,
1065 & NRLADULR_UD,
1066 & NRLADULR_WC,
1067 & NRLNECLR_CB_UD,
1068 & NRLNECLR_LUCB_UD,
1069 & NRLNECLR_LUCB_WC
1070 INTEGER(8), INTENT(OUT) :: MemEstimGlobal
1071.GT..OR..EQ. IF ( OOC_STRAT 0 OOC_STRAT -1 ) THEN
1072 MemEstimGlobal = PEAK_FR_OOC
1073 ELSE
1074 MemEstimGlobal = PEAK_FR
1075 ENDIF
1076.GT. IF (BLR_STRAT0) THEN
1077.NOT. IF (SUM_OF_PEAKS) THEN
1078.EQ. IF (BLR_STRAT1) THEN
1079.LE. IF (BLR_CASE1) THEN
1080.EQ. IF (OOC_STRAT0) THEN
1081 MemEstimGlobal = KEEP8(40)
1082 ELSE
1083 MemEstimGlobal = KEEP8(41)
1084 ENDIF
1085.EQ. ELSE IF (BLR_CASE2) THEN
1086.EQ. IF (OOC_STRAT0) THEN
1087 MemEstimGlobal = KEEP8(33)
1088 ELSE
1089 MemEstimGlobal = KEEP8(54)
1090 ENDIF
1091 ELSE
1092.EQ. IF (OOC_STRAT0) THEN
1093 MemEstimGlobal = KEEP8(53)
1094 ELSE
1095 MemEstimGlobal = KEEP8(42)
1096 ENDIF
1097 ENDIF
1098 ELSE
1099.LE. IF (BLR_CASE1) THEN
1100.EQ. IF (OOC_STRAT0) THEN
1101 MemEstimGlobal = KEEP8(43)
1102 ELSE
1103 MemEstimGlobal = KEEP8(45)
1104 ENDIF
1105.EQ. ELSE IF (BLR_CASE2) THEN
1106.EQ. IF (OOC_STRAT0) THEN
1107 MemEstimGlobal = KEEP8(34)
1108 ELSE
1109 MemEstimGlobal = KEEP8(35)
1110 ENDIF
1111 ELSE
1112.EQ. IF (OOC_STRAT0) THEN
1113 MemEstimGlobal = KEEP8(44)
1114 ELSE
1115 MemEstimGlobal = KEEP8(46)
1116 ENDIF
1117 ENDIF
1118 ENDIF
1119 ELSE
1120.EQ. IF (BLR_STRAT1) THEN
1121.EQ. IF (OOC_STRAT0) THEN
1122 MemEstimGlobal = NRLNEC_if_LR_LU
1123 & + SUM_NRLADU_if_LR_LU_underL0
1124 ELSE
1125 MemEstimGlobal = PEAK_FR_OOC
1126 ENDIF
1127.EQ. IF (BLR_CASE1) THEN
1128 MemEstimGlobal = MemEstimGlobal + NRLADULR_UD
1129 & + SUM_NRLADULR_UD_underL0
1130.EQ. ELSE IF (BLR_CASE3) THEN
1131 MemEstimGlobal = MemEstimGlobal + NRLADULR_WC
1132 & + SUM_NRLADULR_WC_underL0
1133 ENDIF
1134.EQ. ELSE IF (BLR_STRAT2) THEN
1135.EQ. IF (OOC_STRAT0) THEN
1136 MemEstimGlobal = NRLNEC_if_LR_LUCB
1137 & + SUM_NRLADU_if_LR_LU_underL0
1138 ELSE
1139 MemEstimGlobal = NRLNECOOC_if_LR_LUCB
1140 ENDIF
1141.EQ. IF (BLR_CASE1) THEN
1142 MemEstimGlobal = MemEstimGlobal + NRLNECLR_LUCB_UD
1143 & + SUM_NRLADULR_UD_underL0
1144.EQ. ELSE IF (BLR_CASE3) THEN
1145 MemEstimGlobal = MemEstimGlobal + NRLNECLR_LUCB_WC
1146 & + SUM_NRLADULR_WC_underL0
1147 ENDIF
1148 ELSE
1149.EQ. IF (OOC_STRAT0) THEN
1150 MemEstimGlobal = NRLNEC_if_LR_CB
1151 & + SUM_NRLADU_underL0
1152 ELSE
1153 MemEstimGlobal = NRLNECOOC_if_LR_LUCB
1154 ENDIF
1155 MemEstimGlobal = MemEstimGlobal + NRLNECLR_CB_UD
1156 ENDIF
1157 ENDIF
1158 ENDIF
1159 RETURN
1160 END SUBROUTINE DMUMPS_SET_MEMESTIMGLOBAL
1161 SUBROUTINE DMUMPS_SET_BLRSTRAT_AND_MAXS_K8 (
1162 & MAXS_BASE8, MAXS_BASE_RELAXED8,
1163 & BLR_STRAT,
1164 & KEEP, KEEP8)
1165 IMPLICIT NONE
1166 INTEGER(8), INTENT(OUT) :: MAXS_BASE8, MAXS_BASE_RELAXED8
1167 INTEGER, INTENT(OUT) :: BLR_STRAT
1168 INTEGER, INTENT(IN) :: KEEP(500)
1169 INTEGER(8), INTENT(IN) :: KEEP8(150)
1170 CALL DMUMPS_SET_BLRSTRAT_AND_MAXS (
1171 & MAXS_BASE8, MAXS_BASE_RELAXED8,
1172 & BLR_STRAT,
1173 & KEEP(1),
1174 & KEEP8(12),
1175 & KEEP8(14),
1176 & KEEP8(33),
1177 & KEEP8(34),
1178 & KEEP8(35),
1179 & KEEP8(50) )
1180 RETURN
1181 END SUBROUTINE DMUMPS_SET_BLRSTRAT_AND_MAXS_K8
1182 SUBROUTINE DMUMPS_SET_BLRSTRAT_AND_MAXS(
1183 & MAXS_BASE8, MAXS_BASE_RELAXED8,
1184 & BLR_STRAT, KEEP,
1185 & NRLNEC,
1186 & NRLNEC_ACTIVE,
1187 & NRLNEC_if_LR_LU,
1188 & NRLNEC_if_LR_LUCB,
1189 & NRLNECOOC_if_LR_LUCB,
1190 & NRLNEC_if_LR_CB )
1191 IMPLICIT NONE
1192 INTEGER(8), INTENT(OUT) :: MAXS_BASE8, MAXS_BASE_RELAXED8
1193 INTEGER, INTENT(OUT) :: BLR_STRAT
1194 INTEGER, INTENT(IN) :: KEEP(500)
1195 INTEGER(8), INTENT(IN) :: NRLNEC,
1196 & NRLNEC_ACTIVE,
1197 & NRLNEC_if_LR_LU,
1198 & NRLNEC_if_LR_LUCB,
1199 & NRLNECOOC_if_LR_LUCB,
1200 & NRLNEC_if_LR_CB
1201 INTEGER :: PERLU
1202 PERLU = KEEP(12)
1203.EQ. IF (KEEP(201) 0) THEN
1204 MAXS_BASE8 = NRLNEC
1205 ELSE
1206 MAXS_BASE8 = NRLNEC_ACTIVE
1207 ENDIF
1208 BLR_STRAT = 0
1209.EQ. IF (KEEP(486)2) THEN
1210.EQ. IF (KEEP(489)1) THEN
1211 BLR_STRAT = 2
1212.NE. IF (KEEP(201)0) THEN
1213 MAXS_BASE8 = NRLNECOOC_if_LR_LUCB
1214 ELSE
1215 MAXS_BASE8 = NRLNEC_if_LR_LUCB
1216 ENDIF
1217 ELSE
1218 BLR_STRAT = 1
1219.NE. IF (KEEP(201)0) THEN
1220 MAXS_BASE8 = NRLNEC_ACTIVE
1221 ELSE
1222 MAXS_BASE8 = NRLNEC_if_LR_LU
1223 ENDIF
1224 ENDIF
1225.EQ. ELSE IF (KEEP(486)3) THEN
1226.EQ. IF (KEEP(489)1) THEN
1227 BLR_STRAT = 3
1228.NE. IF (KEEP(201)0) THEN
1229 MAXS_BASE8 = NRLNECOOC_if_LR_LUCB
1230 ELSE
1231 MAXS_BASE8 = NRLNEC_if_LR_CB
1232 ENDIF
1233 ENDIF
1234 ENDIF
1235.GT. IF ( MAXS_BASE8 0_8 ) THEN
1236 MAXS_BASE_RELAXED8 =
1237 & MAXS_BASE8 + int(PERLU,8) * ( MAXS_BASE8 / 100_8 + 1_8)
1238 MAXS_BASE_RELAXED8 = max(MAXS_BASE_RELAXED8, 1_8)
1239 ELSE
1240 MAXS_BASE_RELAXED8 = 1_8
1241 END IF
1242 RETURN
1243 END SUBROUTINE DMUMPS_SET_BLRSTRAT_AND_MAXS
1244 SUBROUTINE DMUMPS_MEM_ALLOWED_SET_MAXS ( MAXS,
1245 & BLR_STRAT, OOC_STRAT, MAXS_ESTIM_RELAXED8,
1246 & KEEP, KEEP8, MYID, N, NELT, NA, LNA,
1247 & NSLAVES, ICNTL38, ICNTL39, IFLAG, IERROR
1248 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
1249 & )
1250 IMPLICIT NONE
1251 INTEGER(8), INTENT(OUT) :: MAXS
1252 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
1253 INTEGER, INTENT(IN) :: BLR_STRAT
1254 INTEGER, INTENT(IN) :: OOC_STRAT
1255 INTEGER(8), INTENT(IN) :: MAXS_ESTIM_RELAXED8
1256 INTEGER, INTENT(IN) :: KEEP(500)
1257 INTEGER(8), INTENT(INOUT) :: KEEP8(150)
1258 INTEGER, INTENT(IN) :: MYID, N, NELT, NSLAVES, LNA
1259 INTEGER, INTENT(IN) :: NA(LNA), ICNTL38, ICNTL39
1260 INTEGER, INTENT(IN) :: NBSTATS_I8, NBCOLS_I8
1261 INTEGER(8), INTENT(IN) :: I8_L0_OMP (NBSTATS_I8, NBCOLS_I8)
1262 INTEGER(8) :: SMALLER_MAXS, UPDATED_DIFF
1263 LOGICAL :: EFF, PERLU_ON, SUM_OF_PEAKS
1264 INTEGER :: BLR_CASE
1265 INTEGER(8) :: TOTAL_BYTES, MEM_ALLOWED_BYTES,
1266 & MEM_DISPO_BYTES, MEM_DISPO
1267 INTEGER :: TOTAL_MBYTES, PERLU
1268 INTEGER(8) :: MEM_DISPO_BYTES_NR, MEM_DISPO_NR,
1269 & TOTAL_BYTES_NR
1270 INTEGER :: TOTAL_MBYTES_NR
1271 INTEGER, PARAMETER :: IDUMMY = -9999
1272 LOGICAL, PARAMETER :: BDUMMY =.FALSE.
1273 PERLU_ON = .TRUE.
1274 PERLU = KEEP(12)
1275 EFF = .FALSE.
1276 SUM_OF_PEAKS = .TRUE.
1277 BLR_CASE = 1
1278 MEM_ALLOWED_BYTES = KEEP8(4)
1279 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
1280 & MYID, N, NELT, NA(1), LNA,
1281 & KEEP8(28), KEEP8(30),
1282 & NSLAVES, TOTAL_MBYTES, EFF, OOC_STRAT,
1283 & BLR_STRAT, PERLU_ON, TOTAL_BYTES,
1284 & BLR_CASE, SUM_OF_PEAKS, .FALSE. ,
1285 & .FALSE.
1286 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
1287 & )
1288 MEM_DISPO_BYTES = MEM_ALLOWED_BYTES-TOTAL_BYTES
1289.GT. IF (MEM_DISPO_BYTES0) THEN
1290 MEM_DISPO = MEM_DISPO_BYTES/int(KEEP(35),8)
1291 ELSE
1292 MEM_DISPO = (MEM_DISPO_BYTES-int(KEEP(35),8)+1)/
1293 & int(KEEP(35),8)
1294 ENDIF
1295.EQ. IF (BLR_STRAT0) THEN
1296 UPDATED_DIFF = 0_8
1297.EQ. ELSE IF (BLR_STRAT1) THEN
1298.NE. IF (KEEP(464)0) THEN
1299 UPDATED_DIFF = int(
1300 & dble(KEEP8(36)) * ( 1.0D0 -
1301 & dble(ICNTL38)/dble(KEEP(464)) )
1302 & , 8)
1303 ELSE
1304 UPDATED_DIFF = int (
1305 & -dble(KEEP8(11)-KEEP8(32)) *
1306 & dble(ICNTL38) / 1000.0D0
1307 & , 8)
1308 ENDIF
1309.EQ. ELSE IF (BLR_STRAT2) THEN
1310.NE. IF (KEEP(464)+KEEP(465)0) THEN
1311 UPDATED_DIFF = int(
1312 & dble(KEEP8(38)) * ( 1.0D0 -
1313 & dble(ICNTL38+ICNTL39)/
1314 & dble(KEEP(464)+KEEP(465)) )
1315 & , 8)
1316 ELSE
1317 UPDATED_DIFF = int(
1318 & -dble(KEEP8(39))*
1319 & dble(ICNTL38+ICNTL39)/1000.0D0
1320 & , 8)
1321 ENDIF
1322.EQ. ELSE IF (BLR_STRAT3) THEN
1323.NE. IF (KEEP(465)0) THEN
1324 UPDATED_DIFF = int(
1325 & dble(KEEP8(37)) * ( 1.0D0 -
1326 & dble(ICNTL39)/dble(KEEP(465)) )
1327 & , 8)
1328 ELSE
1329 UPDATED_DIFF = int(
1330 & -dble(KEEP8(39))*
1331 & dble(ICNTL39)/1000.0D0
1332 & , 8)
1333 ENDIF
1334 ELSE
1335 UPDATED_DIFF = 0_8
1336 ENDIF
1337 MEM_DISPO = MEM_DISPO + UPDATED_DIFF
1338 MAXS = MAXS_ESTIM_RELAXED8
1339 MEM_DISPO_NR = 0_8
1340.LT..AND..GT. IF ( (MEM_DISPO0) MAXS_ESTIM_RELAXED8
1341 & (MEM_ALLOWED_BYTES/int(KEEP(35),8)) ) THEN
1342 PERLU_ON = .FALSE.
1343 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
1344 & MYID, N, NELT, NA(1), LNA,
1345 & KEEP8(28), KEEP8(30),
1346 & NSLAVES, TOTAL_MBYTES_NR, EFF, OOC_STRAT,
1347 & BLR_STRAT, PERLU_ON, TOTAL_BYTES_NR,
1348 & BLR_CASE, SUM_OF_PEAKS, .FALSE.,
1349 & .FALSE.
1350 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
1351 & )
1352 MEM_DISPO_BYTES_NR = MEM_ALLOWED_BYTES-TOTAL_BYTES_NR
1353 MEM_DISPO_NR =
1354 & MEM_DISPO_BYTES_NR/int(KEEP(35),8)
1355 & + UPDATED_DIFF
1356.LT. IF ( MEM_DISPO_NR0 ) THEN
1357 IFLAG=-19
1358 CALL MUMPS_SET_IERROR(-MEM_DISPO_NR,IERROR)
1359 GOTO 500
1360 ELSE
1361.GE. IF (BLR_STRAT2) THEN
1362 IFLAG=-19
1363 CALL MUMPS_SET_IERROR(-MEM_DISPO_NR,IERROR)
1364 GOTO 500
1365 ELSE
1366 MEM_DISPO_NR = MEM_DISPO_NR -
1367 & (int(KEEP(12),8)/120_8)*
1368 & (KEEP8(11)/4_8)
1369.LT. IF ( MEM_DISPO_NR0 ) THEN
1370 IFLAG=-19
1371 CALL MUMPS_SET_IERROR(-MEM_DISPO_NR,IERROR)
1372 GOTO 500
1373 ELSE
1374 ENDIF
1375 ENDIF
1376 ENDIF
1377 ENDIF
1378 MAXS = MAXS_ESTIM_RELAXED8
1379.EQ. IF (BLR_STRAT0) THEN
1380.GT. IF (MEM_DISPO0) THEN
1381.EQ. IF (OOC_STRAT0) THEN
1382 MAXS = MAXS_ESTIM_RELAXED8+(MEM_DISPO/2_8)
1383 ELSE
1384 MAXS = MAXS_ESTIM_RELAXED8+(MEM_DISPO/2_8)
1385 ENDIF
1386 ELSE
1387 MAXS = MAXS_ESTIM_RELAXED8 + MEM_DISPO
1388 ENDIF
1389.EQ. ELSE IF (BLR_STRAT1) THEN
1390.LT. IF ( MEM_DISPO 0) THEN
1391.EQ. IF (OOC_STRAT0) THEN
1392 SMALLER_MAXS = KEEP8(34) +
1393 & int(PERLU,8) * ( KEEP8(34) / 100_8 + 1_8)
1394 ELSE
1395 SMALLER_MAXS = KEEP8(35) +
1396 & int(PERLU,8) * ( KEEP8(35) / 100_8 + 1_8)
1397 ENDIF
1398 MAXS = max(MAXS_ESTIM_RELAXED8+MEM_DISPO,
1399 & SMALLER_MAXS)
1400 ENDIF
1401.EQ. ELSE IF (BLR_STRAT2) THEN
1402.LT. IF ( MEM_DISPO0) THEN
1403 MAXS = max(
1404 & MAXS_ESTIM_RELAXED8+MEM_DISPO,
1405 & MAXS_ESTIM_RELAXED8)
1406 ENDIF
1407.EQ. ELSE IF (BLR_STRAT3) THEN
1408.LT. IF ( MEM_DISPO0) THEN
1409 MAXS = max(
1410 & MAXS_ESTIM_RELAXED8+MEM_DISPO,
1411 & MAXS_ESTIM_RELAXED8)
1412 ENDIF
1413 ENDIF
1414.LE. IF (MAXS 0_8) THEN
1415 IFLAG=-19
1416.LT. IF (MEM_DISPO0) THEN
1417 CALL MUMPS_SET_IERROR(MEM_DISPO,IERROR)
1418 ELSE
1419 CALL MUMPS_SET_IERROR(MAXS_ESTIM_RELAXED8-MAXS,IERROR)
1420 ENDIF
1421 ENDIF
1422 500 CONTINUE
1423 RETURN
1424 END SUBROUTINE DMUMPS_MEM_ALLOWED_SET_MAXS
1425 SUBROUTINE DMUMPS_MEM_ALLOWED_SET_K75 (
1426 & MAXS, MYID, UNDER_L0_OMP,
1427 & N, NELT, NA, LNA, NSLAVES,
1428 & BLR_STRAT, OOC_STRAT,
1429 & KEEP, KEEP8, IFLAG, IERROR
1430 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
1431 & )
1432 IMPLICIT NONE
1433 INTEGER(8), INTENT(IN) :: MAXS
1434 INTEGER, INTENT(IN) :: MYID, N, NELT, LNA, NSLAVES,
1435 & BLR_STRAT, OOC_STRAT
1436 LOGICAL, INTENT(IN) :: UNDER_L0_OMP
1437 INTEGER, INTENT(IN) :: NA(LNA), KEEP(500)
1438 INTEGER(8), INTENT(INOUT) :: KEEP8(150)
1439 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
1440 INTEGER, INTENT(IN) :: NBSTATS_I8, NBCOLS_I8
1441 INTEGER(8), INTENT(IN) :: I8_L0_OMP (NBSTATS_I8, NBCOLS_I8)
1442 INTEGER(8) :: KEEP8_23_SAVETMP, TOTAL_BYTES
1443 INTEGER :: TOTAL_MBYTES
1444 LOGICAL :: PERLU_ON, MEM_EFF_ALLOCATED, EFF
1445 INTEGER, PARAMETER :: IDUMMY = -9999
1446 LOGICAL, PARAMETER :: BDUMMY =.FALSE.
1447 KEEP8_23_SAVETMP = KEEP8(23)
1448 KEEP8(23) = MAXS
1449 PERLU_ON =.TRUE.
1450 MEM_EFF_ALLOCATED = .TRUE.
1451 EFF = .TRUE.
1452 KEEP8(74) = 0_8
1453 KEEP8(63) = 0_8
1454 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
1455 & MYID, N, NELT, NA(1), LNA, KEEP8(28),
1456 & KEEP8(30),
1457 & NSLAVES, TOTAL_MBYTES, EFF , KEEP(201),
1458 & BLR_STRAT, PERLU_ON, TOTAL_BYTES,
1459 & IDUMMY, BDUMMY , MEM_EFF_ALLOCATED,
1460 & UNDER_L0_OMP
1461 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
1462 & )
1463 KEEP8(23) = KEEP8_23_SAVETMP
1464 KEEP8(75) = KEEP8(4) - TOTAL_BYTES
1465 KEEP8(75) = KEEP8(75)/int(KEEP(35),8)
1466.LT. IF (KEEP8(75)0_8) THEN
1467 IFLAG=-19
1468 CALL MUMPS_SET_IERROR(-KEEP8(75),IERROR)
1469 ENDIF
1470 RETURN
1471 END SUBROUTINE DMUMPS_MEM_ALLOWED_SET_K75
1472 SUBROUTINE DMUMPS_L0_COMPUTE_PEAK_ALLOWED (
1473 & MYID, N,
1474 & NELT, NA, LNA, NSLAVES,
1475 & BLR_STRAT, OOC_STRAT,
1476 & KEEP, KEEP8, IFLAG, IERROR
1477 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
1478 & )
1479 IMPLICIT NONE
1480 INTEGER, INTENT(IN) :: MYID, N, NELT, LNA, NSLAVES,
1481 & BLR_STRAT, OOC_STRAT
1482 INTEGER, INTENT(IN) :: NA(LNA), KEEP(500)
1483 INTEGER(8), INTENT(INOUT) :: KEEP8(150)
1484 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
1485 INTEGER, INTENT(IN) :: NBSTATS_I8, NBCOLS_I8
1486 INTEGER(8), INTENT(IN) :: I8_L0_OMP (NBSTATS_I8, NBCOLS_I8)
1487 INTEGER(8) :: KEEP8_23_SAVETMP, TOTAL_BYTES, TOTAL_STATIC,
1488 & TOTAL_ABOVE, TOTAL_UNDER
1489 INTEGER(8) :: EXTRA_MEM, MIN_NRLADU_underL0,
1490 & MIN_NRLADU_if_LR_LU_underL0
1491 INTEGER :: TOTAL_MBYTES
1492 LOGICAL :: PERLU_ON, MEM_EFF_ALLOCATED, EFF
1493 LOGICAL :: UNDER_L0_OMP, SUM_OF_PEAKS
1494 INTEGER :: BLR_CASE, ITH
1495 INTEGER, PARAMETER :: IDUMMY = -9999
1496 LOGICAL, PARAMETER :: BDUMMY =.FALSE.
1497 KEEP8_23_SAVETMP = KEEP8(23)
1498 KEEP8(23) = 0_8
1499 UNDER_L0_OMP = .TRUE.
1500 PERLU_ON = .TRUE.
1501 MEM_EFF_ALLOCATED = .TRUE.
1502 EFF = .TRUE.
1503 KEEP8(74) = 0_8
1504 KEEP8(63) = 0_8
1505 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
1506 & MYID, N, NELT, NA(1), LNA, KEEP8(28),
1507 & KEEP8(30),
1508 & NSLAVES, TOTAL_MBYTES, EFF , KEEP(201),
1509 & BLR_STRAT, PERLU_ON, TOTAL_BYTES,
1510 & IDUMMY, BDUMMY , MEM_EFF_ALLOCATED,
1511 & UNDER_L0_OMP
1512 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
1513 & )
1514 TOTAL_STATIC = TOTAL_BYTES
1515 KEEP8(23) = KEEP8_23_SAVETMP
1516 MEM_EFF_ALLOCATED = .FALSE.
1517 EFF = .FALSE.
1518 BLR_CASE = 2
1519 SUM_OF_PEAKS = .TRUE.
1520 UNDER_L0_OMP = .FALSE.
1521 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
1522 & MYID, N, NELT, NA(1), LNA, KEEP8(28),
1523 & KEEP8(30),
1524 & NSLAVES, TOTAL_MBYTES, EFF , KEEP(201),
1525 & BLR_STRAT, PERLU_ON, TOTAL_BYTES,
1526 & BLR_CASE, SUM_OF_PEAKS , MEM_EFF_ALLOCATED,
1527 & UNDER_L0_OMP
1528 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
1529 & )
1530 TOTAL_ABOVE = TOTAL_BYTES
1531.AND..LE. IF (PERLU_ONKEEP(201)0) THEN
1532.GT. IF (BLR_STRAT0) THEN
1533 MIN_NRLADU_if_LR_LU_underL0 = I8_L0_OMP(4,1)
1534 DO ITH=1, KEEP(400)
1535 MIN_NRLADU_if_LR_LU_underL0 = min (
1536 & MIN_NRLADU_if_LR_LU_underL0, I8_L0_OMP(4,ITH)
1537 & )
1538 ENDDO
1539 EXTRA_MEM = int(KEEP(12),8)*
1540 & ( MIN_NRLADU_if_LR_LU_underL0 / 100_8 + 1_8 )
1541 ELSE
1542 MIN_NRLADU_underL0 = I8_L0_OMP(1,1)
1543 DO ITH=1, KEEP(400)
1544 MIN_NRLADU_underL0 = min (
1545 & MIN_NRLADU_underL0, I8_L0_OMP(1,ITH)
1546 & )
1547 ENDDO
1548 EXTRA_MEM = int(KEEP(12),8)*
1549 & ( MIN_NRLADU_underL0 / 100_8 + 1_8 )
1550 ENDIF
1551 TOTAL_ABOVE = TOTAL_ABOVE + EXTRA_MEM
1552 ENDIF
1553 UNDER_L0_OMP = .TRUE.
1554 CALL DMUMPS_MAX_MEM( KEEP(1), KEEP8(1),
1555 & MYID, N, NELT, NA(1), LNA, KEEP8(28),
1556 & KEEP8(30),
1557 & NSLAVES, TOTAL_MBYTES, EFF , KEEP(201),
1558 & BLR_STRAT, PERLU_ON, TOTAL_BYTES,
1559 & BLR_CASE, SUM_OF_PEAKS , MEM_EFF_ALLOCATED,
1560 & UNDER_L0_OMP
1561 & , I8_L0_OMP, NBSTATS_I8, NBCOLS_I8
1562 & )
1563 TOTAL_UNDER = TOTAL_BYTES
1564 KEEP8(77) = ( max(TOTAL_UNDER,TOTAL_ABOVE) - TOTAL_STATIC )
1565 & / int(KEEP(35),8)
1566 RETURN
1567 END SUBROUTINE DMUMPS_L0_COMPUTE_PEAK_ALLOWED
1568 SUBROUTINE DMUMPS_SETMAXTOZERO(M_ARRAY, M_SIZE)
1569 IMPLICIT NONE
1570 INTEGER M_SIZE
1571 DOUBLE PRECISION M_ARRAY(M_SIZE)
1572 DOUBLE PRECISION ZERO
1573 PARAMETER (ZERO=0.0D0)
1574 M_ARRAY=ZERO
1575 RETURN
1576 END SUBROUTINE DMUMPS_SETMAXTOZERO
1577 SUBROUTINE DMUMPS_COMPUTE_NBROWSinF (
1578 & N, INODE, IFATH, KEEP,
1579 & IOLDPS, HF, IW, LIW,
1580 & NROWS, NCOLS, NPIV,
1581 & NELIM, NFS4FATHER,
1582 & NBROWSinF
1583 & )
1584 IMPLICIT NONE
1585 INTEGER, INTENT(IN) :: N, INODE, IFATH
1586 INTEGER, INTENT(IN) :: KEEP(500)
1587 INTEGER, INTENT(IN) :: IOLDPS, HF, LIW, NROWS, NCOLS
1588 INTEGER, INTENT(IN) :: NPIV, NELIM, NFS4FATHER
1589 INTEGER, INTENT(IN) :: IW(LIW)
1590 INTEGER, INTENT(OUT):: NBROWSinF
1591 INTEGER :: ShiftFirstRowinFront
1592 NBROWSinF = 0
1593.EQ..OR..NE..OR. IF ( (KEEP(219)0)(KEEP(50)2)
1594.LE. & (NFS4FATHER0) ) THEN
1595 RETURN
1596 ENDIF
1597 ShiftFirstRowinFront = NCOLS-NPIV-NELIM-NROWS
1598.EQ. IF (ShiftFirstRowinFront0) THEN
1599 NBROWSinF = min(NROWS, NFS4FATHER-NELIM)
1600.LT. ELSE IF (ShiftFirstRowinFrontNFS4FATHER-NELIM) THEN
1601 NBROWSinF = min(NROWS,NFS4FATHER-NELIM-ShiftFirstRowinFront)
1602 ELSE
1603 NBROWSinF=0
1604 ENDIF
1605 RETURN
1606 END SUBROUTINE DMUMPS_COMPUTE_NBROWSinF
1607 SUBROUTINE DMUMPS_COMPUTE_ESTIM_NFS4FATHER (
1608 & N, INODE, IFATH, FILS, PERM, KEEP,
1609 & IOLDPS, HF, IW, LIW, NFRONT, NASS1,
1610 & ESTIM_NFS4FATHER_ATSON
1611 & )
1612 IMPLICIT NONE
1613 INTEGER, INTENT(IN) :: N, INODE, IFATH
1614 INTEGER, INTENT(IN) :: FILS(N), PERM(N), KEEP(500)
1615 INTEGER, INTENT(IN) :: IOLDPS, HF, LIW, NFRONT, NASS1
1616 INTEGER, INTENT(IN) :: IW(LIW)
1617 INTEGER, INTENT(OUT):: ESTIM_NFS4FATHER_ATSON
1618 INTEGER :: J, J_LASTFS, IN, NCB, I, IPOS
1619 ESTIM_NFS4FATHER_ATSON = 0
1620 IN = IFATH
1621 J_LASTFS = IN
1622.GT. DO WHILE (IN0)
1623 J_LASTFS = IN
1624 IN = FILS(IN)
1625 ENDDO
1626 NCB = NFRONT-NASS1
1627 IPOS = IOLDPS + HF + NASS1
1628 ESTIM_NFS4FATHER_ATSON = 0
1629 DO I=1, NCB
1630 J = IW(IPOS+ESTIM_NFS4FATHER_ATSON)
1631.LE. IF (PERM(J)PERM(J_LASTFS)) THEN
1632 ESTIM_NFS4FATHER_ATSON =
1633 & ESTIM_NFS4FATHER_ATSON+1
1634 ELSE
1635 EXIT
1636 ENDIF
1637 ENDDO
1638 RETURN
1639 END SUBROUTINE DMUMPS_COMPUTE_ESTIM_NFS4FATHER
1640 SUBROUTINE DMUMPS_COMPUTE_MAXPERCOL(
1641 & A,ASIZE,NCOL,NROW,
1642 & M_ARRAY,NMAX,PACKED_CB,LROW1)
1643 IMPLICIT NONE
1644 INTEGER(8) :: ASIZE
1645 INTEGER NROW,NCOL,NMAX,LROW1
1646 LOGICAL PACKED_CB
1647 DOUBLE PRECISION A(ASIZE)
1648 DOUBLE PRECISION M_ARRAY(NMAX)
1649 INTEGER I
1650 INTEGER(8):: APOS, J, LROW
1651 DOUBLE PRECISION ZERO,TMP
1652 PARAMETER (ZERO=0.0D0)
1653 DO I=1, NMAX
1654 M_ARRAY(I) = ZERO
1655 ENDDO
1656 APOS = 0_8
1657 IF (PACKED_CB) THEN
1658 LROW=int(LROW1,8)
1659 ELSE
1660 LROW=int(NCOL,8)
1661 ENDIF
1662 DO I=1,NROW
1663 DO J=1_8,int(NMAX,8)
1664 TMP = abs(A(APOS+J))
1665.GT. IF(TMPM_ARRAY(J)) M_ARRAY(J) = TMP
1666 ENDDO
1667 APOS = APOS + LROW
1668 IF (PACKED_CB) LROW=LROW+1_8
1669 ENDDO
1670 RETURN
1671 END SUBROUTINE DMUMPS_COMPUTE_MAXPERCOL
1672 SUBROUTINE DMUMPS_SIZE_IN_STRUCT( id, NB_INT, NB_CMPLX, NB_CHAR )
1673 USE DMUMPS_STRUC_DEF
1674 IMPLICIT NONE
1675 TYPE(DMUMPS_STRUC) :: id
1676 INTEGER(8) NB_INT, NB_CMPLX
1677 INTEGER(8) NB_REAL,NB_CHAR
1678 NB_INT = 0_8
1679 NB_CMPLX = 0_8
1680 NB_REAL = 0_8
1681 NB_CHAR = 0_8
1682 IF (associated(id%IS)) NB_INT=NB_INT+size(id%IS)
1683 NB_INT=NB_INT+size(id%KEEP)
1684 NB_INT=NB_INT+size(id%ICNTL)
1685 NB_INT=NB_INT+size(id%INFO)
1686 NB_INT=NB_INT+size(id%INFOG)
1687 IF (associated(id%MAPPING)) NB_INT=NB_INT+size(id%MAPPING)
1688 IF (associated(id%STEP)) NB_INT=NB_INT+size(id%STEP)
1689 IF (associated(id%NE_STEPS )) NB_INT=NB_INT+size(id%NE_STEPS )
1690 IF (associated(id%ND_STEPS)) NB_INT=NB_INT+size(id%ND_STEPS)
1691 IF (associated(id%Step2node)) NB_INT=NB_INT+size(id%Step2node)
1692 IF (associated(id%FRERE_STEPS)) NB_INT=NB_INT+size(id%FRERE_STEPS)
1693 IF (associated(id%DAD_STEPS)) NB_INT=NB_INT+size(id%DAD_STEPS)
1694 IF (associated(id%FILS)) NB_INT=NB_INT+size(id%FILS)
1695 IF (associated(id%PTRAR))
1696 & NB_INT=NB_INT+size(id%PTRAR)* id%KEEP(10)
1697 IF (associated(id%FRTPTR)) NB_INT=NB_INT+size(id%FRTPTR)
1698 NB_INT=NB_INT+size(id%KEEP8) * id%KEEP(10)
1699 IF (associated(id%PTRFAC)) NB_INT=NB_INT+size(id%PTRFAC) *
1700 & id%KEEP(10)
1701 IF (associated(id%FRTELT)) NB_INT=NB_INT+size(id%FRTELT)
1702 IF (associated(id%NA)) NB_INT=NB_INT+size(id%NA)
1703 IF (associated(id%PROCNODE_STEPS))
1704 & NB_INT=NB_INT+size(id%PROCNODE_STEPS)
1705 IF (associated(id%PTLUST_S)) NB_INT=NB_INT+size(id%PTLUST_S)
1706 IF (associated(id%INTARR)) NB_INT=NB_INT+id%KEEP8(27)
1707 IF (associated(id%ELTPROC)) NB_INT=NB_INT+size(id%ELTPROC)
1708 IF (associated(id%CANDIDATES))
1709 & NB_INT=NB_INT+size(id%CANDIDATES)
1710 IF (associated(id%SYM_PERM))
1711 & NB_INT=NB_INT+size(id%SYM_PERM)
1712 IF (associated(id%UNS_PERM))
1713 & NB_INT=NB_INT+size(id%UNS_PERM)
1714 IF (associated(id%ISTEP_TO_INIV2))
1715 & NB_INT=NB_INT+size(id%ISTEP_TO_INIV2)
1716 IF (associated(id%FUTURE_NIV2))
1717 & NB_INT=NB_INT+size(id%FUTURE_NIV2)
1718 IF (associated(id%TAB_POS_IN_PERE))
1719 & NB_INT=NB_INT+size(id%TAB_POS_IN_PERE)
1720 IF (associated(id%I_AM_CAND))
1721 & NB_INT=NB_INT+size(id%I_AM_CAND)
1722 IF (associated(id%MEM_DIST))
1723 & NB_INT=NB_INT+size(id%MEM_DIST)
1724 IF (associated(id%POSINRHSCOMP_ROW))
1725 & NB_INT=NB_INT+size(id%POSINRHSCOMP_ROW)
1726.AND. IF(id%POSINRHSCOMP_COL_ALLOCassociated(id%POSINRHSCOMP_COL))
1727 & NB_INT=NB_INT+size(id%POSINRHSCOMP_COL)
1728 IF (associated(id%MEM_SUBTREE))
1729 & NB_REAL=NB_REAL+size(id%MEM_SUBTREE)*(id%KEEP(35)/id%KEEP(16))
1730 IF (associated(id%MY_ROOT_SBTR))
1731 & NB_INT=NB_INT+size(id%MY_ROOT_SBTR)
1732 IF (associated(id%MY_FIRST_LEAF))
1733 & NB_INT=NB_INT+size(id%MY_FIRST_LEAF)
1734 IF (associated(id%MY_NB_LEAF)) NB_INT=NB_INT+size(id%MY_NB_LEAF)
1735 IF (associated(id%DEPTH_FIRST)) NB_INT=NB_INT+size(id%DEPTH_FIRST)
1736 IF (associated(id%DEPTH_FIRST_SEQ))
1737 & NB_INT=NB_INT+size(id%DEPTH_FIRST_SEQ)
1738 IF (associated(id%SBTR_ID)) NB_INT=NB_INT+size(id%SBTR_ID)
1739 IF (associated(id%SCHED_DEP)) NB_INT=NB_INT+size(id%SCHED_DEP)
1740 IF (associated(id%SCHED_GRP)) NB_INT=NB_INT+size(id%SCHED_GRP)
1741 IF (associated(id%SCHED_SBTR)) NB_INT=NB_INT+size(id%SCHED_SBTR)
1742 IF (associated(id%CROIX_MANU)) NB_INT=NB_INT+size(id%CROIX_MANU)
1743 IF (associated(id%COST_TRAV))
1744 & NB_REAL=NB_REAL+size(id%COST_TRAV)*(id%KEEP(35)/id%KEEP(16))
1745 IF (associated(id%CB_SON_SIZE)) NB_INT=NB_INT+size(id%CB_SON_SIZE)
1746 IF (associated(id%OOC_INODE_SEQUENCE))
1747 & NB_INT=NB_INT+size(id%OOC_INODE_SEQUENCE)
1748 IF (associated(id%OOC_SIZE_OF_BLOCK))
1749 & NB_INT=NB_INT+size(id%OOC_SIZE_OF_BLOCK)*id%KEEP(10)
1750 IF (associated(id%OOC_VADDR))
1751 & NB_INT=NB_INT+size(id%OOC_VADDR)*id%KEEP(10)
1752 IF (associated(id%OOC_TOTAL_NB_NODES))
1753 & NB_INT=NB_INT+size(id%OOC_TOTAL_NB_NODES)
1754 IF (associated(id%OOC_NB_FILES))
1755 & NB_INT=NB_INT+size(id%OOC_NB_FILES)
1756 IF (associated(id%OOC_FILE_NAME_LENGTH))
1757 & NB_INT=NB_INT+size(id%OOC_FILE_NAME_LENGTH)
1758 IF (associated(id%PIVNUL_LIST)) NB_INT=NB_INT+size(id%PIVNUL_LIST)
1759 IF (associated(id%SUP_PROC)) NB_INT=NB_INT+size(id%SUP_PROC)
1760 IF (associated(id%IPTR_WORKING))
1761 & NB_INT=NB_INT+size(id%IPTR_WORKING)
1762 IF (associated(id%WORKING)) NB_INT=NB_INT+size(id%WORKING)
1763 IF (associated(id%LRGROUPS))
1764 & NB_INT=NB_INT+size(id%LRGROUPS)
1765 IF (associated(id%IPOOL_B_L0_OMP))
1766 & NB_INT=NB_INT+size(id%IPOOL_B_L0_OMP)
1767 IF (associated(id%IPOOL_A_L0_OMP))
1768 & NB_INT=NB_INT+size(id%IPOOL_A_L0_OMP)
1769 IF (associated(id%PHYS_L0_OMP))
1770 & NB_INT=NB_INT+size(id%PHYS_L0_OMP)
1771 IF (associated(id%VIRT_L0_OMP))
1772 & NB_INT=NB_INT+size(id%VIRT_L0_OMP)
1773 IF (associated(id%PERM_L0_OMP))
1774 & NB_INT=NB_INT+size(id%PERM_L0_OMP)
1775 IF (associated(id%PTR_LEAFS_L0_OMP))
1776 & NB_INT=NB_INT+size(id%PTR_LEAFS_L0_OMP)
1777 IF (associated(id%L0_OMP_MAPPING))
1778 & NB_INT=NB_INT+size(id%L0_OMP_MAPPING)
1779 IF (associated(id%SINGULAR_VALUES))
1780 & NB_REAL=NB_REAL+size(id%SINGULAR_VALUES)
1781 IF (associated(id%root%RG2L_COL))
1782 & NB_INT=NB_INT+size(id%root%RG2L_COL)
1783 IF (associated(id%root%RG2L_ROW))
1784 & NB_INT=NB_INT+size(id%root%RG2L_ROW)
1785 IF (associated(id%root%IPIV))
1786 & NB_INT=NB_INT+size(id%root%IPIV)
1787 IF (associated(id%root%RHS_CNTR_MASTER_ROOT))
1788 & NB_CMPLX=NB_CMPLX+size(id%root%RHS_CNTR_MASTER_ROOT)
1789 IF (associated(id%root%SCHUR_POINTER))
1790 & NB_CMPLX=NB_CMPLX+size(id%root%SCHUR_POINTER)
1791 IF (associated(id%root%QR_TAU))
1792 & NB_CMPLX=NB_CMPLX+size(id%root%QR_TAU)
1793 IF (associated(id%root%RHS_ROOT))
1794 & NB_CMPLX=NB_CMPLX+size(id%root%RHS_ROOT)
1795 IF (associated(id%root%SVD_U))
1796 & NB_CMPLX=NB_CMPLX+size(id%root%SVD_U)
1797 IF (associated(id%root%SVD_VT))
1798 & NB_CMPLX=NB_CMPLX+size(id%root%SVD_VT)
1799 IF (associated(id%root%SINGULAR_VALUES))
1800 & NB_REAL=NB_REAL+size(id%root%SINGULAR_VALUES)
1801 IF (associated(id%DBLARR)) NB_CMPLX=NB_CMPLX+id%KEEP8(26)
1802 IF (associated(id%RHSCOMP)) NB_CMPLX = NB_CMPLX + id%KEEP8(25)
1803 IF (associated(id%S)) NB_CMPLX=NB_CMPLX+id%KEEP8(23)
1804.AND..NE. IF (associated(id%COLSCA)(id%KEEP(52)-1))
1805 & NB_REAL=NB_REAL+size(id%COLSCA)
1806.AND..NE. IF (associated(id%ROWSCA)(id%KEEP(52)-1))
1807 & NB_REAL=NB_REAL+size(id%ROWSCA)
1808 NB_REAL=NB_REAL+size(id%CNTL)
1809 NB_REAL=NB_REAL+size(id%RINFO)
1810 NB_REAL=NB_REAL+size(id%RINFOG)
1811 NB_REAL=NB_REAL+size(id%DKEEP)
1812 NB_CHAR=NB_CHAR+len(id%VERSION_NUMBER)
1813 NB_CHAR=NB_CHAR+len(id%OOC_TMPDIR)
1814 NB_CHAR=NB_CHAR+len(id%OOC_PREFIX)
1815 NB_CHAR=NB_CHAR+len(id%WRITE_PROBLEM)
1816 NB_CHAR=NB_CHAR+len(id%SAVE_DIR)
1817 NB_CHAR=NB_CHAR+len(id%SAVE_PREFIX)
1818 NB_CMPLX = NB_CMPLX + NB_REAL
1819 NB_CMPLX = NB_CMPLX + id%KEEP8(71) + id%KEEP8(64)
1820 RETURN
1821 END SUBROUTINE DMUMPS_SIZE_IN_STRUCT
1822 SUBROUTINE DMUMPS_COPYI8SIZE(N8,SRC,DEST)
1823 IMPLICIT NONE
1824 INTEGER(8) :: N8
1825 DOUBLE PRECISION, intent(in) :: SRC(N8)
1826 DOUBLE PRECISION, intent(out) :: DEST(N8)
1827 INTEGER(8) :: SHIFT8, HUG8
1828 INTEGER :: I, I4SIZE
1829.EQ. IF(int(huge(I4SIZE),8) int(huge(HUG8),8)) THEN
1830 CALL dcopy(N8, SRC(1), 1, DEST(1), 1)
1831 ELSE
1832 HUG8=int(huge(I4SIZE),8)
1833 DO I = 1, int(( N8 + HUG8 - 1_8 ) / HUG8)
1834 SHIFT8 = 1_8 + int(I-1,8) * HUG8
1835 I4SIZE = int(min(HUG8, N8-SHIFT8+1_8))
1836 CALL dcopy(I4SIZE, SRC(SHIFT8), 1, DEST(SHIFT8), 1)
1837 ENDDO
1838 END IF
1839 RETURN
1840 END SUBROUTINE DMUMPS_COPYI8SIZE
1841 SUBROUTINE DMUMPS_SET_TMP_PTR( THE_ADDRESS, THE_SIZE8 )
1842 USE DMUMPS_STATIC_PTR_M
1843 INTEGER(8), INTENT(IN) :: THE_SIZE8
1844 DOUBLE PRECISION, INTENT(IN) :: THE_ADDRESS(THE_SIZE8)
1845 CALL DMUMPS_SET_STATIC_PTR(THE_ADDRESS(1:THE_SIZE8))
1846 RETURN
1847 END SUBROUTINE DMUMPS_SET_TMP_PTR
1848 SUBROUTINE DMUMPS_OOC_IO_LU_PANEL_I
1849 & ( STRAT, TYPEFile,
1850 & AFAC, LAFAC, MonBloc,
1851 & LNextPiv2beWritten, UNextPiv2beWritten,
1852 & IW, LIWFAC,
1853 & MYID, FILESIZE, IERR , LAST_CALL)
1854 USE DMUMPS_OOC, ONLY : IO_BLOCK,
1855 & DMUMPS_OOC_IO_LU_PANEL
1856 IMPLICIT NONE
1857 TYPE(IO_BLOCK), INTENT(INOUT):: MonBloc
1858 INTEGER(8) :: LAFAC
1859 INTEGER, INTENT(IN) :: STRAT, LIWFAC, MYID, TYPEFile
1860 INTEGER, INTENT(INOUT) :: IW(0:LIWFAC-1)
1861 DOUBLE PRECISION, INTENT(IN) :: AFAC(LAFAC)
1862 INTEGER, INTENT(INOUT) :: LNextPiv2beWritten, UNextPiv2beWritten
1863 INTEGER(8), INTENT(INOUT) :: FILESIZE
1864 INTEGER, INTENT(OUT) :: IERR
1865 LOGICAL, INTENT(IN) :: LAST_CALL
1866 CALL DMUMPS_OOC_IO_LU_PANEL
1867 & ( STRAT, TYPEFile,
1868 & AFAC, LAFAC, MonBloc,
1869 & LNextPiv2beWritten, UNextPiv2beWritten,
1870 & IW, LIWFAC,
1871 & MYID, FILESIZE, IERR , LAST_CALL)
1872 RETURN
1873 END SUBROUTINE DMUMPS_OOC_IO_LU_PANEL_I
1874 SUBROUTINE DMUMPS_BUF_SEND_CONTRIB_TYPE3_I ( N, ISON,
1875 & NBCOL_SON, NBROW_SON, INDCOL_SON, INDROW_SON,
1876 & LD_SON, VAL_SON, TAG, SUBSET_ROW, SUBSET_COL,
1877 & NSUBSET_ROW, NSUBSET_COL,
1878 & NSUPROW, NSUPCOL,
1879 & NPROW, NPCOL, MBLOCK, RG2L_ROW, RG2L_COL,
1880 & NBLOCK, PDEST, COMM, IERR ,
1881 & TAB, TABSIZE, TRANSP, SIZE_PACK,
1882 & N_ALREADY_SENT, KEEP, BBPCBP )
1883 USE DMUMPS_BUF, ONLY : DMUMPS_BUF_SEND_CONTRIB_TYPE3
1884 IMPLICIT NONE
1885 INTEGER N, ISON, NBCOL_SON, NBROW_SON, NSUBSET_ROW, NSUBSET_COL
1886 INTEGER NPROW, NPCOL, MBLOCK, NBLOCK, LD_SON
1887 INTEGER BBPCBP
1888 INTEGER PDEST, TAG, COMM, IERR
1889 INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON )
1890 INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL )
1891 INTEGER :: RG2L_ROW(N)
1892 INTEGER :: RG2L_COL(N)
1893 INTEGER NSUPROW, NSUPCOL
1894 INTEGER(8), INTENT(IN) :: TABSIZE
1895 INTEGER SIZE_PACK
1896 INTEGER KEEP(500)
1897 DOUBLE PRECISION VAL_SON( LD_SON, * ), TAB(*)
1898 LOGICAL TRANSP
1899 INTEGER N_ALREADY_SENT
1900 CALL DMUMPS_BUF_SEND_CONTRIB_TYPE3( N, ISON,
1901 & NBCOL_SON, NBROW_SON, INDCOL_SON, INDROW_SON,
1902 & LD_SON, VAL_SON, TAG, SUBSET_ROW, SUBSET_COL,
1903 & NSUBSET_ROW, NSUBSET_COL,
1904 & NSUPROW, NSUPCOL,
1905 & NPROW, NPCOL, MBLOCK, RG2L_ROW, RG2L_COL,
1906 & NBLOCK, PDEST, COMM, IERR ,
1907 & TAB, TABSIZE, TRANSP, SIZE_PACK,
1908 & N_ALREADY_SENT, KEEP, BBPCBP )
1909 RETURN
1910 END SUBROUTINE DMUMPS_BUF_SEND_CONTRIB_TYPE3_I
1911 SUBROUTINE DMUMPS_BLR_UPDATE_TRAILING_I(
1912 & A, LA, POSELT, IFLAG, IERROR, NFRONT,
1913 & BEGS_BLR_L, sizeBEGS_BLR_L,
1914 & BEGS_BLR_U, sizeBEGS_BLR_U, CURRENT_BLR, BLR_L, NB_BLR_L,
1915 & BLR_U,
1916 & NB_BLR_U, NELIM, LBANDSLAVE, ISHIFT, NIV, SYM,
1917 & MIDBLK_COMPRESS, TOLEPS, TOL_OPT, KPERCENT)
1918 USE DMUMPS_LR_TYPE, ONLY : LRB_TYPE
1919 USE DMUMPS_FAC_LR, ONLY : DMUMPS_BLR_UPDATE_TRAILING
1920 INTEGER(8), intent(in) :: LA
1921 INTEGER(8), intent(in) :: POSELT
1922 INTEGER, intent(in) :: NFRONT, NB_BLR_L, NB_BLR_U,
1923 & CURRENT_BLR,
1924 & NELIM, NIV, SYM, TOL_OPT
1925 INTEGER, intent(inout) :: IFLAG, IERROR
1926 LOGICAL, intent(in) :: LBANDSLAVE
1927 INTEGER, intent(in) :: ISHIFT
1928 DOUBLE PRECISION, intent(inout) :: A(LA)
1929 TYPE(LRB_TYPE),intent(in) :: BLR_U(NB_BLR_U-CURRENT_BLR)
1930 TYPE(LRB_TYPE),intent(in) :: BLR_L(NB_BLR_L-CURRENT_BLR)
1931 INTEGER :: sizeBEGS_BLR_L, sizeBEGS_BLR_U
1932 INTEGER :: BEGS_BLR_L(sizeBEGS_BLR_L)
1933 INTEGER :: BEGS_BLR_U(sizeBEGS_BLR_U)
1934 INTEGER,intent(in) :: MIDBLK_COMPRESS, KPERCENT
1935 DOUBLE PRECISION,intent(in) :: TOLEPS
1936 CALL DMUMPS_BLR_UPDATE_TRAILING(
1937 & A, LA, POSELT, IFLAG, IERROR, NFRONT,
1938 & BEGS_BLR_L, BEGS_BLR_U, CURRENT_BLR, BLR_L, NB_BLR_L,
1939 & BLR_U,
1940 & NB_BLR_U, NELIM, LBANDSLAVE, ISHIFT, NIV, SYM,
1941 & MIDBLK_COMPRESS, TOLEPS, TOL_OPT, KPERCENT)
1942 RETURN
1943 END SUBROUTINE DMUMPS_BLR_UPDATE_TRAILING_I
1944 SUBROUTINE DMUMPS_COMPRESS_CB_I(A_PTR, LA_PTR, POSELT, LDA,
1945 & BEGS_BLR, sizeBEGS_BLR, BEGS_BLR_U, sizeBEGS_BLR_U,
1946 & NB_ROWS, NB_COLS, NB_INASM,
1947 & NROWS, NCOLS, INODE,
1948 & IWHANDLER, SYM, NIV, IFLAG, IERROR,
1949 & TOLEPS, TOL_OPT, KPERCENT, K489, CB_LRB,
1950 & WORK, TAU, JPVT, LWORK, RWORK, BLOCK,
1951 & MAXI_CLUSTER, KEEP8, OMP_NUM,
1952 & NFS4FATHER, NPIV, NVSCHUR_K253, KEEP,
1953 & M_ARRAY,
1954 & NELIM,
1955 & NBROWSinF
1956 & )
1957 USE DMUMPS_LR_TYPE, ONLY : LRB_TYPE
1958 USE DMUMPS_FAC_LR, ONLY : DMUMPS_COMPRESS_CB
1959 IMPLICIT NONE
1960 INTEGER(8), intent(in) :: LA_PTR
1961 DOUBLE PRECISION, intent(inout) :: A_PTR(LA_PTR)
1962 INTEGER(8), intent(in) :: POSELT
1963 INTEGER :: sizeBEGS_BLR, sizeBEGS_BLR_U
1964 INTEGER, intent(in) :: LDA, NB_ROWS, NB_COLS, NB_INASM
1965 INTEGER, INTENT(IN) :: NIV, IWHANDLER, MAXI_CLUSTER,
1966 & KPERCENT, TOL_OPT, LWORK, OMP_NUM
1967 INTEGER, INTENT(IN) :: K489, NROWS, NCOLS, INODE, SYM
1968 INTEGER, intent(inout) :: IFLAG, IERROR
1969 TYPE(LRB_TYPE), intent(inout) :: CB_LRB(NB_ROWS,NB_COLS)
1970 INTEGER :: BEGS_BLR(sizeBEGS_BLR), BEGS_BLR_U(sizeBEGS_BLR_U)
1971 DOUBLE PRECISION :: RWORK(2*MAXI_CLUSTER*OMP_NUM)
1972 DOUBLE PRECISION :: BLOCK(MAXI_CLUSTER, MAXI_CLUSTER*OMP_NUM)
1973 DOUBLE PRECISION :: WORK(LWORK*OMP_NUM), TAU(MAXI_CLUSTER*OMP_NUM)
1974 INTEGER :: JPVT(MAXI_CLUSTER*OMP_NUM)
1975 INTEGER(8) :: KEEP8(150)
1976 DOUBLE PRECISION,intent(in) :: TOLEPS
1977 INTEGER, INTENT(in) :: NFS4FATHER, NPIV, NVSCHUR_K253, KEEP(500)
1978 DOUBLE PRECISION :: M_ARRAY(max(NFS4FATHER,1))
1979 INTEGER, intent(in) :: NELIM
1980 INTEGER, intent(in) :: NBROWSinF
1981 CALL DMUMPS_COMPRESS_CB(A_PTR, LA_PTR, POSELT, LDA,
1982 & BEGS_BLR, BEGS_BLR_U,
1983 & NB_ROWS, NB_COLS, NB_INASM,
1984 & NROWS, NCOLS, INODE,
1985 & IWHANDLER, SYM, NIV, IFLAG, IERROR,
1986 & TOLEPS, TOL_OPT, KPERCENT, K489, CB_LRB,
1987 & WORK, TAU, JPVT, LWORK, RWORK, BLOCK,
1988 & MAXI_CLUSTER, KEEP8,
1989 & NFS4FATHER, NPIV, NVSCHUR_K253, KEEP,
1990 & M_ARRAY=M_ARRAY,
1991 & NELIM=NELIM,
1992 & NBROWSinF=NBROWSinF
1993 & )
1994 RETURN
1995 END SUBROUTINE DMUMPS_COMPRESS_CB_I
1996 SUBROUTINE DMUMPS_COMPRESS_PANEL_I_NOOPT(
1997 & A, LA, POSELT, IFLAG, IERROR, NFRONT,
1998 & BEGS_BLR, sizeBEGS_BLR,
1999 & NB_BLR, TOLEPS, TOL_OPT, K473, BLR_PANEL,
2000 & CURRENT_BLR,
2001 & DIR, WORK, TAU, JPVT,
2002 & LWORK, RWORK, BLOCK,
2003 & MAXI_CLUSTER, NELIM,
2004 & LBANDSLAVE, NPIV, ISHIFT, NIV, KPERCENT,
2005 & KEEP8,
2006 & OMP_NUM
2007 & )
2008 USE DMUMPS_LR_TYPE, ONLY : LRB_TYPE
2009 USE DMUMPS_FAC_LR, ONLY : DMUMPS_COMPRESS_PANEL
2010 IMPLICIT NONE
2011 INTEGER(8), intent(in) :: LA, POSELT
2012 INTEGER, intent(in) :: NFRONT, NB_BLR, CURRENT_BLR, NIV
2013 INTEGER, intent(in) :: OMP_NUM
2014 INTEGER, intent(inout) :: IFLAG, IERROR
2015 TYPE(LRB_TYPE), intent(inout) :: BLR_PANEL(NB_BLR-CURRENT_BLR)
2016 DOUBLE PRECISION, intent(inout) :: A(LA)
2017 INTEGER :: MAXI_CLUSTER
2018 DOUBLE PRECISION :: RWORK(2*MAXI_CLUSTER*OMP_NUM)
2019 DOUBLE PRECISION :: BLOCK(MAXI_CLUSTER,MAXI_CLUSTER*OMP_NUM)
2020 DOUBLE PRECISION :: WORK(MAXI_CLUSTER*MAXI_CLUSTER*OMP_NUM)
2021 DOUBLE PRECISION :: TAU(MAXI_CLUSTER*OMP_NUM)
2022 INTEGER :: JPVT(MAXI_CLUSTER*OMP_NUM)
2023 INTEGER :: sizeBEGS_BLR
2024 INTEGER :: BEGS_BLR(sizeBEGS_BLR)
2025 INTEGER(8) :: KEEP8(150)
2026 INTEGER, intent(in) :: NPIV, ISHIFT, KPERCENT, K473,
2027 & TOL_OPT
2028 LOGICAL, intent(in) :: LBANDSLAVE
2029 INTEGER :: LWORK, NELIM
2030 DOUBLE PRECISION,intent(in) :: TOLEPS
2031 CHARACTER(len=1) :: DIR
2032 CALL DMUMPS_COMPRESS_PANEL(
2033 & A, LA, POSELT, IFLAG, IERROR, NFRONT,
2034 & BEGS_BLR, NB_BLR, TOLEPS, TOL_OPT, K473, BLR_PANEL,
2035 & CURRENT_BLR,
2036 & DIR, WORK, TAU, JPVT,
2037 & LWORK, RWORK, BLOCK,
2038 & MAXI_CLUSTER, NELIM,
2039 & LBANDSLAVE, NPIV, ISHIFT, NIV, KPERCENT,
2040 & KEEP8
2041 & )
2042 RETURN
2043 END SUBROUTINE DMUMPS_COMPRESS_PANEL_I_NOOPT
2044 SUBROUTINE DMUMPS_DECOMPRESS_PANEL_I_NOOPT(
2045 & A, LA, POSELT, LDA11,
2046 & LDA21, COPY_DENSE_BLOCKS,
2047 & BEGS_BLR_DIAG, BEGS_BLR_FIRST_OFFDIAG,
2048 & NB_BLR, BLR_PANEL, CURRENT_BLR, DIR,
2049 & DECOMP_TIMER)
2050 USE DMUMPS_LR_TYPE, ONLY : LRB_TYPE
2051 USE DMUMPS_FAC_LR, ONLY : DMUMPS_DECOMPRESS_PANEL
2052 IMPLICIT NONE
2053 INTEGER(8), intent(in) :: LA
2054 DOUBLE PRECISION, intent(inout) :: A(LA)
2055 INTEGER(8), intent(in) :: POSELT
2056 LOGICAL, intent(in) :: COPY_DENSE_BLOCKS
2057 INTEGER, intent(in) :: NB_BLR, CURRENT_BLR
2058 INTEGER, intent(in) :: BEGS_BLR_DIAG,
2059 & BEGS_BLR_FIRST_OFFDIAG
2060 TYPE(LRB_TYPE), intent(inout) :: BLR_PANEL(NB_BLR-CURRENT_BLR)
2061 CHARACTER(len=1) :: DIR
2062 INTEGER, intent(in) :: DECOMP_TIMER
2063 INTEGER, intent(in) :: LDA11, LDA21
2064 CALL DMUMPS_DECOMPRESS_PANEL(A, LA, POSELT, LDA11,
2065 & LDA21, COPY_DENSE_BLOCKS,
2066 & BEGS_BLR_DIAG, BEGS_BLR_FIRST_OFFDIAG,
2067 & NB_BLR, BLR_PANEL, CURRENT_BLR, DIR,
2068 & DECOMP_TIMER)
2069 RETURN
2070 END SUBROUTINE DMUMPS_DECOMPRESS_PANEL_I_NOOPT
2071 SUBROUTINE DMUMPS_BLR_UPD_NELIM_VAR_L_I(
2072 & A_U, LA_U, UPOS, A_L, LA_L, LPOS, IFLAG, IERROR, LDU, LDL,
2073 & BEGS_BLR_L, sizeBEGS_BLR_L, CURRENT_BLR, BLR_L, NB_BLR_L,
2074 & FIRST_BLOCK, NELIM, UTRANS)
2075 USE DMUMPS_LR_TYPE, ONLY : LRB_TYPE
2076 USE DMUMPS_FAC_LR, ONLY : DMUMPS_BLR_UPD_NELIM_VAR_L
2077 IMPLICIT NONE
2078 INTEGER(8), intent(in) :: LA_U, LA_L
2079 INTEGER(8), intent(in) :: UPOS, LPOS
2080 INTEGER, intent(in) :: LDU, LDL, NB_BLR_L, CURRENT_BLR,
2081 & NELIM, FIRST_BLOCK
2082 CHARACTER(len=1),INTENT(IN) :: UTRANS
2083 INTEGER, intent(inout) :: IFLAG, IERROR
2084 DOUBLE PRECISION, TARGET, intent(inout) :: A_L(LA_L), A_U(LA_U)
2085 TYPE(LRB_TYPE),intent(in) :: BLR_L(NB_BLR_L-CURRENT_BLR)
2086 INTEGER, INTENT(in) :: sizeBEGS_BLR_L
2087 INTEGER :: BEGS_BLR_L(sizeBEGS_BLR_L)
2088 CALL DMUMPS_BLR_UPD_NELIM_VAR_L(
2089 & A_U, LA_U, UPOS, A_L, LA_L, LPOS, IFLAG, IERROR, LDU, LDL,
2090 & BEGS_BLR_L, CURRENT_BLR, BLR_L, NB_BLR_L,
2091 & FIRST_BLOCK, NELIM, UTRANS)
2092 RETURN
2093 END SUBROUTINE DMUMPS_BLR_UPD_NELIM_VAR_L_I
2094 SUBROUTINE DMUMPS_BLR_SLV_UPD_TRAIL_LDLT_I(A, LA, POSELT,
2095 & IFLAG, IERROR, NCOL, NROW,
2096 & A_BLOCFACTO, LA_BLOCFACTO, LD_BLOCFACTO,
2097 & BEGS_BLR_LM, sizeBEGS_BLR_LM,
2098 & NB_BLR_LM, BLR_LM, ISHIFT_LM,
2099 & BEGS_BLR_LS, sizeBEGS_BLR_LS,
2100 & NB_BLR_LS, BLR_LS, ISHIFT_LS,
2101 & CURRENT_BLR_LM, CURRENT_BLR_LS,
2102 & IW2, BLOCK,
2103 & MAXI_CLUSTER, OMP_NUM,
2104 & MIDBLK_COMPRESS, TOLEPS, TOL_OPT, KPERCENT
2105 & )
2106 USE DMUMPS_LR_TYPE, ONLY : LRB_TYPE
2107 USE DMUMPS_FAC_LR, ONLY : DMUMPS_BLR_SLV_UPD_TRAIL_LDLT
2108 IMPLICIT NONE
2109 INTEGER(8), intent(in) :: LA, LA_BLOCFACTO
2110 DOUBLE PRECISION, intent(inout) :: A(LA)
2111 DOUBLE PRECISION, intent(in) :: A_BLOCFACTO(LA_BLOCFACTO)
2112 INTEGER(8), intent(in) :: POSELT
2113 INTEGER, intent(inout) :: IFLAG, IERROR
2114 INTEGER, intent(in) :: NCOL, NROW, IW2(*), TOL_OPT,
2115 & MAXI_CLUSTER, OMP_NUM, LD_BLOCFACTO
2116 INTEGER, intent(in) :: NB_BLR_LM, NB_BLR_LS,
2117 & ISHIFT_LM, ISHIFT_LS,
2118 & CURRENT_BLR_LM, CURRENT_BLR_LS
2119 DOUBLE PRECISION, INTENT(INOUT) ::
2120 & BLOCK(MAXI_CLUSTER,MAXI_CLUSTER*OMP_NUM)
2121 INTEGER :: sizeBEGS_BLR_LM, sizeBEGS_BLR_LS
2122 INTEGER :: BEGS_BLR_LM(sizeBEGS_BLR_LM)
2123 INTEGER :: BEGS_BLR_LS(sizeBEGS_BLR_LS)
2124 TYPE(LRB_TYPE),intent(in) :: BLR_LM(NB_BLR_LM-CURRENT_BLR_LM),
2125 & BLR_LS(NB_BLR_LS-CURRENT_BLR_LS)
2126 INTEGER,intent(in) :: MIDBLK_COMPRESS, KPERCENT
2127 DOUBLE PRECISION,intent(in) :: TOLEPS
2128 CALL DMUMPS_BLR_SLV_UPD_TRAIL_LDLT(A, LA, POSELT,
2129 & IFLAG, IERROR, NCOL, NROW,
2130 & A_BLOCFACTO, LA_BLOCFACTO, LD_BLOCFACTO,
2131 & BEGS_BLR_LM, NB_BLR_LM, BLR_LM, ISHIFT_LM,
2132 & BEGS_BLR_LS, NB_BLR_LS, BLR_LS, ISHIFT_LS,
2133 & CURRENT_BLR_LM, CURRENT_BLR_LS,
2134 & IW2, BLOCK,
2135 & MAXI_CLUSTER,
2136 & MIDBLK_COMPRESS, TOLEPS, TOL_OPT, KPERCENT
2137 & )
2138 RETURN
2139 END SUBROUTINE DMUMPS_BLR_SLV_UPD_TRAIL_LDLT_I
2140 SUBROUTINE DMUMPS_SET_INNERBLOCKSIZE( SIZE_INNER,
2141 & NASS, KEEP )
2142 IMPLICIT NONE
2143 INTEGER :: SIZE_INNER, NASS, KEEP(500)
2144.LT. IF (NASSKEEP(4)) THEN
2145 SIZE_INNER = NASS
2146.GT. ELSE IF (NASS KEEP(3)) THEN
2147 SIZE_INNER = min( KEEP(6), NASS )
2148 ELSE
2149 SIZE_INNER = min( KEEP(5), NASS )
2150 ENDIF
2151 RETURN
2152 END SUBROUTINE DMUMPS_SET_INNERBLOCKSIZE
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
dmumps_bdc_error
subroutine dmumps_bdc_error(myid, slavef, comm, keep)
Definition dbcast_int.F:38
dmumps_compre_new
subroutine dmumps_compre_new(n, keep, iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb, ptrist, ptrast, step, pimaster, pamaster, lrlus, xsize, comp, acc_time, myid, slavef, procnode_steps, dad)
Definition dfac_mem_compress_cb.F:120
dmumps_ooc_io_lu_panel_i
subroutine dmumps_ooc_io_lu_panel_i(strat, typefile, afac, lafac, monbloc, lnextpiv2bewritten, unextpiv2bewritten, iw, liwfac, myid, filesize, ierr, last_call)
Definition dtools.F:1854
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_compress_lu
subroutine dmumps_compress_lu(size_inplace, myid, n, ioldps, type, iw, liw, a, la, posfac, lrlu, lrlus, iwpos, ptrast, ptrfac, step, keep, keep8, ssarbr, inode, ierr, lrgroups, nass)
Definition dtools.F:20
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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_load
Definition dmumps_load.F:14
dmumps_load::dmumps_load_mem_update
subroutine, public dmumps_load_mem_update(ssarbr, process_bande_arg, mem_value, new_lu, inc_mem_arg, keep, keep8, lrlus)
Definition dmumps_load.F:920
dmumps_load::dmumps_load_update
subroutine, public dmumps_load_update(check_flops, process_bande, inc_load, keep, keep8)
Definition dmumps_load.F:824
dmumps_lr_core
Definition dlr_core.F:18
dmumps_ooc
Definition dmumps_ooc.F:14
dmumps_ooc::dmumps_new_factor
subroutine, public dmumps_new_factor(inode, ptrfac, keep, keep8, a, la, size, ierr)
Definition dmumps_ooc.F:285
mumps_storei8
subroutine mumps_storei8(i8, int_array)
Definition tools_common.F:871
mumps_subtri8toarray
subroutine mumps_subtri8toarray(int_array, i8)
Definition tools_common.F:913
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865
mumps_geti8
subroutine mumps_geti8(i8, int_array)
Definition tools_common.F:888
mumps_ldltpanel_storage
subroutine mumps_ldltpanel_storage(npiv, keep, iw, nb_entries)
Definition tools_common.F:1331