OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
imp_mumps.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| imp_mumps1 ../engine/source/implicit/imp_mumps.F
25!||--- called by ------------------------------------------------------
26!|| imp_solv ../engine/source/implicit/imp_solv.F
27!||--- calls -----------------------------------------------------
28!|| mumps_set2 ../engine/source/implicit/imp_mumps.F
29!|| print_stiff_mat ../engine/source/implicit/imp_mumps.F
30!|| spmd_cddl ../engine/source/mpi/implicit/imp_spmd.F
31!|| spmd_inf_g ../engine/source/mpi/implicit/imp_spmd.F
32!|| spmd_mumps_count ../engine/source/mpi/implicit/imp_spmd.F
33!|| spmd_mumps_deal ../engine/source/mpi/implicit/imp_spmd.F
34!|| spmd_mumps_gath ../engine/source/mpi/implicit/imp_spmd.F
35!|| spmd_mumps_ini ../engine/source/mpi/implicit/imp_spmd.F
36!|| tmpenvf ../engine/source/system/tmpenv_c.c
37!||--- uses -----------------------------------------------------
38!|| imp_intm ../engine/share/modules/imp_intm.F
39!|| imp_kbcs ../engine/share/modules/impbufdef_mod.F
40!|| message_mod ../engine/share/message_module/message_mod.F
41!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
42!||====================================================================
43 SUBROUTINE imp_mumps1(NDDL0 , NNZK0 , NDDL , NNZK , NNMAX ,
44 . NODGLOB, IDDL , NDOF , INLOC, IKC ,
45 . IADK , JDIK , DIAG_K, LT_K , IAD_ELEM,
46 . FR_ELEM, MUMPS_PAR, CDDLP , IADI , JDII ,
47 . ITOK , DIAG_I , LT_I , NDDLI, NNZI ,
48 . IMPRINT, IT)
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE imp_intm
53 USE imp_kbcs
54 USE message_mod
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58 USE spmd_comm_world_mod, ONLY : spmd_comm_world
59#include "implicit_f.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#if defined(MUMPS5)
64#include "dmumps_struc.h"
65#endif
66#include "impl1_c.inc"
67#include "task_c.inc"
68#include "units_c.inc"
69#include "com01_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER NDDL0, NNZK0, NDDL, NNZK, NNMAX, NODGLOB(*), IDDL(*),
74 . NDOF(*), INLOC(*), IKC(*), IADK(*), JDIK(*),
75 . IAD_ELEM(2,*), FR_ELEM(*), CDDLP(*), IADI(*), JDII(*),
76 . ITOK(*), NDDLI, NNZI,IMPRINT,TLEN, IT
77 my_real
78 . diag_k(*), lt_k(*), diag_i(*), lt_i(*)
79#ifdef MUMPS5
80 TYPE(dmumps_struc) MUMPS_PAR
81#else
82 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
83 INTEGER MUMPS_PAR
84#endif
85#ifdef MUMPS5
86C----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 INTEGER I, J , N
90 INTEGER NDDLG0, NNZKG0, NDDLG, NNZKG, NNMAXG,
91 . NDDL0P(NSPMD), NNZK0P(NSPMD), NDDLP(NSPMD),
92 . NNZKP(NSPMD), NNMAXP(NSPMD), NKLOC,
93 . NKFRONT, NKFLOC, NZLOC, NNZ, NZP(NSPMD-1), IACTI(NDDL),
94 . nnzt
95 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITK
96 my_real
97 . , DIMENSION(:), ALLOCATABLE :: RTK
98C
99 IF (NDDLI==0) nnzi=0
100C Desallocations si necessaire
101
102 CALL spmd_mumps_deal(mumps_par)
103C
104 CALL spmd_mumps_ini(mumps_par, 1)
105C
106
107 IF (ncycle==1.AND.inconv==1) THEN
108 mumps_par%ICNTL(3) = iout
109 ELSE
110 mumps_par%ICNTL(3) = -1
111 ENDIF
112C--Level of info to be printed with user input /MUMPS/MSGLV/n
113 IF(m_msg > 0) THEN
114 mumps_par%ICNTL(3) = iout ! standard output
115 mumps_par%ICNTL(4) = m_msg ! max lev of info
116 ENDIF
117C
118 IF (m_order==0) THEN
119 mumps_par%ICNTL(7) = 7 ! Automatic choice of ordering
120 ELSE
121 mumps_par%ICNTL(7) = m_order
122 END IF
123
124 mumps_par%ICNTL(13) = 1 ! Disable scalapack for the root matrix
125C uncomment to set out of core
126C MUMPS_PAR%ICNTL(22)=1
127
128 IF (m_ocore > 0) THEN
129 CALL tmpenvf(mumps_par%OOC_TMPDIR,tlen)
130 mumps_par%ICNTL(22)=1
131 ENDIF
132
133 IF (nspmd>1) THEN
134C LMEMV is the memory on the host (i.e. node)
135C MUMPS_PAR%ICNTL(23)=LMEMV/NSPMD_PER_NODE
136 IF (imumpsd==1) THEN
137 mumps_par%ICNTL(18)=3
138 ELSEIF (imumpsd==2) THEN
139 mumps_par%ICNTL(18)=0
140 ENDIF
141 IF (idtc==3) mumps_par%ICNTL(13)=1
142C
143 nddlg0 = nddl0
144 nnzkg0 = nnzk0
145 nddlg = nddl
146 nnzkg = nnzk
147 nnmaxg = nnmax
148 CALL spmd_inf_g(
149 1 nddlg0 ,nnzkg0 ,nddlg ,nnzkg ,nnmaxg ,
150 2 nddl0p ,nnzk0p ,nddlp ,nnzkp ,nnmaxp )
151C
152 CALL spmd_cddl(nddl, nodglob, iddl, ndof, cddlp,
153 . inloc, ikc, nddlg, nddlp)
154C
155 nnzt = nddl+nnzk+nnzi+nz_sl+nz_si
156 ALLOCATE(itk(2,nnzt),rtk(nnzt))
157C
158 DO i=1,nddl
159 iacti(i)=i
160 ENDDO
161C
162 CALL mumps_set2(
163 . iadk, jdik, diag_k, lt_k, cddlp,
164 . nkloc, nkfront, itk, rtk, iddl,
165 . inloc, iad_elem, fr_elem, ndof, ikc,
166 . nddl, nnzk, iacti, nddli, nnzi,
167 . iadi, jdii, itok, diag_i, lt_i )
168C
169c CALL SPMD_MUMPS_FRONT(
170c . ITK, RTK, NKFRONT, NKFLOC, NKLOC,
171c . NDDLG, IMPRINT )
172C
173 nkfloc = 0
174 nzloc=nkloc+nkfloc
175 IF (imumpsd==1) THEN
176 ALLOCATE(mumps_par%A_LOC(nzloc),
177 . mumps_par%IRN_LOC(nzloc),
178 . mumps_par%JCN_LOC(nzloc))
179 IF (ispmd==0) THEN
180 ALLOCATE(mumps_par%RHS(nddlg))
181 ELSE
182 ALLOCATE(mumps_par%RHS(0))
183 ENDIF
184 mumps_par%N=nddlg
185 mumps_par%NZ_LOC=nzloc
186C
187 DO i=1,nzloc
188 mumps_par%IRN_LOC(i)=itk(1,i)
189 mumps_par%JCN_LOC(i)=itk(2,i)
190 mumps_par%A_LOC(i)=rtk(i)
191 ENDDO
192 ELSEIF (imumpsd==2) THEN
193 CALL spmd_mumps_count(nzloc, nzp, nnz)
194C
195 IF (ispmd==0) THEN
196 ALLOCATE(mumps_par%A(nnz),
197 . mumps_par%IRN(nnz),
198 . mumps_par%JCN(nnz),
199 . mumps_par%RHS(nddlg))
200 mumps_par%N=nddlg
201 mumps_par%NZ=nnz
202 ELSE
203 ALLOCATE(mumps_par%A(0),
204 . mumps_par%IRN(0),
205 . mumps_par%JCN(0),
206 . mumps_par%RHS(0))
207 ENDIF
208C
209 CALL spmd_mumps_gath(
210 . itk, rtk, nzloc, mumps_par%A, mumps_par%IRN,
211 . mumps_par%JCN, nzp)
212C
213 ENDIF
214 DEALLOCATE(itk, rtk)
215 ELSE
216 mumps_par%ICNTL(18)=0
217C
218 DO i=1,nddl
219 cddlp(i)=i
220 ENDDO
221 nnzt = nnzk
222 nnzk = nnzk + nddli + nnzi
223C
224 ALLOCATE(mumps_par%A(nddl+nnzk),
225 . mumps_par%IRN(nddl+nnzk),
226 . mumps_par%JCN(nddl+nnzk),
227 . mumps_par%RHS(nddl))
228C
229 nnz=0
230 DO i=1,nddli
231 j=itok(i)
232 nnz=nnz+1
233 mumps_par%IRN(nnz)=j
234 mumps_par%JCN(nnz)=j
235 mumps_par%A(nnz)=diag_i(i)
236 DO n=iadi(i),iadi(i+1)-1
237 nnz=nnz+1
238 mumps_par%IRN(nnz)=j
239 mumps_par%JCN(nnz)=itok(jdii(n))
240 mumps_par%A(nnz)=lt_i(n)
241 ENDDO
242 ENDDO
243 DO i=1,nddl
244 nnz=nnz+1
245 mumps_par%IRN(nnz)=i
246 mumps_par%JCN(nnz)=i
247 mumps_par%A(nnz)=diag_k(i)
248 DO j=iadk(i),iadk(i+1)-1
249 nnz=nnz+1
250 mumps_par%IRN(nnz)=i
251 mumps_par%JCN(nnz)=jdik(j)
252 mumps_par%A(nnz)=lt_k(j)
253 ENDDO
254 ENDDO
255C
256 IF (imprint/=0) THEN
257 WRITE(istdo,*)
258 WRITE(istdo,'(A21,I10,A8,I10)')
259 .' mumps dim : nnz =',NNZK+NDDL,' nnzfr =',0
260 ENDIF
261C
262 MUMPS_PAR%N=NDDL
263 MUMPS_PAR%NZ=NNZK+NDDL
264 NNZK = NNZT
265 ENDIF
266C
267c WRITE(IOUT,*) "NCYCLE,IT=",NCYCLE,IT
268.AND..OR. IF (PRSTIFMAT == 1 (ILINE==1 (PRSTIFMAT_NC == NCYCLE
269.AND. . PRSTIFMAT_IT == IT))) THEN
270 IF (ISPMD == 0) THEN
271 WRITE(IOUT,1000)
272 WRITE(ISTDO,1000)
273 WRITE(IOUT,*)
274 WRITE(ISTDO,*)
275 ENDIF
276 CALL PRINT_STIFF_MAT(MUMPS_PAR, NDDL, NODGLOB, IDDL, NDOF,
277 . CDDLP, INLOC, IKC, NDDLG, NDDLP)
278
279
280 ENDIF
2811000 FORMAT(5X,'--stiffness matrix is printed--')
282 RETURN
283#endif
284 END
285!||====================================================================
286!|| print_stiff_mat ../engine/source/implicit/imp_mumps.F
287!||--- called by ------------------------------------------------------
288!|| imp_mumps1 ../engine/source/implicit/imp_mumps.F
289!||--- calls -----------------------------------------------------
290!|| spmd_int_allreduce_max ../engine/source/mpi/implicit/imp_spmd.F
291!||--- uses -----------------------------------------------------
292!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
293!||====================================================================
294 SUBROUTINE PRINT_STIFF_MAT(MUMPS_PAR, NDDL, NODGLOB, IDDL, NDOF,
295 . CDDLP, INLOC, IKC, NDDLG, NDDLP)
296C-----------------------------------------------
297C I m p l i c i t T y p e s
298C-----------------------------------------------
299 USE SPMD_COMM_WORLD_MOD, ONLY : SPMD_COMM_WORLD
300#include "implicit_f.inc"
301C-----------------------------------------------
302C C o m m o n B l o c k s
303C-----------------------------------------------
304#if defined(MUMPS5)
305#include "dmumps_struc.h"
306#endif
307#include "task_c.inc"
308#include "com01_c.inc"
309#include "com04_c.inc"
310#include "impl2_c.inc"
311C-----------------------------------------------
312C M e s s a g e P a s s i n g
313C-----------------------------------------------
314#include "spmd.inc"
315C-----------------------------------------------
316C D u m m y A r g u m e n t s
317C-----------------------------------------------
318#ifdef MUMPS5
319 TYPE(DMUMPS_STRUC) MUMPS_PAR
320#else
321 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
322 INTEGER MUMPS_PAR
323#endif
324 INTEGER NDDL, NODGLOB(*), IDDL(*), NDOF(*), CDDLP(*), INLOC(*), IKC(*), NDDLG, NDDLP(*)
325#ifdef MUMPS5
326C-----------------------------------------------
327C L o c a l V a r i a b l e s
328C-----------------------------------------------
329 INTEGER I,J,II,JJ,NROWS,NCOLS,NENTRIES,IItmp,JJtmp,
330 . tmpIROWS,tmpICOLS,LENGTH,L,IND,COUNT_DUP,
331 . NKC,TDDL(2,MUMPS_PAR%N),N,ID,ND,IERROR,OFFST
332 my_real
333 . tmpK,sumK,tmpPROC
334 INTEGER, DIMENSION(:), ALLOCATABLE :: IROWS,ICOLS,NENTRIEStmp
335 my_real, DIMENSION(:), ALLOCATABLE :: K
336 LOGICAL SWITCH
337 CHARACTER FILNAME*100,FILNAME2*100,CSPMD
338C-----------------------------------------------
339C Define offset for UNIT file
340 OFFST = 100
341C Automatic write of stiffness coefficients in MatrixMarket format by MUMPS: MUMPS_PAR%WRITE_PROBLEM = 'string'
342C MUMPS_PAR%WRITE_PROBLEM ="./stiffness_matrix_MUMPS"
343 WRITE(CSPMD,'(i1)') ISPMD
344 FILNAME = 'local_stiffness_matrix_domain'//CSPMD
345 OPEN(UNIT=OFFST+ISPMD,FILE=FILNAME(1:30),ACCESS="SEQUENTIAL",
346 . ACTION="WRITE",STATUS="UNKNOWN")
347C Manual write of stiffness coefficients in MatrixMarket format
348C TDDL: local DOF (at MPI domain level) to global node and direction (DX,DY,DZ,RX,RY,RZ)
349 NKC = 0
350 TDDL(1,:) = 0
351 TDDL(2,:) = 0
352 DO N=1,NUMNOD
353 I=INLOC(N)
354 DO J=1,NDOF(I)
355 ND=IDDL(I)+J
356 ID=ND-NKC
357 IF (IKC(ND)<1) THEN
358 TDDL(1,CDDLP(ID))=NODGLOB(I)
359 TDDL(2,CDDLP(ID))=J
360 ELSE
361 NKC=NKC+1
362 ENDIF
363 ENDDO
364 ENDDO
365C Communications between processes for TDDL(1:2,1:MUMPS_PAR%N)
366 IF (NSPMD > 1) THEN
367 CALL SPMD_INT_ALLREDUCE_MAX(TDDL(1,:),TDDL(1,:),
368 . MUMPS_PAR%N)
369 CALL SPMD_INT_ALLREDUCE_MAX(TDDL(2,:),TDDL(2,:),
370 . MUMPS_PAR%N)
371 END IF
372C All processes: write local stiffness coefficients (at MPI domain level) in MatrixMarket format
373 IF (NSPMD == 1) THEN
374 WRITE(OFFST+ISPMD,1002) MUMPS_PAR%N,MUMPS_PAR%N,MUMPS_PAR%NZ
375 DO I=1,MUMPS_PAR%NZ
376 IItmp = MUMPS_PAR%IRN(I)
377 JJtmp = MUMPS_PAR%JCN(I)
378 II = 6*(TDDL(1,IItmp)-1)+TDDL(2,IItmp)
379 JJ = 6*(TDDL(1,JJtmp)-1)+TDDL(2,JJtmp)
380 IF (JJ > II) THEN
381 IItmp = II
382 II = JJ
383 JJ = IItmp
384 ENDIF
385 WRITE(OFFST+ISPMD,1003) II,JJ,MUMPS_PAR%A(I)
386 ENDDO
387 ELSE
388 WRITE(OFFST+ISPMD,1002) MUMPS_PAR%N,MUMPS_PAR%N,MUMPS_PAR%NZ_LOC
389 DO I=1,MUMPS_PAR%NZ_LOC
390 IItmp = MUMPS_PAR%IRN_LOC(I)
391 JJtmp = MUMPS_PAR%JCN_LOC(I)
392 II = 6*(TDDL(1,IItmp)-1)+TDDL(2,IItmp)
393 JJ = 6*(TDDL(1,JJtmp)-1)+TDDL(2,JJtmp)
394 IF (JJ > II) THEN
395 IItmp = II
396 II = JJ
397 JJ = IItmp
398 ENDIF
399 WRITE(OFFST+ISPMD,1003) II,JJ,MUMPS_PAR%A_LOC(I)
400 ENDDO
401 ENDIF
402 CLOSE(UNIT=OFFST+ISPMD)
403#ifdef MPI
404 CALL MPI_BARRIER(SPMD_COMM_WORLD,IERROR)
405#endif
406C Process 0: read stiff. coeff. from all processes, sort (bubble) and write stiffness coefficients in MatrixMarket format
407 IF (ISPMD == 0) THEN
408 ALLOCATE(NENTRIEStmp(NSPMD))
409 WRITE(CSPMD,'(i1)') NSPMD
410 NENTRIES = 0
411 FILNAME2 = 'stiffness_matrix_'//CSPMD//'_spmd'
412 OPEN(UNIT=OFFST+NSPMD,FILE=FILNAME2(1:23),ACCESS="SEQUENTIAL",
413 . ACTION="WRITE",STATUS="UNKNOWN")
414 DO L = 0,NSPMD-1
415 WRITE(CSPMD,'(i1)') L
416 FILNAME = 'local_stiffness_matrix_domain'//CSPMD
417 OPEN(UNIT=OFFST+L,FILE=FILNAME(1:30),ACCESS="SEQUENTIAL",
418 . ACTION="READ",STATUS="UNKNOWN")
419 READ(UNIT=OFFST+L,FMT=*) NROWS,NCOLS,NENTRIEStmp(L+1)
420 NENTRIES = NENTRIES + NENTRIEStmp(L+1)
421 ENDDO
422 ALLOCATE(IROWS(NENTRIES))
423 ALLOCATE(ICOLS(NENTRIES))
424 ALLOCATE(K(NENTRIES))
425 IND = 0
426 sumK = ZERO
427 DO L = 0,NSPMD-1
428 DO I = 1,NENTRIEStmp(L+1)
429 IND = IND + 1
430 READ(UNIT=OFFST+L,FMT=*) IROWS(IND),ICOLS(IND),K(IND)
431 ENDDO
432 ENDDO
433C Bubble sort in ascending order of ICOLS and then IROWS
434 I = NENTRIES
435 SWITCH = .TRUE.
436.AND. DO WHILE ((I>0) (SWITCH))
437 SWITCH = .FALSE.
438 DO J = 1,I-1
439.OR. IF (ICOLS(J) > ICOLS(J+1) (ICOLS(J) == ICOLS(J+1)
440.AND. . IROWS(J) > IROWS(J+1))) THEN
441 tmpIROWS = IROWS(J)
442 IROWS(J) = IROWS(J+1)
443 IROWS(J+1) = tmpIROWS
444 tmpICOLS = ICOLS(J)
445 ICOLS(J) = ICOLS(J+1)
446 ICOLS(J+1) = tmpICOLS
447 tmpK = K(J)
448 K(J) = K(J+1)
449 K(J+1) = tmpK
450 SWITCH = .TRUE.
451 ENDIF
452 ENDDO
453 I = I - 1
454 ENDDO
455C Write stiff. coeff. in only one file (suppress duplications)
456 IND = 1
457 DO WHILE (IND <= NENTRIES)
458 tmpK = K(IND)
459.AND. DO WHILE (IND <= NENTRIES IROWS(IND)==IROWS(IND+1)
460.AND. . ICOLS(IND)==ICOLS(IND+1))
461 IND = IND + 1
462 tmpK = tmpK + K(IND)
463 ENDDO
464 IF (ABS(tmpK)>=PRSTIFMAT_TOL) THEN
465 WRITE(OFFST+NSPMD,1003) IROWS(IND),ICOLS(IND),tmpK
466 sumK = sumK + ABS(tmpK)
467 ENDIF
468 IND = IND + 1
469 ENDDO
470 WRITE(OFFST+NSPMD,1001) sumK
471 DO L = 0,NSPMD
472 CLOSE(UNIT=OFFST+L)
473 ENDDO
474 DEALLOCATE(NENTRIEStmp)
475 DEALLOCATE(IROWS)
476 DEALLOCATE(ICOLS)
477 DEALLOCATE(K)
478 ENDIF
4791000 FORMAT(I10,I10,I10,I10,E10.2)
4801001 FORMAT('sum abs(k_ij) = ',E10.2)
4811002 FORMAT(I10,I10,I10)
4821003 FORMAT(I10,I10,E10.2)
483C
484#endif
485 RETURN
486 END
487!||====================================================================
488!|| imp_mumps2 ../engine/source/implicit/imp_mumps.F
489!||--- called by ------------------------------------------------------
490!|| lin_solvp2 ../engine/source/implicit/lin_solv.F
491!||--- calls -----------------------------------------------------
492!|| spmd_mumps_exec ../engine/source/mpi/implicit/imp_spmd.F
493!|| spmd_mumps_rhs ../engine/source/mpi/implicit/imp_spmd.F
494!||--- uses -----------------------------------------------------
495!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
496!||====================================================================
497 SUBROUTINE IMP_MUMPS2(MUMPS_PAR, CDDLP, F, X, NDDL)
498C-----------------------------------------------
499C I m p l i c i t T y p e s
500C-----------------------------------------------
501 USE SPMD_COMM_WORLD_MOD, ONLY : SPMD_COMM_WORLD
502#include "implicit_f.inc"
503C-----------------------------------------------
504C C o m m o n B l o c k s
505C-----------------------------------------------
506#if defined(MUMPS5)
507#include "dmumps_struc.h"
508#endif
509#include "impl1_c.inc"
510#include "filescount_c.inc"
511C-----------------------------------------------
512C D u m m y A r g u m e n t s
513C-----------------------------------------------
514 INTEGER CDDLP(*), NDDL
515 my_real F(*), X(*)
516#ifdef MUMPS5
517 TYPE(DMUMPS_STRUC) MUMPS_PAR
518#else
519 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
520 INTEGER MUMPS_PAR
521#endif
522
523#ifdef MUMPS5
524C----------------------------------------------
525C L o c a l V a r i a b l e s
526C-----------------------------------------------
527 INTEGER I, NDDLG,LENT
528C
529 IF (MUMPS_PAR%N<=0) RETURN
530 IF (IDSC==1) CALL SPMD_MUMPS_EXEC(MUMPS_PAR, 1)
531C---------For licence
532 IF (IDSC==1) ISOLV_D = 1
533C
534 NDDLG=MUMPS_PAR%N
535 CALL SPMD_MUMPS_RHS(F, CDDLP, MUMPS_PAR%RHS, NDDL, 1,
536 . NDDLG)
537C
538 CALL SPMD_MUMPS_EXEC(MUMPS_PAR, 2)
539C
540 CALL SPMD_MUMPS_RHS(X, CDDLP, MUMPS_PAR%RHS, NDDL, 2,
541 . NDDLG)
542C----FLAG for MUMPS: IF (IMPL_S>0.AND.ISOLV==3)
543 LENT = 1024*MUMPS_PAR%INFO(16)
544 MUMPSFILESIZE = MAX(MUMPSFILESIZE,LENT)
545C
546 RETURN
547#endif
548 END
549
550!||====================================================================
551!|| mumps_set ../engine/source/implicit/imp_mumps.F
552!||--- calls -----------------------------------------------------
553!|| spmd_ifri ../engine/source/mpi/implicit/imp_spmd.F
554!||--- uses -----------------------------------------------------
555!|| imp_intm ../engine/share/modules/imp_intm.F
556!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
557!||====================================================================
558 SUBROUTINE MUMPS_SET(IADK , JDIK , DIAG_K , LT_K , CDDLP,
559 . NKLOC, NKFRONT , ITK , RTK , IDDL ,
560 . INLOC, IAD_ELEM, FR_ELEM, NDOF , IKC ,
561 . NDDL , NNZK , IACTI , NDDLI , NNZI ,
562 . IADI , JDII , ITOK , DIAG_I, LT_I )
563C-----------------------------------------------
564C M o d u l e s
565C-----------------------------------------------
566 USE IMP_INTM
567C-----------------------------------------------
568C I m p l i c i t T y p e s
569C-----------------------------------------------
570 USE SPMD_COMM_WORLD_MOD, ONLY : SPMD_COMM_WORLD
571#include "implicit_f.inc"
572C-----------------------------------------------
573C C o m m o n B l o c k s
574C-----------------------------------------------
575#include "com01_c.inc"
576#include "com04_c.inc"
577#include "com08_c.inc"
578#include "task_c.inc"
579C-----------------------------------------------
580C D u m m y A r g u m e n t s
581C-----------------------------------------------
582 INTEGER IADK(*), JDIK(*), CDDLP(*), NKLOC, NKFRONT, ITK(2,*),
583 . IDDL(*), INLOC(*), IAD_ELEM(2,*), FR_ELEM(*), NDOF(*),
584 . IKC(*), NDDL, NNZK, IACTI(*), NDDLI, NNZI, IADI(*),
585 . JDII(*), ITOK(*)
586 my_real
587 . DIAG_K(*), LT_K(*), RTK(*), DIAG_I(*), LT_I(*)
588#ifdef MUMPS5
589C----------------------------------------------
590C L o c a l V a r i a b l e s
591C-----------------------------------------------
592 INTEGER I, IDDL_FRONT(NSPMD+1,NDDL), NKC, N, TNKC(NUMNOD),
593 . J, ND, NOD, INOD, KK, K, ID, NN, ILOC, JJ,
594 . ITAG(2,NSPMD), INDEX, II, IDIAG(NDDL), IADL(NDDL),
595 . IADLFRONT(NDDL), IFOUND, CDDLP_REM(NDDL_SI),
596 . IDDL_REM(NDDL_SI)
597 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITKFRONT
598 my_real, DIMENSION(:), ALLOCATABLE :: RTKFRONT
599C
600 ALLOCATE(ITKFRONT(2,NDDL+NNZK+NNZI+NZ_SI),
601 . RTKFRONT(NDDL+NNZK+NNZI+NZ_SI))
602C
603 DO I=1,NDDL
604 IDDL_FRONT(1,I)=1
605 IDDL_FRONT(2,I)=ISPMD+1
606 ENDDO
607C
608 NKC=0
609 DO N=1,NUMNOD
610 I=INLOC(N)
611 TNKC(I)=NKC
612 DO J=1,NDOF(I)
613 ND=IDDL(I)+J
614 ID=ND-NKC
615 IF (IKC(ND)>=1) NKC=NKC+1
616 ENDDO
617 ENDDO
618C
619 DO I=1,NSPMD
620C IF (I==ISPMD+1) CYCLE
621C
622 DO J=IAD_ELEM(1,I),IAD_ELEM(1,I+1)-1
623 INOD=FR_ELEM(J)
624 NKC=TNKC(INOD)
625 DO K=1,NDOF(INOD)
626 ND=IDDL(INOD)+K
627 ID=ND-NKC
628 IF (IKC(ND)<1) THEN
629 IDDL_FRONT(1,ID)=IDDL_FRONT(1,ID)+1
630 NN=IDDL_FRONT(1,ID)
631 IDDL_FRONT(NN+1,ID)=I
632 ELSE
633 NKC=NKC+1
634 ENDIF
635 ENDDO
636 ENDDO
637 ENDDO
638C
639 NKLOC=0
640 NKFRONT=0
641 DO I=1,NDDL
642 IF (IACTI(I)==0) CYCLE
643 II=IACTI(I)
644 IADL(II)=NKLOC+1
645 IADLFRONT(II)=NKFRONT+1
646 IF (IDDL_FRONT(1,II)==1) THEN
647 NKLOC=NKLOC+1
648 IDIAG(II)=NKLOC
649 ITK(1,NKLOC)=CDDLP(II)
650 ITK(2,NKLOC)=CDDLP(II)
651 RTK(NKLOC)=DIAG_K(I)
652 ELSE
653 NKFRONT=NKFRONT+1
654 IDIAG(II)=NKFRONT
655 ITKFRONT(1,NKFRONT)=CDDLP(II)
656 ITKFRONT(2,NKFRONT)=CDDLP(II)
657 RTKFRONT(NKFRONT)=DIAG_K(I)
658 ENDIF
659C
660 DO J=IADK(I),IADK(I+1)-1
661 ILOC=1
662 JJ=IACTI(JDIK(J))
663 IF (JJ==0) CYCLE
664.OR. IF (IDDL_FRONT(1,II)==1IDDL_FRONT(1,JJ)==1) THEN
665 ILOC=0
666 ELSE
667 DO K=1,NSPMD
668 ITAG(1,K)=0
669 ITAG(2,K)=0
670 ENDDO
671 DO K=1,IDDL_FRONT(1,II)
672 KK=IDDL_FRONT(1+K,II)
673 ITAG(1,KK)=1
674 ENDDO
675 DO K=1,IDDL_FRONT(1,JJ)
676 KK=IDDL_FRONT(1+K,JJ)
677 ITAG(2,KK)=1
678 ENDDO
679 INDEX=0
680 DO K=1,NSPMD
681 INDEX=INDEX+ITAG(1,K)*ITAG(2,K)
682 ENDDO
683 IF (INDEX==1) ILOC=0
684 ENDIF
685C
686 IF (ILOC==0) THEN
687 NKLOC=NKLOC+1
688 ITK(1,NKLOC)=CDDLP(II)
689 ITK(2,NKLOC)=CDDLP(JJ)
690 RTK(NKLOC)=LT_K(J)
691 ELSEIF (ILOC==1) THEN
692 NKFRONT=NKFRONT+1
693 ITKFRONT(1,NKFRONT)=CDDLP(II)
694 ITKFRONT(2,NKFRONT)=CDDLP(JJ)
695 RTKFRONT(NKFRONT)=LT_K(J)
696 ENDIF
697 ENDDO
698 ENDDO
699 IF (NDDLI>0) THEN
700C Matrice de rigidite d'interface
701 DO N=1,NDDLI
702 I=ITOK(N)
703 IF (IACTI(I)==0) CYCLE
704 II=IACTI(I)
705 IF (IDDL_FRONT(1,II)==1) THEN
706 J=IDIAG(II)
707 RTK(J)=RTK(J)+DIAG_I(N)
708 ELSE
709 J=IDIAG(II)
710 RTKFRONT(J)=RTKFRONT(J)+DIAG_I(N)
711 ENDIF
712C
713 DO J=IADI(N),IADI(N+1)-1
714 ILOC=1
715 JJ=ITOK(JDII(J))
716 JJ=IACTI(JJ)
717 IF (JJ==0) CYCLE
718.OR. IF (IDDL_FRONT(1,II)==1IDDL_FRONT(1,JJ)==1) THEN
719 ILOC=0
720 ELSE
721 DO K=1,NSPMD
722 ITAG(1,K)=0
723 ITAG(2,K)=0
724 ENDDO
725 DO K=1,IDDL_FRONT(1,II)
726 KK=IDDL_FRONT(1+K,II)
727 ITAG(1,KK)=1
728 ENDDO
729 DO K=1,IDDL_FRONT(1,JJ)
730 KK=IDDL_FRONT(1+K,JJ)
731 ITAG(2,KK)=1
732 ENDDO
733 INDEX=0
734 DO K=1,NSPMD
735 INDEX=INDEX+ITAG(1,K)*ITAG(2,K)
736 ENDDO
737 IF (INDEX==1) ILOC=0
738 ENDIF
739C
740 IF (ILOC==0) THEN
741 IFOUND=0
742 K=IADL(II)
743.AND. DO WHILE (IFOUND==0K<=IADL(II+1)-1)
744 IF (CDDLP(II)==ITK(1,K)
745.AND. . CDDLP(JJ)==ITK(2,K)) IFOUND=K
746 K=K+1
747 ENDDO
748 IF (IFOUND/=0) THEN
749 RTK(IFOUND)=RTK(IFOUND)+LT_I(J)
750 ELSE
751 NKLOC=NKLOC+1
752 ITK(1,NKLOC)=CDDLP(II)
753 ITK(2,NKLOC)=CDDLP(JJ)
754 RTK(NKLOC)=LT_I(J)
755 ENDIF
756 ELSEIF (ILOC==1) THEN
757 IFOUND=0
758 K=IADLFRONT(II)
759.AND. DO WHILE (IFOUND==0K<=IADLFRONT(II+1)-1)
760 IF (CDDLP(II)==ITKFRONT(1,K)
761.AND. . CDDLP(JJ)==ITKFRONT(2,K)) IFOUND=K
762 K=K+1
763 ENDDO
764 IF (IFOUND/=0) THEN
765 RTKFRONT(IFOUND)=RTKFRONT(IFOUND)+LT_I(J)
766 ELSE
767 NKFRONT=NKFRONT+1
768 ITKFRONT(1,NKFRONT)=CDDLP(II)
769 ITKFRONT(2,NKFRONT)=CDDLP(JJ)
770 RTKFRONT(NKFRONT)=LT_I(J)
771 ENDIF
772 ENDIF
773 ENDDO
774 ENDDO
775 ENDIF
776C Complement de la matrice de rigidite d'interface pour secnds remote
777 DO I=1,NDDL_SL
778 II=IDDL_SL(I)
779 DO J=IAD_SS(I),IAD_SS(I+1)-1
780 ILOC=1
781 JJ=JDI_SL(J)
782.OR. IF (IDDL_FRONT(1,II)==1IDDL_FRONT(1,JJ)==1) THEN
783 ILOC=0
784 ELSE
785 DO K=1,NSPMD
786 ITAG(1,K)=0
787 ITAG(2,K)=0
788 ENDDO
789 DO K=1,IDDL_FRONT(1,II)
790 KK=IDDL_FRONT(1+K,II)
791 ITAG(1,KK)=1
792 ENDDO
793 DO K=1,IDDL_FRONT(1,JJ)
794 KK=IDDL_FRONT(1+K,JJ)
795 ITAG(2,KK)=1
796 ENDDO
797 INDEX=0
798 DO K=1,NSPMD
799 INDEX=INDEX+ITAG(1,K)*ITAG(2,K)
800 ENDDO
801 IF (INDEX==1) ILOC=0
802 ENDIF
803 IF (ILOC==0) THEN
804 NKLOC=NKLOC+1
805 ITK(1,NKLOC)=CDDLP(II)
806 ITK(2,NKLOC)=CDDLP(JJ)
807 RTK(NKLOC)=LT_SL(J)
808 ELSEIF (ILOC==1) THEN
809 NKFRONT=NKFRONT+1
810 ITKFRONT(1,NKFRONT)=CDDLP(II)
811 ITKFRONT(2,NKFRONT)=CDDLP(JJ)
812 RTKFRONT(NKFRONT)=LT_SL(J)
813 ENDIF
814 ENDDO
815 ENDDO
816C----- il manque DIAG_SL--------
817 DO N=1,NDDL_SL
818 I=IDDL_SL(N)
819 IF (IACTI(I)==0) CYCLE
820 II=IACTI(I)
821 J=IDIAG(II)
822 IF (IDDL_FRONT(1,II)==1) THEN
823 RTK(J)=RTK(J)+DIAG_SL(N)
824 ELSE
825 RTKFRONT(J)=RTKFRONT(J)+DIAG_SL(N)
826 ENDIF
827 ENDDO
828 IF ((NDDL_SI+NDDL_SL)>0) THEN
829 CALL SPMD_IFRI(CDDLP, CDDLP_REM)
830 DO I=1,NDDL
831 IADL(I) = IDDL_FRONT(1,I)
832 ENDDO
833 CALL SPMD_IFRI(IADL, IDDL_REM)
834 ENDIF
835 DO I=1,NDDL_SI
836 DO J=IAD_SI(I),IAD_SI(I+1)-1
837 JJ=JDI_SI(J)
838.OR. IF (IDDL_FRONT(1,JJ)==1IDDL_REM(I)==1) THEN
839 NKLOC=NKLOC+1
840 ITK(1,NKLOC)=CDDLP_REM(I)
841 ITK(2,NKLOC)=CDDLP(JJ)
842 RTK(NKLOC)=LT_SI(J)
843 ELSE
844 NKFRONT=NKFRONT+1
845 ITKFRONT(1,NKFRONT)=CDDLP_REM(I)
846 ITKFRONT(2,NKFRONT)=CDDLP(JJ)
847 RTKFRONT(NKFRONT)=LT_SI(J)
848 ENDIF
849 ENDDO
850 ENDDO
851C
852 DO I=1,NKFRONT
853 ITK(1,NKLOC+I)=ITKFRONT(1,I)
854 ITK(2,NKLOC+I)=ITKFRONT(2,I)
855 RTK(NKLOC+I)=RTKFRONT(I)
856 ENDDO
857C
858 DEALLOCATE(ITKFRONT, RTKFRONT)
859C
860 RETURN
861#endif
862 END
863
864
865!||====================================================================
866!|| mumps_set2 ../engine/source/implicit/imp_mumps.F
867!||--- called by ------------------------------------------------------
868!|| imp_buck ../engine/source/implicit/imp_buck.F
869!|| imp_mumps1 ../engine/source/implicit/imp_mumps.F
870!||--- calls -----------------------------------------------------
871!|| spmd_ifri ../engine/source/mpi/implicit/imp_spmd.F
872!||--- uses -----------------------------------------------------
873!|| imp_intm ../engine/share/modules/imp_intm.F
874!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
875!||====================================================================
876 SUBROUTINE MUMPS_SET2(IADK , JDIK , DIAG_K , LT_K , CDDLP,
877 . NKLOC, NKFRONT , ITK , RTK , IDDL ,
878 . INLOC, IAD_ELEM, FR_ELEM, NDOF , IKC ,
879 . NDDL , NNZK , IACTI , NDDLI , NNZI ,
880 . IADI , JDII , ITOK , DIAG_I, LT_I )
881C-----------------------------------------------
882C M o d u l e s
883C-----------------------------------------------
884 USE IMP_INTM
885C-----------------------------------------------
886C I m p l i c i t T y p e s
887C-----------------------------------------------
888 USE SPMD_COMM_WORLD_MOD, ONLY : SPMD_COMM_WORLD
889#include "implicit_f.inc"
890C-----------------------------------------------
891C C o m m o n B l o c k s
892C-----------------------------------------------
893#include "com01_c.inc"
894#include "com04_c.inc"
895C-----------------------------------------------
896C D u m m y A r g u m e n t s
897C-----------------------------------------------
898 INTEGER IADK(*), JDIK(*), CDDLP(*), NKLOC, NKFRONT, ITK(2,*),
899 . IDDL(*), INLOC(*), IAD_ELEM(2,*), FR_ELEM(*), NDOF(*),
900 . IKC(*), NDDL, NNZK, IACTI(*), NDDLI, NNZI, IADI(*),
901 . JDII(*), ITOK(*)
902 my_real
903 . DIAG_K(*), LT_K(*), RTK(*), DIAG_I(*), LT_I(*)
904#ifdef MUMPS5
905C----------------------------------------------
906C L o c a l V a r i a b l e s
907C-----------------------------------------------
908 INTEGER I, NKC, N,
909 . J, ND, NOD, INOD, KK, K, ID, NN, ILOC, JJ,
910 . ITAG(2,NSPMD), INDEX, II, IDIAG(NDDL), IADL(NDDL+1),
911 . IFOUND, CDDLP_REM(NDDL_SI),
912 . IDDL_REM(NDDL_SI)
913 NKC=0
914 DO N=1,NUMNOD
915 I=INLOC(N)
916 DO J=1,NDOF(I)
917 ND=IDDL(I)+J
918 ID=ND-NKC
919 IF (IKC(ND)>=1) NKC=NKC+1
920 ENDDO
921 ENDDO
922
923 NKLOC=0
924 DO I=1,NDDL
925 IF (IACTI(I)==0) CYCLE
926 II=IACTI(I)
927 IADL(II)=NKLOC+1
928 NKLOC=NKLOC+1
929 IDIAG(II)=NKLOC
930 ITK(1,NKLOC)=CDDLP(II)
931 ITK(2,NKLOC)=CDDLP(II)
932 RTK(NKLOC)=DIAG_K(I)
933 DO J=IADK(I),IADK(I+1)-1
934 ILOC=1
935 JJ=IACTI(JDIK(J))
936 IF (JJ==0) CYCLE
937 NKLOC=NKLOC+1
938 ITK(1,NKLOC)=CDDLP(II)
939 ITK(2,NKLOC)=CDDLP(JJ)
940 RTK(NKLOC)=LT_K(J)
941 ENDDO
942 ENDDO
943 IADL(NDDL+1) = NKLOC+1
944 IF (NDDLI>0) THEN
945C Matrice de rigidite d'interface
946 DO N=1,NDDLI
947 I=ITOK(N)
948 IF (IACTI(I)==0) CYCLE
949 II=IACTI(I)
950 J=IDIAG(II)
951 RTK(J)=RTK(J)+DIAG_I(N)
952 DO J=IADI(N),IADI(N+1)-1
953 ILOC=1
954 JJ=ITOK(JDII(J))
955 JJ=IACTI(JJ)
956 IF (JJ==0) CYCLE
957 IFOUND=0
958 K=IADL(II)
959.AND. DO WHILE (IFOUND==0K<=IADL(II+1)-1)
960 IF (CDDLP(II)==ITK(1,K)
961.AND. . CDDLP(JJ)==ITK(2,K)) IFOUND=K
962 K=K+1
963 ENDDO
964 IF (IFOUND/=0) THEN
965 RTK(IFOUND)=RTK(IFOUND)+LT_I(J)
966 ELSE
967 NKLOC=NKLOC+1
968 ITK(1,NKLOC)=CDDLP(II)
969 ITK(2,NKLOC)=CDDLP(JJ)
970 RTK(NKLOC)=LT_I(J)
971 ENDIF
972 ENDDO
973 ENDDO
974 ENDIF
975C Complement de la matrice de rigidite d'interface pour secnds remote
976 DO I=1,NDDL_SL
977 II=IDDL_SL(I)
978 DO J=IAD_SS(I),IAD_SS(I+1)-1
979 ILOC=1
980 JJ=JDI_SL(J)
981 NKLOC=NKLOC+1
982 ITK(1,NKLOC)=CDDLP(II)
983 ITK(2,NKLOC)=CDDLP(JJ)
984 RTK(NKLOC)=LT_SL(J)
985 ENDDO
986 ENDDO
987C----- il manque DIAG_SL--------
988 DO N=1,NDDL_SL
989 I=IDDL_SL(N)
990 IF (IACTI(I)==0) CYCLE
991 II=IACTI(I)
992 J=IDIAG(II)
993 RTK(J)=RTK(J)+DIAG_SL(N)
994 ENDDO
995 IF ((NDDL_SI+NDDL_SL)>0) THEN
996 CALL SPMD_IFRI(CDDLP, CDDLP_REM)
997 ENDIF
998 DO I=1,NDDL_SI
999 DO J=IAD_SI(I),IAD_SI(I+1)-1
1000 JJ=JDI_SI(J)
1001 NKLOC=NKLOC+1
1002 ITK(1,NKLOC)=CDDLP_REM(I)
1003 ITK(2,NKLOC)=CDDLP(JJ)
1004 RTK(NKLOC)=LT_SI(J)
1005 ENDDO
1006 ENDDO
1007C
1008 RETURN
1009#endif
1010 END
mumps_set2
subroutine mumps_set2(iadk, jdik, diag_k, lt_k, cddlp, nkloc, nkfront, itk, rtk, iddl, inloc, iad_elem, fr_elem, ndof, ikc, nddl, nnzk, iacti, nddli, nnzi, iadi, jdii, itok, diag_i, lt_i)
Definition imp_mumps.F:881
imp_mumps1
subroutine imp_mumps1(nddl0, nnzk0, nddl, nnzk, nnmax, nodglob, iddl, ndof, inloc, ikc, iadk, jdik, diag_k, lt_k, iad_elem, fr_elem, mumps_par, cddlp, iadi, jdii, itok, diag_i, lt_i, nddli, nnzi, imprint, it)
Definition imp_mumps.F:49
spmd_mumps_ini
subroutine spmd_mumps_ini(mumps_par, sym)
Definition imp_spmd.F:498
spmd_mumps_gath
subroutine spmd_mumps_gath(itk, rtk, nzloc, a, irn, jcn, nzp)
Definition imp_spmd.F:408
spmd_mumps_deal
subroutine spmd_mumps_deal(mumps_par)
Definition imp_spmd.F:558
spmd_mumps_count
subroutine spmd_mumps_count(nzloc, nzp, nnz)
Definition imp_spmd.F:350
spmd_inf_g
subroutine spmd_inf_g(nddl0, nzzk0, nddl, nzzk, nnmax, nddl0p, nzzk0p, nddlp, nzzkp, nnmaxp)
Definition imp_spmd.F:1514
spmd_cddl
subroutine spmd_cddl(nddl, nodglob, iddl, ndof, cddlp, inloc, ikc, nddlg, nddlp)
Definition imp_spmd.F:3146
imp_intm
Definition imp_intm.F:118
imp_intm::nz_sl
integer nz_sl
Definition imp_intm.F:173
imp_intm::nz_si
integer nz_si
Definition imp_intm.F:173
imp_kbcs
Definition impbufdef_mod.F:471
message_mod
Definition message_mod.F:1249
tmpenvf
void tmpenvf(char *tmpdir, int *tmplen)
Definition tmpenv_c.c:149