OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cfac_distrib_ELT.F File Reference

Go to the source code of this file.

Functions/Subroutines

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)
subroutine cmumps_elt_fill_buf (elnodes, elval, sizei, sizer, dest, nbuf, nbrecords, bufi, bufr, comm)
subroutine cmumps_maxelt_size (eltptr, nelt, maxelt_size)
subroutine cmumps_scale_element (n, sizei, sizer, eltvar, eltval, seltval, lseltval, rowsca, colsca, k50)

Function/Subroutine Documentation

◆ cmumps_elt_distrib()

subroutine cmumps_elt_distrib ( integer n,
integer nelt,
integer(8) na_elt8,
integer comm,
integer myid,
integer slavef,
integer(8), dimension( nelt + 1 ), intent(in) ielptr_loc8,
integer(8), dimension( nelt + 1 ), intent(inout) relptr_loc8,
integer, dimension( lintarr ) eltvar_loc,
complex, dimension( ldblarr ) eltval_loc,
integer(8), intent(in) lintarr,
integer(8), intent(in) ldblarr,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer maxelt_size,
integer, dimension( n+1 ) frtptr,
integer, dimension( nelt ) frtelt,
complex, dimension( la ) a,
integer(8), intent(in) la,
integer, dimension ( n ) fils,
type(cmumps_struc) id,
type(cmumps_root_struc) root )

Definition at line 14 of file cfac_distrib_ELT.F.

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
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition mpi.f:786
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
cmumps_struc_def
Definition cmumps_struc_def.F:14

◆ cmumps_elt_fill_buf()

subroutine cmumps_elt_fill_buf ( integer, dimension( sizei ) elnodes,
complex, dimension( sizer ) elval,
integer sizei,
integer sizer,
integer dest,
integer nbuf,
integer nbrecords,
integer, dimension( 2*nbrecords + 1, nbuf ) bufi,
complex, dimension( nbrecords + 1, nbuf ) bufr,
integer comm )

Definition at line 457 of file cfac_distrib_ELT.F.

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 IF ( dest .lt. 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 IF ( nbreci .ne.0 .and.
480 & ( dest.eq.-2 .or.
481 & nbreci + sizei .GT. 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 IF ( nbrecr .ne.0 .and.
489 & ( dest.eq.-2 .or.
490 & nbrecr + sizer .GT. 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 IF ( dest .ne. -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
cmplx
float cmplx[2]
Definition pblas.h:136
mpi_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480

◆ cmumps_maxelt_size()

subroutine cmumps_maxelt_size ( integer, dimension( nelt + 1 ) eltptr,
integer nelt,
integer maxelt_size )

Definition at line 507 of file cfac_distrib_ELT.F.

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
max
#define max(a, b)
Definition macros.h:21

◆ cmumps_scale_element()

subroutine cmumps_scale_element ( integer n,
integer sizei,
integer sizer,
integer, dimension( sizei ) eltvar,
complex, dimension( sizer ) eltval,
complex, dimension( lseltval ) seltval,
integer lseltval,
real, dimension( n ) rowsca,
real, dimension( n ) colsca,
integer k50 )

Definition at line 518 of file cfac_distrib_ELT.F.

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 IF ( k50 .eq. 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