OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cfac_distrib_ELT.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, University of Bordeaux.
8C
9C This version of MUMPS is provided to you free of charge. It is
10C released under the CeCILL-C license
11C (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14 SUBROUTINE cmumps_elt_distrib(
15 & N, NELT, NA_ELT8,
16 & COMM, MYID, SLAVEF,
17 & IELPTR_LOC8, RELPTR_LOC8,
18 & ELTVAR_LOC, ELTVAL_LOC,
19 & LINTARR, LDBLARR,
20 & KEEP,KEEP8, MAXELT_SIZE,
21 & FRTPTR, FRTELT, A, LA, FILS,
22 & id, root )
23 USE cmumps_struc_def
24 IMPLICIT NONE
25 INTEGER N, NELT
26 INTEGER(8) :: NA_ELT8
27 INTEGER COMM, MYID, SLAVEF, MAXELT_SIZE, MSGLEN
28 INTEGER(8), intent(IN) :: LA
29 INTEGER FRTPTR( N+1 )
30 INTEGER FRTELT( NELT ), FILS ( N )
31 INTEGER KEEP(500)
32 INTEGER(8) KEEP8(150)
33 INTEGER(8), INTENT(IN) :: IELPTR_LOC8( NELT + 1 )
34 INTEGER(8), INTENT(INOUT) :: RELPTR_LOC8( NELT + 1 )
35 INTEGER(8), INTENT(IN) :: LINTARR, LDBLARR
36 INTEGER ELTVAR_LOC( LINTARR )
37 COMPLEX ELTVAL_LOC( LDBLARR )
38 COMPLEX A( LA )
39 TYPE(cmumps_struc) :: id
40 TYPE(cmumps_root_struc) :: root
41 INTEGER numroc
42 EXTERNAL numroc
43 include 'mpif.h'
44 INCLUDE 'mumps_tags.h'
45 INTEGER :: IERR_MPI
46 INTEGER :: STATUS(MPI_STATUS_SIZE)
47 INTEGER MSGTAG
48 INTEGER allocok
49 INTEGER I, DEST, MAXELT_REAL_SIZE, MPG, IEL, SIZEI, SIZER
50 INTEGER NBRECORDS, NBUF
51 INTEGER(8) :: RECV_IELTPTR8
52 INTEGER(8) :: RECV_RELTPTR8
53 INTEGER INODE
54 INTEGER(8) :: IELTPTR8, RELTPTR8
55 LOGICAL FINI, PROKG, I_AM_SLAVE, EARLYT3ROOTINS
56 INTEGER(8) :: PTR_ROOT
57 INTEGER LOCAL_M, LOCAL_N, LP, IBEG, IGLOB, JGLOB
58 INTEGER ARROW_ROOT
59 INTEGER IELT, J, NB_REC, IREC
60 INTEGER(8) :: K8, IVALPTR8
61 INTEGER ILOCROOT, JLOCROOT, IPOSROOT, JPOSROOT, IPTR
62 INTEGER JCOL_GRID, IROW_GRID
63 INTEGER NBELROOT
64 INTEGER MASTER
65 PARAMETER( MASTER = 0 )
66 COMPLEX VAL
67 COMPLEX ZERO
68 PARAMETER( ZERO = (0.0E0,0.0E0) )
69 INTEGER, DIMENSION( :, : ), ALLOCATABLE :: BUFI
70 COMPLEX, DIMENSION( :, : ), ALLOCATABLE :: BUFR
71 COMPLEX, DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_R
72 INTEGER, DIMENSION( : ), ALLOCATABLE :: TEMP_ELT_I
73 INTEGER(8), DIMENSION( : ), ALLOCATABLE :: ELROOTPOS8
74 INTEGER, DIMENSION( : ), ALLOCATABLE, TARGET :: RG2LALLOC
75 INTEGER, DIMENSION( : ), POINTER :: RG2L
76 MPG = id%ICNTL(3)
77 LP = id%ICNTL(1)
78.eq..or..ne. I_AM_SLAVE = ( KEEP(46) 1 MYID MASTER )
79.and..eq. PROKG = ( MPG > 0 MYID MASTER )
80.AND..GE. PROKG = (PROKG(id%ICNTL(4)2))
81 KEEP(49) = 0
82 ARROW_ROOT = 0
83.EQ. EARLYT3ROOTINS = KEEP(200) 0
84.OR..LT..AND..EQ. & ( KEEP(200) 0 KEEP(400) 0 )
85.eq. IF ( MYID MASTER ) THEN
86.eq. IF ( KEEP(46) 0 ) THEN
87 NBUF = SLAVEF
88 ELSE
89 NBUF = SLAVEF - 1
90 END IF
91 NBRECORDS = KEEP(39)
92 IF (NA_ELT8 < int(NBRECORDS,8)) THEN
93 NBRECORDS = int(NA_ELT8)
94 ENDIF
95.eq. IF ( KEEP(50) 0 ) THEN
96 MAXELT_REAL_SIZE = MAXELT_SIZE * MAXELT_SIZE
97 ELSE
98 MAXELT_REAL_SIZE = MAXELT_SIZE * (MAXELT_SIZE+1)/2
99 END IF
100.GT. IF ( MAXELT_REAL_SIZE KEEP(39) ) THEN
101 NBRECORDS = MAXELT_REAL_SIZE
102.GT. IF ( MPG 0 ) THEN
103 WRITE(MPG,*)
104 & ' ** warning : for element distrib nbrecords set to ',
105 & MAXELT_REAL_SIZE,' because one element is large'
106 END IF
107 END IF
108 ALLOCATE( BUFI( 2*NBRECORDS+1, NBUF ), stat=allocok )
109.gt. IF ( allocok 0 ) THEN
110 id%INFO(1) = -13
111 id%INFO(2) = 2*NBRECORDS + 1
112 GOTO 100
113 END IF
114 ALLOCATE( BUFR( NBRECORDS+1, NBUF ), stat=allocok )
115.gt. IF ( allocok 0 ) THEN
116 id%INFO(1) = -13
117 id%INFO(2) = NBRECORDS + 1
118 GOTO 100
119 END IF
120.ne. IF ( KEEP(52) 0 ) THEN
121 ALLOCATE( TEMP_ELT_R( MAXELT_REAL_SIZE ), stat =allocok )
122.gt. IF ( allocok 0 ) THEN
123 id%INFO(1) = -13
124 id%INFO(2) = MAXELT_REAL_SIZE
125 GOTO 100
126 END IF
127 END IF
128 ALLOCATE( TEMP_ELT_I( MAXELT_SIZE ), stat=allocok )
129.gt. IF ( allocok 0 ) THEN
130 id%INFO(1) = -13
131 id%INFO(2) = MAXELT_SIZE
132 GOTO 100
133 END IF
134.ne. IF ( KEEP(38) 0 ) THEN
135 NBELROOT = FRTPTR(KEEP(38)+1)-FRTPTR(KEEP(38))
136 IF ( EARLYT3ROOTINS ) THEN
137 ALLOCATE( ELROOTPOS8( max(NBELROOT,1) ),
138 & stat = allocok )
139.gt. IF ( allocok 0 ) THEN
140 id%INFO(1) = -13
141 id%INFO(2) = NBELROOT
142 GOTO 100
143 END IF
144 ENDIF
145.eq. IF (KEEP(46) 0 ) THEN
146 ALLOCATE( RG2LALLOC( N ), stat = allocok )
147.gt. IF ( allocok 0 ) THEN
148 id%INFO(1) = -13
149 id%INFO(2) = N
150 GOTO 100
151 END IF
152 INODE = KEEP(38)
153 I = 1
154.GT. DO WHILE ( INODE 0 )
155 RG2LALLOC( INODE ) = I
156 INODE = FILS( INODE )
157 I = I + 1
158 END DO
159 RG2L => RG2LALLOC
160 ELSE
161 RG2L => root%RG2L_ROW
162 END IF
163 END IF
164 DO I = 1, NBUF
165 BUFI( 1, I ) = 0
166 BUFR( 1, I ) = ZERO
167 END DO
168 END IF
169 100 CONTINUE
170 CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), COMM, MYID )
171.LT. IF ( id%INFO(1) 0 ) RETURN
172 CALL MPI_BCAST( NBRECORDS, 1, MPI_INTEGER, MASTER,
173 & COMM, IERR_MPI )
174 RECV_IELTPTR8 = 1_8
175 RECV_RELTPTR8 = 1_8
176.eq. IF ( MYID MASTER ) THEN
177 NBELROOT = 0
178 RELTPTR8 = 1_8
179 RELPTR_LOC8(1) = 1
180 DO IEL = 1, NELT
181 IELTPTR8 = int(id%ELTPTR( IEL ),8)
182 SIZEI = int(int(id%ELTPTR( IEL + 1 ),8) - IELTPTR8)
183.eq. IF ( KEEP( 50 ) 0 ) THEN
184 SIZER = SIZEI * SIZEI
185 ELSE
186 SIZER = SIZEI * ( SIZEI + 1 ) / 2
187 END IF
188 DEST = id%ELTPROC( IEL )
189.eq. IF ( DEST -2 ) THEN
190 NBELROOT = NBELROOT + 1
191 FRTELT( FRTPTR(KEEP(38)) + NBELROOT - 1 ) = IEL
192 ELROOTPOS8( NBELROOT ) = RELTPTR8
193 GOTO 200
194 END IF
195.ge..and..eq. IF ( DEST 0 KEEP(46) 0 ) DEST = DEST + 1
196.ne. IF ( KEEP(52) 0 ) THEN
197 CALL CMUMPS_SCALE_ELEMENT( N, SIZEI, SIZER,
198 & id%ELTVAR( IELTPTR8 ), id%A_ELT( RELTPTR8 ),
199 & TEMP_ELT_R(1), MAXELT_REAL_SIZE,
200 & id%ROWSCA(1), id%COLSCA(1), KEEP(50) )
201 END IF
202.eq..or..eq..and..ne. IF ( DEST 0 ( DEST -1 KEEP(46) 0 ) )
203 & THEN
204 ELTVAR_LOC( RECV_IELTPTR8: RECV_IELTPTR8 + SIZEI - 1 )
205 & = id%ELTVAR( IELTPTR8: IELTPTR8 + SIZEI - 1 )
206 RECV_IELTPTR8 = RECV_IELTPTR8 + SIZEI
207.ne. IF ( KEEP(52) 0 ) THEN
208 ELTVAL_LOC( RECV_RELTPTR8: RECV_RELTPTR8 + SIZER - 1)
209 & = TEMP_ELT_R( 1: SIZER )
210 RECV_RELTPTR8 = RECV_RELTPTR8 + SIZER
211 END IF
212 END IF
213.NE..AND. IF ( DEST 0 DEST. NE. -3 ) THEN
214.eq. IF ( KEEP(52) 0 ) THEN
215 CALL CMUMPS_ELT_FILL_BUF(
216 & id%ELTVAR(IELTPTR8),
217 & id%A_ELT (RELTPTR8),
218 & SIZEI, SIZER,
219 &
220 & DEST, NBUF, NBRECORDS,
221 & BUFI, BUFR, COMM )
222 ELSE
223 CALL CMUMPS_ELT_FILL_BUF(
224 & id%ELTVAR(IELTPTR8),
225 & TEMP_ELT_R( 1 ),
226 & SIZEI, SIZER,
227 &
228 & DEST, NBUF, NBRECORDS,
229 & BUFI, BUFR, COMM )
230 END IF
231 END IF
232 200 CONTINUE
233 RELTPTR8 = RELTPTR8 + SIZER
234.eq..OR..eq. IF ( KEEP(46) 0 KEEP(52) 0 ) THEN
235 RELPTR_LOC8( IEL + 1 ) = RELTPTR8
236 ELSE
237 RELPTR_LOC8( IEL + 1 ) = RECV_RELTPTR8
238 ENDIF
239 END DO
240.eq..OR..eq. IF ( KEEP(46) 0 KEEP(52) 0 ) THEN
241 KEEP8(26) = RELTPTR8 - 1_8
242 ELSE
243 KEEP8(26) = RECV_RELTPTR8 - 1_8
244 ENDIF
245.NE. IF ( RELTPTR8 - 1_8 NA_ELT8 ) THEN
246 WRITE(*,*) " ** Internal error in CMUMPS_ELT_DISTRIB",
247 & RELTPTR8 - 1_8, NA_ELT8
248 CALL MUMPS_ABORT()
249 END IF
250 DEST = -2
251 IELTPTR8 = 1_8
252 RELTPTR8 = 1_8
253 SIZEI = 1
254 SIZER = 1
255 CALL CMUMPS_ELT_FILL_BUF(
256 & id%ELTVAR(IELTPTR8),
257 & id%A_ELT (RELTPTR8),
258 & SIZEI, SIZER,
259 &
260 & DEST, NBUF, NBRECORDS,
261 & BUFI, BUFR, COMM )
262.NE. IF ( KEEP(52) 0 ) DEALLOCATE( TEMP_ELT_R )
263 ELSE
264.eq. FINI = ( RECV_IELTPTR8 IELPTR_LOC8( NELT+1 )
265.and..eq. & RECV_RELTPTR8 RELPTR_LOC8( NELT+1 ) )
266.not. DO WHILE ( FINI )
267 CALL MPI_PROBE( MASTER, MPI_ANY_TAG,
268 & COMM, STATUS, IERR_MPI )
269 MSGTAG = STATUS( MPI_TAG )
270 SELECT CASE ( MSGTAG )
271 CASE( ELT_INT )
272 CALL MPI_GET_COUNT( STATUS, MPI_INTEGER,
273 & MSGLEN, IERR_MPI )
274 CALL MPI_RECV( ELTVAR_LOC( RECV_IELTPTR8 ), MSGLEN,
275 & MPI_INTEGER, MASTER, ELT_INT,
276 & COMM, STATUS, IERR_MPI )
277 RECV_IELTPTR8 = RECV_IELTPTR8 + MSGLEN
278 CASE( ELT_REAL )
279 CALL MPI_GET_COUNT( STATUS, MPI_COMPLEX,
280 & MSGLEN, IERR_MPI )
281 CALL MPI_RECV( ELTVAL_LOC( RECV_RELTPTR8 ), MSGLEN,
282 & MPI_COMPLEX, MASTER, ELT_REAL,
283 & COMM, STATUS, IERR_MPI )
284 RECV_RELTPTR8 = RECV_RELTPTR8 + MSGLEN
285 END SELECT
286.eq. FINI = ( RECV_IELTPTR8 IELPTR_LOC8( NELT+1 )
287.and..eq. & RECV_RELTPTR8 RELPTR_LOC8( NELT+1 ) )
288 END DO
289 END IF
290.NE..AND. IF ( KEEP(38) 0 EARLYT3ROOTINS ) THEN
291.and. IF ( I_AM_SLAVE root%yes ) THEN
292 CALL CMUMPS_GET_ROOT_INFO(root,
293 & LOCAL_M, LOCAL_N, PTR_ROOT, LA)
294 CALL CMUMPS_SET_ROOT_TO_ZERO(root, KEEP, A, LA)
295 END IF
296.NE. IF ( MYID MASTER ) THEN
297 ALLOCATE( BUFI( NBRECORDS * 2 + 1, 1 ), stat = allocok )
298.GT. IF ( allocok 0 ) THEN
299 id%INFO(1) = -13
300 id%INFO(2) = NBRECORDS * 2 + 1
301 GOTO 250
302 END IF
303 ALLOCATE( BUFR( NBRECORDS, 1 ) , stat = allocok )
304.GT. IF ( allocok 0 ) THEN
305 id%INFO(1) = -13
306 id%INFO(2) = NBRECORDS
307 END IF
308 END IF
309 250 CONTINUE
310 CALL MUMPS_PROPINFO( id%ICNTL(1), id%INFO(1), COMM, MYID )
311.LT. IF ( id%INFO(1) 0 ) RETURN
312.eq. IF ( MYID MASTER ) THEN
313 DO IPTR = FRTPTR(KEEP(38)), FRTPTR(KEEP(38)+1) - 1
314 IELT = FRTELT( IPTR )
315 SIZEI = id%ELTPTR( IELT + 1 ) - id%ELTPTR( IELT )
316 DO I = 1, SIZEI
317 TEMP_ELT_I( I ) = RG2L
318 & ( id%ELTVAR( id%ELTPTR(IELT) + I - 1 ) )
319 END DO
320 IVALPTR8 = ELROOTPOS8( IPTR - FRTPTR(KEEP(38)) + 1 ) - 1
321 K8 = 1_8
322 DO J = 1, SIZEI
323 JGLOB = id%ELTVAR( id%ELTPTR( IELT ) + J - 1 )
324.eq. IF ( KEEP(50) 0 ) THEN
325 IBEG = 1
326 ELSE
327 IBEG = J
328 END IF
329 DO I = IBEG, SIZEI
330 IGLOB = id%ELTVAR( id%ELTPTR( IELT ) + I - 1 )
331.eq. IF ( KEEP(52) 0 ) THEN
332 VAL = id%A_ELT( IVALPTR8 + K8 )
333 ELSE
334 VAL = id%A_ELT( IVALPTR8 + K8 ) *
335 & id%ROWSCA( IGLOB ) * id%COLSCA( JGLOB )
336 END IF
337.eq. IF ( KEEP(50)0 ) THEN
338 IPOSROOT = TEMP_ELT_I( I )
339 JPOSROOT = TEMP_ELT_I( J )
340 ELSE
341.GT. IF ( TEMP_ELT_I(I) TEMP_ELT_I(J) ) THEN
342 IPOSROOT = TEMP_ELT_I(I)
343 JPOSROOT = TEMP_ELT_I(J)
344 ELSE
345 IPOSROOT = TEMP_ELT_I(J)
346 JPOSROOT = TEMP_ELT_I(I)
347 END IF
348 END IF
349 IROW_GRID = mod( ( IPOSROOT - 1 )/root%MBLOCK,
350 & root%NPROW )
351 JCOL_GRID = mod( ( JPOSROOT - 1 )/root%NBLOCK,
352 & root%NPCOL )
353.eq. IF ( KEEP(46) 0 ) THEN
354 DEST = IROW_GRID * root%NPCOL + JCOL_GRID + 1
355 ELSE
356 DEST = IROW_GRID * root%NPCOL + JCOL_GRID
357 END IF
358.eq. IF ( DEST MASTER ) THEN
359 ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) /
360 & ( root%MBLOCK * root%NPROW ) )
361 & + mod( IPOSROOT - 1, root%MBLOCK ) + 1
362 JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) /
363 & ( root%NBLOCK * root%NPCOL ) )
364 & + mod( JPOSROOT - 1, root%NBLOCK ) + 1
365 ARROW_ROOT = ARROW_ROOT + 1
366 IF (KEEP(60)==0) THEN
367 A( PTR_ROOT
368 & + int(JLOCROOT - 1,8) * int(LOCAL_M,8)
369 & + int(ILOCROOT - 1,8) )
370 & = A( PTR_ROOT
371 & + int(JLOCROOT - 1,8) * int(LOCAL_M,8)
372 & + int(ILOCROOT - 1,8) )
373 & + VAL
374 ELSE
375 root%SCHUR_POINTER( int(JLOCROOT-1,8)
376 & * int(root%SCHUR_LLD,8)
377 & + int(ILOCROOT,8) )
378 & = root%SCHUR_POINTER( int(JLOCROOT-1,8)
379 & * int(root%SCHUR_LLD,8)
380 & + int(ILOCROOT,8) )
381 & + VAL
382 ENDIF
383 ELSE
384 CALL CMUMPS_ARROW_FILL_SEND_BUF_ELT(
385 & IPOSROOT, JPOSROOT, VAL, DEST, BUFI, BUFR, NBRECORDS,
386 & NBUF, LP, COMM )
387 END IF
388 K8 = K8 + 1_8
389 END DO
390 END DO
391 END DO
392 CALL CMUMPS_ARROW_FINISH_SEND_BUF(
393 & BUFI, BUFR, NBRECORDS,
394 & NBUF, LP, COMM, KEEP(46) )
395 ELSE
396 FINI = .FALSE.
397.not. DO WHILE ( FINI )
398 CALL MPI_RECV( BUFI(1,1), 2*NBRECORDS+1,
399 & MPI_INTEGER, MASTER,
400 & ARROWHEAD,
401 & COMM, STATUS, IERR_MPI )
402 NB_REC = BUFI(1,1)
403 ARROW_ROOT = ARROW_ROOT + NB_REC
404.LE. IF (NB_REC0) THEN
405 FINI = .TRUE.
406 NB_REC = -NB_REC
407 ENDIF
408.EQ. IF (NB_REC0) EXIT
409 CALL MPI_RECV( BUFR(1,1), NBRECORDS, MPI_COMPLEX,
410 & MASTER, ARROWHEAD,
411 & COMM, STATUS, IERR_MPI )
412 DO IREC = 1, NB_REC
413 IPOSROOT = BUFI( IREC * 2, 1 )
414 JPOSROOT = BUFI( IREC * 2 + 1, 1 )
415 VAL = BUFR( IREC, 1 )
416 ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) /
417 & ( root%MBLOCK * root%NPROW ) )
418 & + mod( IPOSROOT - 1, root%MBLOCK ) + 1
419 JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) /
420 & ( root%NBLOCK * root%NPCOL ) )
421 & + mod( JPOSROOT - 1, root%NBLOCK ) + 1
422.eq. IF (KEEP(60)0) THEN
423 A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8)
424 & + int(ILOCROOT-1,8))
425 & = A( PTR_ROOT + int(JLOCROOT-1,8) * int(LOCAL_M,8)
426 & + int(ILOCROOT-1,8))
427 & + VAL
428 ELSE
429 root%SCHUR_POINTER(int(JLOCROOT-1,8)
430 & * int(root%SCHUR_LLD,8)
431 & + int(ILOCROOT,8) )
432 & = root%SCHUR_POINTER( int(JLOCROOT - 1,8)
433 & * int(root%SCHUR_LLD,8)
434 & + int(ILOCROOT,8))
435 & + VAL
436 ENDIF
437 END DO
438 END DO
439 DEALLOCATE( BUFI )
440 DEALLOCATE( BUFR )
441 END IF
442 END IF
443.eq. IF ( MYID MASTER ) THEN
444 DEALLOCATE( BUFI )
445 DEALLOCATE( BUFR )
446 IF (allocated(ELROOTPOS8)) DEALLOCATE(ELROOTPOS8)
447.ne. IF (KEEP(38)0) THEN
448.eq. IF (KEEP(46) 0 ) THEN
449 DEALLOCATE(RG2LALLOC)
450 ENDIF
451 ENDIF
452 DEALLOCATE( TEMP_ELT_I )
453 END IF
454 KEEP(49) = ARROW_ROOT
455 RETURN
456 END SUBROUTINE CMUMPS_ELT_DISTRIB
457 SUBROUTINE CMUMPS_ELT_FILL_BUF(
458 & ELNODES, ELVAL, SIZEI, SIZER,
459 & DEST, NBUF, NBRECORDS, BUFI, BUFR, COMM )
460 IMPLICIT NONE
461 INTEGER SIZEI, SIZER, DEST, NBUF, NBRECORDS, COMM
462 INTEGER ELNODES( SIZEI ), BUFI( 2*NBRECORDS + 1, NBUF )
463 COMPLEX ELVAL( SIZER ), BUFR( NBRECORDS + 1, NBUF )
464 INCLUDE 'mumps_tags.h'
465 INCLUDE 'mpif.h'
466 INTEGER I, IBEG, IEND, IERR_MPI, NBRECR
467 INTEGER NBRECI
468 COMPLEX ZERO
469 PARAMETER( ZERO = (0.0E0,0.0E0) )
470.lt. IF ( DEST 0 ) THEN
471 IBEG = 1
472 IEND = NBUF
473 ELSE
474 IBEG = DEST
475 IEND = DEST
476 END IF
477 DO I = IBEG, IEND
478 NBRECI = BUFI(1,I)
479.ne..and. IF ( NBRECI 0
480.eq..or. & ( DEST-2
481.GT. & NBRECI + SIZEI 2*NBRECORDS ) ) THEN
482 CALL MPI_SEND( BUFI(2, I), NBRECI, MPI_INTEGER,
483 & I, ELT_INT, COMM, IERR_MPI )
484 BUFI(1,I) = 0
485 NBRECI = 0
486 END IF
487 NBRECR = int(real(BUFR(1,I))+0.5E0)
488.ne..and. IF ( NBRECR 0
489.eq..or. & ( DEST-2
490.GT. & NBRECR + SIZER NBRECORDS ) ) THEN
491 CALL MPI_SEND( BUFR(2, I), NBRECR, MPI_COMPLEX,
492 & I, ELT_REAL, COMM, IERR_MPI )
493 BUFR(1,I) = ZERO
494 NBRECR = 0
495 END IF
496.ne. IF ( DEST -2 ) THEN
497 BUFI( 2 + NBRECI : 2 + NBRECI + SIZEI - 1, I ) =
498 & ELNODES( 1: SIZEI )
499 BUFR( 2 + NBRECR : 2 + NBRECR + SIZER - 1, I ) =
500 & ELVAL( 1: SIZER )
501 BUFI(1,I) = NBRECI + SIZEI
502 BUFR(1,I) = cmplx( NBRECR + SIZER, kind=kind(BUFR) )
503 END IF
504 END DO
505 RETURN
506 END SUBROUTINE CMUMPS_ELT_FILL_BUF
507 SUBROUTINE CMUMPS_MAXELT_SIZE( ELTPTR, NELT, MAXELT_SIZE )
508 INTEGER NELT, MAXELT_SIZE
509 INTEGER ELTPTR( NELT + 1 )
510 INTEGER I, S
511 MAXELT_SIZE = 0
512 DO I = 1, NELT
513 S = ELTPTR( I + 1 ) - ELTPTR( I )
514 MAXELT_SIZE = max( S, MAXELT_SIZE )
515 END DO
516 RETURN
517 END SUBROUTINE CMUMPS_MAXELT_SIZE
518 SUBROUTINE CMUMPS_SCALE_ELEMENT( N, SIZEI, SIZER,
519 & ELTVAR, ELTVAL,
520 & SELTVAL, LSELTVAL,
521 & ROWSCA, COLSCA, K50 )
522 INTEGER N, SIZEI, SIZER, LSELTVAL, K50
523 INTEGER ELTVAR( SIZEI )
524 COMPLEX ELTVAL( SIZER )
525 COMPLEX SELTVAL( LSELTVAL )
526 REAL ROWSCA( N ), COLSCA( N )
527 INTEGER I, J, K
528 K = 1
529.eq. IF ( K50 0 ) THEN
530 DO J = 1, SIZEI
531 DO I = 1, SIZEI
532 SELTVAL(K) = ELTVAL(K) *
533 & ROWSCA(ELTVAR(I)) *
534 & COLSCA(ELTVAR(J))
535 K = K + 1
536 END DO
537 END DO
538 ELSE
539 DO J = 1, SIZEI
540 DO I = J, SIZEI
541 SELTVAL(K) = ELTVAL(K) *
542 & ROWSCA(ELTVAR(I)) *
543 & COLSCA(ELTVAR(J))
544 K = K + 1
545 END DO
546 END DO
547 END IF
548 RETURN
549 END SUBROUTINE CMUMPS_SCALE_ELEMENT
cmumps_elt_distrib
subroutine cmumps_elt_distrib(n, nelt, na_elt8, comm, myid, slavef, ielptr_loc8, relptr_loc8, eltvar_loc, eltval_loc, lintarr, ldblarr, keep, keep8, maxelt_size, frtptr, frtelt, a, la, fils, id, root)
Definition cfac_distrib_ELT.F:23
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
cmumps_struc_def
Definition cmumps_struc_def.F:14