OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
prec_solv.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/.
23C---------------------solves [L][D][L]^t{z}={v}--DIAG_M(deja inverse)-----
24C---------------------or {z}=[Z][D]^-1[Z]^t{v}-----for inverse option IPREC>=6
25!||====================================================================
26!|| prec_solv ../engine/source/implicit/prec_solv.F
27!||--- calls -----------------------------------------------------
28!|| arret ../engine/source/system/arret.F
29!|| lin_solv2 ../engine/source/implicit/lin_solv.F
30!|| mav_lt1 ../engine/source/implicit/produt_v.F
31!|| prec0_solv ../engine/source/implicit/prec_solv.F
32!|| precic_solv ../engine/source/implicit/prec_solv.F
33!||--- uses -----------------------------------------------------
34!|| dsgraph_mod ../engine/share/modules/dsgraph_mod.F
35!||====================================================================
36 SUBROUTINE prec_solv(IPREC,
37 1 IADK ,JDIK ,DIAG_K,LT_K ,ITASK ,
38 2 GRAPHE,ITAB ,INSOLV,IT ,FAC_K ,
39 3 IPIV_K,NK ,IDSC ,ISOLV ,IPRINT ,
40 4 NDDL ,NNZ ,IADM ,JDIM ,DIAG_M ,
41 5 LT_M ,V ,Z )
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE dsgraph_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NDDL ,NNZ ,IADM(*) ,JDIM(*),IPREC,ITASK,IPRINT
54 INTEGER IADK(*),JDIK(*),
55 . ISOLV ,ITAB(*), INSOLV,IT, IPIV_K(*), NK, IDSC
56C REAL
57 my_real
58 . diag_m(*), z(*), lt_m(*) ,v(*)
59 my_real
60 . diag_k(*),lt_k(*),fac_k(*)
61 TYPE(prgraph) :: GRAPHE(*)
62#ifdef MUMPS5
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66c iprec=1 => [I]
67c iprec=2 => jacobien NNZ=0
68c iprec=3 => I.C.(0) :[LT_M]-->strict upper triangle [L]^t en c.r.s.
69c iprec=4 => I.C.(0)_Stab :item
70c iprec=5 => fsai .r same indice than [K]
71c iprec=12 => I.C.(J) :[LT_M]-->strict upper triangle [L]^t en c.r.s.
72c iprec=13 => ORTH :[LT_M]-->strict upper triangle [L]^t en c.r.s.
73c iprec=14 => inv ORTH.C:[LT_M]-->strict upper triangle [Z] en c.c.s.
74c iprec=15 => inv ORTH.R:[LT_M]-->strict upper triangle [Z] en c.r.s.
75c iprec=16,19=>inv Approx.R:[LT_M]-->strict upper triangle [Z] en c.r.s.
76c iprec=20,23=>f.inv Approx.C:[LT_M]-->lower triangle [L] en c.r.s.
77C-----------------------------
78 INTEGER I,J,K,NI0,IBID,NNZK
79 my_real
80 . RBID
81C-----------------------------
82 IF (IPREC==1) then
83 IF (isolv>2) THEN
84 ni0= 0
85 nnzk = iadk(nddl+1)-iadk(1)
86#ifdef MUMPS5
87 CALL lin_solv2(
88 1 nddl ,nnzk ,iadk ,jdik ,diag_k ,
89 2 lt_k ,ni0 ,ibid ,ibid ,ibid ,
90 3 rbid ,z ,v ,itask ,iprint ,
91 4 isolv ,ibid ,graphe,itab ,insolv ,
92 5 it ,fac_k ,ipiv_k,nk ,rbid ,
93 6 idsc )
94#else
95 WRITE(6,*) "Fatal error: MUMPS required"
96 CALL flush(6)
97 CALL arret(5)
98#endif
99 ELSE
100 DO i=1,nddl
101 z(i)=v(i)
102 ENDDO
103 ENDIF
104 ELSEIF (iprec==5) THEN
105 CALL precic_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
106 1 lt_m ,v ,z )
107 ELSEIF (iprec==14) THEN
108 CALL precic_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
109 1 lt_m ,v ,z )
110 ELSEIF (iprec==15) THEN
111 CALL precic_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
112 1 lt_m ,v ,z )
113 ELSEIF (iprec>=16.AND.iprec<=19) THEN
114 CALL mav_lt1( nddl ,nnz ,iadm ,jdim ,diag_m ,
115 2 lt_m ,v ,z )
116 ELSEIF (iprec>=20.AND.iprec<=23) THEN
117 CALL precic_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
118 1 lt_m ,v ,z )
119 ELSE
120 CALL prec0_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
121 1 lt_m ,v ,z )
122 ENDIF
123C--------------------------------------------
124 RETURN
125#endif
126 END
127C-----------spmd----------solves [L][D][L]^t{z}={v}--DIAG_M(deja inverse)-----
128!||====================================================================
129!|| prec_solvp ../engine/source/implicit/prec_solv.F
130!||--- called by ------------------------------------------------------
131!|| imp_lanzp ../engine/source/implicit/imp_lanz.F
132!||--- calls -----------------------------------------------------
133!|| lin_solvp2 ../engine/source/implicit/lin_solv.F
134!|| prec0_solv ../engine/source/implicit/prec_solv.F
135!|| precic_solv ../engine/source/implicit/prec_solv.F
136!|| spmd_sumf_v ../engine/source/mpi/implicit/imp_spmd.F
137!||--- uses -----------------------------------------------------
138!|| dsgraph_mod ../engine/share/modules/dsgraph_mod.F
139!||====================================================================
140 SUBROUTINE prec_solvp(IPREC, ITASK ,
141 1 GRAPHE,IAD_ELEM,FR_ELEM,DIAG_K,LT_K ,
142 2 IADK ,JDIK ,ITAB ,IPRINT,INSOLV ,
143 3 IT ,FAC_K , IPIV_K, NK ,MUMPS_PAR,
144 4 CDDLP ,ISOLV , IDSC , IDDL ,IKC ,
145 5 INLOC ,NDOF , NDDL ,NNZ ,IADM ,
146 6 JDIM ,DIAG_M , LT_M ,V ,Z )
147C-----------------------------------------------
148C M o d u l e s
149C-----------------------------------------------
150 USE dsgraph_mod
151C-----------------------------------------------
152C I m p l i c i t T y p e s
153C-----------------------------------------------
154#include "implicit_f.inc"
155C-----------------------------------------------
156C C o m m o n B l o c k s
157C-----------------------------------------------
158#if defined(MUMPS5)
159#include "dmumps_struc.h"
160#endif
161C-----------------------------------------------
162C D u m m y A r g u m e n t s
163C-----------------------------------------------
164 INTEGER NDDL ,NNZ ,IADM(*) ,JDIM(*),IPREC, ITASK
165 INTEGER IAD_ELEM(2,*), FR_ELEM(*), IADK(*), JDIK(*),
166 . ITAB(*), IPRINT,
167 . INSOLV, IT, IPIV_K(*), NK, CDDLP(*), ISOLV, IDSC,
168 . IDDL(*), IKC(*), INLOC(*), NDOF(*)
169 my_real DIAG_M(*), Z(*), LT_M(*) ,V(*)
170 my_real DIAG_K(*), LT_K(*),FAC_K(*)
171 TYPE(PRGRAPH) :: GRAPHE(*)
172C
173#ifdef MUMPS5
174 TYPE(DMUMPS_STRUC) MUMPS_PAR
175#else
176 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
177 INTEGER MUMPS_PAR
178#endif
179
180#ifdef MUMPS5
181C-----------------------------------------------
182C L o c a l V a r i a b l e s
183C-----------------------------------------------
184c iprec=1 => [I]
185c iprec=2 => jacobien NNZ=0
186c iprec=5 => fsai .r same indice than [K]
187C-----------------------------
188 INTEGER I,J,K,IBID,NI0
189 my_real
190 . RBID
191C-----------------------------
192 IF (IPREC==1) then
193 IF (isolv>2) THEN
194 ni0= 0
195#ifdef MUMPS5
196 CALL lin_solvp2(graphe, v , nddl , iad_elem , fr_elem,
197 1 diag_k, lt_k , iadk , jdik , z ,
198 2 itab , iprint, ni0 , ibid , ibid ,
199 3 rbid , rbid , ibid , insolv , it ,
200 4 fac_k , ipiv_k, nk , mumps_par, cddlp ,
201 5 isolv , idsc , iddl , ikc , inloc ,
202 6 ndof , itask )
203#else
204 WRITE(6,*) "Fatal error: MUMPS required"
205 CALL flush(6)
206
207#endif
208 ELSE
209 DO i=1,nddl
210 z(i)=v(i)
211 ENDDO
212 ENDIF
213 ELSEIF (iprec==5) THEN
214 CALL precic_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
215 1 lt_m ,v ,z )
216 CALL spmd_sumf_v(z)
217 ELSE
218 CALL prec0_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
219 1 lt_m ,v ,z )
220 CALL spmd_sumf_v(z)
221 ENDIF
222C
223C--------------------------------------------
224 RETURN
225#endif
226 END
227C---------------------solves [L][D][L]^t{z}={v}--DIAG_M(deja inverse)-----
228!||====================================================================
229!|| prec0_solv ../engine/source/implicit/prec_solv.F
230!||--- called by ------------------------------------------------------
231!|| imp_fsai ../engine/source/implicit/imp_fsa_inv.F
232!|| prec_solv ../engine/source/implicit/prec_solv.F
233!|| prec_solvh ../engine/source/implicit/prec_solv.F
234!|| prec_solvp ../engine/source/implicit/prec_solv.F
235!||====================================================================
236 SUBROUTINE prec0_solv(
237 1 NDDL ,NNZ ,IADM ,JDIM ,DIAG_M ,
238 2 LT_M ,V ,Z )
239C-----------------------------------------------
240C I m p l i c i t T y p e s
241C-----------------------------------------------
242#include "implicit_f.inc"
243C-----------------------------------------------
244C D u m m y A r g u m e n t s
245C-----------------------------------------------
246 INTEGER NDDL ,NNZ ,IADM(*) ,JDIM(*)
247C REAL
248 my_real
249 . diag_m(*), z(*), lt_m(*) ,v(*)
250#ifdef MUMPS5
251C-----------------------------------------------
252C L o c a l V a r i a b l e s
253C-----------------------------------------------
254C------------[LT_M]-->strict upper triangle---
255 INTEGER I,J,K
256C-----------------------------
257 DO I=1,nddl
258 z(i)=v(i)
259 ENDDO
260 IF (nnz>0) THEN
261C --------Forword---[LT_M]^t[D]{z}={v}----
262 DO i=1,nddl
263 DO j =iadm(i),iadm(i+1)-1
264 k = jdim(j)
265 z(k) = z(k)-lt_m(j)*z(i)
266 ENDDO
267 z(i) = z(i)*diag_m(i)
268 ENDDO
269C --------Backword----[LT_M]{z}={v}---
270 DO i=nddl-1,1,-1
271 DO j =iadm(i),iadm(i+1)-1
272 k = jdim(j)
273 z(i) = z(i)-lt_m(j)*z(k)
274 ENDDO
275 ENDDO
276 ELSE
277 DO i=1,nddl
278 z(i) = z(i)*diag_m(i)
279 ENDDO
280 ENDIF
281C--------------------------------------------
282 RETURN
283#endif
284 END
285C-------------solves {z}=[Z][D]^-1[Z]^t{v}-----
286!||====================================================================
287!|| precir_solv ../engine/source/implicit/prec_solv.F
288!||====================================================================
289 SUBROUTINE precir_solv(
290 1 NDDL ,NNZ ,IADM ,JDIM ,DIAG_M ,
291 2 LT_M ,V ,Z )
292C-----------------------------------------------
293C I m p l i c i t T y p e s
294C-----------------------------------------------
295#include "implicit_f.inc"
296C-----------------------------------------------
297C D u m m y A r g u m e n t s
298C-----------------------------------------------
299 INTEGER NDDL ,NNZ ,IADM(*) ,JDIM(*),IPREC
300C REAL
301 my_real
302 . DIAG_M(*), Z(*), LT_M(*) ,V(*)
303#ifdef MUMPS5
304C-----------------------------------------------
305C L o c a l V a r i a b l e s
306C-----------------------------------------------
307 INTEGER I,J,K
308 my_real
309 . TMP(NDDL)
310C--[LT_M]-->[Z]^t strict lower triangle c.c.s.(= transpose of strict upper tria c.r.s.)---
311C--------- tmp est utilisee pour la raison //--------
312 DO I=1,nddl
313 z(i) = v(i)
314 ENDDO
315C--------{z}=[Z]^t{v}-------------
316 DO j=1,nddl
317 DO i =iadm(j),iadm(j+1)-1
318 k = jdim(i)
319 z(k) = z(k)+lt_m(i)*v(j)
320 ENDDO
321 ENDDO
322C--------{z}=[D]^-1{v}-------------
323 DO i=1,nddl
324 z(i) = z(i)*diag_m(i)
325 tmp(i) = z(i)
326 ENDDO
327C --------[Z]{z}-------
328 DO i=1,nddl
329 DO j =iadm(i),iadm(i+1)-1
330 k = jdim(j)
331 z(i) = z(i)+lt_m(j)*tmp(k)
332 ENDDO
333 ENDDO
334C--------------------------------------------
335 RETURN
336#endif
337 END
338C-------------solves {z}=[Z][D]^-1[Z]^t{v}----[Z] en colonne-
339!||====================================================================
340!|| precic_solv ../engine/source/implicit/prec_solv.F
341!||--- called by ------------------------------------------------------
342!|| prec_solv ../engine/source/implicit/prec_solv.F
343!|| prec_solvp ../engine/source/implicit/prec_solv.F
344!||====================================================================
345 SUBROUTINE precic_solv(
346 1 NDDL ,NNZ ,IADM ,JDIM ,DIAG_M ,
347 2 LT_M ,V ,Z )
348C-----------------------------------------------
349C I m p l i c i t T y p e s
350C-----------------------------------------------
351#include "implicit_f.inc"
352C-----------------------------------------------
353C D u m m y A r g u m e n t s
354C-----------------------------------------------
355 INTEGER NDDL ,NNZ ,IADM(*) ,JDIM(*),IPREC
356C REAL
357 my_real
358 . DIAG_M(*), Z(*), LT_M(*) ,V(*)
359#ifdef MUMPS5
360C-----------------------------------------------
361C L o c a l V a r i a b l e s
362C-----------------------------------------------
363 INTEGER I,J,K
364 my_real
365 . TMP(NDDL)
366C--[LT_M]-->[Z]^t strict lower triangle c.r.s.(= transpose of strict upper tria c.c.s.)---
367C--------- tmp est utilisee pour la raison //--------
368C-----------------------------
369 DO I=1,nddl
370 z(i) = v(i)
371 ENDDO
372C--------{z}=[Z]^t{v}-------------
373 DO i=2,nddl
374 DO j =iadm(i),iadm(i+1)-1
375 k = jdim(j)
376 z(i) = z(i)+lt_m(j)*v(k)
377 ENDDO
378 ENDDO
379C--------{z}=[D]^-1{z}-------------
380 DO i=1,nddl
381 z(i) = z(i)*diag_m(i)
382 tmp(i) = z(i)
383 ENDDO
384C --------{z}=[Z]{z}-------
385 DO j = 2,nddl
386 DO i =iadm(j),iadm(j+1)-1
387 k = jdim(i)
388 z(k) = z(k)+lt_m(i)*tmp(j)
389 ENDDO
390 ENDDO
391C--------------------------------------------
392 RETURN
393#endif
394 END
395C------------hibrid version-solves {z}=[Z][D]^-1[Z]^t{v}----[Z] en colonne-
396!||====================================================================
397!|| prec5h_solv ../engine/source/implicit/prec_solv.F
398!||--- calls -----------------------------------------------------
399!|| my_barrier ../engine/source/system/machine.F
400!||====================================================================
401 SUBROUTINE prec5h_solv(
402 1 NDDL ,NNZ ,IADM ,JDIM ,DIAG_M ,
403 2 LT_M ,V ,Z ,F_DDL ,L_DDL )
404C-----------------------------------------------
405C I m p l i c i t T y p e s
406C-----------------------------------------------
407#include "implicit_f.inc"
408#include "comlock.inc"
409C-----------------------------------------------
410C D u m m y A r g u m e n t s
411C-----------------------------------------------
412 INTEGER NDDL ,NNZ ,IADM(*) ,JDIM(*),F_DDL ,L_DDL
413C REAL
414 my_real
415 . diag_m(*), z(*), lt_m(*) ,v(*)
416#ifdef MUMPS5
417C-----------------------------------------------
418C L o c a l V a r i a b l e s
419C-----------------------------------------------
420 INTEGER I,J,K
421 my_real
422 . TMP(NDDL)
423C--[LT_M]-->[Z]^t strict lower triangle c.r.s.(= transpose of strict upper tria c.c.s.)---
424C--------- tmp est utilisee pour la raison //--------
425C-----------------------------
426 DO I=f_ddl ,l_ddl
427 z(i) = v(i)
428 ENDDO
429C-------------------
430 DO i= 1 ,nddl
431 tmp(i) = zero
432 ENDDO
433C--------{z}=[Z]^t{v}-------------
434 DO i=f_ddl ,l_ddl
435 DO j =iadm(i),iadm(i+1)-1
436 k = jdim(j)
437 z(i) = z(i)+lt_m(j)*v(k)
438 ENDDO
439 ENDDO
440C--------{z}=[D]^-1{z}-------------
441 DO i=f_ddl ,l_ddl
442 z(i) = z(i)*diag_m(i)
443 ENDDO
444C --------{z}=[Z]{z}-------
445 DO i = f_ddl ,l_ddl
446 DO j =iadm(i),iadm(i+1)-1
447 k = jdim(j)
448 tmp(k) = tmp(k)+lt_m(j)*z(i)
449 ENDDO
450 ENDDO
451C----------------------
452 CALL my_barrier
453C---------------------
454#include "lockon.inc"
455 DO i= 1 ,nddl
456 z(i) = z(i) + tmp(i)
457 ENDDO
458#include "lockoff.inc"
459C--------------------------------------------
460 RETURN
461#endif
462 END
463C------------hibrid version-solves {z}=[Z][D]^-1[Z]^t{v}----[Z] en colonne-
464!||====================================================================
465!|| prec5hc_solv ../engine/source/implicit/prec_solv.F
466!||--- called by ------------------------------------------------------
467!|| prec_solvgh ../engine/source/implicit/prec_solv.F
468!|| prec_solvh ../engine/source/implicit/prec_solv.F
469!||--- calls -----------------------------------------------------
470!|| my_barrier ../engine/source/system/machine.F
471!||--- uses -----------------------------------------------------
472!|| imp_workh ../engine/share/modules/impbufdef_mod.F
473!||====================================================================
474 SUBROUTINE prec5hc_solv(
475 1 NDDL ,NNZ ,IADM ,JDIM ,DIAG_M ,
476 2 LT_M ,V ,Z ,F_DDL ,L_DDL )
477C-----------------------------------------------
478C M o d u l e s
479C-----------------------------------------------
480 USE imp_workh
481C-----------------------------------------------
482C I m p l i c i t T y p e s
483C-----------------------------------------------
484#include "implicit_f.inc"
485C-----------------------------------------------
486C D u m m y A r g u m e n t s
487C-----------------------------------------------
488 INTEGER NDDL ,NNZ ,IADM(*) ,JDIM(*),F_DDL ,L_DDL
489C REAL
490 my_real
491 . DIAG_M(*), Z(*), LT_M(*) ,V(*)
492#ifdef MUMPS5
493C-----------------------------------------------
494C L o c a l V a r i a b l e s
495C-----------------------------------------------
496 INTEGER I,J,K
497 my_real
498 . TMP(NDDL)
499C--[LT_M]-->[Z]^t , [LT_M0] ->[Z]----------
500C-----------------------------
501 DO i=f_ddl ,l_ddl
502 z(i) = v(i)
503 ENDDO
504C--------{z}=[Z]^t{v}-------------
505 DO i=f_ddl ,l_ddl
506 DO j =iadm(i),iadm(i+1)-1
507 k = jdim(j)
508 z(i) = z(i)+lt_m(j)*v(k)
509 ENDDO
510 ENDDO
511C--------{z}=[D]^-1{z}-------------
512 DO i=f_ddl ,l_ddl
513 z(i) = z(i)*diag_m(i)
514 ENDDO
515C----------------------
516 CALL my_barrier
517C---------------------
518 DO i=1 ,nddl
519 tmp(i) = z(i)
520 ENDDO
521C----------------------
522 CALL my_barrier
523C---------------------
524C --------{z}=[Z]{z}-------
525 DO i=f_ddl ,l_ddl
526 DO j =iadm0(i),iadm0(i+1)-1
527 k = jdim0(j)
528 z(i) = z(i)+lt_m0(j)*tmp(k)
529 ENDDO
530 ENDDO
531C--------------------------------------------
532 RETURN
533#endif
534 END
535!||====================================================================
536!|| prec2h_solv ../engine/source/implicit/prec_solv.F
537!||--- called by ------------------------------------------------------
538!|| prec_solvgh ../engine/source/implicit/prec_solv.F
539!|| prec_solvh ../engine/source/implicit/prec_solv.F
540!||====================================================================
541 SUBROUTINE prec2h_solv(
542 1 F_DDL ,L_DDL ,DIAG_M ,V ,Z )
543C-----------------------------------------------
544C I m p l i c i t T y p e s
545C-----------------------------------------------
546#include "implicit_f.inc"
547C-----------------------------------------------
548C D u m m y A r g u m e n t s
549C-----------------------------------------------
550 INTEGER F_DDL ,L_DDL
551C REAL
552 my_real
553 . diag_m(*), z(*) ,v(*)
554#ifdef MUMPS5
555C-----------------------------------------------
556C L o c a l V a r i a b l e s
557C-----------------------------------------------
558 INTEGER I,J,K
559 DO I=f_ddl ,l_ddl
560 z(i) = v(i)*diag_m(i)
561 ENDDO
562C--------------------------------------------
563 RETURN
564#endif
565 END
566C-----------spmd----------solves [L][D][L]^t{z}={v}--DIAG_M(deja inverse)-----
567!||====================================================================
568!|| prec_solvh ../engine/source/implicit/prec_solv.F
569!||--- called by ------------------------------------------------------
570!|| imp_pcgh ../engine/source/implicit/imp_pcg.F
571!||--- calls -----------------------------------------------------
572!|| lin_solv2 ../engine/source/implicit/lin_solv.F
573!|| lin_solvp2 ../engine/source/implicit/lin_solv.F
574!|| my_barrier ../engine/source/system/machine.f
575!|| prec0_solv ../engine/source/implicit/prec_solv.F
576!|| prec2h_solv ../engine/source/implicit/prec_solv.F
577!|| prec5hc_solv ../engine/source/implicit/prec_solv.F
578!|| spmd_sumf_v ../engine/source/mpi/implicit/imp_spmd.f
579!||--- uses -----------------------------------------------------
580!|| dsgraph_mod ../engine/share/modules/dsgraph_mod.F
581!||====================================================================
582 SUBROUTINE prec_solvh(IPREC, ITASK ,
583 1 GRAPHE,IAD_ELEM,FR_ELEM,DIAG_K,LT_K ,
584 2 IADK ,JDIK ,ITAB ,IPRINT,INSOLV ,
585 3 IT ,FAC_K , IPIV_K, NK ,MUMPS_PAR,
586 4 CDDLP ,ISOLV , IDSC , IDDL ,IKC ,
587 5 INLOC ,NDOF , NDDL ,NNZ ,IADM ,
588 6 JDIM ,DIAG_M , LT_M ,V ,Z ,
589 7 F_DDL ,L_DDL )
590C-----------------------------------------------
591C M o d u l e s
592C-----------------------------------------------
593 USE dsgraph_mod
594C-----------------------------------------------
595C I m p l i c i t T y p e s
596C-----------------------------------------------
597#include "implicit_f.inc"
598C-----------------------------------------------
599C C o m m o n B l o c k s
600C-----------------------------------------------
601#if defined(MUMPS5)
602#include "dmumps_struc.h"
603#endif
604#include "timeri_c.inc"
605#include "com01_c.inc"
606C-----------------------------------------------
607C D u m m y A r g u m e n t s
608C-----------------------------------------------
609 INTEGER NDDL ,NNZ ,IADM(*) ,JDIM(*),IPREC, ITASK
610 INTEGER IAD_ELEM(2,*), FR_ELEM(*), IADK(*), JDIK(*),
611 . itab(*), iprint,
612 . insolv, it, ipiv_k(*), nk, cddlp(*), isolv, idsc,
613 . iddl(*), ikc(*), inloc(*), ndof(*),f_ddl ,l_ddl
614 my_real diag_m(*), z(*), lt_m(*) ,v(*)
615 my_real diag_k(*), lt_k(*),fac_k(*)
616 TYPE(prgraph) :: GRAPHE(*)
617C
618#ifdef MUMPS5
619 TYPE(DMUMPS_STRUC) MUMPS_PAR
620#else
621 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
622 INTEGER MUMPS_PAR
623#endif
624
625#ifdef MUMPS5
626C-----------------------------------------------
627C L o c a l V a r i a b l e s
628C-----------------------------------------------
629c iprec=1 => [I]
630c iprec=2 => jacobien NNZ=0
631c iprec=5 => fsai .r same indice than [K]
632C-----------------------------
633 INTEGER I,J,K,IBID,NI0,NNZK
634 my_real RBID
635C-----------------------------
636 IF (IPREC==1) then
637 IF (isolv>2.AND.isolv<7) THEN
638#ifdef MUMPS5
639 IF (itask==0) THEN
640 IF (nspmd>1) THEN
641
642 ni0= 0
643 CALL lin_solvp2(graphe, v , nddl , iad_elem , fr_elem,
644 1 diag_k, lt_k , iadk , jdik , z ,
645 2 itab , iprint, ni0 , ibid , ibid ,
646 3 rbid , rbid , ibid , insolv , it ,
647 4 fac_k , ipiv_k, nk , mumps_par, cddlp ,
648 5 isolv , idsc , iddl , ikc , inloc ,
649 6 ndof , itask )
650 ELSE
651 ni0= 0
652 nnzk = iadk(nddl+1)-iadk(1)
653 CALL lin_solv2(
654 1 nddl ,nnzk ,iadk ,jdik ,diag_k ,
655 2 lt_k ,ni0 ,ibid ,ibid ,ibid ,
656 3 rbid ,z ,v ,itask ,iprint ,
657 4 isolv ,ibid ,graphe,itab ,insolv ,
658 5 it ,fac_k ,ipiv_k,nk ,rbid ,
659 6 idsc )
660 END IF !(NSPMD>1) THEN
661 END IF
662#else
663 WRITE(6,*) "Fatal error: MUMPS required"
664 CALL flush(6)
665#endif
666
667C----------------------
668 CALL my_barrier
669C---------------------
670 ELSE
671 DO i = f_ddl ,l_ddl
672 z(i)=v(i)
673 ENDDO
674 ENDIF
675 ELSEIF (iprec==2) THEN
676 CALL prec2h_solv(
677 1 f_ddl ,l_ddl ,diag_m ,v ,z )
678 ELSEIF (iprec==5) THEN
679 CALL prec5hc_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
680 1 lt_m ,v ,z ,f_ddl ,l_ddl )
681 ELSE
682 IF (itask==0) THEN
683 CALL prec0_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
684 1 lt_m ,v ,z )
685 ENDIF
686 ENDIF
687C
688 IF (iprec>1) THEN
689C----------------------
690 CALL my_barrier
691 IF (itask==0.AND.nspmd>1) THEN
692 CALL spmd_sumf_v(z)
693 END IF
694 ENDIF
695C--------------------------------------------
696 RETURN
697#endif
698 END
699!||====================================================================
700!|| prec_solvgh ../engine/source/implicit/prec_solv.F
701!||--- calls -----------------------------------------------------
702!|| my_barrier ../engine/source/system/machine.F
703!|| prec2h_solv ../engine/source/implicit/prec_solv.F
704!|| prec5hc_solv ../engine/source/implicit/prec_solv.F
705!|| spmd_sumf_v ../engine/source/mpi/implicit/imp_spmd.F
706!||====================================================================
707 SUBROUTINE prec_solvgh(IPREC, ITASK ,NDDL ,IADM ,JDIM ,
708 6 DIAG_M , LT_M ,V ,Z ,F_DDL ,
709 7 L_DDL )
710C-----------------------------------------------
711C I m p l i c i t T y p e s
712C-----------------------------------------------
713#include "implicit_f.inc"
714C-----------------------------------------------
715C C o m m o n B l o c k s
716C-----------------------------------------------
717#include "com01_c.inc"
718C-----------------------------------------------
719C D u m m y A r g u m e n t s
720C-----------------------------------------------
721 INTEGER NDDL ,IADM(*) ,JDIM(*),IPREC, ITASK,
722 . f_ddl ,l_ddl
723 my_real diag_m(*), z(*), lt_m(*) ,v(*)
724#ifdef MUMPS5
725C-----------------------------------------------
726C L o c a l V a r i a b l e s
727C-----------------------------------------------
728c iprec=1 => [I]
729c iprec=2 => jacobien NNZ=0
730c iprec=5 => fsai .r same indice than [K]
731C-----------------------------
732 INTEGER I,J,K,IBID,NI0,NNZ
733 my_real RBID
734C-----------------------------
735 IF (IPREC==1) then
736 DO i = f_ddl ,l_ddl
737 z(i)=v(i)
738 ENDDO
739 ELSEIF (iprec==2) THEN
740 CALL prec2h_solv(
741 1 f_ddl ,l_ddl ,diag_m ,v ,z )
742 ELSEIF (iprec==5) THEN
743 nnz=iadm(nddl+1)-iadm(1)
744 CALL prec5hc_solv(nddl ,nnz ,iadm ,jdim ,diag_m ,
745 1 lt_m ,v ,z ,f_ddl ,l_ddl )
746 ENDIF
747C
748 IF (iprec>1) THEN
749C----------------------
750 CALL my_barrier
751C---------------------
752 IF (itask==0.AND.nspmd>1) CALL spmd_sumf_v(z)
753 ENDIF
754C--------------------------------------------
755 RETURN
756#endif
757 END
my_real
#define my_real
Definition cppsort.cpp:32
spmd_sumf_v
subroutine spmd_sumf_v(v)
Definition imp_spmd.F:1650
lin_solvp2
subroutine lin_solvp2(graphe, f, nddl, iad_elem, fr_elem, diag_k, lt_k, iadk, jdik, x, itab, iprint, nddli, iadi, jdii, diag_i, lt_i, itok, insolv, it, fac_k, ipiv_k, nk, mumps_par, cddlp, isolv, idsc, iddl, ikc, inloc, ndof, itask)
Definition lin_solv.F:531
lin_solv2
subroutine lin_solv2(nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, x, f, itask, iprint, isolv, istop, graphe, itab, insolv, it, fac_k, ipiv_k, nk, diag_i, idsc)
Definition lin_solv.F:453
dsgraph_mod
Definition dsgraph_mod.F:31
imp_workh
Definition impbufdef_mod.F:571
imp_workh::jdim0
integer, dimension(:), allocatable jdim0
Definition impbufdef_mod.F:584
imp_workh::iadm0
integer, dimension(:), allocatable iadm0
Definition impbufdef_mod.F:584
prec5h_solv
subroutine prec5h_solv(nddl, nnz, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl)
Definition prec_solv.F:404
prec_solvgh
subroutine prec_solvgh(iprec, itask, nddl, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl)
Definition prec_solv.F:710
prec_solvp
subroutine prec_solvp(iprec, itask, graphe, iad_elem, fr_elem, diag_k, lt_k, iadk, jdik, itab, iprint, insolv, it, fac_k, ipiv_k, nk, mumps_par, cddlp, isolv, idsc, iddl, ikc, inloc, ndof, nddl, nnz, iadm, jdim, diag_m, lt_m, v, z)
Definition prec_solv.F:147
prec_solvh
subroutine prec_solvh(iprec, itask, graphe, iad_elem, fr_elem, diag_k, lt_k, iadk, jdik, itab, iprint, insolv, it, fac_k, ipiv_k, nk, mumps_par, cddlp, isolv, idsc, iddl, ikc, inloc, ndof, nddl, nnz, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl)
Definition prec_solv.F:590
prec5hc_solv
subroutine prec5hc_solv(nddl, nnz, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl)
Definition prec_solv.F:477
prec0_solv
subroutine prec0_solv(nddl, nnz, iadm, jdim, diag_m, lt_m, v, z)
Definition prec_solv.F:239
precic_solv
subroutine precic_solv(nddl, nnz, iadm, jdim, diag_m, lt_m, v, z)
Definition prec_solv.F:348
precir_solv
subroutine precir_solv(nddl, nnz, iadm, jdim, diag_m, lt_m, v, z)
Definition prec_solv.F:292
prec2h_solv
subroutine prec2h_solv(f_ddl, l_ddl, diag_m, v, z)
Definition prec_solv.F:543
prec_solv
subroutine prec_solv(iprec, iadk, jdik, diag_k, lt_k, itask, graphe, itab, insolv, it, fac_k, ipiv_k, nk, idsc, isolv, iprint, nddl, nnz, iadm, jdim, diag_m, lt_m, v, z)
Definition prec_solv.F:42
mav_lt1
subroutine mav_lt1(nddl, nnz, iadl, jdil, diag_k, lt_k, v, w)
Definition produt_v.F:399
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31
dsgraph_mod::prgraph
Definition dsgraph_mod.F:45