OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
prec_solv.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "timeri_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)
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)
subroutine prec0_solv (nddl, nnz, iadm, jdim, diag_m, lt_m, v, z)
subroutine precir_solv (nddl, nnz, iadm, jdim, diag_m, lt_m, v, z)
subroutine precic_solv (nddl, nnz, iadm, jdim, diag_m, lt_m, v, z)
subroutine prec5h_solv (nddl, nnz, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl)
subroutine prec5hc_solv (nddl, nnz, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl)
subroutine prec2h_solv (f_ddl, l_ddl, diag_m, v, z)
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)
subroutine prec_solvgh (iprec, itask, nddl, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl)

Function/Subroutine Documentation

◆ prec0_solv()

subroutine prec0_solv ( integer nddl,
integer nnz,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z )

Definition at line 236 of file prec_solv.F.

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
my_real
#define my_real
Definition cppsort.cpp:32

◆ prec2h_solv()

subroutine prec2h_solv ( integer f_ddl,
integer l_ddl,
diag_m,
v,
z )

Definition at line 541 of file prec_solv.F.

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

◆ prec5h_solv()

subroutine prec5h_solv ( integer nddl,
integer nnz,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z,
integer f_ddl,
integer l_ddl )

Definition at line 401 of file prec_solv.F.

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
my_barrier
subroutine my_barrier
Definition machine.F:31

◆ prec5hc_solv()

subroutine prec5hc_solv ( integer nddl,
integer nnz,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z,
integer f_ddl,
integer l_ddl )

Definition at line 474 of file prec_solv.F.

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
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

◆ prec_solv()

subroutine prec_solv ( integer iprec,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer itask,
type(prgraph), dimension(*) graphe,
integer, dimension(*) itab,
integer insolv,
integer it,
fac_k,
integer, dimension(*) ipiv_k,
integer nk,
integer idsc,
integer isolv,
integer iprint,
integer nddl,
integer nnz,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z )

Definition at line 36 of file prec_solv.F.

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
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
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
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

◆ prec_solvgh()

subroutine prec_solvgh ( integer iprec,
integer itask,
integer nddl,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z,
integer f_ddl,
integer l_ddl )

Definition at line 707 of file prec_solv.F.

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
spmd_sumf_v
subroutine spmd_sumf_v(v)
Definition imp_spmd.F:1650
prec5hc_solv
subroutine prec5hc_solv(nddl, nnz, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl)
Definition prec_solv.F:477
prec2h_solv
subroutine prec2h_solv(f_ddl, l_ddl, diag_m, v, z)
Definition prec_solv.F:543

◆ prec_solvh()

subroutine prec_solvh ( integer iprec,
integer itask,
type(prgraph), dimension(*) graphe,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
diag_k,
lt_k,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
integer, dimension(*) itab,
integer iprint,
integer insolv,
integer it,
fac_k,
integer, dimension(*) ipiv_k,
integer nk,
integer mumps_par,
integer, dimension(*) cddlp,
integer isolv,
integer idsc,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) inloc,
integer, dimension(*) ndof,
integer nddl,
integer nnz,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z,
integer f_ddl,
integer l_ddl )

Definition at line 582 of file prec_solv.F.

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
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

◆ prec_solvp()

subroutine prec_solvp ( integer iprec,
integer itask,
type(prgraph), dimension(*) graphe,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
diag_k,
lt_k,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
integer, dimension(*) itab,
integer iprint,
integer insolv,
integer it,
fac_k,
integer, dimension(*) ipiv_k,
integer nk,
integer mumps_par,
integer, dimension(*) cddlp,
integer isolv,
integer idsc,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) inloc,
integer, dimension(*) ndof,
integer nddl,
integer nnz,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z )

Definition at line 140 of file prec_solv.F.

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

◆ precic_solv()

subroutine precic_solv ( integer nddl,
integer nnz,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z )

Definition at line 345 of file prec_solv.F.

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

◆ precir_solv()

subroutine precir_solv ( integer nddl,
integer nnz,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z )

Definition at line 289 of file prec_solv.F.

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