OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dmumps_load.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 MODULE dmumps_load
15 implicit none
16 PUBLIC :: dmumps_load_set_inicost, dmumps_load_init,
17 & dmumps_load_set_slaves, dmumps_load_update,
18 & dmumps_load_end, dmumps_load_process_message,
19 & dmumps_load_less, dmumps_load_less_cand,
20 & dmumps_load_set_slaves_cand, dmumps_load_master_2_all,
21 & dmumps_load_recv_msgs, dmumps_load_mem_update,
22 & dmumps_load_set_partition,
23 & dmumps_split_prep_partition, dmumps_split_post_partition,
24 & dmumps_split_propagate_parti, dmumps_load_pool_upd_new_pool,
25 & dmumps_load_sbtr_upd_new_pool, dmumps_load_pool_check_mem,
26 & dmumps_load_set_sbtr_mem,
27 & dmumps_remove_node, dmumps_upper_predict
28 & ,dmumps_load_send_md_info,
29 & dmumps_load_clean_meminfo_pool, dmumps_load_comp_maxmem_pool,
30 & dmumps_load_chk_memcst_pool, dmumps_check_sbtr_cost,
31 & dmumps_find_best_node_for_mem,
32 & dmumps_load_init_sbtr_struct
33 DOUBLE PRECISION, DIMENSION(:),
34 & ALLOCATABLE, SAVE, PRIVATE :: load_flops
35 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PRIVATE :: buf_load_recv
36 INTEGER, SAVE, PRIVATE :: lbuf_load_recv, lbuf_load_recv_bytes
37 INTEGER, SAVE, PRIVATE :: k50, k69, k35
38 INTEGER(8), SAVE, PRIVATE :: max_surf_master
39 LOGICAL, SAVE, PRIVATE :: bdc_mem, bdc_pool, bdc_sbtr,
40 & bdc_pool_mng,
41 & bdc_m2_mem,bdc_m2_flops,bdc_md,remove_node_flag,
42 & remove_node_flag_mem
43 DOUBLE PRECISION, SAVE, PRIVATE :: remove_node_cost,
44 & remove_node_cost_mem
45 INTEGER, SAVE, PRIVATE :: sbtr_which_m
46 DOUBLE PRECISION, DIMENSION(:),
47 & ALLOCATABLE, TARGET, SAVE, PRIVATE :: wload
48 DOUBLE PRECISION, SAVE, PRIVATE :: delta_load, delta_mem
49 LOGICAL, SAVE, PRIVATE :: is_mumps_load_enabled
50 PUBLIC:: mumps_load_enable, mumps_load_disable
51 INTEGER(8), SAVE, PRIVATE :: check_mem
52 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, TARGET, PRIVATE ::
53 & idwload
54 DOUBLE PRECISION, SAVE, PRIVATE :: cost_subtree
55 DOUBLE PRECISION, SAVE, PRIVATE :: alpha
56 DOUBLE PRECISION, SAVE, PRIVATE :: beta
57 INTEGER, SAVE, PRIVATE :: myid, nprocs, comm_ld
58 INTEGER, SAVE, PRIVATE :: comm_nodes
59 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE,
60 & PRIVATE :: pool_mem
61 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, PRIVATE,
62 & SAVE :: sbtr_mem
63 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE,
64 & PRIVATE, SAVE :: sbtr_cur
65 INTEGER, DIMENSION(:), ALLOCATABLE,
66 & PRIVATE, SAVE :: nb_son
67 DOUBLE PRECISION,
68 & PRIVATE, SAVE :: sbtr_cur_local
69 DOUBLE PRECISION,
70 & PRIVATE, SAVE :: peak_sbtr_cur_local
71 DOUBLE PRECISION,
72 & PRIVATE, SAVE :: max_peak_stk
73 DOUBLE PRECISION, SAVE,
74 & PRIVATE :: pool_last_cost_sent
75 DOUBLE PRECISION, SAVE,
76 & PRIVATE :: min_diff
77 INTEGER, SAVE :: pos_id,pos_mem
78 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: cb_cost_id
79 INTEGER(8), DIMENSION(:), ALLOCATABLE, save
80 & :: cb_cost_mem
81 PUBLIC :: cb_cost_id, cb_cost_mem,pos_mem,pos_id
82 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: lu_usage
83 INTEGER(8), DIMENSION(:), ALLOCATABLE, SAVE,
84 & PRIVATE::md_mem, tab_maxs
85 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE ::mem_subtree
86 INTEGER :: nb_subtrees,niv1_flag
87 INTEGER, PRIVATE :: indice_sbtr,indice_sbtr_array
88 INTEGER :: pool_niv2_size
89 INTEGER,SAVE :: inside_subtree
90 PUBLIC :: nb_subtrees,mem_subtree,inside_subtree,niv1_flag
91 DOUBLE PRECISION, SAVE, PRIVATE :: dm_sumlu,
92 & dm_thres_mem
93 DOUBLE PRECISION, DIMENSION(:),
94 & ALLOCATABLE, SAVE , PRIVATE:: dm_mem
95 INTEGER, SAVE, PRIVATE :: pool_size,id_max_m2
96 DOUBLE PRECISION, SAVE, PRIVATE :: max_m2,tmp_m2
97 INTEGER, DIMENSION(:),ALLOCATABLE,SAVE, PRIVATE:: pool_niv2
98 DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE,SAVE,
99 & PRIVATE :: pool_niv2_cost, niv2
100 DOUBLE PRECISION, SAVE, PRIVATE :: chk_ld
101 INTEGER, DIMENSION(:),POINTER, SAVE, PRIVATE ::
102 & procnode_load, step_to_niv2_load
103 INTEGER, DIMENSION(:),POINTER, SAVE, PRIVATE :: keep_load
104 INTEGER, SAVE, PRIVATE :: N_LOAD
105 INTEGER(8), DIMENSION(:), POINTER, SAVE, PRIVATE:: keep8_load
106 INTEGER, DIMENSION(:),POINTER, SAVE ::
107 & fils_load, step_load,
108 & frere_load, nd_load,
109 & ne_load,dad_load
110 INTEGER, DIMENSION(:,:),POINTER, SAVE, PRIVATE :: cand_load
111 INTEGER, DIMENSION(:),POINTER, SAVE,
112 & PRIVATE :: my_first_leaf,my_nb_leaf, my_root_sbtr
113 INTEGER, DIMENSION(:),ALLOCATABLE,SAVE,
114 & PRIVATE ::sbtr_first_pos_in_pool
115 DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE,SAVE,
116 & PRIVATE ::sbtr_peak_array,
117 & sbtr_cur_array
118 DOUBLE PRECISION,DIMENSION(:),POINTER, SAVE :: cost_trav
119 INTEGER, DIMENSION(:),POINTER, SAVE :: depth_first_load,
120 & depth_first_seq_load,sbtr_id_load
121 PUBLIC :: depth_first_load,cost_trav, fils_load,step_load,
122 & frere_load, nd_load,ne_load,dad_load,
123 & depth_first_seq_load,sbtr_id_load
124 INTEGER, SAVE :: root_current_subtree,current_best,
125 & second_current_best
126 PUBLIC :: root_current_subtree,current_best,
127 & second_current_best
128 CONTAINS
129 SUBROUTINE mumps_load_enable()
130 IMPLICIT NONE
131 is_mumps_load_enabled = .true.
132 RETURN
133 END SUBROUTINE mumps_load_enable
134 SUBROUTINE mumps_load_disable()
135 IMPLICIT NONE
136 is_mumps_load_enabled = .false.
137 RETURN
138 END SUBROUTINE mumps_load_disable
139 SUBROUTINE dmumps_load_set_inicost( COST_SUBTREE_ARG, K64, DK15,
140 & K375, MAXS )
141 IMPLICIT NONE
142 DOUBLE PRECISION cost_subtree_arg
143 INTEGER, INTENT(IN) :: k64, k375
144 DOUBLE PRECISION, INTENT(IN) :: dk15
145 INTEGER(8)::maxs
146 DOUBLE PRECISION :: t64, t66
147 LOGICAL :: avoid_load_messages
148 t64 = max( dble(k64), dble(1) )
149 t64 = min( t64, dble(1000) )
150 t66 = max(dble(dk15), dble(100))
151 min_diff = ( t64 / dble(1000) )*
152 & t66 * dble(1000000)
153 dm_thres_mem = dble(maxs/300_8)
154 cost_subtree = cost_subtree_arg
155 avoid_load_messages = .false.
156 IF (k375.EQ.1) THEN
157 avoid_load_messages = .true.
158 ENDIF
159 IF (avoid_load_messages) THEN
160 min_diff = min_diff * 1000.d0
161 dm_thres_mem = dm_thres_mem * 1000_8
162 ENDIF
163 RETURN
164 END SUBROUTINE dmumps_load_set_inicost
165 SUBROUTINE dmumps_split_prep_partition (
166 & INODE, STEP, N, SLAVEF,
167 & PROCNODE_STEPS, KEEP, DAD, FILS,
168 & CAND, ICNTL, COPY_CAND,
169 & NBSPLIT, NUMORG_SPLIT, SLAVES_LIST,
170 & SIZE_SLAVES_LIST
171 & )
172 IMPLICIT NONE
173 INTEGER, intent(in) :: inode, n, size_slaves_list, slavef,
174 & keep(500)
175 INTEGER, intent(in) :: step(n), dad (keep(28)), icntl(60),
176 & procnode_steps(keep(28)), cand(slavef+1),
177 & fils(n)
178 INTEGER, intent(out) :: nbsplit, numorg_split
179 INTEGER, intent(inout) :: slaves_list(size_slaves_list),
180 & copy_cand(slavef+1)
181 INTEGER :: in, lp, ii
182 INTEGER mumps_typesplit
183 EXTERNAL mumps_typesplit
184 lp = icntl(1)
185 in = inode
186 nbsplit = 0
187 numorg_split = 0
188 DO WHILE
189 & (
190 & ( mumps_typesplit
191 & (procnode_steps(step(dad(step(in)))),keep(199))
192 & .EQ.5
193 & )
194 & .OR.
195 & ( mumps_typesplit
196 & (procnode_steps(step(dad(step(in)))),keep(199))
197 & .EQ.6
198 & )
199 & )
200 nbsplit = nbsplit + 1
201 in = dad(step(in))
202 ii = in
203 DO WHILE (ii.GT.0)
204 numorg_split = numorg_split + 1
205 ii = fils(ii)
206 ENDDO
207 END DO
208 slaves_list(1:nbsplit) = cand(1:nbsplit)
209 copy_cand(1:size_slaves_list-nbsplit) =
210 & cand(1+nbsplit:size_slaves_list)
211 copy_cand(size_slaves_list-nbsplit+1:slavef) = -1
212 copy_cand(slavef+1) = size_slaves_list-nbsplit
213 RETURN
214 END SUBROUTINE dmumps_split_prep_partition
215 SUBROUTINE dmumps_split_post_partition (
216 & INODE, STEP, N, SLAVEF, NBSPLIT, NCB,
217 & PROCNODE_STEPS, KEEP, DAD, FILS, ICNTL,
218 & TAB_POS, NSLAVES_NODE
219 & )
220 IMPLICIT NONE
221 INTEGER, intent(in) :: INODE, n, slavef, ncb,
222 & keep(500), nbsplit
223 INTEGER, intent(in) :: step(n), dad (keep(28)), icntl(60),
224 & procnode_steps(keep(28)),
225 & fils(n)
226 INTEGER, intent(inout) :: tab_pos ( slavef+2 ), nslaves_node
227 INTEGER :: in, lp, ii, numorg, nbsplit_loc, i
228 INTEGER mumps_typesplit
229 EXTERNAL mumps_typesplit
230 do i= nslaves_node+1, 1, -1
231 tab_pos(i+nbsplit) = tab_pos(i)
232 END DO
233 lp = icntl(1)
234 in = inode
235 nbsplit_loc = 0
236 numorg = 0
237 tab_pos(1) = 1
238 DO WHILE
239 & (
240 & ( mumps_typesplit
241 & (procnode_steps(step(dad(step(in)))),keep(199))
242 & .EQ.5
243 & )
244 & .OR.
245 & ( mumps_typesplit
246 & (procnode_steps(step(dad(step(in)))),keep(199))
247 & .EQ.6
248 & )
249 & )
250 nbsplit_loc = nbsplit_loc + 1
251 in = dad(step(in))
252 ii = in
253 DO WHILE (ii.GT.0)
254 numorg = numorg + 1
255 ii = fils(ii)
256 ENDDO
257 tab_pos(nbsplit_loc+1) = numorg + 1
258 END DO
259 DO i = nbsplit+2, nbsplit+nslaves_node+1
260 tab_pos(i) = tab_pos(i) + numorg
261 ENDDO
262 nslaves_node = nslaves_node + nbsplit
263 tab_pos(nslaves_node+2:slavef+1) = -9999
264 tab_pos( slavef+2 ) = nslaves_node
265 RETURN
266 END SUBROUTINE dmumps_split_post_partition
267 SUBROUTINE dmumps_split_propagate_parti (
268 & INODE, TYPESPLIT, IFSON,
269 & CAND, SIZE_CAND,
270 & SON_SLAVE_LIST, NSLSON,
271 & STEP, N, SLAVEF,
272 & PROCNODE_STEPS, KEEP, DAD, FILS, ICNTL,
273 & ISTEP_TO_INIV2, INIV2,
274 & TAB_POS_IN_PERE, NSLAVES_NODE,
275 & SLAVES_LIST, SIZE_SLAVES_LIST
276 & )
277 IMPLICIT NONE
278 INTEGER, intent(in) :: inode, typesplit, ifson, n, slavef,
279 & keep(500),
280 & nslson, size_slaves_list, size_cand
281 INTEGER, intent(in) :: step(n), dad (keep(28)), icntl(60),
282 & procnode_steps(keep(28)),
283 & fils(n), iniv2,
284 & son_slave_list(nslson),
285 & istep_to_iniv2(keep(71)),
286 & cand(size_cand)
287 INTEGER, intent(out) :: nslaves_node
288 INTEGER, intent(inout) ::
289 & tab_pos_in_pere(slavef+2,max(1,keep(56)))
290 INTEGER, intent(out) :: slaves_list (size_slaves_list)
291 INTEGER :: in, lp, i, nslaves_sons,
292 & iniv2_fils, ishift
293 lp = icntl(1)
294 in = inode
295 iniv2_fils = istep_to_iniv2( step( ifson ))
296 nslaves_sons = tab_pos_in_pere(slavef+2, iniv2_fils)
297 tab_pos_in_pere(1,iniv2) = 1
298 ishift = tab_pos_in_pere(2, iniv2_fils) -1
299 DO i = 2, nslaves_sons
300 tab_pos_in_pere(i,iniv2) =
301 & tab_pos_in_pere(i+1,iniv2_fils) - ishift
302 slaves_list(i-1) = son_slave_list(i)
303 END DO
304 tab_pos_in_pere(nslaves_sons+1:slavef+1,iniv2) = -9999
305 nslaves_node = nslaves_sons - 1
306 tab_pos_in_pere(slavef+2, iniv2) = nslaves_node
307 RETURN
308 END SUBROUTINE dmumps_split_propagate_parti
309 SUBROUTINE dmumps_load_set_partition(
310 & NCBSON_MAX, SLAVEF,
311 & KEEP,KEEP8,ICNTL,
312 & CAND_OF_NODE,
313 & MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE,
314 & TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST,INODE
315 &)
316 IMPLICIT NONE
317 INTEGER, intent(in) :: KEEP(500),size_slaves_list
318 INTEGER(8) keep8(150)
319 INTEGER, intent(in) :: icntl(60)
320 INTEGER, intent(in) :: slavef, nfront
321 INTEGER, intent (inout) ::ncb
322 INTEGER, intent(in) :: cand_of_node(slavef+1)
323 INTEGER, intent(in) :: MEM_DISTRIB(0:slavef-1),inode
324 INTEGER, intent(in) :: NCBSON_MAX
325 INTEGER, intent(out):: slaves_list(size_slaves_list)
326 INTEGER, intent(out):: tab_pos(slavef+2)
327 INTEGER, intent(out):: nslaves_node
328 INTEGER i
329 INTEGER lp,mp
330 INTEGER(8) dummy1
331 INTEGER dummy2
332 INTEGER tmp_array(2)
333 lp=icntl(4)
334 mp=icntl(2)
335 IF ( keep(48) == 0 .OR. keep(48) .EQ. 3 ) THEN
336 CALL dmumps_load_parti_regular(
337 & slavef,
338 & keep,keep8,
339 & cand_of_node,
340 & mem_distrib, ncb, nfront, nslaves_node,
341 & tab_pos, slaves_list, size_slaves_list)
342 ELSE IF ( keep(48) == 4 ) THEN
343 CALL dmumps_set_parti_actv_mem(
344 & slavef,
345 & keep,keep8,
346 & cand_of_node,
347 & mem_distrib, ncb, nfront, nslaves_node,
348 & tab_pos, slaves_list, size_slaves_list,myid)
349 DO i=1,nslaves_node
350 IF(tab_pos(i+1)-tab_pos(i).LE.0)THEN
351 WRITE(*,*)'probleme de partition dans
352 &DMUMPS_LOAD_SET_PARTI_ACTV_MEM'
353 CALL mumps_abort()
354 ENDIF
355 ENDDO
356 ELSE IF ( keep(48) == 5 ) THEN
357 IF (keep(375).EQ.1) THEN
358 GOTO 458
359 ENDIF
360 CALL dmumps_set_parti_flop_irr(
361 & ncbson_max,
362 & slavef,
363 & keep,keep8,
364 & cand_of_node,
365 & mem_distrib, ncb, nfront, nslaves_node,
366 & tab_pos, slaves_list, size_slaves_list,myid,inode,
367 & mp,lp)
368 DO i=1,nslaves_node
369 IF(tab_pos(i+1)-tab_pos(i).LE.0)THEN
370 WRITE(*,*)'problem with partition in
371 &DMUMPS_SET_PARTI_FLOP_IRR'
372 CALL mumps_abort()
373 ENDIF
374 ENDDO
375 GOTO 457
376 458 CONTINUE
377 IF ( keep(375).EQ.1 )THEN
378 tmp_array(1)=0
379 tmp_array(2)=0
380 ENDIF
381 CALL mumps_set_parti_regular(
382 & slavef,
383 & keep,keep8,
384 & cand_of_node,
385 & mem_distrib, ncb, nfront, nslaves_node,
386 & tab_pos, slaves_list, size_slaves_list,myid,inode,
387 & tab_maxs,tmp_array,dummy1,dummy2
388 & )
389 ELSE
390 WRITE(*,*) "Strategy 6 not implemented"
391 CALL mumps_abort()
392 ENDIF
393 457 CONTINUE
394 RETURN
395 END SUBROUTINE dmumps_load_set_partition
396 SUBROUTINE dmumps_load_parti_regular(
397 & SLAVEF,
398 & KEEP,KEEP8,
399 & CAND_OF_NODE,
400 & MEM_DISTRIB, NCB, NFRONT, NSLAVES_NODE,
401 & TAB_POS, SLAVES_LIST, SIZE_SLAVES_LIST)
402 IMPLICIT NONE
403 INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
404 INTEGER(8) KEEP8(150)
405 INTEGER, intent(in) :: SLAVEF, NFRONT, NCB
406 INTEGER, intent(in) :: CAND_OF_NODE(SLAVEF+1)
407 INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1)
408 INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
409 INTEGER, intent(out):: TAB_POS(SLAVEF+2)
410 INTEGER, intent(out):: NSLAVES_NODE
411 INTEGER ITEMP, NMB_OF_CAND, NSLAVES_LESS
412 DOUBLE PRECISION MSG_SIZE
413 LOGICAL FORCE_CAND
414 INTEGER MUMPS_REG_GET_NSLAVES
415 EXTERNAL MUMPS_REG_GET_NSLAVES
416 IF ( KEEP(48) == 0 .AND. keep(50) .NE. 0) THEN
417 write(*,*) "Internal error 2 in DMUMPS_LOAD_PARTI_REGULAR."
418 CALL mumps_abort()
419 END IF
420 IF ( keep(48) == 3 .AND. keep(50) .EQ. 0) THEN
421 write(*,*) "Internal error 3 in DMUMPS_LOAD_PARTI_REGULAR."
422 CALL mumps_abort()
423 END IF
424 msg_size = dble( nfront - ncb ) * dble(ncb)
425 IF ( keep(24) == 0 .OR. keep(24) == 1 ) THEN
426 force_cand = .false.
427 ELSE
428 force_cand = (mod(keep(24),2).eq.0)
429 END IF
430 IF (force_cand) THEN
431 itemp=dmumps_load_less_cand
432 & (mem_distrib,
433 & cand_of_node,
434 &
435 & keep(69), slavef, msg_size,
436 & nmb_of_cand )
437 ELSE
438 itemp=dmumps_load_less(keep(69),mem_distrib,msg_size)
439 nmb_of_cand = slavef - 1
440 END IF
441 nslaves_less = max(itemp,1)
442 nslaves_node = mumps_reg_get_nslaves(keep8(21), keep(48),
443 & keep(50),slavef,
444 & ncb, nfront, nslaves_less, nmb_of_cand,
445 & keep(375), keep(119))
446 CALL mumps_bloc2_setpartition(
447 & keep,keep8, slavef,
448 & tab_pos,
449 & nslaves_node, nfront, ncb
450 & )
451 IF (force_cand) THEN
452 CALL dmumps_load_set_slaves_cand(mem_distrib(0),
453 & cand_of_node, slavef, nslaves_node,
454 & slaves_list)
455 ELSE
456 CALL dmumps_load_set_slaves(mem_distrib(0),
457 & msg_size, slaves_list, nslaves_node)
458 ENDIF
459 RETURN
460 END SUBROUTINE dmumps_load_parti_regular
461 SUBROUTINE dmumps_load_init( id, MEMORY_MD_ARG, MAXS )
462 USE dmumps_buf
463 USE dmumps_struc_def
464 USE mumps_future_niv2
465 IMPLICIT NONE
466 TYPE(dmumps_struc), TARGET :: id
467 INTEGER(8), intent(in) :: memory_md_arg
468 INTEGER(8), intent(in) :: maxs
469 INTEGER k34_loc
470 INTEGER(8) :: i8size
471 INTEGER allocok, ierr, ierr_mpi, i, buf_load_size
472 DOUBLE PRECISION :: max_sbtr
473 DOUBLE PRECISION zero
474 DOUBLE PRECISION memory_sent
475 PARAMETER( zero=0.0d0 )
476 DOUBLE PRECISION size_dble(2)
477 INTEGER what
478 INTEGER(8) memory_md, la
479 call MUMPS_LOAD_ENABLE()
480 step_to_niv2_load=>id%ISTEP_TO_INIV2
481 cand_load=>id%CANDIDATES
482 nd_load=>id%ND_STEPS
483 keep_load=>id%KEEP
484 keep8_load=>id%KEEP8
485 fils_load=>id%FILS
486 frere_load=>id%FRERE_STEPS
487 dad_load=>id%DAD_STEPS
488 procnode_load=>id%PROCNODE_STEPS
489 step_load=>id%STEP
490 ne_load=>id%NE_STEPS
491 n_load=id%N
492 root_current_subtree=-9999
493 memory_md=memory_md_arg
494 la=maxs
495 max_surf_master=id%MAX_SURF_MASTER+
496 & (int(id%KEEP(12),8)*int(id%MAX_SURF_MASTER,8)/int(100,8))
497 comm_ld = id%COMM_LOAD
498 comm_nodes = id%COMM_NODES
499 max_peak_stk = 0.0d0
500 k69 = id%KEEP(69)
501 IF ( id%KEEP(47) .le. 0 .OR. id%KEEP(47) .gt. 4 ) THEN
502 write(*,*) "Internal error 1 in DMUMPS_LOAD_INIT"
503 CALL mumps_abort()
504 END IF
505 chk_ld=dble(0)
506 bdc_mem = ( id%KEEP(47) >= 2 )
507 bdc_pool = ( id%KEEP(47) >= 3 )
508 bdc_sbtr = ( id%KEEP(47) >= 4 )
509 bdc_m2_mem = ( ( id%KEEP(80) == 2 .OR. id%KEEP(80) == 3 )
510 & .AND. id%KEEP(47) == 4 )
511 bdc_m2_flops = ( id%KEEP(80) == 1
512 & .AND. id%KEEP(47) .GE. 1 )
513 bdc_md = (id%KEEP(86)==1)
514 sbtr_which_m = id%KEEP(90)
515 remove_node_flag=.false.
516 remove_node_flag_mem=.false.
517 remove_node_cost_mem=dble(0)
518 remove_node_cost=dble(0)
519 IF (id%KEEP(80) .LT. 0 .OR. id%KEEP(80)>3) THEN
520 WRITE(*,*) "Unimplemented KEEP(80) Strategy"
521 CALL mumps_abort()
522 ENDIF
523 IF ((id%KEEP(80) == 2 .OR. id%KEEP(80)==3).AND. id%KEEP(47).NE.4)
524 & THEN
525 WRITE(*,*) "Internal error 3 in DMUMPS_LOAD_INIT"
526 CALL mumps_abort()
527 END IF
528 IF (id%KEEP(81) == 1 .AND. id%KEEP(47) < 2) THEN
529 WRITE(*,*) "Internal error 2 in DMUMPS_LOAD_INIT"
530 CALL mumps_abort()
531 ENDIF
532 bdc_pool_mng = ((id%KEEP(81) == 1).AND.(id%KEEP(47) >= 2))
533 IF(id%KEEP(76).EQ.4)THEN
534 depth_first_load=>id%DEPTH_FIRST
535 ENDIF
536 IF(id%KEEP(76).EQ.5)THEN
537 cost_trav=>id%COST_TRAV
538 ENDIF
539 IF(id%KEEP(76).EQ.6)THEN
540 depth_first_load=>id%DEPTH_FIRST
541 depth_first_seq_load=>id%DEPTH_FIRST_SEQ
542 sbtr_id_load=>id%SBTR_ID
543 ENDIF
544 IF (bdc_m2_mem.OR.bdc_m2_flops) THEN
545 pool_niv2_size=max(1,min(id%NBSA+id%KEEP(262),id%NA(1)))
546 ALLOCATE(niv2(id%NSLAVES), nb_son(id%KEEP(28)),
547 & pool_niv2(pool_niv2_size),
548 & pool_niv2_cost(pool_niv2_size),
549 & stat=allocok)
550 DO i = 1, id%KEEP(28)
551 nb_son(i)=id%NE_STEPS(i)
552 ENDDO
553 niv2=dble(0)
554 IF (allocok > 0) THEN
555 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
556 id%INFO(1) = -13
557 id%INFO(2) = id%NSLAVES + id%KEEP(28) + 200
558 RETURN
559 ENDIF
560 ENDIF
561 k50 = id%KEEP(50)
562 CALL mpi_comm_rank( comm_ld, myid, ierr_mpi )
563 nprocs = id%NSLAVES
564 dm_sumlu=zero
565 pool_size=0
566 IF(bdc_md)THEN
567 IF ( allocated(md_mem) ) DEALLOCATE(md_mem)
568 ALLOCATE( md_mem( 0: nprocs - 1 ), stat=allocok )
569 IF ( allocok .gt. 0 ) THEN
570 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
571 id%INFO(1) = -13
572 id%INFO(2) = nprocs
573 RETURN
574 END IF
575 IF ( allocated(tab_maxs) ) DEALLOCATE(tab_maxs)
576 ALLOCATE( tab_maxs( 0: nprocs - 1 ), stat=allocok )
577 IF ( allocok .gt. 0 ) THEN
578 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
579 id%INFO(1) = -13
580 id%INFO(2) = nprocs
581 RETURN
582 END IF
583 tab_maxs=0_8
584 IF ( allocated(lu_usage) ) DEALLOCATE(lu_usage)
585 ALLOCATE( lu_usage( 0: nprocs - 1 ), stat=allocok )
586 IF ( allocok .gt. 0 ) THEN
587 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
588 id%INFO(1) = -13
589 id%INFO(2) = nprocs
590 RETURN
591 END IF
592 lu_usage=dble(0)
593 md_mem=int(0,8)
594 ENDIF
595 IF((id%KEEP(81).EQ.2).OR.(id%KEEP(81).EQ.3))THEN
596 ALLOCATE(cb_cost_mem(2*2000*id%NSLAVES),
597 & stat=allocok)
598 IF (allocok > 0) THEN
599 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
600 id%INFO(1) = -13
601 id%INFO(2) = id%NSLAVES
602 RETURN
603 ENDIF
604 cb_cost_mem=int(0,8)
605 ALLOCATE(cb_cost_id(2000*3),
606 & stat=allocok)
607 IF (allocok > 0) THEN
608 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
609 id%INFO(1) = -13
610 id%INFO(2) = id%NSLAVES
611 RETURN
612 ENDIF
613 cb_cost_id=0
614 pos_mem=1
615 pos_id=1
616 ENDIF
617 ALLOCATE(future_niv2(nprocs), stat=allocok)
618 IF (allocok > 0 ) THEN
619 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
620 id%INFO(1) = -13
621 id%INFO(2) = nprocs
622 RETURN
623 ENDIF
624 DO i = 1, nprocs
625 future_niv2(i) = id%FUTURE_NIV2(i)
626 IF(bdc_md)THEN
627 IF(future_niv2(i).EQ.0)THEN
628 md_mem(i-1)=999999999_8
629 ENDIF
630 ENDIF
631 ENDDO
632 delta_mem=zero
633 delta_load=zero
634 check_mem=0_8
635 IF(bdc_sbtr.OR.bdc_pool_mng)THEN
636 nb_subtrees=id%NBSA_LOCAL
637 IF (allocated(mem_subtree)) DEALLOCATE(mem_subtree)
638 ALLOCATE(mem_subtree(id%NBSA_LOCAL),stat=allocok)
639 IF (allocok > 0 ) THEN
640 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
641 id%INFO(1) = -13
642 id%INFO(2) = id%NBSA_LOCAL
643 RETURN
644 ENDIF
645 DO i=1,id%NBSA_LOCAL
646 mem_subtree(i)=id%MEM_SUBTREE(i)
647 ENDDO
648 my_first_leaf=>id%MY_FIRST_LEAF
649 my_nb_leaf=>id%MY_NB_LEAF
650 my_root_sbtr=>id%MY_ROOT_SBTR
651 IF (allocated(sbtr_first_pos_in_pool))
652 & DEALLOCATE(sbtr_first_pos_in_pool)
653 ALLOCATE(sbtr_first_pos_in_pool(id%NBSA_LOCAL),stat=allocok)
654 IF (allocok > 0 ) THEN
655 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
656 id%INFO(1) = -13
657 id%INFO(2) = id%NBSA_LOCAL
658 RETURN
659 ENDIF
660 inside_subtree=0
661 peak_sbtr_cur_local = dble(0)
662 sbtr_cur_local = dble(0)
663 IF (allocated(sbtr_peak_array)) DEALLOCATE(sbtr_peak_array)
664 ALLOCATE(sbtr_peak_array(id%NBSA_LOCAL),stat=allocok)
665 IF (allocok > 0 ) THEN
666 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
667 id%INFO(1) = -13
668 id%INFO(2) = id%NBSA_LOCAL
669 RETURN
670 ENDIF
671 sbtr_peak_array=dble(0)
672 IF (allocated(sbtr_cur_array)) DEALLOCATE(sbtr_cur_array)
673 ALLOCATE(sbtr_cur_array(id%NBSA_LOCAL),stat=allocok)
674 IF (allocok > 0 ) THEN
675 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
676 id%INFO(1) = -13
677 id%INFO(2) = id%NBSA_LOCAL
678 RETURN
679 ENDIF
680 sbtr_cur_array=dble(0)
681 indice_sbtr_array=1
682 niv1_flag=0
683 indice_sbtr=1
684 ENDIF
685 IF ( allocated(load_flops) ) DEALLOCATE( load_flops )
686 ALLOCATE( load_flops( 0: nprocs - 1 ), stat=allocok )
687 IF ( allocok .gt. 0 ) THEN
688 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
689 id%INFO(1) = -13
690 id%INFO(2) = nprocs
691 RETURN
692 END IF
693 IF ( allocated(wload) ) DEALLOCATE( wload )
694 ALLOCATE( wload( nprocs ), stat=allocok )
695 IF ( allocok .gt. 0 ) THEN
696 WRITE(*,*) 'PB allocation in DMUMPS_LOAD_INIT'
697 id%INFO(1) = -13
698 id%INFO(2) = nprocs
699 RETURN
700 END IF
701 IF ( allocated(idwload) ) DEALLOCATE( idwload )
702 ALLOCATE( idwload( nprocs ), stat=allocok )
703 IF ( allocok .gt. 0 ) THEN
704 WRITE(*,*) 'pb allocation in dmumps_load_init'
705 id%INFO(1) = -13
706 id%INFO(2) = NPROCS
707 RETURN
708 END IF
709 IF ( BDC_MEM ) THEN
710 IF ( allocated(DM_MEM) ) DEALLOCATE( DM_MEM )
711 ALLOCATE( DM_MEM( 0:NPROCS-1 ), stat=allocok )
712.gt. IF ( allocok 0 ) THEN
713 WRITE(*,*) 'pb allocation in dmumps_load_init'
714 id%INFO(1) = -13
715 id%INFO(2) = NPROCS
716 RETURN
717 END IF
718 END IF
719 IF ( BDC_POOL ) THEN
720 IF ( allocated(POOL_MEM) ) DEALLOCATE(POOL_MEM)
721 ALLOCATE( POOL_MEM(0: NPROCS -1), stat=allocok)
722.gt. IF ( allocok 0 ) THEN
723 WRITE(*,*) 'pb allocation in dmumps_load_init'
724 id%INFO(1) = -13
725 id%INFO(2) = NPROCS
726 RETURN
727 END IF
728 POOL_MEM = dble(0)
729 POOL_LAST_COST_SENT = dble(0)
730 END IF
731 IF ( BDC_SBTR ) THEN
732 IF ( allocated(SBTR_MEM) ) DEALLOCATE(SBTR_MEM)
733 ALLOCATE( SBTR_MEM(0: NPROCS -1), stat=allocok)
734.gt. IF ( allocok 0 ) THEN
735 WRITE(*,*) 'pb allocation in dmumps_load_init'
736 id%INFO(1) = -13
737 id%INFO(2) = NPROCS
738 RETURN
739 END IF
740 IF ( allocated(SBTR_CUR) ) DEALLOCATE(SBTR_CUR)
741 ALLOCATE( SBTR_CUR(0: NPROCS -1), stat=allocok)
742.gt. IF ( allocok 0 ) THEN
743 WRITE(*,*) 'pb allocation in dmumps_load_init'
744 id%INFO(1) = -13
745 id%INFO(2) = NPROCS
746 RETURN
747 END IF
748 SBTR_CUR = dble(0)
749 SBTR_MEM = dble(0)
750 END IF
751 K34_LOC=id%KEEP(34)
752 CALL MUMPS_SIZE_C(SIZE_DBLE(1),SIZE_DBLE(2),I8SIZE)
753 K35 = int(I8SIZE)
754 BUF_LOAD_SIZE = K34_LOC * 2 * ( NPROCS - 1 ) +
755 & NPROCS * ( K35 + K34_LOC )
756 IF (BDC_MEM) THEN
757 BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35
758 END IF
759 IF (BDC_SBTR)THEN
760 BUF_LOAD_SIZE = BUF_LOAD_SIZE + NPROCS * K35
761 ENDIF
762 LBUF_LOAD_RECV = (BUF_LOAD_SIZE+K34_LOC)/K34_LOC
763 LBUF_LOAD_RECV_BYTES = LBUF_LOAD_RECV * K34_LOC
764 IF ( allocated(BUF_LOAD_RECV) ) DEALLOCATE(BUF_LOAD_RECV)
765 ALLOCATE( BUF_LOAD_RECV( LBUF_LOAD_RECV), stat=allocok)
766 IF ( allocok > 0 ) THEN
767 WRITE(*,*) 'pb allocation in dmumps_load_init'
768 id%INFO(1) = -13
769 id%INFO(2) = LBUF_LOAD_RECV
770 RETURN
771 ENDIF
772 BUF_LOAD_SIZE = BUF_LOAD_SIZE * 20
773 CALL DMUMPS_BUF_ALLOC_LOAD_BUFFER( BUF_LOAD_SIZE, IERR )
774.LT. IF ( IERR 0 ) THEN
775 id%INFO(1) = -13
776 id%INFO(2) = BUF_LOAD_SIZE
777 RETURN
778 END IF
779 DO i = 0, NPROCS - 1
780 LOAD_FLOPS( i ) = ZERO
781 END DO
782 IF ( BDC_MEM ) THEN
783 DO i = 0, NPROCS - 1
784 DM_MEM( i )=ZERO
785 END DO
786 ENDIF
787 CALL DMUMPS_INIT_ALPHA_BETA(id%KEEP(69))
788 IF(BDC_MD)THEN
789 MAX_SBTR=0.0D0
790 IF(BDC_SBTR)THEN
791 DO i=1,id%NBSA_LOCAL
792 MAX_SBTR=max(id%MEM_SUBTREE(i),MAX_SBTR)
793 ENDDO
794 ENDIF
795 MD_MEM(MYID)=MEMORY_MD
796 WHAT=8
797 CALL DMUMPS_BUF_BROADCAST( WHAT,
798 & COMM_LD, NPROCS,
799 & FUTURE_NIV2,
800 & dble(MEMORY_MD),dble(0) ,MYID, id%KEEP, IERR )
801 WHAT=9
802 MEMORY_SENT = dble(LA-MAX_SURF_MASTER)-MAX_SBTR
803 & - max( dble(LA) * dble(3) / dble(100),
804 & dble(2) *
805 & dble(max(id%KEEP(5),id%KEEP(6))) * dble(id%KEEP(127)))
806 IF (id%KEEP(12) > 25) THEN
807 MEMORY_SENT = MEMORY_SENT -
808 & dble(id%KEEP(12))*0.2d0*dble(LA)/100.0d0
809 ENDIF
810.EQ. IF (id%KEEP(375)1) THEN
811 MEMORY_SENT=dble(LA)
812 ENDIF
813 TAB_MAXS(MYID)=int(MEMORY_SENT,8)
814 CALL DMUMPS_BUF_BROADCAST( WHAT,
815 & COMM_LD, NPROCS,
816 & FUTURE_NIV2,
817 & MEMORY_SENT,
818 & dble(0),MYID, id%KEEP, IERR )
819 ENDIF
820 RETURN
821 END SUBROUTINE DMUMPS_LOAD_INIT
822 SUBROUTINE DMUMPS_LOAD_UPDATE( CHECK_FLOPS,PROCESS_BANDE,
823 & INC_LOAD, KEEP,KEEP8 )
824 USE DMUMPS_BUF
825 USE MUMPS_FUTURE_NIV2
826 IMPLICIT NONE
827 DOUBLE PRECISION INC_LOAD
828 INTEGER KEEP(500)
829 INTEGER(8) KEEP8(150)
830 LOGICAL PROCESS_BANDE
831 LOGICAL :: EXIT_FLAG
832 INTEGER CHECK_FLOPS
833 INTEGER IERR
834 DOUBLE PRECISION ZERO, SEND_MEM, SEND_LOAD,SBTR_TMP
835 PARAMETER( ZERO=0.0d0 )
836 INTRINSIC max
837.NOT. IF ( IS_MUMPS_LOAD_ENABLED) RETURN
838 IF (INC_LOAD == 0.0D0) THEN
839 IF(REMOVE_NODE_FLAG)THEN
840 REMOVE_NODE_FLAG=.FALSE.
841 ENDIF
842 RETURN
843 ENDIF
844.NE..AND. IF((CHECK_FLOPS0)
845.NE..AND..NE. & (CHECK_FLOPS1)(CHECK_FLOPS2))THEN
846 WRITE(*,*)MYID,': bad value for check_flops'
847 CALL MUMPS_ABORT()
848 ENDIF
849.EQ. IF(CHECK_FLOPS1)THEN
850 CHK_LD=CHK_LD+INC_LOAD
851 ELSE
852.EQ. IF(CHECK_FLOPS2)THEN
853 RETURN
854 ENDIF
855 ENDIF
856 IF ( PROCESS_BANDE ) THEN
857 RETURN
858 ENDIF
859 LOAD_FLOPS( MYID ) = max( LOAD_FLOPS( MYID ) + INC_LOAD, ZERO)
860.AND. IF(BDC_M2_FLOPSREMOVE_NODE_FLAG)THEN
861.NE. IF(INC_LOADREMOVE_NODE_COST)THEN
862.GT. IF(INC_LOADREMOVE_NODE_COST)THEN
863 DELTA_LOAD = DELTA_LOAD +
864 & (INC_LOAD-REMOVE_NODE_COST)
865 GOTO 888
866 ELSE
867 DELTA_LOAD = DELTA_LOAD -
868 & (REMOVE_NODE_COST-INC_LOAD)
869 GOTO 888
870 ENDIF
871 ENDIF
872 GOTO 333
873 ENDIF
874 DELTA_LOAD = DELTA_LOAD + INC_LOAD
875 888 CONTINUE
876.OR. IF ( DELTA_LOAD > MIN_DIFF DELTA_LOAD < -MIN_DIFF) THEN
877 SEND_LOAD = DELTA_LOAD
878 IF (BDC_MEM) THEN
879 SEND_MEM = DELTA_MEM
880 ELSE
881 SEND_MEM = ZERO
882 END IF
883 IF(BDC_SBTR)THEN
884 SBTR_TMP=SBTR_CUR(MYID)
885 ELSE
886 SBTR_TMP=dble(0)
887 ENDIF
888 111 CONTINUE
889 CALL DMUMPS_BUF_SEND_UPDATE_LOAD( BDC_SBTR,BDC_MEM,
890 & BDC_MD,COMM_LD, NPROCS,
891 & SEND_LOAD,
892 & SEND_MEM,SBTR_TMP,
893 & DM_SUMLU,
894 & FUTURE_NIV2,
895 & MYID, KEEP, IERR )
896 IF ( IERR == -1 )THEN
897 CALL DMUMPS_LOAD_RECV_MSGS(COMM_LD)
898 CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
899 IF (EXIT_FLAG) THEN
900 GOTO 333
901 ELSE
902 GOTO 111
903 ENDIF
904.NE. ELSE IF ( IERR 0 ) THEN
905 WRITE(*,*) "Internal Error in DMUMPS_LOAD_UPDATE",IERR
906 CALL MUMPS_ABORT()
907 ENDIF
908 DELTA_LOAD = ZERO
909 IF (BDC_MEM) DELTA_MEM = ZERO
910 ENDIF
911 333 CONTINUE
912 IF(REMOVE_NODE_FLAG)THEN
913 REMOVE_NODE_FLAG=.FALSE.
914 ENDIF
915 RETURN
916 END SUBROUTINE DMUMPS_LOAD_UPDATE
917 SUBROUTINE DMUMPS_LOAD_MEM_UPDATE( SSARBR,
918 & PROCESS_BANDE_ARG, MEM_VALUE, NEW_LU, INC_MEM_ARG,
919 & KEEP,KEEP8,LRLUS)
920 USE DMUMPS_BUF
921 USE MUMPS_FUTURE_NIV2
922 IMPLICIT NONE
923 INTEGER(8), INTENT(IN) :: MEM_VALUE, INC_MEM_ARG, NEW_LU,LRLUS
924 LOGICAL, INTENT(IN) :: PROCESS_BANDE_ARG, SSARBR
925 INTEGER IERR, KEEP(500)
926 INTEGER(8) KEEP8(150)
927 DOUBLE PRECISION ZERO, SEND_MEM, SBTR_TMP
928 PARAMETER( ZERO=0.0d0 )
929 INTRINSIC max, abs
930 INTEGER(8) :: INC_MEM
931 LOGICAL PROCESS_BANDE
932 LOGICAL :: EXIT_FLAG
933.NOT. IF ( IS_MUMPS_LOAD_ENABLED) RETURN
934 PROCESS_BANDE=PROCESS_BANDE_ARG
935 INC_MEM = INC_MEM_ARG
936.AND..NE. IF ( PROCESS_BANDE NEW_LU 0_8) THEN
937 WRITE(*,*) " Internal Error in DMUMPS_LOAD_MEM_UPDATE."
938 WRITE(*,*) " NEW_LU must be zero if called from PROCESS_BANDE"
939 CALL MUMPS_ABORT()
940 ENDIF
941 DM_SUMLU = DM_SUMLU + dble(NEW_LU)
942.EQ. IF(KEEP_LOAD(201)0)THEN
943 CHECK_MEM = CHECK_MEM + INC_MEM
944 ELSE
945 CHECK_MEM = CHECK_MEM + INC_MEM - NEW_LU
946 ENDIF
947.NE. IF ( MEM_VALUE CHECK_MEM ) THEN
948 WRITE(*,*)MYID,
949 & ':problem with increments in dmumps_load_mem_update',
950 & CHECK_MEM, MEM_VALUE, INC_MEM,NEW_LU
951 CALL MUMPS_ABORT()
952 ENDIF
953 IF (PROCESS_BANDE) THEN
954 RETURN
955 ENDIF
956 IF(BDC_POOL_MNG) THEN
957.EQ. IF(SBTR_WHICH_M0)THEN
958 IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+
959 & dble(INC_MEM-NEW_LU)
960 ELSE
961 IF (SSARBR) SBTR_CUR_LOCAL = SBTR_CUR_LOCAL+
962 & dble(INC_MEM)
963 ENDIF
964 ENDIF
965.NOT. IF ( BDC_MEM ) THEN
966 RETURN
967 ENDIF
968.AND. IF (BDC_SBTR SSARBR) THEN
969.EQ..AND..NE. IF((SBTR_WHICH_M0)(KEEP(201)0))THEN
970 SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM-NEW_LU)
971 ELSE
972 SBTR_CUR(MYID) = SBTR_CUR(MYID)+dble(INC_MEM)
973 ENDIF
974 SBTR_TMP = SBTR_CUR(MYID)
975 ELSE
976 SBTR_TMP=dble(0)
977 ENDIF
978 IF ( NEW_LU > 0_8 ) THEN
979 INC_MEM = INC_MEM - NEW_LU
980 ENDIF
981 DM_MEM( MYID ) = DM_MEM(MYID) + dble(INC_MEM)
982 MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MYID))
983.AND. IF(BDC_M2_MEMREMOVE_NODE_FLAG_MEM)THEN
984.NE. IF(dble(INC_MEM)REMOVE_NODE_COST_MEM)THEN
985.GT. IF(dble(INC_MEM)REMOVE_NODE_COST_MEM)THEN
986 DELTA_MEM = DELTA_MEM +
987 & (dble(INC_MEM)-REMOVE_NODE_COST_MEM)
988 GOTO 888
989 ELSE
990 DELTA_MEM = DELTA_MEM -
991 & (REMOVE_NODE_COST_MEM-dble(INC_MEM))
992 GOTO 888
993 ENDIF
994 ENDIF
995 GOTO 333
996 ENDIF
997 DELTA_MEM = DELTA_MEM + dble(INC_MEM)
998 888 CONTINUE
999.NE..OR. IF ((KEEP(48)5)
1000.EQ..AND. & ((KEEP(48)5)(abs(DELTA_MEM)
1001.GE. & 0.2d0*dble(LRLUS))))THEN
1002 IF ( abs(DELTA_MEM) > DM_THRES_MEM ) THEN
1003 SEND_MEM = DELTA_MEM
1004 111 CONTINUE
1005 CALL DMUMPS_BUF_SEND_UPDATE_LOAD(
1006 & BDC_SBTR,
1007 & BDC_MEM,BDC_MD, COMM_LD,
1008 & NPROCS,
1009 & DELTA_LOAD,
1010 & SEND_MEM,SBTR_TMP,
1011 & DM_SUMLU,
1012 & FUTURE_NIV2,
1013 & MYID, KEEP, IERR )
1014 IF ( IERR == -1 )THEN
1015 CALL DMUMPS_LOAD_RECV_MSGS(COMM_LD)
1016 CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
1017 IF (EXIT_FLAG) THEN
1018 GOTO 333
1019 ELSE
1020 GOTO 111
1021 ENDIF
1022.NE. ELSE IF ( IERR 0 ) THEN
1023 WRITE(*,*) "Internal Error in DMUMPS_LOAD_MEM_UPDATE",IERR
1024 CALL MUMPS_ABORT()
1025 ENDIF
1026 DELTA_LOAD = ZERO
1027 DELTA_MEM = ZERO
1028 ENDIF
1029 ENDIF
1030 333 CONTINUE
1031 IF(REMOVE_NODE_FLAG_MEM)THEN
1032 REMOVE_NODE_FLAG_MEM=.FALSE.
1033 ENDIF
1034 END SUBROUTINE DMUMPS_LOAD_MEM_UPDATE
1035 INTEGER FUNCTION DMUMPS_LOAD_LESS( K69, MEM_DISTRIB,MSG_SIZE )
1036 IMPLICIT NONE
1037 INTEGER i, NLESS, K69
1038 INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB
1039 DOUBLE PRECISION LREF
1040 DOUBLE PRECISION MSG_SIZE
1041 NLESS = 0
1042 DO i=1,NPROCS
1043 IDWLOAD(i) = i - 1
1044 ENDDO
1045 WLOAD(1:NPROCS) = LOAD_FLOPS(0:NPROCS-1)
1046 IF(BDC_M2_FLOPS)THEN
1047 DO i=1,NPROCS
1048 WLOAD(i)=WLOAD(i)+NIV2(i)
1049 ENDDO
1050 ENDIF
1051.gt. IF(K69 1) THEN
1052 CALL DMUMPS_ARCHGENWLOAD(MEM_DISTRIB,MSG_SIZE,IDWLOAD,NPROCS)
1053 ENDIF
1054 LREF = LOAD_FLOPS(MYID)
1055 DO i=1, NPROCS
1056.LT. IF (WLOAD(i)LREF) NLESS=NLESS+1
1057 ENDDO
1058 DMUMPS_LOAD_LESS = NLESS
1059 RETURN
1060 END FUNCTION DMUMPS_LOAD_LESS
1061 SUBROUTINE DMUMPS_LOAD_SET_SLAVES(MEM_DISTRIB,MSG_SIZE,DEST,
1062 & NSLAVES)
1063 IMPLICIT NONE
1064 INTEGER NSLAVES
1065 INTEGER DEST(NSLAVES)
1066 INTEGER, DIMENSION(0:NPROCS - 1) :: MEM_DISTRIB
1067 INTEGER i,J,NBDEST
1068 DOUBLE PRECISION MSG_SIZE
1069.eq. IF ( NSLAVESNPROCS-1 ) THEN
1070 J = MYID+1
1071 DO i=1,NSLAVES
1072 J=J+1
1073.GT. IF (JNPROCS) J=1
1074 DEST(i) = J - 1
1075 ENDDO
1076 ELSE
1077 DO i=1,NPROCS
1078 IDWLOAD(i) = i - 1
1079 ENDDO
1080 CALL MUMPS_SORT_DOUBLES(NPROCS, WLOAD, IDWLOAD)
1081 NBDEST = 0
1082 DO i=1, NSLAVES
1083 J = IDWLOAD(i)
1084.NE. IF (JMYID) THEN
1085 NBDEST = NBDEST+1
1086 DEST(NBDEST) = J
1087 ENDIF
1088 ENDDO
1089.NE. IF (NBDESTNSLAVES) THEN
1090 DEST(NSLAVES) = IDWLOAD(NSLAVES+1)
1091 ENDIF
1092 IF(BDC_MD)THEN
1093 J=NSLAVES+1
1094 do i=NSLAVES+1,NPROCS
1095.NE. IF(IDWLOAD(i)MYID)THEN
1096 DEST(J)= IDWLOAD(i)
1097 J=J+1
1098 ENDIF
1099 end do
1100 ENDIF
1101 ENDIF
1102 RETURN
1103 END SUBROUTINE DMUMPS_LOAD_SET_SLAVES
1104 SUBROUTINE DMUMPS_LOAD_END( INFO1, NSLAVES, IERR )
1105 USE DMUMPS_BUF
1106 USE MUMPS_FUTURE_NIV2
1107 IMPLICIT NONE
1108 INTEGER, INTENT(IN) :: INFO1
1109 INTEGER, INTENT(IN) :: NSLAVES
1110 INTEGER, INTENT(OUT) :: IERR
1111 INTEGER :: DUMMY_COMMUNICATOR
1112 IERR=0
1113 DUMMY_COMMUNICATOR = -999
1114 CALL DMUMPS_CLEAN_PENDING( INFO1, KEEP_LOAD(1), BUF_LOAD_RECV(1),
1115 & LBUF_LOAD_RECV,
1116 & LBUF_LOAD_RECV_BYTES, DUMMY_COMMUNICATOR, COMM_LD,
1117 & NSLAVES,
1118 & .FALSE.,
1119 & .TRUE.
1120 & )
1121 DEALLOCATE( LOAD_FLOPS )
1122 DEALLOCATE( WLOAD )
1123 DEALLOCATE( IDWLOAD )
1124 DEALLOCATE(FUTURE_NIV2)
1125 IF(BDC_MD)THEN
1126 DEALLOCATE(MD_MEM)
1127 DEALLOCATE(LU_USAGE)
1128 DEALLOCATE(TAB_MAXS)
1129 ENDIF
1130 IF ( BDC_MEM ) DEALLOCATE( DM_MEM )
1131 IF ( BDC_POOL) DEALLOCATE( POOL_MEM )
1132 IF ( BDC_SBTR) THEN
1133 DEALLOCATE( SBTR_MEM )
1134 DEALLOCATE( SBTR_CUR )
1135 DEALLOCATE(SBTR_FIRST_POS_IN_POOL)
1136 NULLIFY(MY_FIRST_LEAF)
1137 NULLIFY(MY_NB_LEAF)
1138 NULLIFY(MY_ROOT_SBTR)
1139 ENDIF
1140.EQ. IF(KEEP_LOAD(76)4)THEN
1141 NULLIFY(DEPTH_FIRST_LOAD)
1142 ENDIF
1143.EQ. IF(KEEP_LOAD(76)5)THEN
1144 NULLIFY(COST_TRAV)
1145 ENDIF
1146.EQ..OR..EQ. IF((KEEP_LOAD(76)4)(KEEP_LOAD(76)6))THEN
1147 NULLIFY(DEPTH_FIRST_LOAD)
1148 NULLIFY(DEPTH_FIRST_SEQ_LOAD)
1149 NULLIFY(SBTR_ID_LOAD)
1150 ENDIF
1151.OR. IF (BDC_M2_MEMBDC_M2_FLOPS) THEN
1152 DEALLOCATE(NB_SON,POOL_NIV2,POOL_NIV2_COST, NIV2)
1153 END IF
1154.EQ..OR..EQ. IF((KEEP_LOAD(81)2)(KEEP_LOAD(81)3))THEN
1155 DEALLOCATE(CB_COST_MEM)
1156 DEALLOCATE(CB_COST_ID)
1157 ENDIF
1158 NULLIFY(ND_LOAD)
1159 NULLIFY(KEEP_LOAD)
1160 NULLIFY(KEEP8_LOAD)
1161 NULLIFY(FILS_LOAD)
1162 NULLIFY(FRERE_LOAD)
1163 NULLIFY(PROCNODE_LOAD)
1164 NULLIFY(STEP_LOAD)
1165 NULLIFY(NE_LOAD)
1166 NULLIFY(CAND_LOAD)
1167 NULLIFY(STEP_TO_NIV2_LOAD)
1168 NULLIFY(DAD_LOAD)
1169.OR. IF (BDC_SBTRBDC_POOL_MNG) THEN
1170 DEALLOCATE(MEM_SUBTREE)
1171 DEALLOCATE(SBTR_PEAK_ARRAY)
1172 DEALLOCATE(SBTR_CUR_ARRAY)
1173 ENDIF
1174 CALL DMUMPS_BUF_DEALL_LOAD_BUFFER( IERR )
1175 DEALLOCATE(BUF_LOAD_RECV)
1176 RETURN
1177 END SUBROUTINE DMUMPS_LOAD_END
1178 RECURSIVE SUBROUTINE DMUMPS_LOAD_RECV_MSGS(COMM)
1179 IMPLICIT NONE
1180 INCLUDE 'mpif.h'
1181 INCLUDE 'mumps_tags.h'
1182 INTEGER MSGTAG, MSGLEN, MSGSOU,COMM
1183 INTEGER IERR_MPI
1184 INTEGER :: STATUS(MPI_STATUS_SIZE)
1185 LOGICAL FLAG
1186 10 CONTINUE
1187 CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM,
1188 & FLAG, STATUS, IERR_MPI )
1189 IF (FLAG) THEN
1190 KEEP_LOAD(65)=KEEP_LOAD(65)+1
1191 KEEP_LOAD(267)=KEEP_LOAD(267)-1
1192 MSGTAG = STATUS( MPI_TAG )
1193 MSGSOU = STATUS( MPI_SOURCE )
1194.NE. IF ( MSGTAG UPDATE_LOAD) THEN
1195 write(*,*) "Internal error 1 in DMUMPS_LOAD_RECV_MSGS",
1196 & MSGTAG
1197 CALL MUMPS_ABORT()
1198 ENDIF
1199 CALL MPI_GET_COUNT(STATUS, MPI_PACKED, MSGLEN, IERR_MPI)
1200 IF ( MSGLEN > LBUF_LOAD_RECV_BYTES ) THEN
1201 write(*,*) "Internal error 2 in DMUMPS_LOAD_RECV_MSGS",
1202 & MSGLEN, LBUF_LOAD_RECV_BYTES
1203 CALL MUMPS_ABORT()
1204 ENDIF
1205 CALL MPI_RECV( BUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES,
1206 & MPI_PACKED, MSGSOU, MSGTAG, COMM_LD, STATUS, IERR_MPI)
1207 CALL DMUMPS_LOAD_PROCESS_MESSAGE( MSGSOU, BUF_LOAD_RECV,
1208 & LBUF_LOAD_RECV, LBUF_LOAD_RECV_BYTES )
1209 GOTO 10
1210 ENDIF
1211 RETURN
1212 END SUBROUTINE DMUMPS_LOAD_RECV_MSGS
1213 RECURSIVE SUBROUTINE DMUMPS_LOAD_PROCESS_MESSAGE
1214 & ( MSGSOU, BUFR, LBUFR, LBUFR_BYTES )
1215 USE MUMPS_FUTURE_NIV2
1216 IMPLICIT NONE
1217 INTEGER MSGSOU, LBUFR, LBUFR_BYTES
1218 INTEGER BUFR( LBUFR )
1219 INCLUDE 'mpif.h'
1220 INTEGER POSITION, WHAT, NSLAVES, i
1221 INTEGER IERR_MPI
1222 DOUBLE PRECISION LOAD_RECEIVED
1223 INTEGER INODE_RECEIVED,NCB_RECEIVED
1224 DOUBLE PRECISION SURF
1225 INTEGER, POINTER, DIMENSION (:) :: LIST_SLAVES
1226 DOUBLE PRECISION, POINTER, DIMENSION (:) :: LOAD_INCR
1227 EXTERNAL MUMPS_TYPENODE
1228 INTEGER MUMPS_TYPENODE
1229 POSITION = 0
1230 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1231 & WHAT, 1, MPI_INTEGER,
1232 & COMM_LD, IERR_MPI )
1233 IF ( WHAT == 0 ) THEN
1234 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1235 & LOAD_RECEIVED, 1,
1236 & MPI_DOUBLE_PRECISION,
1237 & COMM_LD, IERR_MPI )
1238 LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED
1239 IF ( BDC_MEM ) THEN
1240 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1241 & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION,
1242 & COMM_LD, IERR_MPI )
1243 DM_MEM(MSGSOU) = DM_MEM(MSGSOU) + LOAD_RECEIVED
1244 MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(MSGSOU))
1245 END IF
1246 IF(BDC_SBTR)THEN
1247 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1248 & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION,
1249 & COMM_LD, IERR_MPI )
1250 SBTR_CUR(MSGSOU)=LOAD_RECEIVED
1251 ENDIF
1252 IF(BDC_MD)THEN
1253 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1254 & LOAD_RECEIVED, 1, MPI_DOUBLE_PRECISION,
1255 & COMM_LD, IERR_MPI )
1256.EQ. IF(KEEP_LOAD(201)0)THEN
1257 LU_USAGE(MSGSOU)=LOAD_RECEIVED
1258 ENDIF
1259 ENDIF
1260.OR..EQ. ELSEIF (( WHAT == 1)(WHAT19)) THEN
1261 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1262 & NSLAVES, 1, MPI_INTEGER,
1263 & COMM_LD, IERR_MPI )
1264 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1265 & INODE_RECEIVED, 1, MPI_INTEGER,
1266 & COMM_LD, IERR_MPI )
1267 LIST_SLAVES => IDWLOAD
1268 LOAD_INCR => WLOAD
1269 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1270 & LIST_SLAVES(1), NSLAVES, MPI_INTEGER,
1271 & COMM_LD, IERR_MPI)
1272 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1273 & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION,
1274 & COMM_LD, IERR_MPI)
1275 DO i = 1, NSLAVES
1276 LOAD_FLOPS(LIST_SLAVES(i)) =
1277 & LOAD_FLOPS(LIST_SLAVES(i)) +
1278 & LOAD_INCR(i)
1279 END DO
1280 IF ( BDC_MEM ) THEN
1281 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1282 & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION,
1283 & COMM_LD, IERR_MPI)
1284 DO i = 1, NSLAVES
1285 DM_MEM(LIST_SLAVES(i)) = DM_MEM(LIST_SLAVES(i)) +
1286 & LOAD_INCR(i)
1287 MAX_PEAK_STK=max(MAX_PEAK_STK,DM_MEM(LIST_SLAVES(i)))
1288 END DO
1289 END IF
1290.EQ. IF(WHAT19)THEN
1291 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1292 & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION,
1293 & COMM_LD, IERR_MPI)
1294 CALL DMUMPS_LOAD_CLEAN_MEMINFO_POOL(INODE_RECEIVED)
1295 CB_COST_ID(POS_ID)=INODE_RECEIVED
1296 CB_COST_ID(POS_ID+1)=NSLAVES
1297 CB_COST_ID(POS_ID+2)=POS_MEM
1298 POS_ID=POS_ID+3
1299 DO i=1,NSLAVES
1300 WRITE(*,*)MYID,':',LIST_SLAVES(i),'->',LOAD_INCR(i)
1301 CB_COST_MEM(POS_MEM)=int(LIST_SLAVES(i),8)
1302 POS_MEM=POS_MEM+1
1303 CB_COST_MEM(POS_MEM)=int(LOAD_INCR(i),8)
1304 POS_MEM=POS_MEM+1
1305 ENDDO
1306 ENDIF
1307 NULLIFY( LIST_SLAVES )
1308 NULLIFY( LOAD_INCR )
1309 ELSE IF (WHAT == 2 ) THEN
1310.not. IF ( BDC_POOL ) THEN
1311 WRITE(*,*) "Internal error 2 in DMUMPS_LOAD_PROCESS_MESSAGE"
1312 CALL MUMPS_ABORT()
1313 END IF
1314 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1315 & LOAD_RECEIVED, 1,
1316 & MPI_DOUBLE_PRECISION,
1317 & COMM_LD, IERR_MPI )
1318 POOL_MEM(MSGSOU)=LOAD_RECEIVED
1319 ELSE IF ( WHAT == 3 ) THEN
1320.NOT. IF ( BDC_SBTR) THEN
1321 WRITE(*,*) "Internal error 3 in DMUMPS_LOAD_PROCESS_MESSAGE"
1322 CALL MUMPS_ABORT()
1323 ENDIF
1324 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1325 & LOAD_RECEIVED, 1,
1326 & MPI_DOUBLE_PRECISION,
1327 & COMM_LD, IERR_MPI )
1328 SBTR_MEM(MSGSOU)=SBTR_MEM(MSGSOU)+LOAD_RECEIVED
1329 ELSE IF (WHAT == 4) THEN
1330 FUTURE_NIV2(MSGSOU+1)=0
1331 IF(BDC_MD)THEN
1332 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1333 & SURF, 1, MPI_DOUBLE_PRECISION,
1334 & COMM_LD, IERR_MPI )
1335 MD_MEM(MSGSOU)=999999999_8
1336 TAB_MAXS(MSGSOU)=TAB_MAXS(MSGSOU)+int(SURF,8)
1337 ENDIF
1338.OR. IF(BDC_M2_MEMBDC_M2_FLOPS)THEN
1339 ENDIF
1340 ELSE IF (WHAT == 5) THEN
1341.NOT..AND..NOT. IF((BDC_M2_MEM)(BDC_M2_FLOPS))THEN
1342 WRITE(*,*) "Internal error 7 in DMUMPS_LOAD_PROCESS_MESSAGE"
1343 CALL MUMPS_ABORT()
1344 ENDIF
1345 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1346 & INODE_RECEIVED, 1,
1347 & MPI_INTEGER,
1348 & COMM_LD, IERR_MPI )
1349 IF(BDC_M2_MEM) THEN
1350 CALL DMUMPS_PROCESS_NIV2_MEM_MSG(INODE_RECEIVED)
1351 ELSEIF(BDC_M2_FLOPS) THEN
1352 CALL DMUMPS_PROCESS_NIV2_FLOPS_MSG(INODE_RECEIVED)
1353 ENDIF
1354.EQ..OR..EQ. IF((KEEP_LOAD(81)2)(KEEP_LOAD(81)3))THEN
1355 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1356 & INODE_RECEIVED, 1,
1357 & MPI_INTEGER,
1358 & COMM_LD, IERR_MPI )
1359 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1360 & NCB_RECEIVED, 1,
1361 & MPI_INTEGER,
1362 & COMM_LD, IERR_MPI )
1363 IF(
1364 & MUMPS_TYPENODE(PROCNODE_LOAD(STEP_LOAD(INODE_RECEIVED)),
1365.EQ. & KEEP_LOAD(199))1
1366 & )THEN
1367 CB_COST_ID(POS_ID)=INODE_RECEIVED
1368 CB_COST_ID(POS_ID+1)=1
1369 CB_COST_ID(POS_ID+2)=POS_MEM
1370 POS_ID=POS_ID+3
1371 CB_COST_MEM(POS_MEM)=int(MSGSOU,8)
1372 POS_MEM=POS_MEM+1
1373 CB_COST_MEM(POS_MEM)=int(NCB_RECEIVED,8)*
1374 & int(NCB_RECEIVED,8)
1375 POS_MEM=POS_MEM+1
1376 ENDIF
1377 ENDIF
1378 ELSE IF ( WHAT == 6 ) THEN
1379.NOT..AND..NOT. IF((BDC_M2_MEM)(BDC_M2_FLOPS))THEN
1380 WRITE(*,*) "Internal error 8 in DMUMPS_LOAD_PROCESS_MESSAGE"
1381 CALL MUMPS_ABORT()
1382 ENDIF
1383 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1384 & LOAD_RECEIVED, 1,
1385 & MPI_DOUBLE_PRECISION,
1386 & COMM_LD, IERR_MPI )
1387 IF(BDC_M2_MEM) THEN
1388 NIV2(MSGSOU+1) = LOAD_RECEIVED
1389 ELSEIF(BDC_M2_FLOPS) THEN
1390 NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED
1391.LT. IF(NIV2(MSGSOU+1)0.0D0)THEN
1392.LE. IF(abs(NIV2(MSGSOU+1)) 1.0D-3) THEN
1393 NIV2(MSGSOU+1)=0.0D0
1394 ELSE
1395 WRITE(*,*)'problem with niv2_flops message',
1396 & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED
1397 CALL MUMPS_ABORT()
1398 ENDIF
1399 ENDIF
1400 ENDIF
1401 ELSEIF(WHAT == 17)THEN
1402 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1403 & LOAD_RECEIVED, 1,
1404 & MPI_DOUBLE_PRECISION,
1405 & COMM_LD, IERR_MPI )
1406 IF(BDC_M2_MEM) THEN
1407 NIV2(MSGSOU+1) = LOAD_RECEIVED
1408 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1409 & LOAD_RECEIVED, 1,
1410 & MPI_DOUBLE_PRECISION,
1411 & COMM_LD, IERR_MPI )
1412 IF(BDC_MD)THEN
1413 DM_MEM(MYID)=DM_MEM(MYID)+LOAD_RECEIVED
1414 ELSEIF(BDC_POOL)THEN
1415 POOL_MEM(MSGSOU)=LOAD_RECEIVED
1416 ENDIF
1417 ELSEIF(BDC_M2_FLOPS) THEN
1418 NIV2(MSGSOU+1) = NIV2(MSGSOU+1) + LOAD_RECEIVED
1419.LT. IF(NIV2(MSGSOU+1)0.0D0)THEN
1420.LE. IF(abs(NIV2(MSGSOU+1)) 1.0D-3) THEN
1421 NIV2(MSGSOU+1)=0.0D0
1422 ELSE
1423 WRITE(*,*)'problem with niv2_flops message',
1424 & NIV2(MSGSOU+1),MSGSOU,LOAD_RECEIVED
1425 CALL MUMPS_ABORT()
1426 ENDIF
1427 ENDIF
1428 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1429 & LOAD_RECEIVED, 1,
1430 & MPI_DOUBLE_PRECISION,
1431 & COMM_LD, IERR_MPI )
1432 LOAD_FLOPS( MSGSOU ) = LOAD_FLOPS(MSGSOU) + LOAD_RECEIVED
1433 ENDIF
1434 ELSEIF ( WHAT == 7 ) THEN
1435.NOT. IF(BDC_MD)THEN
1436 WRITE(*,*)MYID,': internal error 4
1437 &in dmumps_load_process_message'
1438 CALL MUMPS_ABORT()
1439 ENDIF
1440 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1441 & NSLAVES, 1, MPI_INTEGER,
1442 & COMM_LD, IERR_MPI )
1443 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1444 & INODE_RECEIVED, 1, MPI_INTEGER,
1445 & COMM_LD, IERR_MPI )
1446 LIST_SLAVES => IDWLOAD
1447 LOAD_INCR => WLOAD
1448 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1449 & LIST_SLAVES(1), NSLAVES, MPI_INTEGER,
1450 & COMM_LD, IERR_MPI )
1451 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1452 & LOAD_INCR(1), NSLAVES, MPI_DOUBLE_PRECISION,
1453 & COMM_LD, IERR_MPI )
1454 DO i = 1, NSLAVES
1455 MD_MEM(LIST_SLAVES(i)) =
1456 & MD_MEM(LIST_SLAVES(i)) +
1457 & int(LOAD_INCR(i),8)
1458.EQ. IF(FUTURE_NIV2(LIST_SLAVES(i)+1)0)THEN
1459 MD_MEM(LIST_SLAVES(i))=999999999_8
1460 ENDIF
1461 END DO
1462 ELSEIF ( WHAT == 8 ) THEN
1463.NOT. IF(BDC_MD)THEN
1464 WRITE(*,*)MYID,': internal error 5
1465 &in dmumps_load_process_message'
1466 CALL MUMPS_ABORT()
1467 ENDIF
1468 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1469 & LOAD_RECEIVED, 1,
1470 & MPI_DOUBLE_PRECISION,
1471 & COMM_LD, IERR_MPI )
1472 MD_MEM(MSGSOU)=MD_MEM(MSGSOU)+int(LOAD_RECEIVED,8)
1473.EQ. IF(FUTURE_NIV2(MSGSOU+1)0)THEN
1474 MD_MEM(MSGSOU)=999999999_8
1475 ENDIF
1476 ELSEIF ( WHAT == 9 ) THEN
1477.NOT. IF(BDC_MD)THEN
1478 WRITE(*,*)MYID,': internal error 6
1479 &in dmumps_load_process_message'
1480 CALL MUMPS_ABORT()
1481 ENDIF
1482 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1483 & LOAD_RECEIVED, 1,
1484 & MPI_DOUBLE_PRECISION,
1485 & COMM_LD, IERR_MPI )
1486 TAB_MAXS(MSGSOU)=int(LOAD_RECEIVED,8)
1487 ELSE
1488 WRITE(*,*) "Internal error 1 in DMUMPS_LOAD_PROCESS_MESSAGE"
1489 CALL MUMPS_ABORT()
1490 END IF
1491 RETURN
1492 END SUBROUTINE DMUMPS_LOAD_PROCESS_MESSAGE
1493 integer function DMUMPS_LOAD_LESS_CAND
1494 & (MEM_DISTRIB,CAND,
1495 & K69,
1496 & SLAVEF,MSG_SIZE,
1497 & NMB_OF_CAND )
1498 implicit none
1499 integer, intent(in) :: K69, SLAVEF
1500 INTEGER, intent(in) :: CAND(SLAVEF+1)
1501 INTEGER, DIMENSION(0:NPROCS - 1), intent(in) :: MEM_DISTRIB
1502 INTEGER, intent(out) :: NMB_OF_CAND
1503 integer i,nless
1504 DOUBLE PRECISION lref
1505 DOUBLE PRECISION MSG_SIZE
1506 nless = 0
1507 NMB_OF_CAND=CAND(SLAVEF+1)
1508 do i=1,NMB_OF_CAND
1509 WLOAD(i)=LOAD_FLOPS(CAND(i))
1510 IF(BDC_M2_FLOPS)THEN
1511 WLOAD(i)=WLOAD(i)+NIV2(CAND(i)+1)
1512 ENDIF
1513 end do
1514.gt. IF(K69 1) THEN
1515 CALL DMUMPS_ARCHGENWLOAD(MEM_DISTRIB,MSG_SIZE,
1516 & CAND,NMB_OF_CAND)
1517 ENDIF
1518 lref = LOAD_FLOPS(MYID)
1519 do i=1, NMB_OF_CAND
1520.lt. if (WLOAD(i)lref) nless=nless+1
1521 end do
1522 DMUMPS_LOAD_LESS_CAND = nless
1523 return
1524 end function DMUMPS_LOAD_LESS_CAND
1525 subroutine DMUMPS_LOAD_SET_SLAVES_CAND
1526 & (MEM_DISTRIB,CAND,
1527 &
1528 & SLAVEF,
1529 & nslaves_inode, DEST)
1530 implicit none
1531 integer, intent(in) :: nslaves_inode, SLAVEF
1532 integer, intent(in) :: CAND(SLAVEF+1)
1533 integer, dimension(0:NPROCS - 1), intent(in) :: MEM_DISTRIB
1534 integer, intent(out) :: DEST(CAND(SLAVEF+1))
1535 integer i,j,NMB_OF_CAND
1536 external MUMPS_SORT_DOUBLES
1537 NMB_OF_CAND = CAND(SLAVEF+1)
1538.ge..or. if(nslaves_inodeNPROCS
1539.gt. & nslaves_inodeNMB_OF_CAND) then
1540 write(*,*)'internal error in dmumps_load_set_slaves_cand',
1541 & nslaves_inode, NPROCS, NMB_OF_CAND
1542 CALL MUMPS_ABORT()
1543 end if
1544.eq. if (nslaves_inodeNPROCS-1) then
1545 j=MYID+1
1546 do i=1,nslaves_inode
1547.ge. if(jNPROCS) j=0
1548 DEST(i)=j
1549 j=j+1
1550 end do
1551 else
1552 do i=1,NMB_OF_CAND
1553 IDWLOAD(i)=i
1554 end do
1555 call MUMPS_SORT_DOUBLES(NMB_OF_CAND,
1556 & WLOAD(1),IDWLOAD(1) )
1557 do i=1,nslaves_inode
1558 DEST(i)= CAND(IDWLOAD(i))
1559 end do
1560 IF(BDC_MD)THEN
1561 do i=nslaves_inode+1,NMB_OF_CAND
1562 DEST(i)= CAND(IDWLOAD(i))
1563 end do
1564 ENDIF
1565 end if
1566 return
1567 end subroutine DMUMPS_LOAD_SET_SLAVES_CAND
1568 SUBROUTINE DMUMPS_INIT_ALPHA_BETA(K69)
1569 IMPLICIT NONE
1570 INTEGER K69
1571.LE. IF (K69 4) THEN
1572 ALPHA = 0.0d0
1573 BETA = 0.0d0
1574 RETURN
1575 ENDIF
1576.EQ. IF (K69 5) THEN
1577 ALPHA = 0.5d0
1578 BETA = 50000.0d0
1579 RETURN
1580 ENDIF
1581.EQ. IF (K69 6) THEN
1582 ALPHA = 0.5d0
1583 BETA = 100000.0d0
1584 RETURN
1585 ENDIF
1586.EQ. IF (K69 7) THEN
1587 ALPHA = 0.5d0
1588 BETA = 150000.0d0
1589 RETURN
1590 ENDIF
1591.EQ. IF (K69 8) THEN
1592 ALPHA = 1.0d0
1593 BETA = 50000.0d0
1594 RETURN
1595 ENDIF
1596.EQ. IF (K69 9) THEN
1597 ALPHA = 1.0d0
1598 BETA = 100000.0d0
1599 RETURN
1600 ENDIF
1601.EQ. IF (K69 10) THEN
1602 ALPHA = 1.0d0
1603 BETA = 150000.0d0
1604 RETURN
1605 ENDIF
1606.EQ. IF (K69 11) THEN
1607 ALPHA = 1.5d0
1608 BETA = 50000.0d0
1609 RETURN
1610 ENDIF
1611.EQ. IF (K69 12) THEN
1612 ALPHA = 1.5d0
1613 BETA = 100000.0d0
1614 RETURN
1615 ENDIF
1616 ALPHA = 1.5d0
1617 BETA = 150000.0d0
1618 RETURN
1619 END SUBROUTINE DMUMPS_INIT_ALPHA_BETA
1620 SUBROUTINE DMUMPS_ARCHGENWLOAD(MEM_DISTRIB,MSG_SIZE,ARRAY_ADM,LEN)
1621 IMPLICIT NONE
1622 INTEGER i,LEN
1623 INTEGER, DIMENSION(0:NPROCS-1) :: MEM_DISTRIB
1624 DOUBLE PRECISION MSG_SIZE,FORBIGMSG
1625 INTEGER ARRAY_ADM(LEN)
1626 DOUBLE PRECISION MY_LOAD
1627 FORBIGMSG = 1.0d0
1628.lt. IF (K69 2) THEN
1629 RETURN
1630 ENDIF
1631 IF(BDC_M2_FLOPS)THEN
1632 MY_LOAD=LOAD_FLOPS(MYID)+NIV2(MYID+1)
1633 ELSE
1634 MY_LOAD=LOAD_FLOPS(MYID)
1635 ENDIF
1636.gt. IF((MSG_SIZE * dble(K35) ) 3200000.0d0) THEN
1637 FORBIGMSG = 2.0d0
1638 ENDIF
1639.le. IF (K69 4) THEN
1640 DO i = 1,LEN
1641.EQ..AND. IF ((MEM_DISTRIB(ARRAY_ADM(i)) 1)
1642.LT. & WLOAD(i) MY_LOAD ) THEN
1643 WLOAD(i) = WLOAD(i)/MY_LOAD
1644 ELSE
1645.NE. IF ( MEM_DISTRIB(ARRAY_ADM(i)) 1 ) THEN
1646 WLOAD(i) = WLOAD(i) *
1647 & dble(MEM_DISTRIB(ARRAY_ADM(i)))
1648 & * FORBIGMSG
1649 & + dble(2)
1650 ENDIF
1651 ENDIF
1652 ENDDO
1653 RETURN
1654 ENDIF
1655 DO i = 1,LEN
1656.EQ..AND. IF ((MEM_DISTRIB(ARRAY_ADM(i)) 1)
1657.LT. & WLOAD(i) MY_LOAD ) THEN
1658 WLOAD(i) = WLOAD(i) / MY_LOAD
1659 ELSE
1660.NE. IF(MEM_DISTRIB(ARRAY_ADM(i)) 1) THEN
1661 WLOAD(i) = (WLOAD(i) +
1662 & ALPHA * MSG_SIZE * dble(K35) +
1663 & BETA) * FORBIGMSG
1664 ENDIF
1665 ENDIF
1666 ENDDO
1667 RETURN
1668 END SUBROUTINE DMUMPS_ARCHGENWLOAD
1669 SUBROUTINE DMUMPS_LOAD_MASTER_2_ALL(MYID, SLAVEF, COMM,
1670 & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES, NSLAVES,INODE)
1671 USE DMUMPS_BUF
1672 USE MUMPS_FUTURE_NIV2
1673 IMPLICIT NONE
1674 INTEGER, INTENT (IN) :: MYID, SLAVEF, COMM, NASS, NSLAVES
1675 INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2)
1676 INTEGER, INTENT (IN) :: LIST_SLAVES( NSLAVES )
1677 INTEGER KEEP(500)
1678 INTEGER(8) KEEP8(150)
1679 INTEGER NCB, NFRONT, NBROWS_SLAVE
1680 INTEGER i, IERR,WHAT,INODE, allocok
1681 LOGICAL :: EXIT_FLAG
1682 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: MEM_INCREMENT
1683 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: FLOPS_INCREMENT
1684 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: CB_BAND
1685 ALLOCATE(MEM_INCREMENT(NSLAVES), stat=allocok)
1686.ne. if(allocok0) then
1687 WRITE(6,*) ' allocation error of mem_increment '
1688 & // 'in routine dmumps_load_master_2_all'
1689 CALL mumps_abort()
1690 endif
1691 ALLOCATE(flops_increment(nslaves), stat=allocok)
1692 if(allocok.ne.0) then
1693 WRITE(6,*) ' Allocation error of FLOPS_INCREMENT '
1694 & // 'in routine DMUMPS_LOAD_MASTER_2_ALL'
1695 CALL mumps_abort()
1696 endif
1697 ALLOCATE(cb_band(nslaves), stat=allocok)
1698 if(allocok.ne.0) then
1699 WRITE(6,*) ' Allocation error of CB_BAND '
1700 & // 'in routine DMUMPS_LOAD_MASTER_2_ALL'
1701 CALL mumps_abort()
1702 endif
1703 IF((keep(81).NE.2).AND.(keep(81).NE.3))THEN
1704 what=1
1705 ELSE
1706 what=19
1707 ENDIF
1708 future_niv2(myid+1) = future_niv2(myid+1) - 1
1709 IF ( future_niv2(myid+1) < 0 ) THEN
1710 WRITE(*,*) "Internal error in DMUMPS_LOAD_MASTER_2_ALL"
1711 CALL mumps_abort()
1712 ENDIF
1713 IF ( future_niv2(myid + 1) == 0 ) THEN
1714 112 CONTINUE
1715 CALL dmumps_buf_send_not_mstr(comm,myid,slavef,
1716 & dble(max_surf_master),keep,ierr)
1717 IF (ierr == -1 ) THEN
1718 CALL dmumps_load_recv_msgs(comm_ld)
1719 CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
1720 IF (exit_flag) THEN
1721 GOTO 100
1722 ELSE
1723 GOTO 112
1724 ENDIF
1725 ELSE IF ( ierr .NE. 0 ) THEN
1726 WRITE(*,*) "Internal Error in DMUMPS_LOAD_MASTER_2_ALL",
1727 & ierr
1728 CALL mumps_abort()
1729 ENDIF
1730 tab_maxs(myid) = tab_maxs(myid) + int(max_surf_master,8)
1731 ENDIF
1732 IF ( nslaves /= tab_pos(slavef + 2) ) THEN
1733 write(*,*) "Error 1 in DMUMPS_LOAD_MASTER_2_ALL",
1734 & nslaves, tab_pos(slavef+2)
1735 CALL mumps_abort()
1736 ENDIF
1737 ncb = tab_pos(nslaves+1) - 1
1738 nfront = ncb + nass
1739 DO i = 1, nslaves
1740 nbrows_slave = tab_pos(i+1) - tab_pos(i)
1741 IF ( keep(50) == 0 ) THEN
1742 flops_increment( i ) = (dble(nbrows_slave)*dble( nass ))+
1743 & dble(nbrows_slave) * dble(nass) *
1744 & dble(2*nfront-nass-1)
1745 ELSE
1746 flops_increment( i ) = dble(nbrows_slave) * dble(nass ) *
1747 & dble( 2 * ( nass + tab_pos(i+1) - 1 )
1748 & - nbrows_slave - nass + 1 )
1749 ENDIF
1750 IF ( bdc_mem ) THEN
1751 IF ( keep(50) == 0 ) THEN
1752 mem_increment( i ) = dble(nbrows_slave) *
1753 & dble(nfront)
1754 ELSE
1755 mem_increment( i ) = dble(nbrows_slave) *
1756 & dble( nass + tab_pos(i+1) - 1 )
1757 END IF
1758 ENDIF
1759 IF((keep(81).NE.2).AND.(keep(81).NE.3))THEN
1760 cb_band(i)=dble(-999999)
1761 ELSE
1762 IF ( keep(50) == 0 ) THEN
1763 cb_band( i ) = dble(nbrows_slave) *
1764 & dble(nfront-nass)
1765 ELSE
1766 cb_band( i ) = dble(nbrows_slave) *
1767 & dble(tab_pos(i+1)-1)
1768 END IF
1769 ENDIF
1770 END DO
1771 IF((keep(81).EQ.2).OR.(keep(81).EQ.3))THEN
1772 cb_cost_id(pos_id)=inode
1773 cb_cost_id(pos_id+1)=nslaves
1774 cb_cost_id(pos_id+2)=pos_mem
1775 pos_id=pos_id+3
1776 DO i=1,nslaves
1777 cb_cost_mem(pos_mem)=int(list_slaves(i),8)
1778 pos_mem=pos_mem+1
1779 cb_cost_mem(pos_mem)=int(cb_band(i),8)
1780 pos_mem=pos_mem+1
1781 ENDDO
1782 ENDIF
1783 111 CONTINUE
1784 CALL dmumps_buf_bcast_array(bdc_mem, comm, myid, slavef,
1785 & future_niv2,
1786 & nslaves, list_slaves,inode,
1787 & mem_increment,
1788 & flops_increment,cb_band, what, keep, ierr)
1789 IF ( ierr == -1 ) THEN
1790 CALL dmumps_load_recv_msgs(comm_ld)
1791 CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
1792 IF (exit_flag) THEN
1793 GOTO 100
1794 ELSE
1795 GOTO 111
1796 ENDIF
1797 ELSE IF ( ierr .NE. 0 ) THEN
1798 WRITE(*,*) "Internal Error in DMUMPS_LOAD_MASTER_2_ALL",
1799 & ierr
1800 CALL mumps_abort()
1801 ENDIF
1802 IF (future_niv2(myid+1) .NE. 0) THEN
1803 DO i = 1, nslaves
1804 load_flops(list_slaves(i)) = load_flops(list_slaves(i))
1805 & + flops_increment(i)
1806 IF ( bdc_mem ) THEN
1807 dm_mem(list_slaves(i)) = dm_mem(list_slaves(i))
1808 & + mem_increment(i)
1809 END IF
1810 ENDDO
1811 ENDIF
1812 100 CONTINUE
1813 DEALLOCATE(mem_increment,flops_increment,cb_band)
1814 RETURN
1815 END SUBROUTINE dmumps_load_master_2_all
1816 SUBROUTINE dmumps_load_pool_upd_new_pool(
1817 & POOL, LPOOL,
1818 & PROCNODE, KEEP,KEEP8, SLAVEF, COMM, MYID, STEP, N,
1819 & ND, FILS )
1820 USE dmumps_buf
1821 USE mumps_future_niv2
1822 IMPLICIT NONE
1823 INTEGER lpool, slavef, comm, myid
1824 INTEGER n, keep(500)
1825 INTEGER(8) keep8(150)
1826 INTEGER pool( lpool ), procnode( keep(28) ), step( n )
1827 INTEGER nd( keep(28) ), fils( n )
1828 INTEGER i, inode, nelim, nfr, level, ierr, what
1829 DOUBLE PRECISION cost
1830 LOGICAL :: exit_flag
1831 INTEGER nbinsubtree,nbtop,insubtree
1832 INTEGER mumps_typenode
1833 EXTERNAL mumps_typenode
1834 nbinsubtree = pool(lpool)
1835 nbtop = pool(lpool - 1)
1836 insubtree = pool(lpool - 2)
1837 IF(bdc_md)THEN
1838 RETURN
1839 ENDIF
1840 IF((keep(76).EQ.0).OR.(keep(76).EQ.2))THEN
1841 IF(nbtop.NE.0)THEN
1842 DO i = lpool-nbtop-2, min(lpool-3,lpool-nbtop-2+3)
1843 inode = pool( i )
1844 IF (inode .LE. n .AND. inode .GE. 1 ) THEN
1845 GOTO 20
1846 END IF
1847 END DO
1848 cost=dble(0)
1849 GOTO 30
1850 ELSE
1851 DO i = nbinsubtree, max(1,nbinsubtree-3), -1
1852 inode = pool( i )
1853 IF (inode .LE. n .AND. inode .GE. 1 ) THEN
1854 GOTO 20
1855 END IF
1856 END DO
1857 cost=dble(0)
1858 GOTO 30
1859 ENDIF
1860 ELSE
1861 IF(keep(76).EQ.1)THEN
1862 IF(insubtree.EQ.1)THEN
1863 DO i = nbinsubtree, max(1,nbinsubtree-3), -1
1864 inode = pool( i )
1865 IF (inode .LE. n .AND. inode .GE. 1 ) THEN
1866 GOTO 20
1867 END IF
1868 END DO
1869 cost=dble(0)
1870 GOTO 30
1871 ELSE
1872 DO i = lpool-nbtop-2, min(lpool-3,lpool-nbtop-2+3)
1873 inode = pool( i )
1874 IF (inode .LE. n .AND. inode .GE. 1 ) THEN
1875 GOTO 20
1876 END IF
1877 END DO
1878 cost=dble(0)
1879 GOTO 30
1880 ENDIF
1881 ELSE
1882 WRITE(*,*)
1883 & 'Internal error: Unknown pool management strategy'
1884 CALL mumps_abort()
1885 ENDIF
1886 ENDIF
1887 20 CONTINUE
1888 i = inode
1889 nelim = 0
1890 10 CONTINUE
1891 IF ( i > 0 ) THEN
1892 nelim = nelim + 1
1893 i = fils(i)
1894 GOTO 10
1895 ENDIF
1896 nfr = nd( step(inode) )
1897 level = mumps_typenode( procnode(step(inode)), keep(199) )
1898 IF (level .EQ. 1) THEN
1899 cost = dble( nfr ) * dble( nfr )
1900 ELSE
1901 IF ( keep(50) == 0 ) THEN
1902 cost = dble( nfr ) * dble( nelim )
1903 ELSE
1904 cost = dble( nelim ) * dble( nelim )
1905 ENDIF
1906 ENDIF
1907 30 CONTINUE
1908 IF ( abs(pool_last_cost_sent-cost).GT.dm_thres_mem ) THEN
1909 what = 2
1910 111 CONTINUE
1911 CALL dmumps_buf_broadcast( what,
1912 & comm, slavef,
1913 & future_niv2,
1914 & cost, dble(0), myid, keep, ierr )
1915 pool_last_cost_sent = cost
1916 pool_mem(myid)=cost
1917 IF ( ierr == -1 )THEN
1918 CALL dmumps_load_recv_msgs(comm_ld)
1919 CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
1920 IF (exit_flag) THEN
1921 ELSE
1922 GOTO 111
1923 ENDIF
1924 ELSE IF ( ierr .NE. 0 ) THEN
1925 WRITE(*,*) "Internal Error in DMUMPS_LOAD_POOL_UPD_NEW_POOL",
1926 & ierr
1927 CALL mumps_abort()
1928 ENDIF
1929 ENDIF
1930 RETURN
1931 END SUBROUTINE dmumps_load_pool_upd_new_pool
1932 SUBROUTINE dmumps_load_sbtr_upd_new_pool(
1933 & OK,INODE,POOL,LPOOL,MYID,SLAVEF,COMM,KEEP,KEEP8)
1934 USE dmumps_buf
1935 USE mumps_future_niv2
1936 IMPLICIT NONE
1937 INTEGER lpool,myid,slavef,comm,inode
1938 INTEGER pool(lpool),keep(500)
1939 INTEGER(8) keep8(150)
1940 INTEGER what,ierr
1941 LOGICAL ok
1942 DOUBLE PRECISION cost
1943 LOGICAL flag, exit_flag
1944 EXTERNAL mumps_rootssarbr,mumps_in_or_root_ssarbr
1945 LOGICAL mumps_rootssarbr,mumps_in_or_root_ssarbr
1946 IF((inode.LE.0).OR.(inode.GT.n_load)) THEN
1947 RETURN
1948 ENDIF
1949 IF (.NOT.mumps_in_or_root_ssarbr(
1950 & procnode_load(step_load(inode)), keep(199))
1951 & ) THEN
1952 RETURN
1953 ENDIF
1954 IF(mumps_rootssarbr(procnode_load(step_load(inode)),
1955 & keep(199)))THEN
1956 IF(ne_load(step_load(inode)).EQ.0)THEN
1957 RETURN
1958 ENDIF
1959 ENDIF
1960 flag=.false.
1961 IF(indice_sbtr.LE.nb_subtrees)THEN
1962 IF(inode.EQ.my_first_leaf(indice_sbtr))THEN
1963 flag=.true.
1964 ENDIF
1965 ENDIF
1966 IF(flag)THEN
1967 sbtr_peak_array(indice_sbtr_array)=mem_subtree(indice_sbtr)
1968 sbtr_cur_array(indice_sbtr_array)=sbtr_cur(myid)
1969 indice_sbtr_array=indice_sbtr_array+1
1970 what = 3
1971 IF(dble(mem_subtree(indice_sbtr)).GE.dm_thres_mem)THEN
1972 111 CONTINUE
1973 CALL dmumps_buf_broadcast(
1974 & what, comm, slavef,
1975 & future_niv2,
1976 & dble(mem_subtree(indice_sbtr)), dble(0),
1977 & myid, keep, ierr )
1978 IF ( ierr == -1 )THEN
1979 CALL dmumps_load_recv_msgs(comm_ld)
1980 CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
1981 IF (exit_flag) THEN
1982 ELSE
1983 GOTO 111
1984 ENDIF
1985 ELSE IF ( ierr .NE. 0 ) THEN
1986 WRITE(*,*)
1987 & "Internal Error 1 in DMUMPS_LOAD_SBTR_UPD_NEW_POOL",
1988 & ierr
1989 CALL mumps_abort()
1990 ENDIF
1991 ENDIF
1992 sbtr_mem(myid)=sbtr_mem(myid)+
1993 & dble(mem_subtree(indice_sbtr))
1994 indice_sbtr=indice_sbtr+1
1995 IF(inside_subtree.EQ.0)THEN
1996 inside_subtree=1
1997 ENDIF
1998 ELSE
1999 IF(inode.EQ.my_root_sbtr(indice_sbtr-1))THEN
2000 what = 3
2001 cost=-sbtr_peak_array(indice_sbtr_array-1)
2002 IF(abs(cost).GE.dm_thres_mem)THEN
2003 112 CONTINUE
2004 CALL dmumps_buf_broadcast(
2005 & what, comm, slavef,
2006 & future_niv2,
2007 & cost, dble(0), myid, keep, ierr )
2008 IF ( ierr == -1 )THEN
2009 CALL dmumps_load_recv_msgs(comm_ld)
2010 CALL mumps_check_comm_nodes(comm_nodes, exit_flag)
2011 IF (exit_flag) THEN
2012 ELSE
2013 GOTO 112
2014 ENDIF
2015 ELSE IF ( ierr .NE. 0 ) THEN
2016 WRITE(*,*)
2017 & "Internal Error 3 in DMUMPS_LOAD_SBTR_UPD_NEW_POOL",
2018 & ierr
2019 CALL mumps_abort()
2020 ENDIF
2021 ENDIF
2022 indice_sbtr_array=indice_sbtr_array-1
2023 sbtr_mem(myid)=sbtr_mem(myid)-
2024 & sbtr_peak_array(indice_sbtr_array)
2025 sbtr_cur(myid)=sbtr_cur_array(indice_sbtr_array)
2026 IF(indice_sbtr_array.EQ.1)THEN
2027 sbtr_cur(myid)=dble(0)
2028 inside_subtree=0
2029 ENDIF
2030 ENDIF
2031 ENDIF
2032 RETURN
2033 END SUBROUTINE dmumps_load_sbtr_upd_new_pool
2034 SUBROUTINE dmumps_set_parti_actv_mem
2035 & (slavef,keep,keep8,procs,mem_distrib,ncb,nfront,
2036 & nslaves_node,tab_pos,
2037 & slaves_list,size_slaves_list,myid)
2038 IMPLICIT NONE
2039 INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
2040 INTEGER(8) KEEP8(150)
2041 INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID
2042 INTEGER, intent(in) :: PROCS(SLAVEF+1)
2043 INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1)
2044 INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
2045 INTEGER, intent(out):: TAB_POS(SLAVEF+2)
2046 INTEGER, intent(out):: NSLAVES_NODE
2047 INTEGER NUMBER_OF_PROCS,K47, K48, K50
2048 INTEGER(8) :: K821
2049 DOUBLE PRECISION DK821
2050 INTEGER J
2051 INTEGER KMIN, KMAX
2052 INTEGER OTHERS,CHOSEN,SMALL_SET,ACC
2053 DOUBLE PRECISION SOMME,TMP_SUM
2054 INTEGER AFFECTED
2055 INTEGER ADDITIONNAL_ROWS,i,X,REF,POS
2056 INTEGER(8)::TOTAL_MEM
2057 LOGICAL FORCE_CAND
2058 DOUBLE PRECISION TEMP(SLAVEF),PEAK
2059 INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF)
2060 EXTERNAL mpi_wtime
2061 DOUBLE PRECISION MPI_WTIME
2062 IF (keep8(21) .GT. 0_8) THEN
2063 write(*,*)myid,
2064 & ": Internal Error 1 in DMUMPS_SET_PARTI_ACTV_MEM"
2065 CALL mumps_abort()
2066 ENDIF
2067 k821=abs(keep8(21))
2068 dk821=dble(k821)
2069 k50=keep(50)
2070 k48=keep(48)
2071 k47=keep(47)
2072 IF ( keep(24) == 0 .OR. keep(24) == 1 ) THEN
2073 force_cand = .false.
2074 ELSE
2075 force_cand = (mod(keep(24),2).eq.0)
2076 END IF
2077 IF(k48.NE.4)THEN
2078 WRITE(*,*)'DMUMPS_COMPUTE_PARTI_ACTV_MEM_K821
2079 & should be called with KEEP(48) different from 4'
2080 CALL mumps_abort()
2081 ENDIF
2082 kmin=1
2083 kmax=int(k821/int(nfront,8))
2084 IF(force_cand)THEN
2085 DO i=1,procs(slavef+1)
2086 wload(i)=dm_mem(procs(i))
2087 idwload(i)=procs(i)
2088 ENDDO
2089 number_of_procs=procs(slavef+1)
2090 others=number_of_procs
2091 ELSE
2092 number_of_procs=slavef
2093 wload(1:slavef) = dm_mem(0:number_of_procs-1)
2094 DO i=1,number_of_procs
2095 idwload(i) = i - 1
2096 ENDDO
2097 others=number_of_procs-1
2098 ENDIF
2099 nb_rows=0
2100 CALL mumps_sort_doubles(number_of_procs, wload, idwload)
2101 total_mem=int(ncb,8)*int(nfront,8)
2102 somme=dble(0)
2103 j=1
2104 peak=dble(0)
2105 DO i=1,number_of_procs
2106 IF((idwload(i).NE.myid))THEN
2107 peak=max(peak,wload(i))
2108 temp_id(j)=idwload(i)
2109 temp(j)=wload(i)
2110 IF(bdc_sbtr)THEN
2111 temp(j)=temp(j)+sbtr_mem(idwload(i))-
2112 & sbtr_cur(idwload(i))
2113 ENDIF
2114 IF(bdc_pool)THEN
2115 temp(j)=temp(j)+pool_mem(temp_id(j))
2116 ENDIF
2117 IF(bdc_m2_mem)THEN
2118 temp(j)=temp(j)+niv2(temp_id(j)+1)
2119 ENDIF
2120 j=j+1
2121 ENDIF
2122 ENDDO
2123 number_of_procs=j-1
2124 CALL mumps_sort_doubles(number_of_procs, temp, temp_id)
2125 IF(k50.EQ.0)THEN
2126 peak=max(peak,
2127 & dm_mem(myid)+dble(nfront)*dble(nfront-ncb))
2128 ELSE
2129 peak=max(peak,
2130 & dm_mem(myid)+dble(nfront-ncb)*dble(nfront-ncb))
2131 ENDIF
2132 peak=max(peak,temp(others))
2133 somme=dble(0)
2134 DO i=1,number_of_procs
2135 somme=somme+temp(others)-temp(i)
2136 ENDDO
2137 IF(somme.LE.dble(total_mem)) THEN
2138 GOTO 096
2139 ENDIF
2140 096 CONTINUE
2141 somme=dble(0)
2142 DO i=1,others
2143 somme=somme+temp(others)-temp(i)
2144 ENDDO
2145 IF(dble(total_mem).GE.somme) THEN
2146 affected=0
2147 chosen=0
2148 acc=0
2149 DO i=1,others
2150 IF(k50.EQ.0)THEN
2151 IF((temp(others)-temp(i)).GT.dk821)THEN
2152 tmp_sum=dk821
2153 ELSE
2154 tmp_sum=temp(others)-temp(i)
2155 ENDIF
2156 x=int(tmp_sum/dble(nfront))
2157 IF((acc+x).GT.ncb) x=ncb-acc
2158 ENDIF
2159 IF(k50.NE.0)THEN
2160 IF((temp(others)-temp(i)).GT.dk821)THEN
2161 tmp_sum=dk821
2162 ELSE
2163 tmp_sum=temp(others)-temp(i)
2164 ENDIF
2165 x=int((-dble(nfront-ncb+acc)
2166 & +sqrt(((dble(nfront-ncb+acc)*
2167 & dble(nfront-ncb+acc))+dble(4)*
2168 & (tmp_sum))))/
2169 & dble(2))
2170 IF((acc+x).GT.ncb) x=ncb-acc
2171 IF(x.LE.0) THEN
2172 WRITE(*,*)"Internal Error 2 in
2173 & DMUMPS_SET_PARTI_ACTV_MEM"
2174 CALL mumps_abort()
2175 ENDIF
2176 ENDIF
2177 nb_rows(i)=x
2178 chosen=chosen+1
2179 acc=acc+x
2180 IF(ncb-acc.LT.kmin) GOTO 111
2181 IF(ncb.EQ.acc) GOTO 111
2182 ENDDO
2183 111 CONTINUE
2184 IF((acc.GT.ncb))THEN
2185 x=0
2186 DO i=1,others
2187 x=x+nb_rows(i)
2188 ENDDO
2189 WRITE(*,*)'NCB=',ncb,',SOMME=',x
2190 WRITE(*,*)myid,
2191 & ": Internal Error 3 in DMUMPS_SET_PARTI_ACTV_MEM"
2192 CALL mumps_abort()
2193 ENDIF
2194 IF((ncb.NE.acc))THEN
2195 IF(k50.NE.0)THEN
2196 IF(chosen.NE.0)THEN
2197 additionnal_rows=ncb-acc
2198 nb_rows(chosen)=nb_rows(chosen)+additionnal_rows
2199 ELSE
2200 tmp_sum=dble(total_mem)/dble(number_of_procs)
2201 chosen=0
2202 acc=0
2203 DO i=1,others
2204 x=int((-dble(nfront-ncb+acc)
2205 & +sqrt(((dble(nfront-ncb+acc)*
2206 & dble(nfront-ncb+acc))+dble(4)*
2207 & (tmp_sum))))/
2208 & dble(2))
2209 IF((acc+x).GT.ncb) x=ncb-acc
2210 nb_rows(i)=x
2211 chosen=chosen+1
2212 acc=acc+x
2213 IF(ncb-acc.LT.kmin) GOTO 002
2214 IF(ncb.EQ.acc) GOTO 002
2215 ENDDO
2216 002 CONTINUE
2217 IF(acc.LT.ncb)THEN
2218 nb_rows(chosen)=nb_rows(chosen)+(ncb-acc)
2219 ENDIF
2220 ENDIF
2221 GOTO 333
2222 ENDIF
2223 additionnal_rows=ncb-acc
2224 DO i=chosen,1,-1
2225 IF(int(dble(additionnal_rows)/
2226 & dble(i)).NE.0)THEN
2227 GOTO 222
2228 ENDIF
2229 ENDDO
2230 222 CONTINUE
2231 x=int(dble(additionnal_rows)/dble(i))
2232 DO j=1,i
2233 nb_rows(j)=nb_rows(j)+x
2234 additionnal_rows=additionnal_rows-x
2235 ENDDO
2236 IF(additionnal_rows.NE.0) THEN
2237 nb_rows(1)=nb_rows(1)+additionnal_rows
2238 ENDIF
2239 ENDIF
2240 333 CONTINUE
2241 IF(nb_rows(chosen).EQ.0) chosen=chosen-1
2242 GOTO 889
2243 ELSE
2244 DO i=others,1,-1
2245 somme=dble(0)
2246 DO j=1,i
2247 somme=somme+temp(j)
2248 ENDDO
2249 somme=(dble(i)*temp(i))-somme
2250 IF(dble(total_mem).GE.somme) GOTO 444
2251 ENDDO
2252 444 CONTINUE
2253 ref=i
2254 DO j=1,i
2255 IF(temp(j).EQ.temp(i)) THEN
2256 small_set=j
2257 GOTO 123
2258 ENDIF
2259 ENDDO
2260 123 CONTINUE
2261 IF(i.EQ.1)THEN
2262 nb_rows(i)=ncb
2263 chosen=1
2264 GOTO 666
2265 ENDIF
2266 323 CONTINUE
2267 affected=0
2268 chosen=0
2269 acc=0
2270 DO i=1,small_set
2271 IF(k50.EQ.0)THEN
2272 IF((temp(small_set)-temp(i)).GT.dk821)THEN
2273 tmp_sum=dk821
2274 ELSE
2275 tmp_sum=temp(small_set)-temp(i)
2276 ENDIF
2277 x=int(tmp_sum/dble(nfront))
2278 IF((acc+x).GT.ncb) x=ncb-acc
2279 ENDIF
2280 IF(k50.NE.0)THEN
2281 IF((temp(small_set)-temp(i)).GT.dk821)THEN
2282 tmp_sum=dk821
2283 ELSE
2284 tmp_sum=temp(small_set)-temp(i)
2285 ENDIF
2286 x=int((-dble(nfront-ncb+acc)
2287 & +sqrt(((dble(nfront-ncb+acc)*
2288 & dble(nfront-ncb+acc))+dble(4)*
2289 & (tmp_sum))))/
2290 & dble(2))
2291 IF(x.LT.0)THEN
2292 WRITE(*,*)myid,
2293 & ': Internal error 4 in DMUMPS_SET_PARTI_ACTV_MEM'
2294 CALL mumps_abort()
2295 ENDIF
2296 IF((acc+x).GT.ncb) x=ncb-acc
2297 ENDIF
2298 nb_rows(i)=x
2299 acc=acc+x
2300 chosen=chosen+1
2301 IF(ncb-acc.LT.kmin) GOTO 888
2302 IF(ncb.EQ.acc) GOTO 888
2303 IF(acc.GT.ncb) THEN
2304 WRITE(*,*)myid,
2305 & ': Internal error 5 in DMUMPS_SET_PARTI_ACTV_MEM'
2306 CALL mumps_abort()
2307 ENDIF
2308 ENDDO
2309 888 CONTINUE
2310 somme=dble(0)
2311 x=nfront-ncb
2312 IF((acc.GT.ncb))THEN
2313 WRITE(*,*)myid,
2314 & ':Internal error 6 in DMUMPS_SET_PARTI_ACTV_MEM'
2315 CALL mumps_abort()
2316 ENDIF
2317 IF((acc.LT.ncb))THEN
2318 IF(k50.NE.0)THEN
2319 IF(small_set.LT.others)THEN
2320 small_set=ref+1
2321 ref=small_set
2322 GOTO 323
2323 ELSE
2324 nb_rows(chosen)=nb_rows(chosen)+ncb-acc
2325 GOTO 666
2326 ENDIF
2327 ENDIF
2328 additionnal_rows=ncb-acc
2329 i=chosen+1
2330 DO WHILE ((additionnal_rows.NE.0)
2331 & .AND.(i.LE.number_of_procs))
2332 j=1
2333 x=int(additionnal_rows/(i-1))
2334 IF((x.EQ.0).AND.(additionnal_rows.NE.0))THEN
2335 DO WHILE ((j.LT.i).AND.(additionnal_rows.GT.0))
2336 nb_rows(j)=nb_rows(j)+1
2337 additionnal_rows=additionnal_rows-1
2338 j=j+1
2339 ENDDO
2340 IF(additionnal_rows.NE.0)THEN
2341 WRITE(*,*)myid,
2342 & ':Internal error 7 in DMUMPS_SET_PARTI_ACTV_MEM'
2343 CALL mumps_abort()
2344 ENDIF
2345 GOTO 047
2346 ENDIF
2347 IF((temp(1)+dble((nb_rows(1)+x)*nfront)).LE.
2348 & temp(i))THEN
2349 DO WHILE ((additionnal_rows.NE.0)
2350 & .AND.(j.LT.i))
2351 affected=x
2352 IF((affected+nb_rows(j)).GT.
2353 & kmax)THEN
2354 affected=kmax-nb_rows(j)
2355 ENDIF
2356 nb_rows(j)=nb_rows(j)+affected
2357 additionnal_rows=additionnal_rows-
2358 & affected
2359 j=j+1
2360 ENDDO
2361 ELSE
2362 DO WHILE ((additionnal_rows.NE.0)
2363 & .AND.(j.LE.i))
2364 affected=int((temp(i)-(temp(j)+
2365 & (dble(nb_rows(j))*dble(nfront))))
2366 & /dble(nfront))
2367 IF((affected+nb_rows(j)).GT.kmax)THEN
2368 affected=kmax-nb_rows(j)
2369 ENDIF
2370 IF(affected.GT.additionnal_rows)THEN
2371 affected=additionnal_rows
2372 ENDIF
2373 nb_rows(j)=nb_rows(j)+affected
2374 additionnal_rows=additionnal_rows-affected
2375 j=j+1
2376 ENDDO
2377 ENDIF
2378 i=i+1
2379 ENDDO
2380 047 CONTINUE
2381 IF((additionnal_rows.EQ.0).AND.
2382 & (i.LT.number_of_procs))THEN
2383 chosen=i-1
2384 ELSE
2385 chosen=i-2
2386 ENDIF
2387 IF((chosen.EQ.number_of_procs-1).AND.
2388 & (additionnal_rows.NE.0))THEN
2389 DO i=1,chosen
2390 nb_rows(i)=nb_rows(i)+1
2391 additionnal_rows=additionnal_rows-1
2392 IF(additionnal_rows.EQ.0) GOTO 048
2393 ENDDO
2394 048 CONTINUE
2395 ENDIF
2396 IF((chosen.EQ.number_of_procs-1).AND.
2397 & (additionnal_rows.NE.0))THEN
2398 i=chosen+1
2399 DO WHILE ((additionnal_rows.NE.0)
2400 & .AND.(i.LE.number_of_procs))
2401 j=1
2402 DO WHILE ((additionnal_rows.NE.0)
2403 & .AND.(j.LE.i))
2404 affected=int((temp(i)-(temp(j)+
2405 & (dble(nb_rows(j))*
2406 & dble(nfront))))/dble(nfront))
2407 IF(affected.GT.additionnal_rows)THEN
2408 affected=additionnal_rows
2409 ENDIF
2410 nb_rows(j)=nb_rows(j)+affected
2411 additionnal_rows=additionnal_rows-affected
2412 j=j+1
2413 ENDDO
2414 i=i+1
2415 ENDDO
2416 chosen=i-2
2417 ENDIF
2418 CONTINUE
2419 ENDIF
2420 666 CONTINUE
2421 somme=dble(0)
2422 x=0
2423 pos=0
2424 DO i=1,chosen
2425 IF(k50.NE.0) THEN
2426 IF((temp(i)+dble(nb_rows(i))
2427 & *dble(x+nb_rows(i)+nfront-ncb))
2428 & .GT.peak)THEN
2429 small_set=small_set+1
2430 ENDIF
2431 ENDIF
2432 IF(k50.EQ.0) THEN
2433 IF((temp(i)+dble(nb_rows(i))*dble(nfront))
2434 & .GT.peak)THEN
2435 small_set=small_set+1
2436 ENDIF
2437 ENDIF
2438 x=x+nb_rows(i)
2439 somme=somme+ dble(nb_rows(i))
2440 ENDDO
2441 ENDIF
2442 889 CONTINUE
2443 j=chosen
2444 x=0
2445 DO i=j,1,-1
2446 IF(nb_rows(i).EQ.0)THEN
2447 IF(x.EQ.1)THEN
2448 WRITE(*,*)myid,
2449 & ':Internal error 12 in DMUMPS_SET_PARTI_ACTV_MEM'
2450 CALL mumps_abort()
2451 ENDIF
2452 chosen=chosen-1
2453 ELSE
2454 IF(nb_rows(i).GT.0)THEN
2455 x=1
2456 ELSE
2457 WRITE(*,*)
2458 & 'Internal error 13 in DMUMPS_SET_PARTI_ACTV_MEM'
2459 CALL mumps_abort()
2460 ENDIF
2461 ENDIF
2462 ENDDO
2463 nslaves_node=chosen
2464 tab_pos(nslaves_node+1)= ncb+1
2465 tab_pos(slavef+2) = chosen
2466 pos=1
2467 DO i=1,chosen
2468 slaves_list(i)=temp_id(i)
2469 tab_pos(i)=pos
2470 pos=pos+nb_rows(i)
2471 IF(nb_rows(i).LE.0)THEN
2472 WRITE(*,*)
2473 & 'Internal error 14 in DMUMPS_SET_PARTI_ACTV_MEM'
2474 CALL mumps_abort()
2475 ENDIF
2476 ENDDO
2477 DO i=chosen+1,number_of_procs
2478 slaves_list(i)=temp_id(i)
2479 ENDDO
2480 IF(pos.NE.(ncb+1))THEN
2481 WRITE(*,*)
2482 & 'Internal error 15 in DMUMPS_SET_PARTI_ACTV_MEM'
2483 CALL mumps_abort()
2484 ENDIF
2485 END SUBROUTINE dmumps_set_parti_actv_mem
2486 SUBROUTINE dmumps_set_parti_flop_irr
2487 & (ncbson_max,slavef,keep,keep8,
2488 & procs,mem_distrib,ncb,nfront,
2489 & nslaves_node,tab_pos,
2490 & slaves_list,size_slaves_list,myid,inode,mp,lp)
2491 IMPLICIT NONE
2492 INTEGER, intent(in) :: KEEP(500),SIZE_SLAVES_LIST
2493 INTEGER(8) KEEP8(150)
2494 INTEGER, intent(in) :: SLAVEF, NFRONT, NCB,MYID
2495 INTEGER, intent(in) :: NCBSON_MAX
2496 INTEGER, intent(in) :: PROCS(SLAVEF+1)
2497 INTEGER, intent(in) :: MEM_DISTRIB(0:SLAVEF-1),INODE
2498 INTEGER, intent(in) :: MP,LP
2499 INTEGER, intent(out):: SLAVES_LIST(SIZE_SLAVES_LIST)
2500 INTEGER, intent(out):: TAB_POS(SLAVEF+2)
2501 INTEGER, intent(out):: NSLAVES_NODE
2502 INTEGER NUMBER_OF_PROCS,K47,K48, K50,K83,K69
2503 INTEGER(8) :: K821
2504 INTEGER J
2505 INTEGER KMIN, KMAX
2506 INTEGER OTHERS,CHOSEN,SMALL_SET,ACC
2507 DOUBLE PRECISION SOMME,TMP_SUM,DELTA,A,B,C,MASTER_WORK
2508 INTEGER AFFECTED
2509 INTEGER ADDITIONNAL_ROWS,i,X,REF,POS,NELIM
2510 INTEGER(8) X8
2511 LOGICAL FORCE_CAND,SMP
2512 DOUBLE PRECISION BANDE_K821
2513 INTEGER NB_SAT,NB_ZERO
2514 DOUBLE PRECISION TEMP(SLAVEF),TOTAL_COST, MAX_MEM_ALLOW
2515 INTEGER TEMP_ID(SLAVEF),NB_ROWS(SLAVEF)
2516 INTEGER NSLAVES_REF,NCB_FILS
2517 EXTERNAL MPI_WTIME,MUMPS_GETKMIN
2518 INTEGER MUMPS_GETKMIN
2519 INTEGER POS_MIN_LOAD,SIZE_MY_SMP,WHAT
2520 LOGICAL HAVE_TYPE1_SON
2521 DOUBLE PRECISION MIN_LOAD,MAX_LOAD,TEMP_MAX_LOAD
2522 DOUBLE PRECISION MPI_WTIME
2523 DOUBLE PRECISION BUF_SIZE,NELIM_MEM_SIZE
2524 DOUBLE PRECISION MEM_SIZE_STRONG(SLAVEF),MEM_SIZE_WEAK(SLAVEF)
2525 K821=abs(keep8(21))
2526 temp_max_load=dble(0)
2527 k50=keep(50)
2528 k48=keep(48)
2529 k47=keep(47)
2530 k83=keep(83)
2531 k69=0
2532 ncb_fils=ncbson_max
2533 IF(int(ncb_fils,8)*int(min(ncb,ncb_fils),8).GT.k821)THEN
2534 have_type1_son=.true.
2535 ELSE
2536 have_type1_son=.false.
2537 ENDIF
2538 smp=(k69.NE.0)
2539 IF ( keep(24) == 0 .OR. keep(24) == 1 ) THEN
2540 force_cand = .false.
2541 ELSE
2542 force_cand = (mod(keep(24),2).eq.0)
2543 END IF
2544 nelim=nfront-ncb
2545 kmax=int(k821/int(ncb,8))
2546 IF(force_cand)THEN
2547 DO i=1,procs(slavef+1)
2548 wload(i)=load_flops(procs(i))
2549 idwload(i)=procs(i)
2550 wload(i)=max(wload(i),0.0d0)
2551 ENDDO
2552 number_of_procs=procs(slavef+1)
2553 others=number_of_procs
2554 ELSE
2555 number_of_procs=slavef
2556 wload(1:slavef) = load_flops(0:number_of_procs-1)
2557 DO i=1,number_of_procs
2558 idwload(i) = i - 1
2559 IF (wload(i) < -0.5d0 ) THEN
2560 IF((mp.GT.0).AND.(lp.GE.2))THEN
2561 WRITE(mp,*)myid,': Negative load ',
2562 & wload(i)
2563 ENDIF
2564 ENDIF
2565 wload(i)=max(wload(i),0.0d0)
2566 ENDDO
2567 others=number_of_procs-1
2568 ENDIF
2569 kmax=int(ncb/others)
2570 kmin=mumps_getkmin(int(ncb,8)*int(kmax,8),k50,kmax,ncb)
2571 nb_rows=0
2572 CALL mumps_sort_doubles(number_of_procs, wload, idwload)
2573 IF(k50.EQ.0)THEN
2574 total_cost=dble( nelim ) * dble( ncb ) +
2575 & dble(ncb) * dble(nelim)*dble(2*nfront-nelim-1)
2576 ELSE
2577 total_cost=dble(nelim) * dble( ncb ) *
2578 & dble(nfront+1)
2579 ENDIF
2580 CALL mumps_get_flops_cost(nfront,nelim,nelim,k50,
2581 & 2,master_work)
2582 somme=dble(0)
2583 j=1
2584 IF(force_cand.AND.(number_of_procs.GT.k83))THEN
2585 master_work=dble(keep(88))*master_work/dble(100)
2586 ENDIF
2587 IF(force_cand.AND.(number_of_procs.LE.k83))THEN
2588 master_work=dble(keep(87))*master_work/dble(100)
2589 ENDIF
2590 IF(master_work.LT.dble(1))THEN
2591 master_work=dble(1)
2592 ENDIF
2593 nslaves_ref=int(total_cost/master_work)+1
2594 IF(force_cand)THEN
2595 nslaves_ref=min(nslaves_ref,number_of_procs)
2596 ELSE
2597 nslaves_ref=min(nslaves_ref,number_of_procs-1)
2598 ENDIF
2599 DO i=1,number_of_procs
2600 IF((idwload(i).NE.myid))THEN
2601 temp_id(j)=idwload(i)
2602 temp(j)=wload(i)
2603 IF(bdc_m2_flops)THEN
2604 temp(j)=temp(j)+niv2(temp_id(j)+1)
2605 ENDIF
2606 j=j+1
2607 ENDIF
2608 ENDDO
2609 number_of_procs=j-1
2610 CALL mumps_sort_doubles(number_of_procs, temp, temp_id)
2611 somme=dble(0)
2612 tmp_sum=dble(0)
2613 DO i=1,others
2614 somme=somme+temp(others)-temp(i)
2615 tmp_sum=tmp_sum+temp(i)
2616 ENDDO
2617 tmp_sum=(tmp_sum/dble(others))+
2618 & (total_cost/dble(others))
2619 size_my_smp=others
2620 min_load=temp(1)
2621 pos_min_load=1
2622 IF(.NOT.smp) max_load=temp(others)
2623 IF(smp)THEN
2624 j=1
2625 DO i=1,others
2626 IF(mem_distrib(temp_id(i)).EQ.1)THEN
2627 IF(temp(i).LE.tmp_sum)THEN
2628 wload(j)=temp(i)
2629 idwload(j)=temp_id(i)
2630 j=j+1
2631 ELSE
2632 ENDIF
2633 ENDIF
2634 ENDDO
2635 max_load=wload(j-1)
2636 size_my_smp=j-1
2637 DO i=1,others
2638 IF((mem_distrib(temp_id(i)).NE.1).OR.
2639 & ((mem_distrib(temp_id(i)).EQ.1).AND.
2640 & (temp(i).GE.tmp_sum)))THEN
2641 wload(j)=temp(i)
2642 idwload(j)=temp_id(i)
2643 j=j+1
2644 ENDIF
2645 ENDDO
2646 temp=wload
2647 temp_id=idwload
2648 ENDIF
2649 IF(bdc_md)THEN
2650 buf_size=dble(k821)
2651 IF (keep(201).EQ.2) THEN
2652 a=dble(int((dble(keep(100))/dble(2))/dble(nelim)))
2653 IF(k50.EQ.0)THEN
2654 buf_size=min(buf_size,a*dble(ncb))
2655 ELSE
2656 buf_size=min(buf_size,a*a)
2657 ENDIF
2658 ENDIF
2659 buf_size=dble(k821)
2660 DO i=1,number_of_procs
2661 a=dble(md_mem(temp_id(i)))/
2662 & dble(nelim)
2663 a=a*dble(nfront)
2664 IF(k50.EQ.0)THEN
2665 b=dble(int(dble(ncb)/dble(number_of_procs))+1)*
2666 & dble(nfront)
2667 ELSE
2668 what = 5
2669 CALL mumps_max_surfcb_nbrows(what, keep,keep8, ncb,
2670 & nfront, min(ncb,others), j, x8)
2671 b=dble(x8)+(dble(j)*dble(nelim))
2672 ENDIF
2673 nelim_mem_size=a+b
2674 mem_size_weak(i)=nelim_mem_size
2675 IF((sbtr_which_m.EQ.0).OR.(.NOT.bdc_sbtr))THEN
2676 IF(bdc_m2_mem)THEN
2677 mem_size_strong(i)=
2678 & dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
2679 & lu_usage(temp_id(i))-niv2(temp_id(i)+1)
2680 ELSE
2681 mem_size_strong(i)=
2682 & dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
2683 & lu_usage(temp_id(i))
2684 ENDIF
2685 ELSE
2686 IF(bdc_sbtr)THEN
2687 IF(bdc_m2_mem)THEN
2688 mem_size_strong(i)=
2689 & dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
2690 & lu_usage(temp_id(i))-niv2(temp_id(i)+1)-
2691 & (sbtr_mem(temp_id(i))-sbtr_cur(temp_id(i)))
2692 ELSE
2693 mem_size_strong(i)=
2694 & dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
2695 & lu_usage(temp_id(i))-
2696 & (sbtr_mem(temp_id(i))-sbtr_cur(temp_id(i)))
2697 ENDIF
2698 ENDIF
2699 ENDIF
2700 IF(min(mem_size_strong(i),mem_size_weak(i)).LT.dble(0))THEN
2701 IF(mem_size_strong(i).LT.0.0d0)THEN
2702 mem_size_strong(i)=dble(0)
2703 ELSE
2704 mem_size_weak(i)=dble(0)
2705 ENDIF
2706 ENDIF
2707 ENDDO
2708 ELSE
2709 buf_size=dble(k821)
2710 DO i=1,number_of_procs
2711 IF((sbtr_which_m.EQ.0).OR.(.NOT.bdc_sbtr))THEN
2712 IF(bdc_m2_mem)THEN
2713 mem_size_strong(i)=
2714 & dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
2715 & lu_usage(temp_id(i))-niv2(temp_id(i)+1)
2716 ELSE
2717 mem_size_strong(i)=
2718 & dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
2719 & lu_usage(temp_id(i))
2720 ENDIF
2721 ELSE
2722 IF(bdc_sbtr)THEN
2723 IF(bdc_m2_mem)THEN
2724 mem_size_strong(i)=
2725 & dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
2726 & lu_usage(temp_id(i))-niv2(temp_id(i)+1)-
2727 & (sbtr_mem(temp_id(i))-sbtr_cur(temp_id(i)))
2728 ELSE
2729 mem_size_strong(i)=
2730 & dble(tab_maxs(temp_id(i)))-dm_mem(temp_id(i))-
2731 & lu_usage(temp_id(i))-
2732 & (sbtr_mem(temp_id(i))-sbtr_cur(temp_id(i)))
2733 ENDIF
2734 ENDIF
2735 ENDIF
2736 mem_size_strong(i)=max(dble(0),mem_size_strong(i))
2737 mem_size_weak(i)=huge(mem_size_weak(i))
2738 ENDDO
2739 ENDIF
2740 IF((((number_of_procs.LE.k83).AND.force_cand).AND.
2741 & (total_cost.GE.somme)).OR.
2742 & (.NOT.force_cand).OR.
2743 & (((number_of_procs+1).GT.k83).AND.force_cand))THEN
2744 ref=nslaves_ref
2745 small_set=nslaves_ref
2746 IF(.NOT.smp)THEN
2747 DO i=nslaves_ref,1,-1
2748 somme=dble(0)
2749 DO j=1,i
2750 somme=somme+temp(j)
2751 ENDDO
2752 somme=(dble(i)*temp(i))-somme
2753 IF(total_cost.GE.somme) GOTO 444
2754 ENDDO
2755 444 CONTINUE
2756 ref=i
2757 small_set=ref
2758 max_load=temp(small_set)
2759 ELSE
2760 x=min(size_my_smp,nslaves_ref)
2761 450 CONTINUE
2762 somme=dble(0)
2763 DO j=1,x
2764 somme=somme+(temp(x)-temp(j))
2765 ENDDO
2766 IF(somme.GT.total_cost)THEN
2767 x=x-1
2768 GOTO 450
2769 ELSE
2770 IF(x.LT.size_my_smp) THEN
2771 ref=x
2772 small_set=ref
2773 max_load=temp(small_set)
2774 ELSE
2775 x=min(size_my_smp,nslaves_ref)
2776 j=x+1
2777 max_load=temp(x)
2778 tmp_sum=max_load
2779 DO i=x+1,others
2780 IF(temp(i).GT.max_load)THEN
2781 somme=somme+(dble(i-1)*(temp(i)-max_load))
2782 tmp_sum=max_load
2783 max_load=temp(i)
2784 ELSE
2785 somme=somme+(max_load-temp(i))
2786 ENDIF
2787 IF(i.EQ.nslaves_ref)THEN
2788 small_set=nslaves_ref
2789 ref=small_set
2790 GOTO 323
2791 ENDIF
2792 IF(somme.GT.total_cost)THEN
2793 ref=i-1
2794 small_set=i-1
2795 max_load=tmp_sum
2796 GOTO 323
2797 ENDIF
2798 ENDDO
2799 ENDIF
2800 ENDIF
2801 ENDIF
2802 323 CONTINUE
2803 max_load=dble(0)
2804 DO i=1,small_set
2805 max_load=max(max_load,temp(i))
2806 ENDDO
2807 temp_max_load=max_load
2808 nb_rows=0
2809 tmp_sum=dble(0)
2810 chosen=0
2811 acc=0
2812 nb_sat=0
2813 nb_zero=0
2814 DO i=1,small_set
2815 IF(k50.EQ.0)THEN
2816 x=int(buf_size/dble(ncb+1))-1
2817 bande_k821=dble(x)*dble(nfront)
2818 ELSE
2819 a=dble(1)
2820 b=dble(acc+2)
2821 c=-buf_size+dble(acc+nelim)
2822 delta=(b*b)-(dble(4)*a*c)
2823 x=int((-b+sqrt(delta))/(dble(2)*a))
2824 IF(x.GT.ncb-acc) x=ncb-acc
2825 bande_k821=dble(x)*dble(nelim+acc+x)
2826 ENDIF
2827 IF(have_type1_son)THEN
2828 IF(k50.EQ.0)THEN
2829 x=int((buf_size-dble(nfront))/dble(nfront+1))
2830 bande_k821=dble(x)*dble(nfront)
2831 ELSE
2832 a=dble(1)
2833 b=dble(acc+2+nelim)
2834 c=-buf_size+dble(acc+nelim)
2835 delta=(b*b)-(dble(4)*a*c)
2836 x=int((-b+sqrt(delta))/(dble(2)*a))
2837 IF(x.GT.ncb-acc) x=ncb-acc
2838 bande_k821=dble(x)*dble(nelim+acc+x)
2839 ENDIF
2840 ENDIF
2841 max_mem_allow=bande_k821
2842 IF(bdc_md)THEN
2843 max_mem_allow=min(
2844 & min(mem_size_weak(i),mem_size_strong(i)),
2845 & bande_k821)
2846 max_mem_allow=max(dble(0),max_mem_allow)
2847 ENDIF
2848 IF(k50.EQ.0)THEN
2849 kmax=int(max_mem_allow/dble(nfront))
2850 x=int((max_load-temp(i))/
2851 & (dble(nelim)*dble(2*nfront-nelim)))
2852 IF(x.GE.kmax)THEN
2853 IF(kmax.GE.kmin)THEN
2854 x=kmax
2855 nb_sat=nb_sat+1
2856 ELSE
2857 x=0
2858 ENDIF
2859 ELSE
2860 IF(x.LT.kmin)THEN
2861 x=0
2862 ENDIF
2863 ENDIF
2864 IF((acc+x).GT.ncb) x=ncb-acc
2865 ENDIF
2866 IF(k50.NE.0)THEN
2867 a=dble(1)
2868 b=dble(acc+nelim)
2869 c=dble(-max_mem_allow)
2870 delta=((b*b)-(dble(4)*a*c))
2871 kmax=int((-b+sqrt(delta))/(dble(2)*a))
2872 a=dble(nelim)
2873 b=dble(nelim)*(dble(nelim)+dble(2*acc+1))
2874 c=-(max_load-temp(i))
2875 delta=(b*b-(dble(4)*a*c))
2876 x=int((-b+sqrt(delta))/(dble(2)*a))
2877 IF(x.LT.0) THEN
2878 WRITE(*,*)myid,
2879 & ': Internal error 1 in DMUMPS_SET_PARTI_FLOP_IRR'
2880 CALL mumps_abort()
2881 ENDIF
2882 IF(x.GE.kmax)THEN
2883 IF(kmax.GE.kmin)THEN
2884 x=kmax
2885 nb_sat=nb_sat+1
2886 ELSE
2887 x=0
2888 ENDIF
2889 ELSE
2890 IF(x.LT.kmin)THEN
2891 x=0
2892 ENDIF
2893 ENDIF
2894 IF((acc+x).GT.ncb) x=ncb-acc
2895 ENDIF
2896 nb_rows(i)=x
2897 acc=acc+x
2898 chosen=chosen+1
2899 IF(smp)THEN
2900 IF(min_load.GT.temp(i))THEN
2901 min_load=temp(i)
2902 pos_min_load=i
2903 ENDIF
2904 ENDIF
2905 tmp_sum=max_load
2906 IF(k50.EQ.0)THEN
2907 max_load=max(max_load,
2908 & (temp(i)+(dble(nelim) *
2909 & dble(nb_rows(i)))+
2910 & (dble(nb_rows(i))*dble(nelim)*
2911 & dble(2*nfront-nelim-1))))
2912 ELSE
2913 max_load=max(max_load,
2914 & temp(i)+(dble(nelim) * dble(nb_rows(i)))*
2915 & dble(2*(nelim+acc)-nb_rows(i)
2916 & -nelim+1))
2917 ENDIF
2918 IF(tmp_sum.LT.max_load)THEN
2919 ENDIF
2920 IF(ncb-acc.LT.kmin) GOTO 888
2921 IF(ncb.EQ.acc) GOTO 888
2922 IF(acc.GT.ncb) THEN
2923 WRITE(*,*)myid,
2924 & ': Internal error 2 in DMUMPS_SET_PARTI_FLOP_IRR'
2925 CALL mumps_abort()
2926 ENDIF
2927 ENDDO
2928 888 CONTINUE
2929 somme=dble(0)
2930 x=nfront-ncb
2931 IF((acc.GT.ncb))THEN
2932 WRITE(*,*)myid,
2933 & ': Internal error 3 in DMUMPS_SET_PARTI_FLOP_IRR'
2934 CALL mumps_abort()
2935 ENDIF
2936 IF((acc.LT.ncb))THEN
2937 IF(k50.NE.0)THEN
2938 IF(small_set.LE.others)THEN
2939 IF((nb_sat.EQ.small_set).AND.(small_set.LT.
2940 & nslaves_ref))THEN
2941 small_set=ref+1
2942 ref=ref+1
2943 nb_rows=0
2944 GOTO 323
2945 ENDIF
2946 DO i=1,small_set
2947 max_load=temp_max_load
2948 additionnal_rows=ncb-acc
2949 somme=dble(nelim)*
2950 & dble(additionnal_rows)*
2951 & dble(2*nfront-additionnal_rows-nelim
2952 & +1)
2953 somme=somme/dble(small_set-nb_sat)
2954 nb_rows=0
2955 nb_zero=0
2956 acc=0
2957 chosen=0
2958 nb_sat=0
2959 IF(smp)THEN
2960 min_load=temp(1)
2961 pos_min_load=1
2962 ENDIF
2963 DO j=1,small_set
2964 a=dble(1)
2965 b=dble(acc+2)
2966 c=-buf_size+dble(acc+nelim)
2967 delta=(b*b)-(dble(4)*a*c)
2968 x=int((-b+sqrt(delta))/(dble(2)*a))
2969 IF(x.GT.ncb-acc) x=ncb-acc
2970 bande_k821=dble(x)*dble(nelim+acc+x)
2971 IF(have_type1_son)THEN
2972 a=dble(1)
2973 b=dble(acc+2+nelim)
2974 c=-buf_size+dble(acc+nelim)
2975 delta=(b*b)-(dble(4)*a*c)
2976 x=int((-b+sqrt(delta))/(dble(2)*a))
2977 IF(x.GT.ncb-acc) x=ncb-acc
2978 bande_k821=dble(x)*dble(nelim+acc+x)
2979 ENDIF
2980 max_mem_allow=bande_k821
2981 IF(bdc_md)THEN
2982 max_mem_allow=min(
2983 & min(mem_size_weak(j),mem_size_strong(j)),
2984 & bande_k821)
2985 max_mem_allow=max(dble(0),
2986 & max_mem_allow)
2987 ENDIF
2988 a=dble(1)
2989 b=dble(acc+nelim)
2990 c=dble(-max_mem_allow)
2991 delta=((b*b)-(dble(4)*a*c))
2992 kmax=int((-b+sqrt(delta))/(dble(2)*a))
2993 a=dble(nelim)
2994 b=(dble(nelim)*dble(nelim+2*acc+1))
2995 c=-(max_load-temp(j)+somme)
2996 delta=(b*b-(dble(4)*a*c))
2997 x=int((-b+sqrt(delta))/(dble(2)*a))
2998 x=x+1
2999 IF(x.LT.0) THEN
3000 WRITE(*,*)myid,
3001 & ': Internal error 4 in DMUMPS_SET_PARTI_FLOP_IRR'
3002 CALL mumps_abort()
3003 ENDIF
3004 IF(x.GE.kmax)THEN
3005 IF(kmax.GE.kmin)THEN
3006 x=kmax
3007 nb_sat=nb_sat+1
3008 ELSE
3009 nb_zero=nb_zero+1
3010 x=0
3011 ENDIF
3012 ELSE
3013 IF(x.LT.min(kmin,kmax))THEN
3014 nb_zero=nb_zero+1
3015 x=0
3016 ENDIF
3017 ENDIF
3018 IF((acc+x).GT.ncb) x=ncb-acc
3019 nb_rows(j)=x
3020 IF(smp)THEN
3021 IF(min_load.GT.temp(j))THEN
3022 min_load=temp(j)
3023 pos_min_load=i
3024 ENDIF
3025 ENDIF
3026 chosen=chosen+1
3027 acc=acc+x
3028 tmp_sum=max_load
3029 temp_max_load=max(temp_max_load,
3030 & temp(j)+(dble(nelim) *
3031 & dble(nb_rows(j)))*
3032 & dble(2*(nelim+
3033 & acc)-nb_rows(j)
3034 & -nelim+1))
3035 IF(ref.LE.number_of_procs-1)THEN
3036 IF(temp_max_load.GT.temp(ref+1))THEN
3037 IF(small_set.LT.nslaves_ref)THEN
3038 small_set=ref+1
3039 ref=ref+1
3040 nb_rows=0
3041 GOTO 323
3042 ENDIF
3043 ENDIF
3044 ENDIF
3045 IF(ncb.EQ.acc) GOTO 666
3046 ENDDO
3047 IF(nb_sat.EQ.small_set)THEN
3048 IF(small_set.LT.nslaves_ref)THEN
3049 small_set=ref+1
3050 ref=ref+1
3051 nb_rows=0
3052 GOTO 323
3053 ELSE
3054 GOTO 434
3055 ENDIF
3056 ENDIF
3057 IF(nb_zero.EQ.small_set)THEN
3058 IF(small_set.LT.nslaves_ref)THEN
3059 small_set=ref+1
3060 ref=ref+1
3061 nb_rows=0
3062 GOTO 323
3063 ELSE
3064 GOTO 434
3065 ENDIF
3066 ENDIF
3067 IF((nb_sat+nb_zero).EQ.small_set)THEN
3068 IF(small_set.LT.nslaves_ref)THEN
3069 small_set=ref+1
3070 ref=ref+1
3071 nb_rows=0
3072 GOTO 323
3073 ELSE
3074 GOTO 434
3075 ENDIF
3076 ENDIF
3077 ENDDO
3078 434 CONTINUE
3079 additionnal_rows=ncb-acc
3080 IF(additionnal_rows.NE.0)THEN
3081 IF(additionnal_rows.LT.kmin)THEN
3082 i=chosen
3083 j=acc
3084 436 CONTINUE
3085 IF(nb_rows(i).NE.0)THEN
3086 j=j-nb_rows(i)
3087 a=dble(1)
3088 b=dble(j+2)
3089 c=-buf_size+dble(j+nelim)
3090 delta=(b*b)-(dble(4)*a*c)
3091 x=int((-b+sqrt(delta))/(dble(2)*a))
3092 IF(x.GT.ncb-j) x=ncb-j
3093 bande_k821=dble(x)*dble(nelim+j+x)
3094 IF(have_type1_son)THEN
3095 a=dble(1)
3096 b=dble(j+2+nelim)
3097 c=-buf_size+dble(j+nelim)
3098 delta=(b*b)-(dble(4)*a*c)
3099 x=int((-b+sqrt(delta))/(dble(2)*a))
3100 IF(x.GT.ncb-j) x=ncb-j
3101 bande_k821=dble(x)*dble(nelim+j+x)
3102 ENDIF
3103 max_mem_allow=bande_k821
3104 IF(bdc_md)THEN
3105 max_mem_allow=min(
3106 & min(mem_size_weak(i),mem_size_strong(i)),
3107 & bande_k821)
3108 max_mem_allow=max(dble(0),
3109 & max_mem_allow)
3110 ENDIF
3111 a=dble(1)
3112 b=dble(j+nelim)
3113 c=dble(-max_mem_allow)
3114 delta=((b*b)-(dble(4)*a*c))
3115 kmax=int((-b+sqrt(delta))/(dble(2)*a))
3116 IF(nb_rows(i).NE.kmax)THEN
3117 IF(ncb-j.LE.kmax)THEN
3118 nb_rows(i)=+ncb-j
3119 additionnal_rows=0
3120 ENDIF
3121 ENDIF
3122 temp_max_load=max(temp_max_load,
3123 & temp(i)+
3124 & (dble(nelim) * dble(nb_rows(i)))*
3125 & dble(2*(nelim+
3126 & acc)-nb_rows(i)
3127 & -nelim+1))
3128 IF(ref.LE.number_of_procs-1)THEN
3129 IF(temp_max_load.GT.temp(ref+1))THEN
3130 IF(small_set.LT.nslaves_ref)THEN
3131 small_set=ref+1
3132 ref=ref+1
3133 nb_rows=0
3134 GOTO 323
3135 ENDIF
3136 ENDIF
3137 ENDIF
3138 ELSE
3139 i=i-1
3140 IF(i.NE.0)GOTO 436
3141 ENDIF
3142 IF(additionnal_rows.NE.0)THEN
3143 i=chosen
3144 IF(i.NE.small_set)THEN
3145 i=i+1
3146 IF(nb_rows(i).NE.0)THEN
3147 WRITE(*,*)myid,
3148 & ': Internal error 5 in DMUMPS_SET_PARTI_FLOP_IRR'
3149 CALL mumps_abort()
3150 ENDIF
3151 ENDIF
3152 nb_rows(i)=nb_rows(i)+additionnal_rows
3153 additionnal_rows=0
3154 ENDIF
3155 chosen=i
3156 ENDIF
3157 ENDIF
3158 i=chosen+1
3159 DO WHILE ((additionnal_rows.NE.0)
3160 & .AND.(i.LE.number_of_procs))
3161 IF((temp(i).LE.max_load))THEN
3162 a=dble(1)
3163 b=dble(acc+2)
3164 c=-buf_size+dble(acc+nelim)
3165 delta=(b*b)-(dble(4)*a*c)
3166 x=int((-b+sqrt(delta))/(dble(2)*a))
3167 IF(x.GT.ncb-acc) x=ncb-acc
3168 bande_k821=dble(x)*dble(nelim+acc+x)
3169 IF(have_type1_son)THEN
3170 a=dble(1)
3171 b=dble(acc+2+nelim)
3172 c=-buf_size+dble(acc+nelim)
3173 delta=(b*b)-(dble(4)*a*c)
3174 x=int((-b+sqrt(delta))/(dble(2)*a))
3175 IF(x.GT.ncb-acc) x=ncb-acc
3176 bande_k821=dble(x)*dble(nelim+acc+x)
3177 ENDIF
3178 max_mem_allow=bande_k821
3179 IF(bdc_md)THEN
3180 max_mem_allow=min(
3181 & min(mem_size_weak(i),mem_size_strong(i)),
3182 & bande_k821)
3183 max_mem_allow=max(dble(0),
3184 & max_mem_allow)
3185 ENDIF
3186 a=dble(1)
3187 b=dble(acc+nelim)
3188 c=dble(-max_mem_allow)
3189 delta=((b*b)-(dble(4)*a*c))
3190 kmax=int((-b+sqrt(delta))/(dble(2)*a))
3191 a=dble(nelim)
3192 b=dble(nelim)*dble(nelim+2*acc+1)
3193 c=-(max_load-temp(i))
3194 delta=(b*b-(dble(4)*a*c))
3195 x=int((-b+sqrt(delta))/(dble(2)*a))
3196 IF(x.GE.kmax)THEN
3197 IF(kmax.GE.kmin)THEN
3198 x=kmax
3199 ELSE
3200 x=0
3201 ENDIF
3202 ELSE
3203 IF(x.LT.kmin)THEN
3204 x=0
3205 ENDIF
3206 ENDIF
3207 IF((acc+x).GT.ncb) x=ncb-acc
3208 nb_rows(i)=x
3209 acc=acc+x
3210 additionnal_rows=ncb-acc
3211 ELSE IF((temp(i).GT.max_load))THEN
3212 max_load=temp(i)
3213 nb_sat=0
3214 acc=0
3215 nb_rows=0
3216 DO j=1,i
3217 a=dble(1)
3218 b=dble(acc+2)
3219 c=-buf_size+dble(acc+nelim)
3220 delta=(b*b)-(dble(4)*a*c)
3221 x=int((-b+sqrt(delta))/(dble(2)*a))
3222 IF(x.GT.ncb-acc) x=ncb-acc
3223 bande_k821=dble(x)*dble(nelim+acc+x)
3224 IF(have_type1_son)THEN
3225 a=dble(1)
3226 b=dble(acc+2+nelim)
3227 c=-buf_size+dble(acc+nelim)
3228 delta=(b*b)-(dble(4)*a*c)
3229 x=int((-b+sqrt(delta))/(dble(2)*a))
3230 IF(x.GT.ncb-acc) x=ncb-acc
3231 bande_k821=dble(x)*dble(nelim+acc+x)
3232 ENDIF
3233 max_mem_allow=bande_k821
3234 IF(bdc_md)THEN
3235 max_mem_allow=min(
3236 & min(mem_size_weak(j),mem_size_strong(j)),
3237 & bande_k821)
3238 max_mem_allow=max(dble(0),
3239 & max_mem_allow)
3240 ENDIF
3241 a=dble(1)
3242 b=dble(acc+nelim)
3243 c=dble(-max_mem_allow)
3244 delta=((b*b)-(dble(4)*a*c))
3245 kmax=int((-b+sqrt(delta))/(dble(2)*a))
3246 a=dble(nelim)
3247 b=dble(nelim)*dble(nelim+2*acc+1)
3248 c=-(max_load-temp(j))
3249 delta=(b*b-(dble(4)*a*c))
3250 x=int((-b+sqrt(delta))/(dble(2)*a))
3251 IF(x.LT.0) THEN
3252 WRITE(*,*)myid,
3253 & ': internal error 6 in dmumps_set_parti_flop_irr'
3254 CALL MUMPS_ABORT()
3255 ENDIF
3256.GE. IF(XKMAX)THEN
3257.GE. IF(KMAXKMIN)THEN
3258 X=KMAX
3259 NB_SAT=NB_SAT+1
3260 ELSE
3261 X=0
3262 ENDIF
3263 ELSE
3264.LT. IF(Xmin(KMIN,KMAX))THEN
3265 X=0
3266 ENDIF
3267 ENDIF
3268.GT. IF((ACC+X)NCB) X=NCB-ACC
3269 NB_ROWS(J)=X
3270 IF(SMP)THEN
3271.GT. IF(MIN_LOADTEMP(J))THEN
3272 MIN_LOAD=TEMP(J)
3273 POS_MIN_LOAD=i
3274 ENDIF
3275 ENDIF
3276 ACC=ACC+X
3277 MAX_LOAD=max(MAX_LOAD,
3278 & TEMP(J)+
3279 & (dble(NELIM)*dble(NB_ROWS(J)))*
3280 & dble(2*(NELIM+
3281 & ACC)-NB_ROWS(J)
3282 & -NELIM+1))
3283.EQ. IF(NCBACC) GOTO 741
3284.LT. IF(NCB-ACCKMIN) GOTO 210
3285 ENDDO
3286 210 CONTINUE
3287 ENDIF
3288 741 CONTINUE
3289 i=i+1
3290 ADDITIONNAL_ROWS=NCB-ACC
3291 ENDDO
3292 CHOSEN=i-1
3293.NE. IF(ADDITIONNAL_ROWS0)THEN
3294 ADDITIONNAL_ROWS=NCB-ACC
3295 SOMME=dble(NELIM)*dble(ADDITIONNAL_ROWS)*
3296 & dble(2*NFRONT-ADDITIONNAL_ROWS-
3297 & NELIM+1)
3298 SOMME=SOMME/dble(NUMBER_OF_PROCS)
3299 NB_ROWS=0
3300 ACC=0
3301 CHOSEN=0
3302 IF(SMP)THEN
3303 MIN_LOAD=TEMP(1)
3304 POS_MIN_LOAD=1
3305 ENDIF
3306 DO i=1,OTHERS
3307 A=dble(1)
3308 B=dble(ACC+2)
3309 C=-BUF_SIZE+dble(ACC+NELIM)
3310 DELTA=(B*B)-(dble(4)*A*C)
3311 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3312.GT. IF(XNCB-ACC) X=NCB-ACC
3313 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3314 IF(HAVE_TYPE1_SON)THEN
3315 A=dble(1)
3316 B=dble(ACC+2+NELIM)
3317 C=-BUF_SIZE+dble(ACC+NELIM)
3318 DELTA=(B*B)-(dble(4)*A*C)
3319 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3320.GT. IF(XNCB-ACC) X=NCB-ACC
3321 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3322 ENDIF
3323 MAX_MEM_ALLOW=BANDE_K821
3324 IF(BDC_MD)THEN
3325 MAX_MEM_ALLOW=min(
3326 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3327 & BANDE_K821)
3328 MAX_MEM_ALLOW=max(dble(0),
3329 & MAX_MEM_ALLOW)
3330 ENDIF
3331 A=dble(1)
3332 B=dble(ACC+NELIM)
3333 C=dble(-MAX_MEM_ALLOW)
3334 DELTA=((B*B)-(dble(4)*A*C))
3335 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3336 A=dble(NELIM)
3337 B=dble(NELIM)*dble(NELIM+2*ACC+1)
3338 C=-(MAX_LOAD-TEMP(i)+SOMME)
3339 DELTA=(B*B-(dble(4)*A*C))
3340 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3341.LT. IF(X0) THEN
3342 WRITE(*,*)MYID,
3343 & ': internal error 7 in dmumps_set_parti_flop_irr'
3344 CALL MUMPS_ABORT()
3345 ENDIF
3346.GE. IF(XKMAX)THEN
3347.GE. IF(KMAXKMIN)THEN
3348 X=KMAX
3349 ELSE
3350 X=0
3351 ENDIF
3352 ELSE
3353.LT. IF(Xmin(KMIN,KMAX))THEN
3354 X=min(KMAX,KMIN)
3355 ENDIF
3356 ENDIF
3357.GT. IF((ACC+X)NCB) X=NCB-ACC
3358 NB_ROWS(i)=X
3359 IF(SMP)THEN
3360.GT. IF(MIN_LOADTEMP(i))THEN
3361 MIN_LOAD=TEMP(i)
3362 POS_MIN_LOAD=i
3363 ENDIF
3364 ENDIF
3365 CHOSEN=CHOSEN+1
3366 ACC=ACC+X
3367.EQ. IF(NCBACC) GOTO 666
3368.LT. IF(NCB-ACCKMIN) GOTO 488
3369 ENDDO
3370 488 CONTINUE
3371 ADDITIONNAL_ROWS=NCB-ACC
3372 SOMME=dble(NELIM)*
3373 & dble(ADDITIONNAL_ROWS)*
3374 & dble(2*NFRONT-ADDITIONNAL_ROWS-
3375 & NELIM+1)
3376 SOMME=SOMME/dble(NUMBER_OF_PROCS)
3377 NB_ROWS=0
3378 ACC=0
3379 CHOSEN=0
3380 IF(SMP)THEN
3381 MIN_LOAD=TEMP(1)
3382 POS_MIN_LOAD=1
3383 ENDIF
3384 DO i=1,OTHERS
3385 A=dble(1)
3386 B=dble(ACC+2)
3387 C=-BUF_SIZE+dble(ACC+NELIM)
3388 DELTA=(B*B)-(dble(4)*A*C)
3389 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3390.GT. IF(XNCB-ACC) X=NCB-ACC
3391 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3392 IF(HAVE_TYPE1_SON)THEN
3393 A=dble(1)
3394 B=dble(ACC+2+NELIM)
3395 C=-BUF_SIZE+dble(ACC+NELIM)
3396 DELTA=(B*B)-(dble(4)*A*C)
3397 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3398.GT. IF(XNCB-ACC) X=NCB-ACC
3399 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3400 ENDIF
3401 MAX_MEM_ALLOW=BANDE_K821
3402 IF(BDC_MD)THEN
3403 MAX_MEM_ALLOW=min(BANDE_K821,
3404 & MEM_SIZE_STRONG(i))
3405 MAX_MEM_ALLOW=max(dble(0),
3406 & MAX_MEM_ALLOW)
3407 ENDIF
3408 A=dble(1)
3409 B=dble(ACC+NELIM)
3410 C=dble(-MAX_MEM_ALLOW)
3411 DELTA=((B*B)-(dble(4)*A*C))
3412 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3413 A=dble(NELIM)
3414 B=dble(NELIM)*dble(NELIM+2*ACC+1)
3415 C=-(MAX_LOAD-TEMP(i)+SOMME)
3416 DELTA=(B*B-(dble(4)*A*C))
3417 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3418.LT. IF(X0) THEN
3419 WRITE(*,*)MYID,
3420 & ': internal error 8 in dmumps_set_parti_flop_irr'
3421 CALL MUMPS_ABORT()
3422 ENDIF
3423.GE. IF(XKMAX)THEN
3424 X=KMAX
3425 ELSE
3426.LT. IF(XKMIN)THEN
3427 X=KMIN
3428 ENDIF
3429 ENDIF
3430.GT. IF((ACC+X)NCB) X=NCB-ACC
3431 NB_ROWS(i)=X
3432 IF(SMP)THEN
3433.GT. IF(MIN_LOADTEMP(i))THEN
3434 MIN_LOAD=TEMP(i)
3435 POS_MIN_LOAD=i
3436 ENDIF
3437 ENDIF
3438 CHOSEN=CHOSEN+1
3439 ACC=ACC+X
3440.EQ. IF(NCBACC) GOTO 666
3441.LT. IF(NCB-ACCKMIN) GOTO 477
3442 ENDDO
3443 477 CONTINUE
3444.NE. IF(ACCNCB)THEN
3445 NB_SAT=0
3446 ACC=0
3447 CHOSEN=0
3448 IF(SMP)THEN
3449 MIN_LOAD=TEMP(1)
3450 POS_MIN_LOAD=1
3451 ENDIF
3452 DO i=1,OTHERS
3453 A=dble(1)
3454 B=dble(ACC+2)
3455 C=-BUF_SIZE+dble(ACC+NELIM)
3456 DELTA=(B*B)-(dble(4)*A*C)
3457 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3458.GT. IF(XNCB-ACC) X=NCB-ACC
3459 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3460 IF(HAVE_TYPE1_SON)THEN
3461 A=dble(1)
3462 B=dble(ACC+2+NELIM)
3463 C=-BUF_SIZE+dble(ACC+NELIM)
3464 DELTA=(B*B)-(dble(4)*A*C)
3465 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3466.GT. IF(XNCB-ACC) X=NCB-ACC
3467 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3468 ENDIF
3469 MAX_MEM_ALLOW=BANDE_K821
3470 IF(BDC_MD)THEN
3471 MAX_MEM_ALLOW=min(BANDE_K821,
3472 & MEM_SIZE_STRONG(i))
3473 MAX_MEM_ALLOW=max(dble(0),
3474 & MAX_MEM_ALLOW)
3475 ENDIF
3476 A=dble(1)
3477 B=dble(ACC+NELIM)
3478 C=dble(-MAX_MEM_ALLOW)
3479 DELTA=((B*B)-(dble(4)*A*C))
3480 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3481 X=KMAX-NB_ROWS(i)
3482.GT. IF((ACC+NB_ROWS(i)+X)NCB)
3483 & X=NCB-(ACC+NB_ROWS(i))
3484 NB_ROWS(i)=NB_ROWS(i)+X
3485 IF((dble(NB_ROWS(i))*
3486.EQ. & dble(NB_ROWS(i)+ACC))
3487 & BANDE_K821)THEN
3488 NB_SAT=NB_SAT+1
3489 ENDIF
3490 ACC=ACC+NB_ROWS(i)
3491 IF(SMP)THEN
3492.GT. IF(MIN_LOADTEMP(i))THEN
3493 MIN_LOAD=TEMP(i)
3494 POS_MIN_LOAD=i
3495 ENDIF
3496 ENDIF
3497 CHOSEN=CHOSEN+1
3498.EQ. IF(NCBACC) GOTO 666
3499.LT. IF(NCB-ACCKMIN) GOTO 834
3500 ENDDO
3501 834 CONTINUE
3502 ENDIF
3503.NE. IF(ACCNCB)THEN
3504 ADDITIONNAL_ROWS=NCB-ACC
3505 SOMME=dble(NELIM)*
3506 & dble(ADDITIONNAL_ROWS)*
3507 & dble(2*NFRONT-ADDITIONNAL_ROWS-
3508 & NELIM+1)
3509 SOMME=SOMME/dble(NUMBER_OF_PROCS-NB_SAT)
3510 ACC=0
3511 DO i=1,CHOSEN
3512 A=dble(1)
3513 B=dble(ACC+2)
3514 C=-BUF_SIZE+dble(ACC+NELIM)
3515 DELTA=(B*B)-(dble(4)*A*C)
3516 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3517.GT. IF(XNCB-ACC) X=NCB-ACC
3518 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3519 IF(HAVE_TYPE1_SON)THEN
3520 A=dble(1)
3521 B=dble(ACC+2+NELIM)
3522 C=-BUF_SIZE+dble(ACC+NELIM)
3523 DELTA=(B*B)-(dble(4)*A*C)
3524 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3525.GT. IF(XNCB-ACC) X=NCB-ACC
3526 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
3527 ENDIF
3528 IF((dble(NB_ROWS(i))*
3529.EQ. & dble(NB_ROWS(i)+ACC))
3530 & BANDE_K821)THEN
3531 GOTO 102
3532 ENDIF
3533 A=dble(NELIM)
3534 B=dble(NELIM)*
3535 & dble(NELIM+2*(ACC+NB_ROWS(i))+1)
3536 C=-(SOMME)
3537 DELTA=(B*B-(dble(4)*A*C))
3538 X=int((-B+sqrt(DELTA))/(dble(2)*A))
3539 A=dble(1)
3540 B=dble(ACC+NELIM)
3541 C=dble(-BANDE_K821)
3542 DELTA=((B*B)-(dble(4)*A*C))
3543 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
3544.LT. IF(X0) THEN
3545 WRITE(*,*)MYID,
3546 & ': internal error 9 in dmumps_set_parti_flop_irr'
3547 CALL MUMPS_ABORT()
3548 ENDIF
3549.GT. IF((ACC+X+NB_ROWS(i))NCB)THEN
3550.GT. IF((NCB-ACC)KMAX)THEN
3551 NB_ROWS(i)=KMAX
3552 ELSE
3553 NB_ROWS(i)=NCB-ACC
3554 ENDIF
3555 ELSE
3556.GT. IF((NB_ROWS(i)+X)KMAX)THEN
3557 NB_ROWS(i)=KMAX
3558 ELSE
3559 NB_ROWS(i)=NB_ROWS(i)+X
3560 ENDIF
3561 ENDIF
3562 102 CONTINUE
3563 ACC=ACC+NB_ROWS(i)
3564.EQ. IF(NCBACC) THEN
3565 CHOSEN=i
3566 GOTO 666
3567 ENDIF
3568.LT. IF(NCB-ACCKMIN) THEN
3569 CHOSEN=i
3570 GOTO 007
3571 ENDIF
3572 ENDDO
3573 007 CONTINUE
3574 DO i=1,CHOSEN
3575 NB_ROWS(i)=NB_ROWS(i)+1
3576 ACC=ACC+1
3577.EQ. IF(ACCNCB)GOTO 666
3578 ENDDO
3579.LT. IF(ACCNCB)THEN
3580 IF(SMP)THEN
3581 NB_ROWS(1)=NB_ROWS(1)+NCB-ACC
3582 ELSE
3583 NB_ROWS(POS_MIN_LOAD)=
3584 & NB_ROWS(POS_MIN_LOAD)+NCB-ACC
3585 ENDIF
3586 ENDIF
3587 ENDIF
3588 GOTO 666
3589 ENDIF
3590 ENDIF
3591 GOTO 666
3592 ENDIF
3593 ADDITIONNAL_ROWS=NCB-ACC
3594 i=CHOSEN+1
3595.EQ. IF(NB_SATSMALL_SET) GOTO 777
3596 DO i=1,SMALL_SET
3597 IDWLOAD(i)=i
3598 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
3599 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3600 IF(HAVE_TYPE1_SON)THEN
3601 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
3602 & (dble(NFRONT+1)))
3603 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3604 ENDIF
3605 MAX_MEM_ALLOW=BANDE_K821
3606 IF(BDC_MD)THEN
3607 MAX_MEM_ALLOW=min(
3608 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3609 & BANDE_K821)
3610 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
3611 ENDIF
3612 WLOAD(i)=MAX_MEM_ALLOW
3613 ENDDO
3614 CALL MUMPS_SORT_DOUBLES(SMALL_SET, WLOAD, IDWLOAD)
3615 NB_ZERO=0
3616.EQ..AND. IF((NB_SATSMALL_SET)
3617.LT. & (SMALL_SETNSLAVES_REF))THEN
3618 SMALL_SET=REF+1
3619 REF=REF+1
3620 NB_ROWS=0
3621 GOTO 323
3622 ENDIF
3623.EQ..AND. IF((NB_SATSMALL_SET)
3624.LE. & (SMALL_SETNUMBER_OF_PROCS))GOTO 777
3625 AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT))
3626 AFFECTED=max(AFFECTED,1)
3627 DO i=1,SMALL_SET
3628 KMAX=int(WLOAD(i)/dble(NFRONT))
3629.EQ. IF(NB_ROWS(IDWLOAD(i))KMAX)THEN
3630 GOTO 912
3631 ENDIF
3632 IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED,
3633.GT. & ADDITIONNAL_ROWS))KMAX)THEN
3634.GT. IF(NB_ROWS(IDWLOAD(i))KMAX)THEN
3635 ENDIF
3636 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
3637 & (KMAX-NB_ROWS(IDWLOAD(i)))
3638 NB_ROWS(IDWLOAD(i))=KMAX
3639 NB_SAT=NB_SAT+1
3640.EQ. IF(NB_SATSMALL_SET)THEN
3641.NE. IF(SMALL_SETNSLAVES_REF)THEN
3642 SMALL_SET=REF+1
3643 REF=REF+1
3644 NB_ROWS=0
3645 GOTO 323
3646 ELSE
3647 MAX_LOAD=max(MAX_LOAD,
3648 & (TEMP(IDWLOAD(i))+(dble(NELIM) *
3649 & dble(NB_ROWS(IDWLOAD(i))))+
3650 & (dble(NB_ROWS(IDWLOAD(i)))*
3651 & dble(NELIM))*
3652 & dble(2*NFRONT-NELIM-1)))
3653 GOTO 777
3654 ENDIF
3655 ENDIF
3656 AFFECTED=int(ADDITIONNAL_ROWS/(SMALL_SET-NB_SAT))
3657 AFFECTED=max(AFFECTED,1)
3658 ELSE
3659 IF((NB_ROWS(IDWLOAD(i))+min(AFFECTED,
3660.GE. & ADDITIONNAL_ROWS))KMIN)THEN
3661 X=min(AFFECTED,ADDITIONNAL_ROWS)
3662 NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+
3663 & X
3664 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
3665 ELSE
3666 X=int((MAX_LOAD-TEMP(IDWLOAD(i)))/
3667 & (dble(NELIM)*dble(2*NFRONT-NELIM)))
3668.GT. IF(X+AFFECTEDADDITIONNAL_ROWS)THEN
3669 X=ADDITIONNAL_ROWS
3670 ELSE
3671 X=AFFECTED+X
3672 ENDIF
3673.GE. IF(XKMIN)THEN
3674 NB_ROWS(IDWLOAD(i))=NB_ROWS(IDWLOAD(i))+
3675 & X
3676 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
3677 & X
3678 ELSE
3679 NB_ZERO=NB_ZERO+1
3680 ENDIF
3681 ENDIF
3682 ENDIF
3683 912 CONTINUE
3684 MAX_LOAD=max(MAX_LOAD,
3685 & (TEMP(IDWLOAD(i))+(dble(NELIM)*
3686 & dble(NB_ROWS(IDWLOAD(i))))+
3687 & (dble(NB_ROWS(IDWLOAD(i)))*dble(NELIM))*
3688 & dble(2*NFRONT-NELIM-1)))
3689.LT. IF(SMALL_SETNUMBER_OF_PROCS)THEN
3690.GT. IF(MAX_LOADTEMP(SMALL_SET+1))THEN
3691.LT. IF(SMALL_SETNSLAVES_REF)THEN
3692 SMALL_SET=REF+1
3693 REF=REF+1
3694 NB_ROWS=0
3695 GOTO 323
3696 ENDIF
3697 ENDIF
3698 ENDIF
3699.EQ. IF(SMALL_SETNB_SAT)GOTO 777
3700.EQ. IF(ADDITIONNAL_ROWS0)THEN
3701 CHOSEN=SMALL_SET
3702 GOTO 049
3703 ENDIF
3704 ENDDO
3705 777 CONTINUE
3706.NE..AND..GE. IF((NB_ZERO0)(ADDITIONNAL_ROWSKMIN))THEN
3707 J=NB_ZERO
3708 732 CONTINUE
3709 X=int(ADDITIONNAL_ROWS/(J))
3710.LT. IF(XKMIN)THEN
3711 J=J-1
3712 GOTO 732
3713 ENDIF
3714.LT. IF(X*JADDITIONNAL_ROWS)THEN
3715 X=X+1
3716 ENDIF
3717 DO i=1,SMALL_SET
3718 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
3719 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3720 IF(HAVE_TYPE1_SON)THEN
3721 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
3722 & dble(NFRONT+1))
3723 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3724 ENDIF
3725 MAX_MEM_ALLOW=BANDE_K821
3726 IF(BDC_MD)THEN
3727 MAX_MEM_ALLOW=min(
3728 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3729 & dble(BANDE_K821))
3730 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
3731 ENDIF
3732 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
3733.EQ. IF(NB_ROWS(i)0)THEN
3734.GT. IF(XADDITIONNAL_ROWS)THEN
3735 X=ADDITIONNAL_ROWS
3736 ENDIF
3737.GT. IF(XKMAX)THEN
3738 X=KMAX
3739 ENDIF
3740.GT. IF(XKMIN)THEN
3741 NB_ROWS(i)=X
3742 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
3743 MAX_LOAD=max(MAX_LOAD,
3744 & (TEMP(i)+(dble(NELIM) *
3745 & dble(NB_ROWS(i)))+
3746 & (dble(NB_ROWS(i))*dble(NELIM))*
3747 & dble(2*NFRONT-NELIM-1)))
3748 ENDIF
3749 ENDIF
3750 ENDDO
3751 ENDIF
3752 i=CHOSEN+1
3753.NE. DO WHILE ((ADDITIONNAL_ROWS0)
3754.AND..LE. & (iNUMBER_OF_PROCS))
3755.LE. IF((TEMP(i)MAX_LOAD))THEN
3756 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
3757 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3758 IF(HAVE_TYPE1_SON)THEN
3759 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
3760 & dble(NFRONT+1))
3761 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3762 ENDIF
3763 MAX_MEM_ALLOW=BANDE_K821
3764 IF(BDC_MD)THEN
3765 MAX_MEM_ALLOW=min(
3766 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3767 & BANDE_K821)
3768 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
3769 ENDIF
3770 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
3771 AFFECTED=int((MAX_LOAD-TEMP(i))/
3772 & (dble(NELIM)*dble(2*NFRONT-NELIM)))
3773.GT. IF(AFFECTEDADDITIONNAL_ROWS)THEN
3774 AFFECTED=ADDITIONNAL_ROWS
3775 ENDIF
3776.LT. IF(NB_ROWS(i)KMAX)THEN
3777.GT. IF((AFFECTED+NB_ROWS(i))KMAX)THEN
3778 AFFECTED=KMAX-NB_ROWS(i)
3779 NB_SAT=NB_SAT+1
3780 ELSE
3781.LT. IF((AFFECTED+NB_ROWS(i))
3782 & KMIN)THEN
3783 AFFECTED=0
3784 ENDIF
3785 ENDIF
3786 NB_ROWS(i)=NB_ROWS(i)+AFFECTED
3787 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED
3788 ENDIF
3789.GT. ELSE IF((TEMP(i)MAX_LOAD))THEN
3790.EQ. IF(NB_SATi-1) GOTO 218
3791 X=(ADDITIONNAL_ROWS/(i-1-NB_SAT))
3792 ACC=1
3793 DO J=1,i-1
3794 TMP_SUM=((dble(NELIM) * dble(NB_ROWS(J)+X))
3795 & +(dble(NB_ROWS(J)+X)*dble(NELIM))*
3796 & dble(2*NFRONT-NELIM-1))
3797.GT. IF((TEMP(J)+TMP_SUM)MAX_LOAD)THEN
3798 ACC=0
3799 ENDIF
3800 ENDDO
3801.EQ. IF(ACC1)THEN
3802 MAX_LOAD=TEMP(i)
3803 J=1
3804.NE. DO WHILE ((ADDITIONNAL_ROWS0)
3805.AND..LT. & (Ji))
3806 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
3807 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3808 IF(HAVE_TYPE1_SON)THEN
3809 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
3810 & dble(NFRONT+1))
3811 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3812 ENDIF
3813 AFFECTED=X
3814 MAX_MEM_ALLOW=BANDE_K821
3815 IF(BDC_MD)THEN
3816 MAX_MEM_ALLOW=min(
3817 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
3818 & BANDE_K821)
3819 MAX_MEM_ALLOW=max(dble(0),
3820 & MAX_MEM_ALLOW)
3821 ENDIF
3822 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
3823.GT. IF(AFFECTEDADDITIONNAL_ROWS)THEN
3824 AFFECTED=ADDITIONNAL_ROWS
3825 ENDIF
3826.LT. IF(NB_ROWS(J)KMAX)THEN
3827.GT. IF((AFFECTED+NB_ROWS(J))KMAX)THEN
3828 AFFECTED=KMAX-NB_ROWS(J)
3829 NB_SAT=NB_SAT+1
3830 ELSE
3831.LT. IF((AFFECTED+NB_ROWS(J))
3832 & KMIN)THEN
3833 AFFECTED=0
3834 ENDIF
3835 ENDIF
3836 NB_ROWS(J)=NB_ROWS(J)+AFFECTED
3837 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
3838 & AFFECTED
3839 ENDIF
3840 J=J+1
3841 ENDDO
3842 ELSE
3843 MAX_LOAD=TEMP(i)
3844 J=1
3845.NE. DO WHILE ((ADDITIONNAL_ROWS0)
3846.AND..LT. & (Ji))
3847 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
3848 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3849 IF(HAVE_TYPE1_SON)THEN
3850 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
3851 & dble(NFRONT+1))
3852 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3853 ENDIF
3854 TMP_SUM=((dble(NELIM)* dble(NB_ROWS(J)))
3855 & +(dble(NB_ROWS(J))*dble(NELIM))*
3856 & dble(2*NFRONT-NELIM-1))
3857 X=int((MAX_LOAD-(TEMP(J)+TMP_SUM))/
3858 & (dble(NELIM)*dble(2*NFRONT-NELIM)))
3859.LT. IF(X0)THEN
3860 WRITE(*,*)MYID,
3861 & ': internal error 10 in dmumps_set_parti_flop_irr'
3862 CALL MUMPS_ABORT()
3863 ENDIF
3864 AFFECTED=X
3865 MAX_MEM_ALLOW=BANDE_K821
3866 IF(BDC_MD)THEN
3867 MAX_MEM_ALLOW=min(
3868 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
3869 & BANDE_K821)
3870 MAX_MEM_ALLOW=max(dble(0),
3871 & MAX_MEM_ALLOW)
3872 ENDIF
3873 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
3874.GT. IF(AFFECTEDADDITIONNAL_ROWS)THEN
3875 AFFECTED=ADDITIONNAL_ROWS
3876 ENDIF
3877.LT. IF(NB_ROWS(J)KMAX)THEN
3878.GT. IF((AFFECTED+NB_ROWS(J))KMAX)THEN
3879 AFFECTED=KMAX-NB_ROWS(J)
3880 NB_SAT=NB_SAT+1
3881 ELSE
3882.LT. IF((AFFECTED+NB_ROWS(J))
3883 & KMIN)THEN
3884 AFFECTED=0
3885 ENDIF
3886 ENDIF
3887 NB_ROWS(J)=NB_ROWS(J)+AFFECTED
3888 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
3889 & AFFECTED
3890 ENDIF
3891 J=J+1
3892 ENDDO
3893 ENDIF
3894 ENDIF
3895 218 CONTINUE
3896 i=i+1
3897 ENDDO
3898 CHOSEN=i-1
3899.EQ..AND. IF((CHOSENNUMBER_OF_PROCS-1)
3900.NE. & (ADDITIONNAL_ROWS0))THEN
3901 DO i=1,CHOSEN
3902.GE. IF(NB_ROWS(i)+1KMIN)THEN
3903 NB_ROWS(i)=NB_ROWS(i)+1
3904 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-1
3905 ENDIF
3906 MAX_LOAD=max(MAX_LOAD,
3907 & (TEMP(i)+(dble(NELIM) *
3908 & dble(NB_ROWS(i)))+
3909 & (dble(NB_ROWS(i))*dble(NELIM))*
3910 & dble(2*NFRONT-NELIM-1)))
3911.EQ. IF(ADDITIONNAL_ROWS0) GOTO 048
3912 ENDDO
3913 048 CONTINUE
3914 ENDIF
3915.NE. IF((ADDITIONNAL_ROWS0))THEN
3916.LT. IF(CHOSENNUMBER_OF_PROCS)THEN
3917 i=CHOSEN+1
3918 ELSE
3919.NE. IF(CHOSENNUMBER_OF_PROCS)THEN
3920 WRITE(*,*)MYID,
3921 & ': internal error 11 in dmumps_set_parti_flop_irr'
3922 CALL MUMPS_ABORT()
3923 ENDIF
3924 i=CHOSEN
3925 ENDIF
3926.NE. DO WHILE ((ADDITIONNAL_ROWS0)
3927.AND..LE. & (iNUMBER_OF_PROCS))
3928.LE. IF(TEMP(i)MAX_LOAD)THEN
3929 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
3930 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3931 IF(HAVE_TYPE1_SON)THEN
3932 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
3933 & dble(NFRONT+1))
3934 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
3935 ENDIF
3936 MAX_MEM_ALLOW=BANDE_K821
3937 IF(BDC_MD)THEN
3938 MAX_MEM_ALLOW=min(
3939 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
3940 & BANDE_K821)
3941 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
3942 ENDIF
3943 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
3944 TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i)))
3945 & +(dble(NB_ROWS(i))*dble(NELIM))*
3946 & dble(2*NFRONT-NELIM-1))
3947 X=int((MAX_LOAD-(TEMP(i)+TMP_SUM))/
3948 & (dble(NELIM)*dble(2*NFRONT-NELIM)))
3949 AFFECTED=X
3950.LT. IF(X0)THEN
3951 WRITE(*,*)MYID,
3952 & ': internal error 12 in dmumps_set_parti_flop_irr'
3953 CALL MUMPS_ABORT()
3954 ENDIF
3955.GT. IF(AFFECTEDADDITIONNAL_ROWS)THEN
3956 AFFECTED=ADDITIONNAL_ROWS
3957 ENDIF
3958.LT. IF(NB_ROWS(i)KMAX)THEN
3959.GT. IF((AFFECTED+NB_ROWS(i))KMAX)THEN
3960 AFFECTED=KMAX-NB_ROWS(i)
3961 ELSE
3962.LT. IF((AFFECTED+NB_ROWS(i))
3963 & KMIN)THEN
3964 AFFECTED=0
3965 ENDIF
3966 ENDIF
3967 NB_ROWS(i)=NB_ROWS(i)+AFFECTED
3968 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-AFFECTED
3969 ENDIF
3970.NE. IF(iNUMBER_OF_PROCS) GOTO 624
3971.GT. ELSE IF((TEMP(i)MAX_LOAD))THEN
3972 X=int(ADDITIONNAL_ROWS/i-1)
3973 X=max(X,1)
3974 IF((MAX_LOAD+((dble(NELIM)*
3975 & dble(X))+(dble(
3976 & X)*dble(NELIM))*dble(
3977.LE. & (2*NFRONT-NELIM-1))))TEMP(i))THEN
3978 AFFECTED=X
3979 POS=1
3980 ELSE
3981 POS=0
3982 ENDIF
3983 MAX_LOAD=TEMP(i)
3984 J=1
3985.NE. DO WHILE ((ADDITIONNAL_ROWS0)
3986.AND..LT. & (Ji))
3987 X=int(BUF_SIZE/dble(NCB+1))-1
3988 BANDE_K821=dble(X)*dble(NFRONT)
3989 MAX_MEM_ALLOW=BANDE_K821
3990 IF(HAVE_TYPE1_SON)THEN
3991 X=int((BUF_SIZE-dble(NFRONT))/
3992 & dble(NFRONT+1))
3993 BANDE_K821=dble(X)*dble(NFRONT)
3994 ENDIF
3995 IF(BDC_MD)THEN
3996 MAX_MEM_ALLOW=min(
3997 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
3998 & BANDE_K821)
3999 MAX_MEM_ALLOW=max(dble(0),
4000 & MAX_MEM_ALLOW)
4001 ENDIF
4002 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4003.EQ. IF(POS0)THEN
4004 TMP_SUM=((dble(NELIM) *
4005 & dble(NB_ROWS(J)))
4006 & +(dble(NB_ROWS(J))*dble(NELIM))*
4007 & dble(2*NFRONT-NELIM-1))
4008 X=int((TEMP(i)-(TEMP(J)+TMP_SUM))/
4009 & (dble(NELIM)*dble(2*NFRONT-
4010 & NELIM)))
4011 ELSE
4012 X=int(TMP_SUM)
4013 ENDIF
4014.GT. IF(XADDITIONNAL_ROWS)THEN
4015 X=ADDITIONNAL_ROWS
4016 ENDIF
4017.LT. IF(NB_ROWS(J)KMAX)THEN
4018.GT. IF((X+NB_ROWS(J))KMAX)THEN
4019 X=KMAX-NB_ROWS(J)
4020 ELSE
4021.LT. IF((NB_ROWS(J)+X)
4022 & KMIN)THEN
4023 X=0
4024 ENDIF
4025 ENDIF
4026 NB_ROWS(J)=NB_ROWS(J)+X
4027 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4028 ENDIF
4029 J=J+1
4030 ENDDO
4031 ENDIF
4032 624 CONTINUE
4033 i=i+1
4034 ENDDO
4035 CHOSEN=i-1
4036.NE. IF(ADDITIONNAL_ROWS0)THEN
4037 ACC=0
4038 DO i=1,CHOSEN
4039 X=int(BUF_SIZE/dble(NCB+1))-1
4040 BANDE_K821=dble(X)*dble(NFRONT)
4041 IF(HAVE_TYPE1_SON)THEN
4042 X=int((BUF_SIZE-dble(NFRONT))/
4043 & dble(NFRONT+1))
4044 BANDE_K821=dble(X)*dble(NFRONT)
4045 ENDIF
4046 MAX_MEM_ALLOW=BANDE_K821
4047 IF(BDC_MD)THEN
4048 MAX_MEM_ALLOW=min(
4049 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
4050 & BANDE_K821)
4051 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4052 ENDIF
4053 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4054 TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i)))
4055 & +(dble(NB_ROWS(i))*dble(NELIM))*
4056 & dble(2*NFRONT-NELIM-1))
4057 X=int((MAX_LOAD-
4058 & (TEMP(i)+TMP_SUM))/
4059 & (dble(NELIM)*dble(2*NFRONT-NELIM)))
4060.LT. IF(X0)THEN
4061 WRITE(*,*)MYID,
4062 & ': internal error 13 in dmumps_set_parti_flop_irr'
4063 CALL MUMPS_ABORT()
4064 ENDIF
4065.GT. IF(XADDITIONNAL_ROWS)THEN
4066 X=ADDITIONNAL_ROWS
4067 ENDIF
4068.LT. IF(NB_ROWS(i)KMAX)THEN
4069.GE. IF((X+NB_ROWS(i))KMAX)THEN
4070 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4071 & (KMAX-NB_ROWS(i))
4072 NB_ROWS(i)=KMAX
4073 ELSE
4074.GE. IF((X+NB_ROWS(i))
4075 & KMIN)THEN
4076 NB_ROWS(i)=NB_ROWS(i)+X
4077 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4078 ACC=ACC+1
4079 ELSE
4080 ACC=ACC+1
4081 ENDIF
4082 ENDIF
4083 ENDIF
4084.EQ. IF(ADDITIONNAL_ROWS0)GOTO 049
4085 ENDDO
4086.LT. IF(CHOSENNUMBER_OF_PROCS)THEN
4087 CHOSEN=CHOSEN+1
4088 ENDIF
4089.EQ. IF(ACC0)THEN
4090 ACC=1
4091 ENDIF
4092 X=int(ADDITIONNAL_ROWS/ACC)
4093 X=max(X,1)
4094 ACC=0
4095 DO i=1,CHOSEN
4096 J=int(BUF_SIZE/dble(NCB+1))-1
4097 BANDE_K821=dble(J)*dble(NFRONT)
4098 IF(HAVE_TYPE1_SON)THEN
4099 J=int((BUF_SIZE-dble(NFRONT))/
4100 & dble(NFRONT+1))
4101 BANDE_K821=dble(J)*dble(NFRONT)
4102 ENDIF
4103 MAX_MEM_ALLOW=BANDE_K821
4104 IF(BDC_MD)THEN
4105 MAX_MEM_ALLOW=min(
4106 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
4107 & BANDE_K821)
4108 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4109 ENDIF
4110 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4111 TMP_SUM=((dble(NELIM) * dble(NB_ROWS(i)))
4112 & +(dble(NB_ROWS(i))*dble(NELIM))*
4113 & dble(2*NFRONT-NELIM-1))
4114 J=int((MAX_LOAD-
4115 & (TEMP(i)+TMP_SUM))/
4116 & (dble(NELIM)*dble(2*NFRONT-NELIM)))
4117.LT. IF(NB_ROWS(i)KMAX)THEN
4118.GE. IF((min(X,J)+NB_ROWS(i))KMAX)THEN
4119.GT. IF((KMAX-NB_ROWS(i))
4120 & ADDITIONNAL_ROWS)THEN
4121 NB_ROWS(i)=NB_ROWS(i)+
4122 & ADDITIONNAL_ROWS
4123 ADDITIONNAL_ROWS=0
4124 ELSE
4125 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4126 & (KMAX-NB_ROWS(i))
4127 NB_ROWS(i)=KMAX
4128 ENDIF
4129 ELSE
4130.GE. IF((min(X,J)+NB_ROWS(i))
4131 & KMIN)THEN
4132 NB_ROWS(i)=NB_ROWS(i)+min(X,J)
4133 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4134 & min(X,J)
4135 ACC=ACC+1
4136 ENDIF
4137 ENDIF
4138 ENDIF
4139.EQ. IF(ADDITIONNAL_ROWS0)GOTO 049
4140 ENDDO
4141.GT. IF(ACC0)THEN
4142 DO i=1,CHOSEN
4143 X=int(BUF_SIZE/dble(NCB+1))-1
4144 BANDE_K821=dble(X)*dble(NFRONT)
4145 IF(HAVE_TYPE1_SON)THEN
4146 X=int((BUF_SIZE-dble(NFRONT))/
4147 & dble(NFRONT+1))
4148 BANDE_K821=dble(X)*dble(NFRONT)
4149 ENDIF
4150 MAX_MEM_ALLOW=BANDE_K821
4151 IF(BDC_MD)THEN
4152 MAX_MEM_ALLOW=min(
4153 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)),
4154 & BANDE_K821)
4155 MAX_MEM_ALLOW=max(dble(0),
4156 & MAX_MEM_ALLOW)
4157 ENDIF
4158 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4159.LT. IF(KMAX-NB_ROWS(i)
4160 & ADDITIONNAL_ROWS)THEN
4161 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4162 & (KMAX-NB_ROWS(i))
4163 NB_ROWS(i)=KMAX
4164 ELSE
4165.EQ. IF(NB_ROWS(i)0)THEN
4166.LT. IF(min(KMIN,KMAX)
4167 & ADDITIONNAL_ROWS)THEN
4168 NB_ROWS(i)=min(KMIN,KMAX)
4169 ADDITIONNAL_ROWS=
4170 & ADDITIONNAL_ROWS-
4171 & min(KMIN,KMAX)
4172 ENDIF
4173 ELSE
4174 NB_ROWS(i)=NB_ROWS(i)+
4175 & ADDITIONNAL_ROWS
4176 ADDITIONNAL_ROWS=0
4177 ENDIF
4178 ENDIF
4179.EQ. IF(ADDITIONNAL_ROWS0)GOTO 049
4180 ENDDO
4181 ENDIF
4182 DO i=1,CHOSEN
4183 IDWLOAD(i)=i
4184 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4185 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4186 IF(HAVE_TYPE1_SON)THEN
4187 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4188 & dble(NFRONT+1))
4189 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4190 ENDIF
4191 WLOAD(i)=(BANDE_K821-dble(NB_ROWS(i)*NFRONT))
4192 ENDDO
4193 CALL MUMPS_SORT_DOUBLES(NUMBER_OF_PROCS, WLOAD,
4194 & IDWLOAD)
4195 NB_SAT=0
4196 DO i=1,CHOSEN
4197 X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT))
4198 X=max(X,1)
4199 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4200 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4201 IF(HAVE_TYPE1_SON)THEN
4202 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4203 & dble(NFRONT+1))
4204 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4205 ENDIF
4206 IF(BDC_MD)THEN
4207 MAX_MEM_ALLOW=min(BANDE_K821,
4208 & MEM_SIZE_STRONG(i))
4209 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4210 ENDIF
4211 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4212.LT. IF(NB_ROWS(IDWLOAD(i))KMAX)THEN
4213.LT. IF((NB_ROWS(IDWLOAD(i))+X)KMAX)THEN
4214 NB_ROWS(IDWLOAD(i))=
4215 & NB_ROWS(IDWLOAD(i))+X
4216 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4217 ELSE
4218 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4219 & (KMAX-NB_ROWS(IDWLOAD(i)))
4220 NB_ROWS(IDWLOAD(i))=KMAX
4221 ENDIF
4222 ENDIF
4223.EQ. IF(NB_ROWS(IDWLOAD(i))KMAX)THEN
4224 NB_SAT=NB_SAT+1
4225 ENDIF
4226.EQ. IF(ADDITIONNAL_ROWS0) GOTO 049
4227 ENDDO
4228 DO i=1,CHOSEN
4229 X=int(BUF_SIZE/dble(NCB+1))-1
4230 BANDE_K821=dble(X)*dble(NFRONT)
4231 IF(HAVE_TYPE1_SON)THEN
4232 X=int((BUF_SIZE-dble(NFRONT))/
4233 & dble(NFRONT+1))
4234 BANDE_K821=dble(X)*dble(NFRONT)
4235 ENDIF
4236 MAX_MEM_ALLOW=BANDE_K821
4237 IF(BDC_MD)THEN
4238 MAX_MEM_ALLOW=min(BANDE_K821,
4239 & MEM_SIZE_STRONG(i))
4240 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4241 ENDIF
4242 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4243.LT. IF(KMAX-NB_ROWS(i)ADDITIONNAL_ROWS)THEN
4244 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4245 & (KMAX-NB_ROWS(i))
4246 NB_ROWS(i)=KMAX
4247 ELSE
4248 NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS
4249 ADDITIONNAL_ROWS=0
4250 ENDIF
4251.EQ. IF(ADDITIONNAL_ROWS0)GOTO 049
4252 ENDDO
4253 X=int(ADDITIONNAL_ROWS/CHOSEN)
4254 X=max(X,1)
4255 DO i=1,CHOSEN
4256 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4257 NB_ROWS(i)=NB_ROWS(i)+X
4258.EQ. IF(ADDITIONNAL_ROWS0)GOTO 049
4259 ENDDO
4260 NB_ROWS(1)=NB_ROWS(1)+ADDITIONNAL_ROWS
4261 ENDIF
4262 ENDIF
4263 049 CONTINUE
4264 ENDIF
4265 666 CONTINUE
4266 SOMME=dble(0)
4267 X=0
4268 POS=0
4269 DO i=1,CHOSEN
4270 X=X+NB_ROWS(i)
4271 SOMME=SOMME+ dble(NB_ROWS(i))
4272 ENDDO
4273 GOTO 890
4274.GE..AND. ELSE IF((KEEP(83)NUMBER_OF_PROCS)FORCE_CAND)THEN
4275 MAX_LOAD=dble(0)
4276 DO i=1,OTHERS
4277 MAX_LOAD=max(MAX_LOAD,TEMP(i))
4278 ENDDO
4279 ACC=0
4280 CHOSEN=0
4281 X=1
4282 DO i=1,OTHERS
4283 ENDDO
4284 DO i=2,OTHERS
4285.EQ. IF(TEMP(i)TEMP(1))THEN
4286 X=X+1
4287 ELSE
4288 GOTO 329
4289 ENDIF
4290 ENDDO
4291 329 CONTINUE
4292 TMP_SUM=TOTAL_COST/dble(X)
4293 TEMP_MAX_LOAD=dble(0)
4294 DO i=1,OTHERS
4295.EQ. IF(K500)THEN
4296 X=int(BUF_SIZE/dble(NCB+1))-1
4297 BANDE_K821=dble(X)*dble(NFRONT)
4298 ELSE
4299 A=dble(1)
4300 B=dble(ACC+2)
4301 C=-BUF_SIZE+dble(ACC+NELIM)
4302 DELTA=(B*B)-(dble(4)*A*C)
4303 X=int((-B+sqrt(DELTA))/(dble(2)*A))
4304.GT. IF(XNCB-ACC) X=NCB-ACC
4305 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4306 ENDIF
4307 IF(HAVE_TYPE1_SON)THEN
4308.EQ. IF(K500)THEN
4309 X=int((BUF_SIZE-dble(NFRONT))/dble(NFRONT+1))
4310 BANDE_K821=dble(X)*dble(NFRONT)
4311 ELSE
4312 A=dble(1)
4313 B=dble(ACC+2+NELIM)
4314 C=-BUF_SIZE+dble(ACC+NELIM)
4315 DELTA=(B*B)-(dble(4)*A*C)
4316 X=int((-B+sqrt(DELTA))/(dble(2)*A))
4317.GT. IF(XNCB-ACC) X=NCB-ACC
4318 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4319 ENDIF
4320 ENDIF
4321 MAX_MEM_ALLOW=BANDE_K821
4322 IF(BDC_MD)THEN
4323 MAX_MEM_ALLOW=min(BANDE_K821,
4324 & min(MEM_SIZE_WEAK(i),MEM_SIZE_STRONG(i)))
4325 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4326 ENDIF
4327.EQ. IF(K500)THEN
4328 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4329.GT. IF(TMP_SUM+TEMP(i)MAX_LOAD)THEN
4330 SOMME=MAX_LOAD-TEMP(i)
4331 ELSE
4332 SOMME=TMP_SUM
4333 ENDIF
4334 X=int(SOMME/
4335 & (dble(NELIM)*dble(2*NFRONT-NELIM)))
4336.GT. IF(XKMAX)THEN
4337 X=KMAX
4338 ELSE
4339.LT. IF(XKMIN)THEN
4340 X=min(KMIN,KMAX)
4341 ENDIF
4342 ENDIF
4343.GT. IF((ACC+X)NCB) X=NCB-ACC
4344 ENDIF
4345.NE. IF(K500)THEN
4346 A=dble(1)
4347 B=dble(ACC+NELIM)
4348 C=dble(-MAX_MEM_ALLOW)
4349 DELTA=((B*B)-(dble(4)*A*C))
4350 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
4351 A=dble(NELIM)
4352 B=dble(NELIM)*dble(NELIM+2*ACC+1)
4353.GT. IF(TMP_SUM+TEMP(i)MAX_LOAD)THEN
4354 C=-(MAX_LOAD-TEMP(i))
4355 ELSE
4356 C=-TMP_SUM
4357 ENDIF
4358 DELTA=(B*B-(dble(4)*A*C))
4359 X=int((-B+sqrt(DELTA))/(dble(2)*A))
4360.LT. IF(X0) THEN
4361 WRITE(*,*)MYID,
4362 & ': internal error 14 in dmumps_set_parti_flop_irr'
4363 CALL MUMPS_ABORT()
4364 ENDIF
4365.GE. IF(XKMAX)THEN
4366.GT. IF(KMAXKMIN)THEN
4367 X=KMAX
4368 ELSE
4369 X=0
4370 ENDIF
4371 ELSE
4372.LE. IF(Xmin(KMIN,KMAX))THEN
4373.LT. IF(KMAXKMIN)THEN
4374 X=0
4375 ELSE
4376 X=min(KMIN,KMAX)
4377 ENDIF
4378 ENDIF
4379 ENDIF
4380.GT. IF((ACC+X)NCB) X=NCB-ACC
4381 ENDIF
4382 TEMP_MAX_LOAD=max(TEMP_MAX_LOAD,TEMP(i))
4383 NB_ROWS(i)=X
4384 CHOSEN=CHOSEN+1
4385 ACC=ACC+X
4386.EQ. IF(ACCNCB) GOTO 541
4387 ENDDO
4388 541 CONTINUE
4389.LT. IF(ACCNCB)THEN
4390.EQ. IF(K500)THEN
4391 ADDITIONNAL_ROWS=NCB-ACC
4392 DO J=1,CHOSEN
4393 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4394 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4395 IF(HAVE_TYPE1_SON)THEN
4396 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4397 & dble(NFRONT+1))
4398 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4399 ENDIF
4400 MAX_MEM_ALLOW=BANDE_K821
4401 IF(BDC_MD)THEN
4402 MAX_MEM_ALLOW=min(
4403 & min(MEM_SIZE_WEAK(J),MEM_SIZE_STRONG(J)),
4404 & dble(BANDE_K821))
4405 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4406 ENDIF
4407 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4408.LT. IF((NB_ROWS(J))KMAX)THEN
4409.GT. IF(ADDITIONNAL_ROWS(KMAX-NB_ROWS(J)))THEN
4410 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4411 & (KMAX-NB_ROWS(J))
4412 NB_ROWS(J)=KMAX
4413 ELSE
4414 NB_ROWS(J)=NB_ROWS(J)+ADDITIONNAL_ROWS
4415 ADDITIONNAL_ROWS=0
4416 ENDIF
4417 ENDIF
4418.EQ. IF(ADDITIONNAL_ROWS0)GOTO 889
4419 ENDDO
4420 X=int(ADDITIONNAL_ROWS/CHOSEN)
4421 X=max(X,1)
4422 DO J=1,CHOSEN
4423 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4424 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4425 IF(HAVE_TYPE1_SON)THEN
4426 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4427 & dble(NFRONT+1))
4428 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4429 ENDIF
4430 MAX_MEM_ALLOW=BANDE_K821
4431 IF(BDC_MD)THEN
4432 MAX_MEM_ALLOW=min(BANDE_K821,
4433 & MEM_SIZE_STRONG(J))
4434 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4435 ENDIF
4436 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4437.GT. IF((NB_ROWS(J)+X)KMAX)THEN
4438 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4439 & (KMAX-NB_ROWS(J))
4440 NB_ROWS(J)=KMAX
4441 ELSE
4442 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4443 NB_ROWS(J)=NB_ROWS(J)+X
4444 ENDIF
4445.EQ. IF(ADDITIONNAL_ROWS0)GOTO 889
4446 ENDDO
4447 DO i=1,CHOSEN
4448 X=int(BUF_SIZE/dble(NCB+1))-1
4449 BANDE_K821=dble(X)*dble(NFRONT)
4450 IF(HAVE_TYPE1_SON)THEN
4451 X=int((BUF_SIZE-dble(NFRONT))/
4452 & dble(NFRONT+1))
4453 BANDE_K821=dble(X)*dble(NFRONT)
4454 ENDIF
4455 MAX_MEM_ALLOW=BANDE_K821
4456 IF(BDC_MD)THEN
4457 MAX_MEM_ALLOW=min(BANDE_K821,
4458 & MEM_SIZE_STRONG(i))
4459 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4460 ENDIF
4461 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4462.LT. IF(KMAX-NB_ROWS(i)ADDITIONNAL_ROWS)THEN
4463 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4464 & (KMAX-NB_ROWS(i))
4465 NB_ROWS(i)=KMAX
4466 ELSE
4467 NB_ROWS(i)=NB_ROWS(i)+ADDITIONNAL_ROWS
4468 ADDITIONNAL_ROWS=0
4469 ENDIF
4470.EQ. IF(ADDITIONNAL_ROWS0)GOTO 889
4471 ENDDO
4472 DO i=1,NUMBER_OF_PROCS
4473 IDWLOAD(i)=i
4474 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4475 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4476 IF(HAVE_TYPE1_SON)THEN
4477 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4478 & dble(NFRONT+1))
4479 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4480 ENDIF
4481 WLOAD(i)=(BANDE_K821-(dble(NB_ROWS(i))*
4482 & dble(NFRONT)))
4483 ENDDO
4484 CALL MUMPS_SORT_DOUBLES(NUMBER_OF_PROCS, WLOAD,
4485 & IDWLOAD)
4486 NB_SAT=0
4487 DO i=1,CHOSEN
4488 X=int(ADDITIONNAL_ROWS/(CHOSEN-NB_SAT))
4489 X=max(X,1)
4490 AFFECTED=int(BUF_SIZE/dble(NCB+1))-1
4491 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4492 IF(HAVE_TYPE1_SON)THEN
4493 AFFECTED=int((BUF_SIZE-dble(NFRONT))/
4494 & dble(NFRONT+1))
4495 BANDE_K821=dble(AFFECTED)*dble(NFRONT)
4496 ENDIF
4497 MAX_MEM_ALLOW=BANDE_K821
4498 KMAX=int(MAX_MEM_ALLOW/dble(NFRONT))
4499.LT. IF(NB_ROWS(IDWLOAD(i))KMAX)THEN
4500.LT. IF((NB_ROWS(IDWLOAD(i))+X)KMAX)THEN
4501 NB_ROWS(IDWLOAD(i))=
4502 & NB_ROWS(IDWLOAD(i))+X
4503 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4504 ELSE
4505 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-
4506 & (KMAX-NB_ROWS(IDWLOAD(i)))
4507 NB_ROWS(IDWLOAD(i))=KMAX
4508 ENDIF
4509 ENDIF
4510.EQ. IF(NB_ROWS(IDWLOAD(i))KMAX)THEN
4511 NB_SAT=NB_SAT+1
4512 ENDIF
4513.EQ. IF(ADDITIONNAL_ROWS0) GOTO 889
4514 ENDDO
4515 GOTO 994
4516 ELSE
4517 ACC=0
4518 CHOSEN=0
4519 DO i=1,OTHERS
4520 A=dble(1)
4521 B=dble(ACC+2)
4522 C=-BUF_SIZE+dble(ACC+NELIM)
4523 DELTA=(B*B)-(dble(4)*A*C)
4524 X=int((-B+sqrt(DELTA))/(dble(2)*A))
4525.GT. IF(XNCB-ACC) X=NCB-ACC
4526 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4527 IF(HAVE_TYPE1_SON)THEN
4528 A=dble(1)
4529 B=dble(ACC+2+NELIM)
4530 C=-BUF_SIZE+dble(ACC+NELIM)
4531 DELTA=(B*B)-(dble(4)*A*C)
4532 X=int((-B+sqrt(DELTA))/(dble(2)*A))
4533.GT. IF(XNCB-ACC) X=NCB-ACC
4534 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4535 ENDIF
4536 MAX_MEM_ALLOW=BANDE_K821
4537 IF(BDC_MD)THEN
4538 MAX_MEM_ALLOW=min(BANDE_K821,
4539 & MEM_SIZE_STRONG(i))
4540 MAX_MEM_ALLOW=max(dble(0),MAX_MEM_ALLOW)
4541 ENDIF
4542 A=dble(1)
4543 B=dble(ACC+NELIM)
4544 C=dble(-MAX_MEM_ALLOW)
4545 DELTA=((B*B)-(dble(4)*A*C))
4546 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
4547 X=KMAX-NB_ROWS(i)
4548.GT. IF((ACC+NB_ROWS(i)+X)NCB)
4549 & X=NCB-(ACC+NB_ROWS(i))
4550 NB_ROWS(i)=NB_ROWS(i)+X
4551 ACC=ACC+NB_ROWS(i)
4552 CHOSEN=CHOSEN+1
4553.EQ. IF(NCBACC) GOTO 889
4554 ENDDO
4555 ADDITIONNAL_ROWS=NCB-ACC
4556 ENDIF
4557 ACC=0
4558 CHOSEN=0
4559 DO i=1,OTHERS
4560 A=dble(1)
4561 B=dble(ACC+2)
4562 C=-BUF_SIZE+dble(ACC+NELIM)
4563 DELTA=(B*B)-(dble(4)*A*C)
4564 X=int((-B+sqrt(DELTA))/(dble(2)*A))
4565.GT. IF(XNCB-ACC) X=NCB-ACC
4566 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4567 IF(HAVE_TYPE1_SON)THEN
4568 A=dble(1)
4569 B=dble(ACC+2+NELIM)
4570 C=-BUF_SIZE+dble(ACC+NELIM)
4571 DELTA=(B*B)-(dble(4)*A*C)
4572 X=int((-B+sqrt(DELTA))/(dble(2)*A))
4573.GT. IF(XNCB-ACC) X=NCB-ACC
4574 BANDE_K821=dble(X)*dble(NELIM+ACC+X)
4575 ENDIF
4576 MAX_MEM_ALLOW=BANDE_K821
4577 A=dble(1)
4578 B=dble(ACC+NELIM)
4579 C=dble(-MAX_MEM_ALLOW)
4580 DELTA=((B*B)-(dble(4)*A*C))
4581 KMAX=int((-B+sqrt(DELTA))/(dble(2)*A))
4582 X=KMAX-NB_ROWS(i)
4583.GT. IF((ACC+NB_ROWS(i)+X)NCB)
4584 & X=NCB-(ACC+NB_ROWS(i))
4585 NB_ROWS(i)=NB_ROWS(i)+X
4586 ACC=ACC+NB_ROWS(i)
4587 CHOSEN=CHOSEN+1
4588.EQ. IF(NCBACC) GOTO 889
4589 ENDDO
4590 ADDITIONNAL_ROWS=NCB-ACC
4591 994 CONTINUE
4592 X=int(dble(ADDITIONNAL_ROWS)/dble(OTHERS))
4593.LT. IF((X*OTHERS)ADDITIONNAL_ROWS)THEN
4594 X=X+1
4595 ENDIF
4596 DO i=1,OTHERS
4597 NB_ROWS(i)=NB_ROWS(i)+X
4598 ADDITIONNAL_ROWS=ADDITIONNAL_ROWS-X
4599.LT. IF(ADDITIONNAL_ROWSX)X=ADDITIONNAL_ROWS
4600 ENDDO
4601 CHOSEN=OTHERS
4602 ENDIF
4603 ENDIF
4604 889 CONTINUE
4605 MAX_LOAD=TEMP_MAX_LOAD
4606 890 CONTINUE
4607 J=CHOSEN
4608 X=0
4609 DO i=J,1,-1
4610.EQ. IF(NB_ROWS(i)0)THEN
4611 CHOSEN=CHOSEN-1
4612 ELSE
4613.GT. IF(NB_ROWS(i)0)THEN
4614 X=1
4615 ELSE
4616 WRITE(*,*)MYID,
4617 & ': internal error 15 in dmumps_set_parti_flop_irr'
4618 CALL MUMPS_ABORT()
4619 ENDIF
4620 ENDIF
4621 ENDDO
4622 NSLAVES_NODE=CHOSEN
4623 TAB_POS(NSLAVES_NODE+1)= NCB+1
4624 TAB_POS(SLAVEF+2) = CHOSEN
4625 POS=1
4626 X=1
4627 DO i=1,J
4628.NE. IF(NB_ROWS(i)0)THEN
4629 SLAVES_LIST(X)=TEMP_ID(i)
4630 TAB_POS(X)=POS
4631 POS=POS+NB_ROWS(i)
4632.LE. IF(NB_ROWS(i)0)THEN
4633 WRITE(*,*)MYID,
4634 & ': internal error 16 in dmumps_set_parti_flop_irr'
4635 CALL MUMPS_ABORT()
4636 ENDIF
4637 X=X+1
4638 ENDIF
4639 ENDDO
4640.NE. IF(POS(NCB+1))THEN
4641 WRITE(*,*)MYID,
4642 & ': internal error 17 in dmumps_set_parti_flop_irr',
4643 & POS,NCB+1
4644 CALL MUMPS_ABORT()
4645 ENDIF
4646 END SUBROUTINE DMUMPS_SET_PARTI_FLOP_IRR
4647 SUBROUTINE DMUMPS_LOAD_POOL_CHECK_MEM
4648 & (INODE,UPPER,SLAVEF,KEEP,KEEP8,
4649 & STEP,POOL,LPOOL,PROCNODE,N)
4650 IMPLICIT NONE
4651 INTEGER INODE, LPOOL, SLAVEF, N
4652 INTEGER KEEP(500)
4653 INTEGER(8) KEEP8(150)
4654 INTEGER STEP(KEEP(28)), POOL(LPOOL), PROCNODE(KEEP(28))
4655 LOGICAL UPPER
4656 INTEGER J
4657 DOUBLE PRECISION MEM_COST
4658 INTEGER NBINSUBTREE,i,NBTOP
4659 EXTERNAL DMUMPS_POOL_EMPTY,
4660 & MUMPS_IN_OR_ROOT_SSARBR
4661 LOGICAL DMUMPS_POOL_EMPTY,
4662 & MUMPS_IN_OR_ROOT_SSARBR
4663 NBINSUBTREE = POOL(LPOOL)
4664 NBTOP = POOL(LPOOL - 1)
4665.LT. IF(KEEP(47)2)THEN
4666 WRITE(*,*)'dmumps_load_pool_check_mem must
4667 & be called with k47>=2'
4668 CALL MUMPS_ABORT()
4669 ENDIF
4670.GT..AND..LE. IF((INODE0)(INODEN))THEN
4671 MEM_COST=DMUMPS_LOAD_GET_MEM(INODE)
4672 IF((DM_MEM(MYID)+dble(MEM_COST)+ PEAK_SBTR_CUR_LOCAL-
4673 & SBTR_CUR_LOCAL)
4674.GT. & MAX_PEAK_STK)THEN
4675 DO i=NBTOP-1,1,-1
4676 INODE = POOL( LPOOL - 2 - i)
4677 MEM_COST=DMUMPS_LOAD_GET_MEM(INODE)
4678.LT..OR..GT. IF((INODE0)(INODEN)) THEN
4679 DO J=i+1,NBTOP,-1
4680 POOL(J-1)=POOL(J)
4681 ENDDO
4682 UPPER=.TRUE.
4683 RETURN
4684 ENDIF
4685 IF((DM_MEM(MYID)+dble(MEM_COST)+PEAK_SBTR_CUR_LOCAL-
4686.LE. & SBTR_CUR_LOCAL)
4687 & MAX_PEAK_STK) THEN
4688 DO J=i+1,NBTOP,-1
4689 POOL(J-1)=POOL(J)
4690 ENDDO
4691 UPPER=.TRUE.
4692 RETURN
4693 ENDIF
4694 ENDDO
4695.NE. IF(NBINSUBTREE0)THEN
4696 INODE = POOL( NBINSUBTREE )
4697.NOT. IF(MUMPS_IN_OR_ROOT_SSARBR(PROCNODE(STEP(INODE)),
4698 & KEEP(199)))THEN
4699 WRITE(*,*)
4700 & 'internal error 1 in dmumps_load_pool_check_mem'
4701 CALL MUMPS_ABORT()
4702 ENDIF
4703 UPPER=.FALSE.
4704 RETURN
4705 ENDIF
4706 INODE=POOL(LPOOL-2-NBTOP)
4707 UPPER=.TRUE.
4708 RETURN
4709 ENDIF
4710 ENDIF
4711 UPPER=.TRUE.
4712 END SUBROUTINE DMUMPS_LOAD_POOL_CHECK_MEM
4713 SUBROUTINE DMUMPS_LOAD_SET_SBTR_MEM(WHAT)
4714 IMPLICIT NONE
4715 LOGICAL WHAT
4716.NOT. IF(BDC_POOL_MNG)THEN
4717 WRITE(*,*)'dmumps_load_set_sbtr_mem
4718 & should be called when k81>0 and k47>2'
4719 ENDIF
4720 IF(WHAT)THEN
4721 PEAK_SBTR_CUR_LOCAL=PEAK_SBTR_CUR_LOCAL+
4722 & dble(MEM_SUBTREE(INDICE_SBTR))
4723.NOT. IF(BDC_SBTR) INDICE_SBTR=INDICE_SBTR+1
4724 ELSE
4725 PEAK_SBTR_CUR_LOCAL=dble(0)
4726 SBTR_CUR_LOCAL=dble(0)
4727 ENDIF
4728 END SUBROUTINE DMUMPS_LOAD_SET_SBTR_MEM
4729 DOUBLE PRECISION FUNCTION DMUMPS_LOAD_GET_MEM( INODE )
4730 IMPLICIT NONE
4731 INTEGER INODE,LEVEL,i,NELIM,NFR
4732 DOUBLE PRECISION COST
4733 EXTERNAL MUMPS_TYPENODE
4734 INTEGER MUMPS_TYPENODE
4735 i = INODE
4736 NELIM = 0
4737 10 CONTINUE
4738 IF ( i > 0 ) THEN
4739 NELIM = NELIM + 1
4740 i = FILS_LOAD(i)
4741 GOTO 10
4742 ENDIF
4743 NFR = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253)
4744 LEVEL = MUMPS_TYPENODE( PROCNODE_LOAD(STEP_LOAD(INODE)),
4745 & KEEP_LOAD(199) )
4746.EQ. IF (LEVEL 1) THEN
4747 COST = dble(NFR) * dble(NFR)
4748 ELSE
4749 IF ( K50 == 0 ) THEN
4750 COST = dble(NFR) * dble(NELIM)
4751 ELSE
4752 COST = dble(NELIM) * dble(NELIM)
4753 ENDIF
4754 ENDIF
4755 DMUMPS_LOAD_GET_MEM=COST
4756 RETURN
4757 END FUNCTION DMUMPS_LOAD_GET_MEM
4758 RECURSIVE SUBROUTINE DMUMPS_NEXT_NODE(FLAG,COST,COMM)
4759 USE DMUMPS_BUF
4760 USE MUMPS_FUTURE_NIV2
4761 IMPLICIT NONE
4762 INTEGER COMM,WHAT,IERR
4763 LOGICAL FLAG, EXIT_FLAG
4764 DOUBLE PRECISION COST
4765 DOUBLE PRECISION TO_BE_SENT
4766 EXTERNAL MUMPS_TYPENODE
4767 INTEGER MUMPS_TYPENODE
4768 IF(FLAG)THEN
4769 WHAT=17
4770 IF(BDC_M2_FLOPS)THEN
4771 TO_BE_SENT=DELTA_LOAD-COST
4772 DELTA_LOAD=dble(0)
4773 ELSE IF(BDC_M2_MEM)THEN
4774.AND..NOT. IF(BDC_POOL(BDC_MD))THEN
4775 TO_BE_SENT=max(TMP_M2,POOL_LAST_COST_SENT)
4776 POOL_LAST_COST_SENT=TO_BE_SENT
4777 ELSE IF(BDC_MD)THEN
4778 DELTA_MEM=DELTA_MEM+TMP_M2
4779 TO_BE_SENT=DELTA_MEM
4780 ELSE
4781 TO_BE_SENT=dble(0)
4782 ENDIF
4783 ENDIF
4784 ELSE
4785 WHAT=6
4786 TO_BE_SENT=dble(0)
4787 ENDIF
4788 111 CONTINUE
4789 CALL DMUMPS_BUF_BROADCAST( WHAT,
4790 & COMM, NPROCS,
4791 & FUTURE_NIV2,
4792 & COST,
4793 & TO_BE_SENT,
4794 & MYID, KEEP_LOAD, IERR )
4795 IF ( IERR == -1 )THEN
4796 CALL DMUMPS_LOAD_RECV_MSGS(COMM_LD)
4797 CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
4798 IF (EXIT_FLAG) THEN
4799 GOTO 100
4800 ELSE
4801 GOTO 111
4802 ENDIF
4803.NE. ELSE IF ( IERR 0 ) THEN
4804 WRITE(*,*) "Internal Error in DMUMPS_LOAD_POOL_UPD_NEW_POOL",
4805 & IERR
4806 CALL MUMPS_ABORT()
4807 ENDIF
4808 100 CONTINUE
4809 RETURN
4810 END SUBROUTINE DMUMPS_NEXT_NODE
4811 SUBROUTINE DMUMPS_UPPER_PREDICT(INODE,STEP,NSTEPS,PROCNODE,FRERE,
4812 & NE,COMM,SLAVEF,MYID,KEEP,KEEP8,N)
4813 USE DMUMPS_BUF
4814 IMPLICIT NONE
4815 INTEGER INODE,NSTEPS,MYID,SLAVEF,COMM,N
4816 INTEGER KEEP(500)
4817 INTEGER(8) KEEP8(150)
4818 INTEGER FRERE(NSTEPS),NE(NSTEPS),STEP(N),PROCNODE(NSTEPS)
4819 EXTERNAL MUMPS_IN_OR_ROOT_SSARBR,MUMPS_PROCNODE
4820 LOGICAL MUMPS_IN_OR_ROOT_SSARBR
4821 INTEGER i,NCB,NELIM
4822 INTEGER MUMPS_PROCNODE
4823 INTEGER FATHER_NODE,FATHER,WHAT,IERR
4824 EXTERNAL MUMPS_TYPENODE
4825 INTEGER MUMPS_TYPENODE
4826 LOGICAL :: EXIT_FLAG
4827.NOT..AND..NOT. IF((BDC_M2_MEM)(BDC_M2_FLOPS))THEN
4828 WRITE(*,*)MYID,': problem in dmumps_upper_predict'
4829 CALL MUMPS_ABORT()
4830 ENDIF
4831.LT..OR..GT. IF((INODE0)(INODEN)) THEN
4832 RETURN
4833 ENDIF
4834 i=INODE
4835 NELIM = 0
4836 10 CONTINUE
4837 IF ( i > 0 ) THEN
4838 NELIM = NELIM + 1
4839 i = FILS_LOAD(i)
4840 GOTO 10
4841 ENDIF
4842 NCB=ND_LOAD(STEP_LOAD(INODE))-NELIM + KEEP_LOAD(253)
4843 WHAT=5
4844 FATHER_NODE=DAD_LOAD(STEP_LOAD(INODE))
4845.EQ. IF (FATHER_NODE0) THEN
4846 RETURN
4847 ENDIF
4848.EQ..AND. IF((FRERE(STEP(FATHER_NODE))0)
4849.EQ..OR. & ((FATHER_NODEKEEP(38))
4850.EQ. & (FATHER_NODEKEEP(20))))THEN
4851 RETURN
4852 ENDIF
4853 IF(MUMPS_IN_OR_ROOT_SSARBR(PROCNODE(STEP(FATHER_NODE)),
4854 & KEEP(199))) THEN
4855 RETURN
4856 ENDIF
4857 FATHER=MUMPS_PROCNODE(PROCNODE(STEP(FATHER_NODE)),KEEP(199))
4858.EQ. IF(FATHERMYID)THEN
4859 IF(BDC_M2_MEM)THEN
4860 CALL DMUMPS_PROCESS_NIV2_MEM_MSG(FATHER_NODE)
4861 ELSEIF(BDC_M2_FLOPS)THEN
4862 CALL DMUMPS_PROCESS_NIV2_FLOPS_MSG(FATHER_NODE)
4863 ENDIF
4864.EQ..OR..EQ. IF((KEEP(81)2)(KEEP(81)3))THEN
4865 IF(MUMPS_TYPENODE(PROCNODE_LOAD(STEP_LOAD(INODE)),
4866.EQ. & KEEP(199))1)THEN
4867 CB_COST_ID(POS_ID)=INODE
4868 CB_COST_ID(POS_ID+1)=1
4869 CB_COST_ID(POS_ID+2)=POS_MEM
4870 POS_ID=POS_ID+3
4871 CB_COST_MEM(POS_MEM)=int(MYID,8)
4872 POS_MEM=POS_MEM+1
4873 CB_COST_MEM(POS_MEM)=int(NCB,8)*int(NCB,8)
4874 POS_MEM=POS_MEM+1
4875 ENDIF
4876 ENDIF
4877 GOTO 666
4878 ENDIF
4879 111 CONTINUE
4880 CALL DMUMPS_BUF_SEND_FILS(WHAT, COMM, NPROCS,
4881 & FATHER_NODE,INODE,NCB, KEEP,MYID,
4882 & FATHER, IERR)
4883 IF (IERR == -1 ) THEN
4884 CALL DMUMPS_LOAD_RECV_MSGS(COMM_LD)
4885 CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
4886 IF (EXIT_FLAG) THEN
4887 GOTO 666
4888 ELSE
4889 GOTO 111
4890 ENDIF
4891.NE. ELSE IF ( IERR 0 ) THEN
4892 WRITE(*,*) "Internal Error in DMUMPS_UPPER_PREDICT",
4893 & IERR
4894 CALL MUMPS_ABORT()
4895 ENDIF
4896 666 CONTINUE
4897 RETURN
4898 END SUBROUTINE DMUMPS_UPPER_PREDICT
4899 SUBROUTINE DMUMPS_REMOVE_NODE(INODE,NUM_CALL)
4900 IMPLICIT NONE
4901 DOUBLE PRECISION MAXI
4902 INTEGER i,J,IND_MAXI
4903 INTEGER INODE,NUM_CALL
4904 IF(BDC_M2_MEM)THEN
4905.EQ..AND..OR. IF(((NUM_CALL1)(BDC_MD))
4906.EQ..AND..NOT. & ((NUM_CALL2)(BDC_MD)))THEN
4907 RETURN
4908 ENDIF
4909 ENDIF
4910.EQ..AND. IF((FRERE_LOAD(STEP_LOAD(INODE))0)
4911.EQ..OR. & ((INODEKEEP_LOAD(38))
4912.EQ. & (INODEKEEP_LOAD(20)))) THEN
4913 RETURN
4914 ENDIF
4915 DO i=POOL_SIZE,1,-1
4916.EQ. IF(POOL_NIV2(i)INODE) GOTO 666
4917 ENDDO
4918 NB_SON(STEP_LOAD(INODE))=-1
4919 RETURN
4920 666 CONTINUE
4921 IF(BDC_M2_MEM)THEN
4922.EQ. IF(POOL_NIV2_COST(i)MAX_M2)THEN
4923 TMP_M2=MAX_M2
4924 MAXI=dble(0)
4925 IND_MAXI=-9999
4926 DO J=POOL_SIZE,1,-1
4927.NE. IF(Ji) THEN
4928.GT. IF(POOL_NIV2_COST(J)MAXI)THEN
4929 MAXI=POOL_NIV2_COST(J)
4930 IND_MAXI=J
4931 ENDIF
4932 ENDIF
4933 ENDDO
4934 MAX_M2=MAXI
4935 J=IND_MAXI
4936 REMOVE_NODE_FLAG_MEM=.TRUE.
4937 REMOVE_NODE_COST_MEM=TMP_M2
4938 CALL DMUMPS_NEXT_NODE(REMOVE_NODE_FLAG,MAX_M2,COMM_LD)
4939 NIV2(MYID+1)=MAX_M2
4940 ENDIF
4941 ELSEIF(BDC_M2_FLOPS)THEN
4942 REMOVE_NODE_COST=POOL_NIV2_COST(i)
4943 REMOVE_NODE_FLAG=.TRUE.
4944 CALL DMUMPS_NEXT_NODE(REMOVE_NODE_FLAG,
4945 & -POOL_NIV2_COST(i),COMM_LD)
4946 NIV2(MYID+1)=NIV2(MYID+1)-POOL_NIV2_COST(i)
4947 ENDIF
4948 DO J=i+1,POOL_SIZE
4949 POOL_NIV2(J-1)=POOL_NIV2(J)
4950 POOL_NIV2_COST(J-1)=POOL_NIV2_COST(J)
4951 ENDDO
4952 POOL_SIZE=POOL_SIZE-1
4953 END SUBROUTINE DMUMPS_REMOVE_NODE
4954 RECURSIVE SUBROUTINE DMUMPS_PROCESS_NIV2_MEM_MSG(INODE)
4955 IMPLICIT NONE
4956 INTEGER INODE
4957 EXTERNAL MUMPS_TYPENODE
4958 INTEGER MUMPS_TYPENODE
4959.EQ..OR. IF((INODEKEEP_LOAD(20))
4960.EQ. & (INODEKEEP_LOAD(38)))THEN
4961 RETURN
4962 ENDIF
4963.EQ. IF(NB_SON(STEP_LOAD(INODE))-1)THEN
4964 RETURN
4965 ELSE
4966.LT. IF(NB_SON(STEP_LOAD(INODE))0)THEN
4967 WRITE(*,*)
4968 & 'internal error 1 in dmumps_process_niv2_mem_msg'
4969 CALL MUMPS_ABORT()
4970 ENDIF
4971 ENDIF
4972 NB_SON(STEP_LOAD(INODE))=
4973 & NB_SON(STEP_LOAD(INODE))-1
4974.EQ. IF(NB_SON(STEP_LOAD(INODE))0)THEN
4975.EQ. IF(POOL_SIZEPOOL_NIV2_SIZE)THEN
4976 WRITE(*,*)MYID,': internal error 2 in
4977 &dmumps_process_niv2_mem_msg'
4978 CALL MUMPS_ABORT()
4979 ENDIF
4980 POOL_NIV2(POOL_SIZE+1)=INODE
4981 POOL_NIV2_COST(POOL_SIZE+1)=
4982 & DMUMPS_LOAD_GET_MEM(INODE)
4983 POOL_SIZE=POOL_SIZE+1
4984.GT. IF(POOL_NIV2_COST(POOL_SIZE)MAX_M2)THEN
4985 MAX_M2=POOL_NIV2_COST(POOL_SIZE)
4986 ID_MAX_M2=POOL_NIV2(POOL_SIZE)
4987 CALL DMUMPS_NEXT_NODE(REMOVE_NODE_FLAG_MEM,MAX_M2,COMM_LD)
4988 NIV2(1+MYID)=MAX_M2
4989 ENDIF
4990 ENDIF
4991 RETURN
4992 END SUBROUTINE DMUMPS_PROCESS_NIV2_MEM_MSG
4993 RECURSIVE SUBROUTINE DMUMPS_PROCESS_NIV2_FLOPS_MSG(INODE)
4994 IMPLICIT NONE
4995 INTEGER INODE
4996 EXTERNAL MUMPS_TYPENODE
4997 INTEGER MUMPS_TYPENODE
4998.EQ..OR. IF((INODEKEEP_LOAD(20))
4999.EQ. & (INODEKEEP_LOAD(38)))THEN
5000 RETURN
5001 ENDIF
5002.EQ. IF(NB_SON(STEP_LOAD(INODE))-1)THEN
5003 RETURN
5004 ELSE
5005.LT. IF(NB_SON(STEP_LOAD(INODE))0)THEN
5006 WRITE(*,*)
5007 & 'internal error 1 in dmumps_process_niv2_flops_msg'
5008 CALL MUMPS_ABORT()
5009 ENDIF
5010 ENDIF
5011 NB_SON(STEP_LOAD(INODE))=
5012 & NB_SON(STEP_LOAD(INODE))-1
5013.EQ. IF(NB_SON(STEP_LOAD(INODE))0)THEN
5014.EQ. IF(POOL_SIZEPOOL_NIV2_SIZE)THEN
5015 WRITE(*,*)MYID,': internal error 2 in
5016 &dmumps_process_niv2_flops_msg',POOL_NIV2_SIZE,
5017 & POOL_SIZE
5018 CALL MUMPS_ABORT()
5019 ENDIF
5020 POOL_NIV2(POOL_SIZE+1)=INODE
5021 POOL_NIV2_COST(POOL_SIZE+1)=
5022 & DMUMPS_LOAD_GET_FLOPS_COST(INODE)
5023 POOL_SIZE=POOL_SIZE+1
5024 MAX_M2=POOL_NIV2_COST(POOL_SIZE)
5025 ID_MAX_M2=POOL_NIV2(POOL_SIZE)
5026 CALL DMUMPS_NEXT_NODE(REMOVE_NODE_FLAG,
5027 & POOL_NIV2_COST(POOL_SIZE),
5028 & COMM_LD)
5029 NIV2(MYID+1)=POOL_NIV2_COST(POOL_SIZE)+NIV2(MYID+1)
5030 ENDIF
5031 RETURN
5032 END SUBROUTINE DMUMPS_PROCESS_NIV2_FLOPS_MSG
5033 DOUBLE PRECISION FUNCTION DMUMPS_LOAD_GET_FLOPS_COST(INODE)
5034 USE MUMPS_FUTURE_NIV2
5035 INTEGER INODE
5036 INTEGER NFRONT,NELIM,i,LEVEL
5037 EXTERNAL MUMPS_TYPENODE
5038 INTEGER MUMPS_TYPENODE
5039 DOUBLE PRECISION COST
5040 i = INODE
5041 NELIM = 0
5042 10 CONTINUE
5043 IF ( i > 0 ) THEN
5044 NELIM = NELIM + 1
5045 i = FILS_LOAD(i)
5046 GOTO 10
5047 ENDIF
5048 NFRONT = ND_LOAD( STEP_LOAD(INODE) ) + KEEP_LOAD(253)
5049 LEVEL = MUMPS_TYPENODE( PROCNODE_LOAD(STEP_LOAD(INODE)),
5050 & KEEP_LOAD(199) )
5051 COST=dble(0)
5052 CALL MUMPS_GET_FLOPS_COST(NFRONT,NELIM,NELIM,
5053 & KEEP_LOAD(50),LEVEL,COST)
5054 DMUMPS_LOAD_GET_FLOPS_COST=COST
5055 RETURN
5056 END FUNCTION DMUMPS_LOAD_GET_FLOPS_COST
5057 INTEGER FUNCTION DMUMPS_LOAD_GET_CB_FREED( INODE )
5058 IMPLICIT NONE
5059 INTEGER INODE,NELIM,NFR,SON,IN,i
5060 INTEGER COST_CB
5061 COST_CB=0
5062 i = INODE
5063 10 CONTINUE
5064 IF ( i > 0 ) THEN
5065 i = FILS_LOAD(i)
5066 GOTO 10
5067 ENDIF
5068 SON=-i
5069 DO i=1, NE_LOAD(STEP_LOAD(INODE))
5070 NFR = ND_LOAD( STEP_LOAD(SON) ) + KEEP_LOAD(253)
5071 IN=SON
5072 NELIM = 0
5073 20 CONTINUE
5074 IF ( IN > 0 ) THEN
5075 NELIM = NELIM + 1
5076 IN = FILS_LOAD(IN)
5077 GOTO 20
5078 ENDIF
5079 COST_CB=COST_CB+((NFR-NELIM)*(NFR-NELIM))
5080 SON=FRERE_LOAD(STEP_LOAD(SON))
5081 ENDDO
5082 DMUMPS_LOAD_GET_CB_FREED=COST_CB
5083 RETURN
5084 END FUNCTION DMUMPS_LOAD_GET_CB_FREED
5085 SUBROUTINE DMUMPS_LOAD_SEND_MD_INFO(SLAVEF,NMB_OF_CAND,
5086 & LIST_OF_CAND,
5087 & TAB_POS, NASS, KEEP,KEEP8, LIST_SLAVES,
5088 & NSLAVES,INODE)
5089 USE DMUMPS_BUF
5090 USE MUMPS_FUTURE_NIV2
5091 IMPLICIT NONE
5092 INTEGER, INTENT (IN) :: SLAVEF, NASS, NSLAVES
5093 INTEGER, INTENT (IN) :: NMB_OF_CAND
5094 INTEGER, INTENT (IN) :: LIST_OF_CAND(NMB_OF_CAND)
5095 INTEGER, INTENT (IN) :: TAB_POS(SLAVEF+2)
5096 INTEGER, INTENT (IN) :: LIST_SLAVES(NSLAVES)
5097 INTEGER KEEP(500),INODE
5098 INTEGER(8) KEEP8(150)
5099 INTEGER allocok
5100 DOUBLE PRECISION MEM_COST,FCT_COST
5101 DOUBLE PRECISION, DIMENSION(:),ALLOCATABLE :: DELTA_MD
5102 INTEGER, DIMENSION(:), ALLOCATABLE :: IPROC2POSINDELTAMD
5103 INTEGER, DIMENSION(:), ALLOCATABLE :: P_TO_UPDATE
5104 INTEGER NBROWS_SLAVE,i,WHAT,IERR
5105 INTEGER :: NP_TO_UPDATE, K
5106 LOGICAL FORCE_CAND
5107 LOGICAL :: EXIT_FLAG
5108 MEM_COST=dble(0)
5109 FCT_COST=dble(0)
5110.OR. IF ( KEEP(24) == 0 KEEP(24) == 1 ) THEN
5111 FORCE_CAND = .FALSE.
5112 ELSE
5113.eq. FORCE_CAND = (mod(KEEP(24),2)0)
5114 END IF
5115 CALL DMUMPS_LOAD_GET_ESTIM_MEM_COST(INODE,FCT_COST,
5116 & MEM_COST,NMB_OF_CAND,NASS)
5117 ALLOCATE(IPROC2POSINDELTAMD(0:SLAVEF-1),
5118 & DELTA_MD(min(SLAVEF, NMB_OF_CAND+NSLAVES)),
5119 & P_TO_UPDATE(min(SLAVEF, NMB_OF_CAND+NSLAVES)),
5120 & stat=allocok)
5121 IF (allocok > 0 ) THEN
5122 WRITE(*,*) "PB ALLOC IN DMUMPS_LOAD_SEND_MD_INFO",
5123 & SLAVEF, NMB_OF_CAND, NSLAVES
5124 CALL MUMPS_ABORT()
5125 ENDIF
5126 IPROC2POSINDELTAMD = -99
5127 NP_TO_UPDATE = 0
5128 DO i = 1, NSLAVES
5129 NP_TO_UPDATE = NP_TO_UPDATE + 1
5130 IPROC2POSINDELTAMD (LIST_SLAVES(i)) = NP_TO_UPDATE
5131 NBROWS_SLAVE = TAB_POS(i+1) - TAB_POS(i)
5132 DELTA_MD(NP_TO_UPDATE)=-dble(NBROWS_SLAVE)*
5133 & dble(NASS)
5134 P_TO_UPDATE(NP_TO_UPDATE) = LIST_SLAVES(i)
5135 ENDDO
5136 DO i = 1, NMB_OF_CAND
5137 K = IPROC2POSINDELTAMD(LIST_OF_CAND(i))
5138 IF ( K > 0 ) THEN
5139 DELTA_MD(K)=DELTA_MD(K)+FCT_COST
5140 ELSE
5141 NP_TO_UPDATE = NP_TO_UPDATE + 1
5142 IPROC2POSINDELTAMD (LIST_OF_CAND(i)) = NP_TO_UPDATE
5143 DELTA_MD (NP_TO_UPDATE) = FCT_COST
5144 P_TO_UPDATE(NP_TO_UPDATE) = LIST_OF_CAND(i)
5145 ENDIF
5146 ENDDO
5147 WHAT=7
5148 111 CONTINUE
5149 CALL DMUMPS_BUF_BCAST_ARRAY(.FALSE., COMM_LD, MYID, SLAVEF,
5150 & FUTURE_NIV2,
5151 & NP_TO_UPDATE, P_TO_UPDATE,0,
5152 & DELTA_MD,
5153 & DELTA_MD,
5154 & DELTA_MD,
5155 & WHAT, KEEP, IERR)
5156 IF ( IERR == -1 ) THEN
5157 CALL DMUMPS_LOAD_RECV_MSGS(COMM_LD)
5158 CALL MUMPS_CHECK_COMM_NODES(COMM_NODES, EXIT_FLAG)
5159 IF (EXIT_FLAG) THEN
5160 GOTO 100
5161 ELSE
5162 GOTO 111
5163 ENDIF
5164.NE. ELSE IF ( IERR 0 ) THEN
5165 WRITE(*,*) "Internal Error 2 in DMUMPS_LOAD_SEND_MD_INFO",
5166 & IERR
5167 CALL MUMPS_ABORT()
5168 ENDIF
5169.NE. IF (FUTURE_NIV2(MYID+1) 0) THEN
5170 DO i = 1, NP_TO_UPDATE
5171 MD_MEM(P_TO_UPDATE(i))=MD_MEM(P_TO_UPDATE(i))+
5172 & int(DELTA_MD( i ),8)
5173.EQ. IF(FUTURE_NIV2(P_TO_UPDATE(i)+1)0)THEN
5174 MD_MEM(P_TO_UPDATE(i))=999999999_8
5175 ENDIF
5176 ENDDO
5177 ENDIF
5178 100 CONTINUE
5179 DEALLOCATE(DELTA_MD,P_TO_UPDATE,IPROC2POSINDELTAMD)
5180 RETURN
5181 END SUBROUTINE DMUMPS_LOAD_SEND_MD_INFO
5182 SUBROUTINE DMUMPS_LOAD_GET_ESTIM_MEM_COST(INODE,FCT_COST,
5183 & MEM_COST,NSLAVES,NELIM)
5184 IMPLICIT NONE
5185 INTEGER INODE,NSLAVES,NFR,NELIM,IN
5186 DOUBLE PRECISION MEM_COST,FCT_COST
5187 NFR=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253)
5188 IN = INODE
5189 FCT_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)*
5190 & dble(NELIM)
5191 MEM_COST=dble(int(dble(NFR-NELIM)/dble(NSLAVES))+1)*
5192 & dble(NFR)
5193 END SUBROUTINE DMUMPS_LOAD_GET_ESTIM_MEM_COST
5194 SUBROUTINE DMUMPS_LOAD_CLEAN_MEMINFO_POOL(INODE)
5195 USE MUMPS_FUTURE_NIV2
5196 IMPLICIT NONE
5197 INTEGER INODE
5198 INTEGER i,J,SON,NSLAVES_TEMP,POS_TEMP,K
5199 INTEGER MUMPS_PROCNODE
5200 EXTERNAL MUMPS_PROCNODE
5201.LT..OR..GT. IF((INODE0)(INODEN_LOAD))THEN
5202 RETURN
5203 ENDIF
5204.GT. IF(POS_ID1)THEN
5205 i=INODE
5206 10 CONTINUE
5207 IF ( i > 0 ) THEN
5208 i = FILS_LOAD(i)
5209 GOTO 10
5210 ENDIF
5211 SON=-i
5212.LT. IF(POS_IDNE_LOAD(STEP_LOAD(INODE))*3)THEN
5213 i=1
5214 ENDIF
5215 DO i=1, NE_LOAD(STEP_LOAD(INODE))
5216 J=1
5217.LT. DO WHILE (JPOS_ID)
5218.EQ. IF(CB_COST_ID(J)SON)GOTO 295
5219 J=J+3
5220 ENDDO
5221 295 CONTINUE
5222.GE. IF(JPOS_ID)THEN
5223 IF ( MUMPS_PROCNODE(
5224 & PROCNODE_LOAD(STEP_LOAD(INODE)),
5225.EQ. & KEEP_LOAD(199) ) MYID ) THEN
5226.EQ. IF(INODEKEEP_LOAD(38))THEN
5227 GOTO 666
5228 ELSE
5229.NE. IF(FUTURE_NIV2(MYID+1)0)THEN
5230 WRITE(*,*)MYID,': i did not find ',SON
5231 CALL MUMPS_ABORT()
5232 ENDIF
5233 GOTO 666
5234 ENDIF
5235 ELSE
5236 GOTO 666
5237 ENDIF
5238 ENDIF
5239 NSLAVES_TEMP=CB_COST_ID(J+1)
5240 POS_TEMP=CB_COST_ID(J+2)
5241 DO K=J,POS_ID-1
5242 CB_COST_ID(K)=CB_COST_ID(K+3)
5243 ENDDO
5244 K=POS_TEMP
5245.LE. DO WHILE (KPOS_MEM-1)
5246 CB_COST_MEM(K)=CB_COST_MEM(K+2*NSLAVES_TEMP)
5247 K=K+1
5248 ENDDO
5249 POS_MEM=POS_MEM-2*NSLAVES_TEMP
5250 POS_ID=POS_ID-3
5251.LT..OR..LT. IF((POS_MEM1)(POS_ID1))THEN
5252 WRITE(*,*)MYID,': negative pos_mem or pos_id'
5253 CALL MUMPS_ABORT()
5254 ENDIF
5255 666 CONTINUE
5256 SON=FRERE_LOAD(STEP_LOAD(SON))
5257 ENDDO
5258 ENDIF
5259 END SUBROUTINE DMUMPS_LOAD_CLEAN_MEMINFO_POOL
5260 SUBROUTINE DMUMPS_LOAD_CHK_MEMCST_POOL(FLAG)
5261 IMPLICIT NONE
5262 LOGICAL FLAG
5263 INTEGER i
5264 DOUBLE PRECISION MEM
5265 FLAG=.FALSE.
5266 DO i=0,NPROCS-1
5267 MEM=DM_MEM(i)+LU_USAGE(i)
5268 IF(BDC_SBTR)THEN
5269 MEM=MEM+SBTR_MEM(i)-SBTR_CUR(i)
5270 ENDIF
5271.GT. IF((MEM/dble(TAB_MAXS(i)))0.8d0)THEN
5272 FLAG=.TRUE.
5273 GOTO 666
5274 ENDIF
5275 ENDDO
5276 666 CONTINUE
5277 END SUBROUTINE DMUMPS_LOAD_CHK_MEMCST_POOL
5278 SUBROUTINE DMUMPS_CHECK_SBTR_COST(NBINSUBTREE,INSUBTREE,NBTOP,
5279 & MIN_COST,SBTR)
5280 IMPLICIT NONE
5281 INTEGER NBINSUBTREE,INSUBTREE,NBTOP
5282 DOUBLE PRECISION MIN_COST
5283 LOGICAL SBTR
5284 INTEGER i
5285 DOUBLE PRECISION TMP_COST,TMP_MIN
5286 TMP_MIN=huge(TMP_MIN)
5287 DO i=0,NPROCS-1
5288.NE. IF(iMYID)THEN
5289 IF(BDC_SBTR)THEN
5290 TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))-(DM_MEM(i)+
5291 & LU_USAGE(i))-(SBTR_MEM(i)-SBTR_CUR(i)))
5292 ELSE
5293 TMP_MIN=min(TMP_MIN,dble(TAB_MAXS(i))-
5294 & (DM_MEM(i)+LU_USAGE(i)))
5295 ENDIF
5296 ENDIF
5297 ENDDO
5298.GT. IF(NBINSUBTREE0)THEN
5299.EQ. IF(INSUBTREE1)THEN
5300 TMP_COST=dble(TAB_MAXS(MYID))-(DM_MEM(MYID)+
5301 & LU_USAGE(MYID))
5302 & -(SBTR_MEM(MYID)-SBTR_CUR(MYID))
5303 ELSE
5304 SBTR=.FALSE.
5305 GOTO 777
5306 ENDIF
5307 ENDIF
5308 TMP_MIN=min(TMP_COST,TMP_MIN)
5309.GT. IF(TMP_MINMIN_COST) SBTR=.TRUE.
5310 777 CONTINUE
5311 END SUBROUTINE DMUMPS_CHECK_SBTR_COST
5312 SUBROUTINE DMUMPS_LOAD_COMP_MAXMEM_POOL(INODE,MAX_MEM,PROC)
5313 USE MUMPS_FUTURE_NIV2
5314 IMPLICIT NONE
5315 INTEGER INODE,PROC
5316 INTEGER i,POS,NSLAVES,SLAVE,NCAND,J,NELIM,NCB,NFRONT,SON,K
5317 INTEGER allocok
5318 EXTERNAL MUMPS_TYPENODE
5319 INTEGER MUMPS_TYPENODE
5320 DOUBLE PRECISION MAX_MEM
5321 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: MEM_ON_PROCS,
5322 & RECV_BUF
5323 LOGICAL, DIMENSION(:), ALLOCATABLE :: CONCERNED
5324 DOUBLE PRECISION MAX_SENT_MSG
5325.EQ. IF((FRERE_LOAD(STEP_LOAD(INODE))0)
5326.AND..EQ. & (INODEKEEP_LOAD(38)))THEN
5327 RETURN
5328 ENDIF
5329 ALLOCATE( MEM_ON_PROCS(0:NPROCS-1), stat=allocok)
5330 IF ( allocok > 0 ) THEN
5331 WRITE(*,*) 'pb allocation in dmumps_load_comp_maxmem_pool'
5332 CALL MUMPS_ABORT()
5333 ENDIF
5334 ALLOCATE( CONCERNED(0:NPROCS-1), stat=allocok)
5335 IF ( allocok > 0 ) THEN
5336 WRITE(*,*) 'pb allocation in dmumps_load_comp_maxmem_pool'
5337 CALL MUMPS_ABORT()
5338 ENDIF
5339 ALLOCATE( RECV_BUF(0:NPROCS-1), stat=allocok)
5340 IF ( allocok > 0 ) THEN
5341 WRITE(*,*) 'pb allocation in dmumps_load_comp_maxmem_pool'
5342 CALL MUMPS_ABORT()
5343 ENDIF
5344 RECV_BUF=dble(0)
5345 MAX_SENT_MSG=dble(0)
5346 i = INODE
5347 NELIM = 0
5348 10 CONTINUE
5349 IF ( i > 0 ) THEN
5350 NELIM = NELIM + 1
5351 i = FILS_LOAD(i)
5352 GOTO 10
5353 ENDIF
5354 SON=-i
5355 NFRONT=ND_LOAD(STEP_LOAD(INODE)) + KEEP_LOAD(253)
5356 NCB=NFRONT-NELIM
5357 IF(MUMPS_TYPENODE(PROCNODE_LOAD(STEP_LOAD(INODE)),
5358.EQ. & KEEP_LOAD(199))2)THEN
5359 NCAND=CAND_LOAD(NPROCS+1, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE)))
5360 ENDIF
5361 DO i=0,NPROCS-1
5362.EQ. IF(iMYID)THEN
5363 MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+
5364 & LU_USAGE(i)+
5365 & DMUMPS_LOAD_GET_MEM(INODE))
5366 IF(BDC_SBTR)THEN
5367 MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i))
5368 ENDIF
5369 CONCERNED(i)=.TRUE.
5370 ELSE
5371 MEM_ON_PROCS(i)=dble(TAB_MAXS(i))-(DM_MEM(i)+LU_USAGE(i))
5372 IF(BDC_SBTR)THEN
5373 MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-(SBTR_MEM(i)-SBTR_CUR(i))
5374 ENDIF
5375 IF(BDC_M2_MEM)THEN
5376 MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-NIV2(i+1)
5377 ENDIF
5378 ENDIF
5379 IF(MUMPS_TYPENODE(PROCNODE_LOAD(STEP_LOAD(INODE)),
5380.EQ. & KEEP_LOAD(199))2)THEN
5381.AND..EQ. IF(BDC_MD(KEEP_LOAD(48)5))THEN
5382 DO J=1,NCAND
5383 IF(CAND_LOAD(J, STEP_TO_NIV2_LOAD(STEP_LOAD(INODE)))
5384.EQ. & i)THEN
5385 MEM_ON_PROCS(i)=MEM_ON_PROCS(i)-
5386 & ((dble(NFRONT)*dble(NCB))/dble(NCAND))
5387 CONCERNED(i)=.TRUE.
5388 GOTO 666
5389 ENDIF
5390 ENDDO
5391 ENDIF
5392 ENDIF
5393 666 CONTINUE
5394 ENDDO
5395 DO K=1, NE_LOAD(STEP_LOAD(INODE))
5396 i=1
5397.LE. DO WHILE (iPOS_ID)
5398.EQ. IF(CB_COST_ID(i)SON)GOTO 295
5399 i=i+3
5400 ENDDO
5401 295 CONTINUE
5402.GE. IF(iPOS_ID)THEN
5403.NE. IF(FUTURE_NIV2(MYID+1)0)THEN
5404 WRITE(*,*)MYID,': ',SON,'has not been found
5405 & in dmumps_load_comp_maxmem_pool'
5406 CALL MUMPS_ABORT()
5407 ENDIF
5408 GOTO 777
5409 ENDIF
5410 NSLAVES=CB_COST_ID(i+1)
5411 POS=CB_COST_ID(i+2)
5412 DO i=1,NSLAVES
5413 SLAVE=int(CB_COST_MEM(POS))
5414.NOT. IF(CONCERNED(SLAVE))THEN
5415 MEM_ON_PROCS(SLAVE)=MEM_ON_PROCS(SLAVE)+
5416 & dble(CB_COST_MEM(POS+1))
5417 ENDIF
5418 DO J=0,NPROCS-1
5419 IF(CONCERNED(J))THEN
5420.NE. IF(SLAVEJ)THEN
5421 RECV_BUF(J)=max(RECV_BUF(J),
5422 & dble(CB_COST_MEM(POS+1)))
5423 ENDIF
5424 ENDIF
5425 ENDDO
5426 POS=POS+2
5427 ENDDO
5428 777 CONTINUE
5429 SON=FRERE_LOAD(STEP_LOAD(SON))
5430 ENDDO
5431 MAX_MEM=huge(MAX_MEM)
5432 WRITE(*,*)'nprocs=',NPROCS,MAX_MEM
5433 DO i=0,NPROCS-1
5434.GT. IF(MAX_MEMMEM_ON_PROCS(i))THEN
5435 PROC=i
5436 ENDIF
5437 MAX_MEM=min(MEM_ON_PROCS(i),MAX_MEM)
5438 ENDDO
5439 DEALLOCATE(MEM_ON_PROCS)
5440 DEALLOCATE(CONCERNED)
5441 DEALLOCATE(RECV_BUF)
5442 END SUBROUTINE DMUMPS_LOAD_COMP_MAXMEM_POOL
5443 SUBROUTINE DMUMPS_FIND_BEST_NODE_FOR_MEM(MIN_PROC,POOL,
5444 & LPOOL,INODE)
5445 IMPLICIT NONE
5446 INTEGER INODE,LPOOL,MIN_PROC
5447 INTEGER POOL(LPOOL)
5448 EXTERNAL MUMPS_PROCNODE
5449 INTEGER MUMPS_PROCNODE
5450 INTEGER i,NBTOP,INSUBTREE,NBINSUBTREE,NODE,FATHER,SON,J
5451 INTEGER SBTR_NB_LEAF,POS,K,allocok,L
5452 INTEGER, ALLOCATABLE, DIMENSION (:) :: TMP_SBTR
5453 NBINSUBTREE = POOL(LPOOL)
5454 NBTOP = POOL(LPOOL - 1)
5455 INSUBTREE = POOL(LPOOL - 2)
5456.EQ..AND. IF((KEEP_LOAD(47)4)
5457.NE. & ((NBINSUBTREE0)))THEN
5458 DO J=INDICE_SBTR,NB_SUBTREES
5459 NODE=MY_ROOT_SBTR(J)
5460 FATHER=DAD_LOAD(STEP_LOAD(NODE))
5461 i=FATHER
5462 110 CONTINUE
5463 IF ( i > 0 ) THEN
5464 i = FILS_LOAD(i)
5465 GOTO 110
5466 ENDIF
5467 SON=-i
5468 i=SON
5469 120 CONTINUE
5470 IF ( i > 0 ) THEN
5471 IF( MUMPS_PROCNODE(PROCNODE_LOAD(STEP_LOAD(i)),
5472.EQ. & KEEP_LOAD(199)) MIN_PROC ) THEN
5473 SBTR_NB_LEAF=MY_NB_LEAF(J)
5474 POS=SBTR_FIRST_POS_IN_POOL(J)
5475.NE. IF(POOL(POS+SBTR_NB_LEAF)MY_FIRST_LEAF(J))THEN
5476 WRITE(*,*)MYID,': the first leaf is not ok'
5477 CALL MUMPS_ABORT()
5478 ENDIF
5479 ALLOCATE (TMP_SBTR(SBTR_NB_LEAF), stat=allocok)
5480 IF (allocok > 0 ) THEN
5481 WRITE(*,*)MYID,': not enough space
5482 & for allocation'
5483 CALL MUMPS_ABORT()
5484 ENDIF
5485 POS=SBTR_FIRST_POS_IN_POOL(J)
5486 DO K=1,SBTR_NB_LEAF
5487 TMP_SBTR(K)=POOL(POS+K-1)
5488 ENDDO
5489 DO K=POS+1,NBINSUBTREE-SBTR_NB_LEAF
5490 POOL(K)=POOL(K+SBTR_NB_LEAF)
5491 ENDDO
5492 POS=1
5493 DO K=NBINSUBTREE-SBTR_NB_LEAF+1,NBINSUBTREE
5494 POOL(K)=TMP_SBTR(POS)
5495 POS=POS+1
5496 ENDDO
5497 DO K=INDICE_SBTR,J
5498 SBTR_FIRST_POS_IN_POOL(K)=SBTR_FIRST_POS_IN_POOL(K)
5499 & -SBTR_FIRST_POS_IN_POOL(J)
5500 ENDDO
5501 SBTR_FIRST_POS_IN_POOL(J)=NBINSUBTREE-SBTR_NB_LEAF
5502 POS=MY_FIRST_LEAF(J)
5503 L=MY_NB_LEAF(J)
5504 DO K=INDICE_SBTR,J
5505 MY_FIRST_LEAF(J)=MY_FIRST_LEAF(J+1)
5506 MY_NB_LEAF(J)=MY_NB_LEAF(J+1)
5507 ENDDO
5508 MY_FIRST_LEAF(INDICE_SBTR)=POS
5509 MY_NB_LEAF(INDICE_SBTR)=L
5510 INODE=POOL(NBINSUBTREE)
5511 DEALLOCATE(TMP_SBTR)
5512 RETURN
5513 ENDIF
5514 i = FRERE_LOAD(STEP_LOAD(i))
5515 GOTO 120
5516 ENDIF
5517 ENDDO
5518 ENDIF
5519 DO J=NBTOP,1,-1
5520 NODE=POOL(LPOOL-2-J)
5521 FATHER=DAD_LOAD(STEP_LOAD(NODE))
5522 i=FATHER
5523 11 CONTINUE
5524 IF ( i > 0 ) THEN
5525 i = FILS_LOAD(i)
5526 GOTO 11
5527 ENDIF
5528 SON=-i
5529 i=SON
5530 12 CONTINUE
5531 IF ( i > 0 ) THEN
5532 IF( MUMPS_PROCNODE(PROCNODE_LOAD(STEP_LOAD(i)),
5533.EQ. & KEEP_LOAD(199)) MIN_PROC ) THEN
5534 INODE=NODE
5535 RETURN
5536 ENDIF
5537 i = FRERE_LOAD(STEP_LOAD(i))
5538 GOTO 12
5539 ENDIF
5540 ENDDO
5541 END SUBROUTINE DMUMPS_FIND_BEST_NODE_FOR_MEM
5542 SUBROUTINE DMUMPS_LOAD_INIT_SBTR_STRUCT(POOL, LPOOL,KEEP,KEEP8)
5543 IMPLICIT NONE
5544 INTEGER LPOOL,POOL(LPOOL),KEEP(500)
5545 INTEGER(8) KEEP8(150)
5546 INTEGER i,POS
5547 EXTERNAL MUMPS_ROOTSSARBR
5548 LOGICAL MUMPS_ROOTSSARBR
5549.NOT. IF(BDC_SBTR) RETURN
5550 POS=0
5551 DO i=NB_SUBTREES,1,-1
5552 DO WHILE(MUMPS_ROOTSSARBR(
5553 & PROCNODE_LOAD(STEP_LOAD(POOL(POS+1))),
5554 & KEEP(199)))
5555 POS=POS+1
5556 ENDDO
5557 SBTR_FIRST_POS_IN_POOL(i)=POS+1
5558 POS=POS+MY_NB_LEAF(i)
5559 ENDDO
5560 END SUBROUTINE DMUMPS_LOAD_INIT_SBTR_STRUCT
5561 END MODULE DMUMPS_LOAD
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
the
end diagonal values have been computed in the(sparse) matrix id.SOL
mumps_get_flops_cost
subroutine mumps_get_flops_cost(nfront, npiv, nass, keep50, level, cost)
Definition estim_flops.F:74
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mpi_wtime
double precision function mpi_wtime()
Definition mpi.f:561
mpi_comm_rank
subroutine mpi_comm_rank(comm, rank, ierr)
Definition mpi.f:254
id
initmumps id
Definition multiplerhs_example.m:4
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
mumps_max_surfcb_nbrows
subroutine mumps_max_surfcb_nbrows(what, keep, keep8, ncb, nfr, slavef, nbrowmax, maxsurfcb8)
Definition mumps_type2_blocking.F:121
mumps_bloc2_setpartition
subroutine mumps_bloc2_setpartition(keep, keep8, slavef, tab_pos_in_pere, nslaves, nfront, ncb)
Definition mumps_type2_blocking.F:327
dmumps_buf
Definition dmumps_comm_buffer.F:14
dmumps_buf::dmumps_buf_broadcast
subroutine, public dmumps_buf_broadcast(what, comm, nprocs, future_niv2, load, upd_load, myid, keep, ierr)
Definition dmumps_comm_buffer.F:2795
dmumps_buf::dmumps_buf_send_not_mstr
subroutine, public dmumps_buf_send_not_mstr(comm, myid, nprocs, max_surf_master, keep, ierr)
Definition dmumps_comm_buffer.F:2962
dmumps_buf::dmumps_buf_bcast_array
subroutine, public dmumps_buf_bcast_array(bdc_mem, comm, myid, nprocs, future_niv2, nslaves, list_slaves, inode, mem_increment, flops_increment, cb_band, what, keep, ierr)
Definition dmumps_comm_buffer.F:3038
dmumps_load
Definition dmumps_load.F:14
dmumps_load::pool_niv2_cost
double precision, dimension(:), allocatable, save, private pool_niv2_cost
Definition dmumps_load.F:98
dmumps_load::bdc_m2_mem
logical, save, private bdc_m2_mem
Definition dmumps_load.F:39
dmumps_load::max_m2
double precision, save, private max_m2
Definition dmumps_load.F:96
dmumps_load::dmumps_load_comp_maxmem_pool
subroutine, public dmumps_load_comp_maxmem_pool(inode, max_mem, proc)
Definition dmumps_load.F:5313
dmumps_load::my_nb_leaf
integer, dimension(:), pointer, save, private my_nb_leaf
Definition dmumps_load.F:111
dmumps_load::dm_sumlu
double precision, save, private dm_sumlu
Definition dmumps_load.F:91
dmumps_load::dmumps_load_pool_upd_new_pool
subroutine, public dmumps_load_pool_upd_new_pool(pool, lpool, procnode, keep, keep8, slavef, comm, myid, step, n, nd, fils)
Definition dmumps_load.F:1820
dmumps_load::cand_load
integer, dimension(:,:), pointer, save, private cand_load
Definition dmumps_load.F:110
dmumps_load::dmumps_load_clean_meminfo_pool
subroutine, public dmumps_load_clean_meminfo_pool(inode)
Definition dmumps_load.F:5195
dmumps_load::pool_niv2_size
integer pool_niv2_size
Definition dmumps_load.F:88
dmumps_load::bdc_mem
logical, save, private bdc_mem
Definition dmumps_load.F:39
dmumps_load::current_best
integer, save, public current_best
Definition dmumps_load.F:124
dmumps_load::sbtr_id_load
integer, dimension(:), pointer, save, public sbtr_id_load
Definition dmumps_load.F:119
dmumps_load::dad_load
integer, dimension(:), pointer, save, public dad_load
Definition dmumps_load.F:106
dmumps_load::bdc_sbtr
logical, save, private bdc_sbtr
Definition dmumps_load.F:39
dmumps_load::dmumps_load_set_partition
subroutine, public dmumps_load_set_partition(ncbson_max, slavef, keep, keep8, icntl, cand_of_node, mem_distrib, ncb, nfront, nslaves_node, tab_pos, slaves_list, size_slaves_list, inode)
Definition dmumps_load.F:316
dmumps_load::beta
double precision, save, private beta
Definition dmumps_load.F:56
dmumps_load::remove_node_cost
double precision, save, private remove_node_cost
Definition dmumps_load.F:43
dmumps_load::pos_mem
integer, save, public pos_mem
Definition dmumps_load.F:77
dmumps_load::pool_size
integer, save, private pool_size
Definition dmumps_load.F:95
dmumps_load::nd_load
integer, dimension(:), pointer, save, public nd_load
Definition dmumps_load.F:106
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_less_cand
integer function, public dmumps_load_less_cand(mem_distrib, cand, k69, slavef, msg_size, nmb_of_cand)
Definition dmumps_load.F:1498
dmumps_load::delta_load
double precision, save, private delta_load
Definition dmumps_load.F:48
dmumps_load::bdc_md
logical, save, private bdc_md
Definition dmumps_load.F:39
dmumps_load::dmumps_load_set_slaves
subroutine, public dmumps_load_set_slaves(mem_distrib, msg_size, dest, nslaves)
Definition dmumps_load.F:1063
dmumps_load::dmumps_process_niv2_mem_msg
recursive subroutine dmumps_process_niv2_mem_msg(inode)
Definition dmumps_load.F:4955
dmumps_load::second_current_best
integer, save, public second_current_best
Definition dmumps_load.F:124
dmumps_load::keep8_load
integer(8), dimension(:), pointer, save, private keep8_load
Definition dmumps_load.F:105
dmumps_load::sbtr_which_m
integer, save, private sbtr_which_m
Definition dmumps_load.F:45
dmumps_load::cost_subtree
double precision, save, private cost_subtree
Definition dmumps_load.F:54
dmumps_load::mumps_load_enable
subroutine, public mumps_load_enable()
Definition dmumps_load.F:130
dmumps_load::pool_mem
double precision, dimension(:), allocatable, save, private pool_mem
Definition dmumps_load.F:59
dmumps_load::depth_first_seq_load
integer, dimension(:), pointer, save, public depth_first_seq_load
Definition dmumps_load.F:119
dmumps_load::load_flops
double precision, dimension(:), allocatable, save, private load_flops
Definition dmumps_load.F:33
dmumps_load::chk_ld
double precision, save, private chk_ld
Definition dmumps_load.F:100
dmumps_load::tmp_m2
double precision, save, private tmp_m2
Definition dmumps_load.F:96
dmumps_load::dmumps_load_parti_regular
subroutine dmumps_load_parti_regular(slavef, keep, keep8, cand_of_node, mem_distrib, ncb, nfront, nslaves_node, tab_pos, slaves_list, size_slaves_list)
Definition dmumps_load.F:402
dmumps_load::inside_subtree
integer, save, public inside_subtree
Definition dmumps_load.F:89
dmumps_load::dmumps_load_end
subroutine, public dmumps_load_end(info1, nslaves, ierr)
Definition dmumps_load.F:1105
dmumps_load::lbuf_load_recv_bytes
integer, save, private lbuf_load_recv_bytes
Definition dmumps_load.F:36
dmumps_load::dmumps_load_set_inicost
subroutine, public dmumps_load_set_inicost(cost_subtree_arg, k64, dk15, k375, maxs)
Definition dmumps_load.F:141
dmumps_load::k69
integer, save, private k69
Definition dmumps_load.F:37
dmumps_load::dmumps_load_set_sbtr_mem
subroutine, public dmumps_load_set_sbtr_mem(what)
Definition dmumps_load.F:4714
dmumps_load::dmumps_load_init
subroutine, public dmumps_load_init(id, memory_md_arg, maxs)
Definition dmumps_load.F:462
dmumps_load::dmumps_load_set_slaves_cand
subroutine, public dmumps_load_set_slaves_cand(mem_distrib, cand, slavef, nslaves_inode, dest)
Definition dmumps_load.F:1530
dmumps_load::dmumps_upper_predict
subroutine, public dmumps_upper_predict(inode, step, nsteps, procnode, frere, ne, comm, slavef, myid, keep, keep8, n)
Definition dmumps_load.F:4813
dmumps_load::dmumps_load_process_message
recursive subroutine, public dmumps_load_process_message(msgsou, bufr, lbufr, lbufr_bytes)
Definition dmumps_load.F:1215
dmumps_load::my_first_leaf
integer, dimension(:), pointer, save, private my_first_leaf
Definition dmumps_load.F:111
dmumps_load::max_peak_stk
double precision, save, private max_peak_stk
Definition dmumps_load.F:71
dmumps_load::fils_load
integer, dimension(:), pointer, save, public fils_load
Definition dmumps_load.F:106
dmumps_load::dmumps_find_best_node_for_mem
subroutine, public dmumps_find_best_node_for_mem(min_proc, pool, lpool, inode)
Definition dmumps_load.F:5445
dmumps_load::dmumps_set_parti_flop_irr
subroutine dmumps_set_parti_flop_irr(ncbson_max, slavef, keep, keep8, procs, mem_distrib, ncb, nfront, nslaves_node, tab_pos, slaves_list, size_slaves_list, myid, inode, mp, lp)
Definition dmumps_load.F:2491
dmumps_load::step_load
integer, dimension(:), pointer, save, public step_load
Definition dmumps_load.F:106
dmumps_load::delta_mem
double precision, save, private delta_mem
Definition dmumps_load.F:48
dmumps_load::is_mumps_load_enabled
logical, save, private is_mumps_load_enabled
Definition dmumps_load.F:49
dmumps_load::peak_sbtr_cur_local
double precision, save, private peak_sbtr_cur_local
Definition dmumps_load.F:69
dmumps_load::step_to_niv2_load
integer, dimension(:), pointer, save, private step_to_niv2_load
Definition dmumps_load.F:101
dmumps_load::dmumps_load_chk_memcst_pool
subroutine, public dmumps_load_chk_memcst_pool(flag)
Definition dmumps_load.F:5261
dmumps_load::cb_cost_mem
integer(8), dimension(:), allocatable, save, public cb_cost_mem
Definition dmumps_load.F:79
dmumps_load::dmumps_load_recv_msgs
recursive subroutine, public dmumps_load_recv_msgs(comm)
Definition dmumps_load.F:1179
dmumps_load::mumps_load_disable
subroutine, public mumps_load_disable()
Definition dmumps_load.F:135
dmumps_load::root_current_subtree
integer, save, public root_current_subtree
Definition dmumps_load.F:124
dmumps_load::dmumps_load_pool_check_mem
subroutine, public dmumps_load_pool_check_mem(inode, upper, slavef, keep, keep8, step, pool, lpool, procnode, n)
Definition dmumps_load.F:4650
dmumps_load::dmumps_split_prep_partition
subroutine, public dmumps_split_prep_partition(inode, step, n, slavef, procnode_steps, keep, dad, fils, cand, icntl, copy_cand, nbsplit, numorg_split, slaves_list, size_slaves_list)
Definition dmumps_load.F:172
dmumps_load::dmumps_load_init_sbtr_struct
subroutine, public dmumps_load_init_sbtr_struct(pool, lpool, keep, keep8)
Definition dmumps_load.F:5543
dmumps_load::alpha
double precision, save, private alpha
Definition dmumps_load.F:55
dmumps_load::pool_last_cost_sent
double precision, save, private pool_last_cost_sent
Definition dmumps_load.F:73
dmumps_load::cost_trav
double precision, dimension(:), pointer, save, public cost_trav
Definition dmumps_load.F:118
dmumps_load::dmumps_load_send_md_info
subroutine, public dmumps_load_send_md_info(slavef, nmb_of_cand, list_of_cand, tab_pos, nass, keep, keep8, list_slaves, nslaves, inode)
Definition dmumps_load.F:5089
dmumps_load::sbtr_first_pos_in_pool
integer, dimension(:), allocatable, save, private sbtr_first_pos_in_pool
Definition dmumps_load.F:113
dmumps_load::buf_load_recv
integer, dimension(:), allocatable, save, private buf_load_recv
Definition dmumps_load.F:35
dmumps_load::cb_cost_id
integer, dimension(:), allocatable, save, public cb_cost_id
Definition dmumps_load.F:78
dmumps_load::md_mem
integer(8), dimension(:), allocatable, save, private md_mem
Definition dmumps_load.F:83
dmumps_load::myid
integer, save, private myid
Definition dmumps_load.F:57
dmumps_load::dmumps_set_parti_actv_mem
subroutine dmumps_set_parti_actv_mem(slavef, keep, keep8, procs, mem_distrib, ncb, nfront, nslaves_node, tab_pos, slaves_list, size_slaves_list, myid)
Definition dmumps_load.F:2038
dmumps_load::comm_ld
integer, save, private comm_ld
Definition dmumps_load.F:57
dmumps_load::ne_load
integer, dimension(:), pointer, save, public ne_load
Definition dmumps_load.F:106
dmumps_load::pos_id
integer, save, public pos_id
Definition dmumps_load.F:77
dmumps_load::indice_sbtr_array
integer, private indice_sbtr_array
Definition dmumps_load.F:87
dmumps_load::lu_usage
double precision, dimension(:), allocatable lu_usage
Definition dmumps_load.F:82
dmumps_load::dmumps_split_post_partition
subroutine, public dmumps_split_post_partition(inode, step, n, slavef, nbsplit, ncb, procnode_steps, keep, dad, fils, icntl, tab_pos, nslaves_node)
Definition dmumps_load.F:220
dmumps_load::sbtr_peak_array
double precision, dimension(:), allocatable, save, private sbtr_peak_array
Definition dmumps_load.F:115
dmumps_load::frere_load
integer, dimension(:), pointer, save, public frere_load
Definition dmumps_load.F:106
dmumps_load::id_max_m2
integer, save, private id_max_m2
Definition dmumps_load.F:95
dmumps_load::my_root_sbtr
integer, dimension(:), pointer, save, private my_root_sbtr
Definition dmumps_load.F:111
dmumps_load::nprocs
integer, save, private nprocs
Definition dmumps_load.F:57
dmumps_load::tab_maxs
integer(8), dimension(:), allocatable, save, private tab_maxs
Definition dmumps_load.F:83
dmumps_load::niv2
double precision, dimension(:), allocatable, save, private niv2
Definition dmumps_load.F:98
dmumps_load::dmumps_load_less
integer function, public dmumps_load_less(k69, mem_distrib, msg_size)
Definition dmumps_load.F:1036
dmumps_load::procnode_load
integer, dimension(:), pointer, save, private procnode_load
Definition dmumps_load.F:101
dmumps_load::remove_node_cost_mem
double precision, save, private remove_node_cost_mem
Definition dmumps_load.F:43
dmumps_load::comm_nodes
integer, save, private comm_nodes
Definition dmumps_load.F:58
dmumps_load::bdc_m2_flops
logical, save, private bdc_m2_flops
Definition dmumps_load.F:39
dmumps_load::check_mem
integer(8), save, private check_mem
Definition dmumps_load.F:51
dmumps_load::dm_mem
double precision, dimension(:), allocatable, save, private dm_mem
Definition dmumps_load.F:93
dmumps_load::bdc_pool
logical, save, private bdc_pool
Definition dmumps_load.F:39
dmumps_load::dmumps_process_niv2_flops_msg
recursive subroutine dmumps_process_niv2_flops_msg(inode)
Definition dmumps_load.F:4994
dmumps_load::k50
integer, save, private k50
Definition dmumps_load.F:37
dmumps_load::dmumps_load_update
subroutine, public dmumps_load_update(check_flops, process_bande, inc_load, keep, keep8)
Definition dmumps_load.F:824
dmumps_load::niv1_flag
integer, public niv1_flag
Definition dmumps_load.F:86
dmumps_load::sbtr_cur
double precision, dimension(:), allocatable, save, private sbtr_cur
Definition dmumps_load.F:63
dmumps_load::dmumps_load_sbtr_upd_new_pool
subroutine, public dmumps_load_sbtr_upd_new_pool(ok, inode, pool, lpool, myid, slavef, comm, keep, keep8)
Definition dmumps_load.F:1934
dmumps_load::sbtr_mem
double precision, dimension(:), allocatable, save, private sbtr_mem
Definition dmumps_load.F:61
dmumps_load::remove_node_flag
logical, save, private remove_node_flag
Definition dmumps_load.F:39
dmumps_load::mem_subtree
double precision, dimension(:), allocatable, save, public mem_subtree
Definition dmumps_load.F:85
dmumps_load::nb_son
integer, dimension(:), allocatable, save, private nb_son
Definition dmumps_load.F:65
dmumps_load::sbtr_cur_array
double precision, dimension(:), allocatable, save, private sbtr_cur_array
Definition dmumps_load.F:115
dmumps_load::pool_niv2
integer, dimension(:), allocatable, save, private pool_niv2
Definition dmumps_load.F:97
dmumps_load::idwload
integer, dimension(:), allocatable, target, save, private idwload
Definition dmumps_load.F:52
dmumps_load::dmumps_load_master_2_all
subroutine, public dmumps_load_master_2_all(myid, slavef, comm, tab_pos, nass, keep, keep8, list_slaves, nslaves, inode)
Definition dmumps_load.F:1671
dmumps_load::keep_load
integer, dimension(:), pointer, save, private keep_load
Definition dmumps_load.F:103
dmumps_load::dm_thres_mem
double precision, save, private dm_thres_mem
Definition dmumps_load.F:91
dmumps_load::sbtr_cur_local
double precision, save, private sbtr_cur_local
Definition dmumps_load.F:67
dmumps_load::k35
integer, save, private k35
Definition dmumps_load.F:37
dmumps_load::nb_subtrees
integer, public nb_subtrees
Definition dmumps_load.F:86
dmumps_load::depth_first_load
integer, dimension(:), pointer, save, public depth_first_load
Definition dmumps_load.F:119
dmumps_load::dmumps_check_sbtr_cost
subroutine, public dmumps_check_sbtr_cost(nbinsubtree, insubtree, nbtop, min_cost, sbtr)
Definition dmumps_load.F:5280
dmumps_load::lbuf_load_recv
integer, save, private lbuf_load_recv
Definition dmumps_load.F:36
dmumps_load::dmumps_remove_node
subroutine, public dmumps_remove_node(inode, num_call)
Definition dmumps_load.F:4900
dmumps_load::max_surf_master
integer(8), save, private max_surf_master
Definition dmumps_load.F:38
dmumps_load::indice_sbtr
integer, private indice_sbtr
Definition dmumps_load.F:87
dmumps_load::remove_node_flag_mem
logical, save, private remove_node_flag_mem
Definition dmumps_load.F:39
dmumps_load::wload
double precision, dimension(:), allocatable, target, save, private wload
Definition dmumps_load.F:46
dmumps_load::min_diff
double precision, save, private min_diff
Definition dmumps_load.F:75
dmumps_load::n_load
integer, save, private n_load
Definition dmumps_load.F:104
dmumps_load::bdc_pool_mng
logical, save, private bdc_pool_mng
Definition dmumps_load.F:39
dmumps_load::dmumps_split_propagate_parti
subroutine, public dmumps_split_propagate_parti(inode, typesplit, ifson, cand, size_cand, son_slave_list, nslson, step, n, slavef, procnode_steps, keep, dad, fils, icntl, istep_to_iniv2, iniv2, tab_pos_in_pere, nslaves_node, slaves_list, size_slaves_list)
Definition dmumps_load.F:277
dmumps_struc_def
Definition dmumps_struc_def.F:14
mumps_future_niv2
Definition fac_future_niv2_mod.F:14
mumps_future_niv2::future_niv2
integer, dimension(:), allocatable, public future_niv2
Definition fac_future_niv2_mod.F:15
mumps_in_or_root_ssarbr
logical function mumps_in_or_root_ssarbr(procinfo_inode, k199)
Definition tools_common.F:214
mumps_rootssarbr
logical function mumps_rootssarbr(procinfo_inode, k199)
Definition tools_common.F:189
mumps_check_comm_nodes
subroutine mumps_check_comm_nodes(comm_nodes, exit_flag)
Definition tools_common.F:1087
mumps_typenode
integer function mumps_typenode(procinfo_inode, k199)
Definition tools_common.F:90
mumps_set_parti_regular
subroutine mumps_set_parti_regular(slavef, keep, keep8, procs, mem_distrib, ncb, nfront, nslaves_node, tab_pos, slaves_list, size_slaves_list, myid, inode, tab_maxs_arg, sup_proc_arg, max_surf, nb_row_max)
Definition tools_common.F:1566
mumps_typesplit
integer function mumps_typesplit(procinfo_inode, k199)
Definition tools_common.F:171
mumps_sort_doubles
subroutine mumps_sort_doubles(n, val, id)
Definition tools_common.F:284