OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lin_solv.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "impl1_c.inc"
#include "impl2_c.inc"
#include "timeri_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lin_solv (nddl, iddl, ndof, ikc, d, dr, tol, nnz, iadk, jdik, diag_k, lt_k, nddli, iadi, jdii, diag_i, lt_i, itok, iadm, jdim, diag_m, lt_m, f, f_u, inloc, fr_elem, iad_elem, w_ddl, itask, icprec, istop, a, ar, ve, ms, xe, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, it, graphe, itab, fac_k, ipiv_k, nk, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, mumps_par, cddlp, ind_imp, xi_c, irbe3, lrbe3, irbe2, lrbe2)
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)
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)
subroutine err_mem (mem)
subroutine recu_kdis0 (ndof, d)
subroutine lin_solvh0 (tol, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, x, f, itask, iprint, f_u, isolv, iprec, l_lim, itol, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, p_mach, istop, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, ind_imp, xi_c, f0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2)
subroutine lin_solvh1 (tol, max_l, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, diag_m, lt_m, x, f, itask, icprec, iprint, f_u, isolv, iprec, l_lim, itol, inega, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, p_mach, maxb, istop, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, ind_imp, diag_i, xi_c, f0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2)
subroutine lin_solvih2 (tol, n_pat, maxb1, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, iadm, jdim, diag_m, lt_m, x, f, max_l, d_tol, itask, icprec, iprint, f_u, isolv, iprec, l_lim, itol, inega, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, p_mach, maxb, istop, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, ind_imp, diag_i, xi_c, f0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2)
subroutine lin_solvhm (tol, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, x, f, itask, iprint, f_u, isolv, iprec, l_lim, itol, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, p_mach, istop, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, graphe, iad_elem, fr_elem, itab, insolv, itn, fac_k, ipiv_k, nk, mumps_par, cddlp, idsc, iddl, ikc, inloc, diag_i, iline, ilintf, ind_imp, xi_c, f0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2, it_pcg, imumpsv)
subroutine set_kisc (nddl, nddli, iadi, jdii, itok, lt_i, iadk0, jdik0, lt_k0)
subroutine ini_kisc (nddl, nddli, iadi)
subroutine mumpslb_hp (f, f1, nddl, iad_elem, fr_elem, iddl, ikc, inloc, ndof, itag)
subroutine mumpslb (f, f1, nddl, iad_elem, fr_elem, iddl, ikc, inloc, ndof, itag)

Function/Subroutine Documentation

◆ err_mem()

subroutine err_mem ( integer mem)

Definition at line 616 of file lin_solv.F.

617C-----------------------------------------------
618C M o d u l e s
619C-----------------------------------------------
620 USE message_mod
621C-----------------------------------------------
622C I m p l i c i t T y p e s
623C-----------------------------------------------
624#include "implicit_f.inc"
625#include "comlock.inc"
626C-----------------------------------------------
627C D u m m y A r g u m e n t s
628C-----------------------------------------------
629C REAL
630 integer
631 . mem
632C-----------------------------------------------
633C L o c a l V a r i a b l e s
634C-----------------------------------------------
635 CALL ancmsg(msgid=81,anmode=aninfo,
636 . i1=mem)
637 CALL arret(2)
638 RETURN
message_mod
Definition message_mod.F:1249
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87

◆ ini_kisc()

subroutine ini_kisc ( integer nddl,
integer nddli,
integer, dimension(*) iadi )

Definition at line 1705 of file lin_solv.F.

1706C-----------------------------------------------
1707C M o d u l e s
1708C-----------------------------------------------
1709 USE imp_workh
1710 USE message_mod
1711C-----------------------------------------------
1712C I m p l i c i t T y p e s
1713C-----------------------------------------------
1714#include "implicit_f.inc"
1715C-----------------------------------------------
1716C D u m m y A r g u m e n t s
1717C-----------------------------------------------
1718 INTEGER NDDL,NDDLI,IADI(*)
1719#ifdef MUMPS5
1720C-----------------------------------------------
1721C L o c a l V a r i a b l e s
1722C-----------------------------------------------
1723 INTEGER IERR,LNZ
1724C----6------------------
1725 IF (nddli<=0) RETURN
1726C
1727 IF(ALLOCATED(iadi0)) DEALLOCATE(iadi0)
1728 IF(ALLOCATED(jdii0)) DEALLOCATE(jdii0)
1729 IF(ALLOCATED(lt_i0)) DEALLOCATE(lt_i0)
1730 lnz=iadi(nddli+1)-iadi(1)
1731C--- KI0 with global id is still not completely validated
1732C--- LNZ=2*(IADI(NDDLI+1)-IADI(1))
1733 ALLOCATE(iadi0(nddli+1),jdii0(lnz),lt_i0(lnz),stat=ierr)
1734C
1735 IF (ierr/=0) THEN
1736 CALL ancmsg(msgid=19,anmode=aninfo,
1737 . c1='FOR IMPLICIT SOLVER W/ CONTACT')
1738 CALL arret(2)
1739 ENDIF
1740C
1741 RETURN
1742#endif
imp_workh
Definition impbufdef_mod.F:571
imp_workh::iadi0
integer, dimension(:), allocatable iadi0
Definition impbufdef_mod.F:588
imp_workh::jdii0
integer, dimension(:), allocatable jdii0
Definition impbufdef_mod.F:588

◆ lin_solv()

subroutine lin_solv ( integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
d,
dr,
tol,
integer nnz,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer nddli,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
diag_i,
lt_i,
integer, dimension(*) itok,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
f,
f_u,
integer, dimension(*) inloc,
integer, dimension(*) fr_elem,
integer, dimension(2,*) iad_elem,
integer, dimension(*) w_ddl,
integer itask,
integer icprec,
integer istop,
a,
ar,
ve,
ms,
xe,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer nsrem,
integer nsl,
integer it,
type(prgraph), dimension(*) graphe,
integer, dimension(*) itab,
fac_k,
integer, dimension(*) ipiv_k,
integer nk,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) monvol,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) fr_mv,
volmon,
integer, dimension(*) ibfv,
skew,
xframe,
integer mumps_par,
integer, dimension(*) cddlp,
integer, dimension(*) ind_imp,
xi_c,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 60 of file lin_solv.F.

74C-----------------------------------------------
75C M o d u l e s
76C-----------------------------------------------
77 USE dsgraph_mod
78 USE imp_workh
79 USE intbufdef_mod
80 USE groupdef_mod
81C-----------------------------------------------
82C I m p l i c i t T y p e s
83C-----------------------------------------------
84#include "implicit_f.inc"
85C-----------------------------------------------
86C C o m m o n B l o c k s
87C-----------------------------------------------
88#if defined(MUMPS5)
89#include "dmumps_struc.h"
90#endif
91#include "com01_c.inc"
92#include "com04_c.inc"
93#include "impl1_c.inc"
94#include "impl2_c.inc"
95#include "timeri_c.inc"
96#include "units_c.inc"
97#include "task_c.inc"
98C-----------------------------------------------
99C D u m m y A r g u m e n t s
100C-----------------------------------------------
101C----------resol [K]{X}={F}------
102 INTEGER NDDL ,NNZ ,IADK(*),JDIK(*),IADM(*),JDIM(*),ITASK,
103 . NDOF(*),IDDL(*),IKC(*),ICPREC,ISTOP,
104 . NDDLI ,IADI(*),JDII(*),ITOK(*),INLOC(*),IBFV(*),
105 . FR_ELEM(*),IAD_ELEM(2,*),W_DDL(*),NSREM ,NSL,IT
106 INTEGER NE_IMP(*),IPARI(*) ,NUM_IMP(*),NS_IMP(*),
107 . ITAB(*), IPIV_K(*), NK,IND_IMP(*),IRBE3(*),LRBE3(*),
108 . IRBE2(*),LRBE2(*)
109C
110 INTEGER NMONV,IMONV(*),MONVOL(*),FR_MV(*)
111 my_real
112 . diag_k(*),lt_k(*),diag_m(*),lt_m(*), f(*),tol,
113 . diag_i(*),lt_i(*),d(3,*),dr(3,*),f_u, fac_k(*)
114 my_real
115 . a(3,*),ar(3,*),ve(3,*),xe(3,*),ms(*),
116 . skew(*) ,xframe(*),volmon(*),xi_c(*)
117C
118 TYPE(PRGRAPH) :: GRAPHE(*)
119C
120 INTEGER CDDLP(*)
121#ifdef MUMPS5
122 TYPE(DMUMPS_STRUC) MUMPS_PAR
123#else
124 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
125 INTEGER MUMPS_PAR
126#endif
127C
128 INTEGER OMP_GET_THREAD_NUM
129 EXTERNAL omp_get_thread_num
130
131 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
132 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
133#ifdef MUMPS5
134C-----------------------------------------------
135C L o c a l V a r i a b l e s
136C-----------------------------------------------
137C------------------------------------------
138c isolv=1 => P.G.C.
139C------------------------------------------
140C-------------avec LIN_SOLV0-----------------------------
141c iprec=1 => [I] (sans precon)
142C-------------avec LIN_SOLV1 (2-10)-----------------------------
143c iprec=2 => jacobien
144c iprec=3 => I.C.(0) supprimed
145c iprec=4 => I.C.(0)_Stab supprimed
146c iprec=5 => fsai .r
147C---------avec LIN_SOLV2 NPAT>1:
148c-----(iprec>10)variable dimension(D_TOL) pour LT_M : supprimed------
149C------------------------------------------
150C------------------------------------------
151C [K]:matrice de rigidite [M]:matrice de preconditionnement
152C------------------------------------------
153C----------------------------------------------
154C L o c a l V a r i a b l e s
155C---------------------)--------------------------
156 INTEGER I,J,IPRINT,ITQ,F_DDL,L_DDL,F_DDLI,L_DDLI,IERR,ITSK
157 my_real
158 . a2,qtol,r2,in_nz,in_nd
159C U->L_U,DIAG_T->DIAG_T,F0->L_F0
160C---------------------
161c F_DDL=1+ITASK*NDDL/NTHREAD
162c L_DDL=(ITASK+1)*NDDL/NTHREAD
163c F_DDLI=1+ITASK*NDDLI/NTHREAD
164c L_DDLI=(ITASK+1)*NDDLI/NTHREAD
165C
166 inega = imp_chk
167!$OMP PARALLEL PRIVATE(ITSK,F_DDL ,L_DDL,I)
168 CALL imp_smpini(itsk ,f_ddl ,l_ddl ,nddl )
169 DO i=f_ddl,l_ddl
170 l_u(i)=zero
171 diag_t(i)=diag_k(i)
172 l_f0(i)=f(i)
173 ENDDO
174!$OMP END PARALLEL
175C
176C--add isolv=1,7 after IF (ITASK == 0.AND.NDDLI > 0.AND.(ISOLV == 1.OR.ISOLV > 6)) THEN
177 IF (nddli > 0.AND.isolv > 7) THEN
178 CALL ini_kisc(nddl,nddli,iadi)
179C CALL SET_KISC(NDDL,NDDLI,IADI,JDII,ITOK,LT_I,IADI0,JDII0,LT_I0)
180 CALL set_ksym(nddli,iadi,jdii,lt_i,iadi0,jdii0,lt_i0)
181 END IF
182C----------------------
183c CALL MY_BARRIER
184C---------------------
185 IF (iqstat>1.AND.(ilintf==0.OR.ilintf==ncycle)) THEN
186 itq = 1
187 CALL produt_hp(nddl,l_f0,l_f0,w_ddl,r2)
188C----------------------
189c CALL MY_BARRIER
190C---------------------
191 qtol = em04*r2
192 ENDIF
193 100 CONTINUE
194 IF ((isolv<3.OR.isolv>6)
195 . .AND.(iprec>1.OR.intp_c>=0)) THEN
196!$OMP PARALLEL PRIVATE(ITSK,F_DDLI ,L_DDLI,I,J)
197 CALL imp_smpini(itsk ,f_ddli ,l_ddli ,nddli )
198 DO i=f_ddli,l_ddli
199 j=itok(i)
200 diag_t(j)=diag_t(j)+diag_i(i)
201 ENDDO
202!$OMP END PARALLEL
203 IF (ilintf>0) CALL diag_kif(diag_t)
204 ENDIF
205C
206!$OMP PARALLEL PRIVATE(ITSK,F_DDL ,L_DDL)
207 CALL imp_smpini(itsk ,f_ddl ,l_ddl ,nddl )
208 IF (insolv==2) CALL bfgs_h1(f_ddl,l_ddl,w_ddl,f,a2,it,itsk)
209C
210 IF (insolv==3) CALL bfgs_h1p(f_ddl,l_ddl,w_ddl,f,a2,it,itsk)
211!$OMP END PARALLEL
212C----------------------
213c CALL MY_BARRIER
214C---------------------
215 IF (ispmd==0) THEN
216 iprint=lprint
217 ELSE
218 iprint=0
219 ENDIF
220! IF (IMON>0) CALL STARTIME(TIMERS,33)
221 IF (nspmd==1.AND.(isolv==3.OR.isolv==4).AND.imumpsv==0)THEN
222C-----------BCS,DS
223citask0 IF (ITASK==0) THEN
224 IF (idsc>0) it_bcs = it_bcs + 1
225 CALL lin_solv2(
226 1 nddl ,nnz ,iadk ,jdik ,diag_t ,
227 2 lt_k ,nddli ,itok ,iadi ,jdii ,
228 3 lt_i ,l_u ,f ,itask ,lprint ,
229 4 isolv ,istop ,graphe,itab ,insolv,
230 5 it ,fac_k ,ipiv_k,nk ,diag_i,
231 6 idsc )
232citask0 END IF
233 ELSE
234C IF (NSPMD>1 .OR. iterative,Mix except Isolv=2 -> Mumps
235 IF (isolv==3.OR.isolv==4) THEN
236citask0 IF (ITASK == 0) THEN
237 IF (ispmd==0.AND.idsc>0) it_bcs = it_bcs + 1
238 CALL lin_solvp2(graphe, f, nddl, iad_elem, fr_elem,
239 1 diag_k, lt_k, iadk, jdik, l_u,
240 2 itab, iprint, nddli, iadi, jdii,
241 3 diag_i, lt_i, itok, insolv, it,
242 4 fac_k, ipiv_k, nk, mumps_par, cddlp,
243 5 isolv, idsc, iddl, ikc, inloc,
244 6 ndof , itask )
245citask0 END IF !(ITASK == 0) THEN
246 ELSEIF (isolv==5.OR.isolv==6) THEN
247 IF (idsc>0.AND.itask==0) it_bcs = it_bcs + 1
248 CALL lin_solvhm(tol ,
249 1 nddl ,nnz ,iadk ,jdik ,diag_t ,
250 2 lt_k ,nddli ,itok ,iadi ,jdii ,
251 3 lt_i ,l_u ,f ,itask ,iprint ,
252 4 f_u ,isolv ,iprec ,l_lim ,itol ,
253 6 w_ddl ,a ,ar ,ve ,ms ,
254 9 xe ,d ,dr ,ndof ,ipari ,
255 a intbuf_tab ,num_imp,ns_imp,ne_imp,
256 b nsrem ,nsl ,p_mach ,istop ,nmonv ,
257 e imonv ,monvol ,igrsurf ,fr_mv ,
258 f volmon,ibfv ,skew ,xframe ,graphe,
259 g iad_elem,fr_elem,itab ,insolv ,it ,
260 h fac_k ,ipiv_k ,nk ,mumps_par,cddlp,
261 i idsc ,iddl ,ikc ,inloc ,diag_i ,
262 j iline ,ilintf,ind_imp,xi_c ,l_f0 ,
263 k nddli_g,intp_c,irbe3 ,lrbe3 ,irbe2 ,
264 l lrbe2 ,it_pcg ,imumpsv)
265 ELSEIF (n_pat>1) THEN
266 CALL lin_solvih2( tol ,n_pat ,maxb1 ,
267 1 nddl ,nnz ,iadk ,jdik ,diag_t ,
268 2 lt_k ,nddli ,itok ,iadi ,jdii ,
269 3 lt_i ,iadm ,jdim ,diag_m ,lt_m ,
270 4 l_u ,f ,max_l ,d_tol ,
271 4 itask ,icprec,iprint,f_u ,isolv ,
272 5 iprec ,l_lim ,itol ,inega ,w_ddl ,
273 7 a ,ar ,ve ,ms ,xe ,
274 8 d ,dr ,ndof ,ipari ,intbuf_tab,
275 9 num_imp,ns_imp,ne_imp,nsrem ,
276 a nsl ,p_mach,maxb ,istop ,nmonv ,
277 b imonv ,monvol,igrsurf ,fr_mv ,
278 c volmon,ibfv ,skew ,xframe ,ind_imp,
279 d diag_i,xi_c ,l_f0 ,nddli_g,intp_c,
280 e irbe3 ,lrbe3,irbe2 ,lrbe2 )
281 ELSEIF (iprec==1) THEN
282 CALL lin_solvh0( tol ,
283 1 nddl ,nnz ,iadk ,jdik ,diag_t ,
284 2 lt_k ,nddli ,itok ,iadi ,jdii ,
285 3 lt_i ,l_u ,f ,itask ,iprint ,
286 4 f_u ,isolv ,iprec ,l_lim ,itol ,
287 6 w_ddl ,a ,ar ,ve ,ms ,
288 9 xe ,d ,dr ,ndof ,ipari ,
289 a intbuf_tab ,num_imp,ns_imp,ne_imp,
290 b nsrem ,nsl ,p_mach ,istop ,nmonv ,
291 e imonv ,monvol ,igrsurf,fr_mv ,
292 f volmon,ibfv ,skew ,xframe ,ind_imp,
293 g xi_c ,l_f0 ,nddli_g,intp_c ,irbe3 ,
294 h lrbe3 ,irbe2 ,lrbe2 )
295 ELSEIF (iprec>1.AND.iprec<10) THEN
296 CALL lin_solvh1( tol ,max_l ,
297 1 nddl ,nnz ,iadk ,jdik ,diag_t ,
298 2 lt_k ,nddli ,itok ,iadi ,jdii ,
299 3 lt_i ,diag_m,lt_m ,l_u ,f ,
300 4 itask ,icprec,iprint,f_u ,isolv ,
301 5 iprec ,l_lim ,itol ,inega ,w_ddl ,
302 6 a ,ar ,ve ,ms ,xe ,
303 7 d ,dr ,ndof ,ipari ,intbuf_tab,
304 8 num_imp,ns_imp,ne_imp,nsrem ,
305 9 nsl ,p_mach,maxb ,istop ,nmonv ,
306 c imonv ,monvol,igrsurf ,fr_mv ,
307 d volmon,ibfv ,skew ,xframe,ind_imp,
308 e diag_i,xi_c ,l_f0 ,nddli_g,intp_c,
309 f irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
310 ENDIF
311 ENDIF
312C----------------------
313c CALL MY_BARRIER
314C---------------------
315! IF (imon>0) CALL stoptime(timers,33)
316C
317 IF (imp_chk>0.OR.(istop>0.AND.impdeb==0)) GOTO 200
318C---------------------------------
319!$OMP PARALLEL PRIVATE(ITSK,F_DDL ,L_DDL)
320 CALL imp_smpini(itsk ,f_ddl ,l_ddl ,nddl )
321 IF (insolv==2) THEN
322 CALL bfgs_h2(f_ddl,l_ddl,w_ddl,l_u,l_f0,a2,it,n_lim,itsk)
323C
324 ELSEIF (insolv==3) THEN
325 CALL bfgs_h2p(f_ddl,l_ddl,w_ddl,l_u,l_f0,a2,it,n_lim,itsk)
326 ENDIF
327!$OMP END PARALLEL
328C----------------------
329c CALL MY_BARRIER
330C---------------------
331 IF (iqstat>1.AND.(ilintf==0.OR.ilintf==ncycle))THEN
332 CALL qstat_it(nddl ,f ,l_u )
333C----------------------
334C CALL MY_BARRIER
335C---------------------
336 CALL produt_hp(nddl,f,f,w_ddl,r2)
337C---------------------
338 IF (r2>qtol.AND.itq<=iqstat) THEN
339 itq = itq + 1
340 idsc = 0
341 icprec = 0
342 GOTO 100
343 ELSE
344 CALL qstat_end(nddl ,l_u )
345 IF(lprint/=0)THEN
346 r2 = em02*sqrt(r2/qtol)
347 WRITE(iout,1002)itq,r2
348 IF(lprint<0) THEN
349 WRITE(istdo,1002)itq,r2
350 ENDIF
351 ENDIF
352 ENDIF !IF (R2>QTOL.AND.ITQ<=IQSTAT)
353 ENDIF !IF (IQSTAT>1.AND.(ILINTF.EQ
354 IF (iline>0.AND.lprint/=0.AND.(isolv==3.OR.isolv==4))THEN
355 IF (ilintf==0.OR.ilintf==ncycle)THEN
356C--------BCS hase done already inside imp_r2bcs---------
357 IF (imumpsv>0 .AND. nddli>0)THEN
358!$OMP PARALLEL PRIVATE(ITSK,F_DDL,L_DDL,I,J)
359 CALL imp_smpini(itsk ,f_ddli ,l_ddli ,nddli )
360 DO i=f_ddli,l_ddli
361 j=itok(i)
362 diag_t(j)=diag_t(j)+diag_i(i)
363 ENDDO
364!$OMP END PARALLEL
365 END IF !(IMUMPSV>0)THEN
366 itq = 0
367C----------------------
368c CALL MY_BARRIER
369C---------------------
370!$OMP PARALLEL PRIVATE(ITSK,F_DDL,L_DDL,I)
371 CALL imp_smpini(itsk ,f_ddl ,l_ddl ,nddl )
372 CALL mav_lth0(
373 1 nddl ,nddli ,iadk ,jdik ,diag_t,
374 2 lt_k ,iadi ,jdii ,itok ,lt_i ,
375 3 l_u ,f ,a ,ar ,
376 5 ve ,ms ,xe ,d ,dr ,
377 6 ndof ,ipari ,intbuf_tab ,num_imp,
378 7 ns_imp,ne_imp,nsrem ,nsl ,ibfv ,
379 8 skew ,xframe,monvol,volmon,igrsurf ,
380 9 fr_mv,nmonv ,imonv ,ind_imp,
381 a xi_c ,itq ,irbe3 ,lrbe3 ,irbe2 ,
382 b lrbe2 ,f_ddl ,l_ddl ,itsk )
383C----------------------
384 CALL my_barrier
385C---------------------
386 DO i=f_ddl,l_ddl
387 f(i) = f(i)-l_f0(i)
388 ENDDO
389!$OMP END PARALLEL
390 CALL produt_hp(nddl,f,f,w_ddl,r2)
391 CALL produt_hp(nddl,l_f0,l_f0,w_ddl,qtol)
392citask0 IF (ITASK == 0) THEN
393 r2 = sqrt(r2/qtol)
394 IF(iprint/=0) WRITE(iout,1003)r2
395 IF(iprint<0) WRITE(istdo,1003)r2
396citask0 END IF !(ITASK == 0) THEN
397 ENDIF
398 ENDIF
399C--------POUR F*X--------
400 CALL produt_hp(nddl,l_u,l_f0,w_ddl,f_u)
401citask0 IF (ITASK == 0) THEN
402C---------
403 IF (nmonv>0.AND.iline==1) THEN
404 CALL recu_kdis(ndof ,d )
405 ENDIF
406 IF (intp_c<0.AND.nddli>0) THEN
407 CALL recu_kdis0(ndof ,d )
408 ENDIF
409 CALL recudis(nddl ,iddl ,ndof ,ikc ,l_u ,
410 1 d ,dr ,inloc )
411C---------
412citask0 END IF !(ITASK == 0) THEN
413 200 CONTINUE
414!$OMP PARALLEL PRIVATE(ITSK,F_DDL,L_DDL,I)
415 CALL imp_smpini(itsk ,f_ddl ,l_ddl ,nddl )
416 DO i=f_ddl,l_ddl
417 f(i) = l_f0(i)
418 ENDDO
419!$OMP END PARALLEL
420C----------------------
421c CALL MY_BARRIER
422C---------------------
423 1001 FORMAT(3x,'L_SOLVER : ISOLV =',i8,2x,'ITOL =',i8,2x,
424 . 'L_TOL =',e11.4)
425 1002 FORMAT(/3x,'NUM.QUASI-STATIC ITERATIONS=',i8,5x,
426 . ' RELATIVE ||R||=',e11.4/)
427 1003 FORMAT(/3x,'DIRECT SOLVER TERMINATED WITH RELATIVE ||R||=',e11.4/)
428 RETURN
429#endif
my_real
#define my_real
Definition cppsort.cpp:32
bfgs_h1
subroutine bfgs_h1(f_ddl, l_ddl, w_ddl, f, a2, it, itask)
Definition imp_bfgs.F:552
bfgs_h2
subroutine bfgs_h2(f_ddl, l_ddl, w_ddl, u, f, a2, it, max_bfgs, itask)
Definition imp_bfgs.F:652
bfgs_h2p
subroutine bfgs_h2p(f_ddl, l_ddl, w_ddl, u, f, a2, it, max_bfgs, itask)
Definition imp_bfgs.F:839
bfgs_h1p
subroutine bfgs_h1p(f_ddl, l_ddl, w_ddl, f, a2, it, itask)
Definition imp_bfgs.F:765
qstat_end
subroutine qstat_end(nddl, u)
Definition imp_dyna.F:686
qstat_it
subroutine qstat_it(nddl, f, u)
Definition imp_dyna.F:651
diag_kif
subroutine diag_kif(diag_k)
Definition imp_solv.F:2619
imp_smpini
subroutine imp_smpini(itsk, n1ftsk, n1ltsk, n1)
Definition imp_solv.F:6895
set_ksym
subroutine set_ksym(nddl, iadk, jdik, lt_k, iadk0, jdik0, lt_k0)
Definition imp_solv.F:5146
recu_kdis0
subroutine recu_kdis0(ndof, d)
Definition lin_solv.F:648
lin_solvhm
subroutine lin_solvhm(tol, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, x, f, itask, iprint, f_u, isolv, iprec, l_lim, itol, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, p_mach, istop, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, graphe, iad_elem, fr_elem, itab, insolv, itn, fac_k, ipiv_k, nk, mumps_par, cddlp, idsc, iddl, ikc, inloc, diag_i, iline, ilintf, ind_imp, xi_c, f0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2, it_pcg, imumpsv)
Definition lin_solv.F:1449
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_solvh0
subroutine lin_solvh0(tol, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, x, f, itask, iprint, f_u, isolv, iprec, l_lim, itol, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, p_mach, istop, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, ind_imp, xi_c, f0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2)
Definition lin_solv.F:710
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
lin_solvh1
subroutine lin_solvh1(tol, max_l, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, diag_m, lt_m, x, f, itask, icprec, iprint, f_u, isolv, iprec, l_lim, itol, inega, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, p_mach, maxb, istop, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, ind_imp, diag_i, xi_c, f0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2)
Definition lin_solv.F:878
ini_kisc
subroutine ini_kisc(nddl, nddli, iadi)
Definition lin_solv.F:1706
lin_solvih2
subroutine lin_solvih2(tol, n_pat, maxb1, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, iadm, jdim, diag_m, lt_m, x, f, max_l, d_tol, itask, icprec, iprint, f_u, isolv, iprec, l_lim, itol, inega, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, p_mach, maxb, istop, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, ind_imp, diag_i, xi_c, f0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2)
Definition lin_solv.F:1176
recu_kdis
subroutine recu_kdis(ndof, d)
Definition monv_imp0.F:2551
dsgraph_mod
Definition dsgraph_mod.F:31
groupdef_mod
Definition groupdef_mod.F:662
produt_hp
subroutine produt_hp(nddl, x, y, w, r)
Definition produt_v.F:3252
mav_lth0
subroutine mav_lth0(nddl, nddli, iadl, jdil, diag_k, lt_k, iadi, jdii, itok, lt_i, v, w, a, ar, ve, ms, x, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, ibfv, skew, xframe, monvol, volmon, igrsurf, fr_mv, nmonv, imonv, index2, xi_c, iupd, irbe3, lrbe3, irbe2, lrbe2, f_ddl, l_ddl, itask)
Definition produt_v.F:1227
recudis
subroutine recudis(nddl, iddl, ndof, ikc, lx, d, dr, inloc)
Definition recudis.F:31
my_barrier
subroutine my_barrier
Definition machine.F:31
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135

◆ lin_solv2()

subroutine lin_solv2 ( integer nddl,
integer nnz,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer nddli,
integer, dimension(*) itok,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
lt_i,
x,
f,
integer itask,
integer iprint,
integer isolv,
integer istop,
type(prgraph), dimension(*) graphe,
integer, dimension(*) itab,
integer insolv,
integer it,
fac_k,
integer, dimension(*) ipiv_k,
integer nk,
diag_i,
integer idsc )

Definition at line 446 of file lin_solv.F.

453C-----------------------------------------------
454C M o d u l e s
455C-----------------------------------------------
456 USE dsgraph_mod
457C-----------------------------------------------
458C I m p l i c i t T y p e s
459C-----------------------------------------------
460#include "implicit_f.inc"
461C-----------------------------------------------
462C D u m m y A r g u m e n t s
463C-----------------------------------------------
464 INTEGER NDDL ,NNZ ,IADK(*),JDIK(*),ITASK,IPRINT,
465 . ISTOP,NDDLI,ITOK(*),IADI(*),JDII(*),
466 . ISOLV ,ITAB(*), INSOLV,IT, IPIV_K(*), NK, IDSC
467C REAL
468 my_real
469 . diag_k(*),lt_k(*),lt_i(*),x(*) ,f(*),
470 . fac_k(*), diag_i(*)
471 TYPE(PRGRAPH) :: GRAPHE(*)
472#ifdef MUMPS5
473C-----------------------------------------------
474C L o c a l V a r i a b l e s
475C-----------------------------------------------
476 INTEGER I,J,NF
477 my_real
478 . rbid
479C------------------------------------------
480C [K]:matrice de rigidite [KI]:matrice de contact
481C------------------------------------------
482C IF (IMON>0) CALL STARTIME(33,ITASK+1)
483C IF (ISOLV==3) THEN
484C WRITE(6,*) "BCS Solver not available"
485C CALL FLUSH(6)
486C CALL ARRET(5)
487C IF (ISOLV==4) THEN
488 nf=1
489 IF (insolv==0) THEN
490 CALL imp_dsolv(graphe, diag_k, lt_k, iadk, jdik,
491 . nddl, nf, f, x, itab,
492 . iprint, nddli, iadi, jdii, diag_i,
493 . lt_i, itok )
494 ELSE
495 CALL imp_dsolv_iter(graphe, diag_k, lt_k, iadk, jdik,
496 . nddl, nf, f, x, itab,
497 . it, fac_k, ipiv_k, nk, iprint,
498 . nddli, iadi, jdii, diag_i, lt_i,
499 . itok )
500 idsc=0
501 ENDIF
502C ENDIF
503C IF (IMON>0) CALL STOPTIME(33,ITASK+1)
504 RETURN
505#endif
imp_dsolv
subroutine imp_dsolv(graphe, k_diag, k_lt, iadk, jdik, nddl, nb, b, x, itab, iprint, nddli7, iadi7, jdii7, i7_diag, i7_lt, i7tok)
Definition imp_dsolv.F:37
imp_dsolv_iter
subroutine imp_dsolv_iter(graphe, k_diag, k_lt, iadk, jdik, nddl, nb, b, x, itab, it, fac_k, ipiv_k, nk, iprint, nddli7, iadi7, jdii7, i7_diag, i7_lt, i7tok)
Definition imp_dsolv.F:82

◆ lin_solvh0()

subroutine lin_solvh0 ( tol,
integer nddl,
integer nnz,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer nddli,
integer, dimension(*) itok,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
lt_i,
x,
f,
integer itask,
integer iprint,
f_u,
integer isolv,
integer iprec,
integer l_lim,
integer itol,
integer, dimension(*) w_ddl,
a,
ar,
ve,
ms,
xe,
d,
dr,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer nsrem,
integer nsl,
p_mach,
integer istop,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) monvol,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) fr_mv,
volmon,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(*) ind_imp,
xi_c,
f0,
integer nddli_g,
integer intp_c,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 697 of file lin_solv.F.

710C-----------------------------------------------
711C M o d u l e s
712C-----------------------------------------------
713 USE dsgraph_mod
714 USE imp_workh
715 USE intbufdef_mod
716 USE groupdef_mod
717C-----------------------------------------------
718C I m p l i c i t T y p e s
719C-----------------------------------------------
720#include "implicit_f.inc"
721C-----------------------------------------------
722C C o m m o n B l o c k s
723C-----------------------------------------------
724#if defined(MUMPS5)
725#include "dmumps_struc.h"
726#endif
727#include "com04_c.inc"
728C-----------------------------------------------
729C D u m m y A r g u m e n t s
730C-----------------------------------------------
731C----------resol [K]{X}={F}------wothout precoditioner----
732 INTEGER NDDL ,NNZ ,IADK(*),JDIK(*),ITASK,IPRINT,ISTOP,
733 . NDDLI ,ITOK(*) ,IADI(*),JDII(*),NDDLI_G,
734 . ISOLV ,IPREC ,L_LIM,ITOL,W_DDL(*),IBFV(*),INTP_C
735 INTEGER NDOF(*),NE_IMP(*),NSREM ,NSL,
736 . IPARI(*) ,NUM_IMP(*),NS_IMP(*),IND_IMP(*)
737 INTEGER NMONV,IMONV(*),MONVOL(*),FR_MV(*),
738 . IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
739C REAL
740 my_real
741 . diag_k(*),lt_k(*),lt_i(*), x(*) ,f(*),tol,f_u,p_mach
742 my_real
743 . a(3,*),ar(3,*),ve(3,*),d(3,*),dr(3,*),xe(3,*),
744 . ms(*),volmon(*),skew(*) ,xframe(*),xi_c(*) ,f0(*)
745
746 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
747 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
748#ifdef MUMPS5
749C-----------------------------------------------
750C L o c a l V a r i a b l e s
751C-----------------------------------------------
752 INTEGER I,J,NNZM,LENV,IBID,IERR,ITSK
753 my_real
754 . shift,kcond,rbid
755 TYPE(PRGRAPH) :: GBID
756 TYPE(DMUMPS_STRUC) MBID
757C
758 INTEGER OMP_GET_THREAD_NUM
759 EXTERNAL omp_get_thread_num
760C
761C-----------------------------------------------
762C------------------------------------------
763c isolv=1 => P.G.C.
764c isolv=2 => P.LANCZOS
765c isolv=4 => direct multi-condensation
766C------------------------------------------
767 nnzm = 0
768C IF (IMON>0) CALL STARTIME(TIMERS,33)
769c IF (ITASK == 0) THEN
770 CALL set_ksym(nddl,iadk,jdik,lt_k,iadk0,jdik0,lt_k0)
771c END IF !(ITASK == 0) THEN
772C----------------------
773c CALL MY_BARRIER
774C---------------------
775!$OMP PARALLEL PRIVATE(ITSK)
776 itsk = omp_get_thread_num()
777 IF (isolv==1.OR.isolv>6) THEN
778 CALL imp_pcgh( iprec ,
779 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
780 2 lt_k ,nddli ,itok ,iadi ,jdii ,
781 3 lt_i ,nnzm ,iadk ,jdik ,diag_k ,
782 4 lt_k ,x ,f ,itol ,tol ,
783 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
784 6 l_lim ,p_mach,f_u ,istop ,
785 8 w_ddl ,a ,ar ,ve ,ms ,
786 9 xe ,d ,dr ,ndof ,ipari ,
787 a intbuf_tab ,num_imp,ns_imp,ne_imp,
788 b nsrem ,nsl ,nmonv ,imonv ,monvol,
789 c igrsurf,volmon,fr_mv,ibfv ,
790 d skew ,xframe ,gbid ,ibid ,ibid ,
791 e ibid ,ibid ,ibid ,rbid ,ibid ,
792 f ibid ,mbid ,ibid ,isolv ,ibid ,
793 g ibid ,ibid ,ibid ,ind_imp,xi_c ,
794 h f0 ,nddli_g,intp_c,irbe3 ,lrbe3,
795 i irbe2 ,lrbe2 )
796 ELSEIF (isolv == 9) THEN
797 CALL imp_ppcgh( iprec ,
798 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
799 2 lt_k ,nddli ,itok ,iadi ,jdii ,
800 3 lt_i ,nnzm ,iadk ,jdik ,diag_k ,
801 4 lt_k ,x ,f ,itol ,tol ,
802 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
803 6 l_lim ,p_mach,f_u ,istop ,
804 8 w_ddl ,a ,ar ,ve ,ms ,
805 9 xe ,d ,dr ,ndof ,ipari ,
806 a intbuf_tab ,num_imp,ns_imp,ne_imp,
807 b nsrem ,nsl ,nmonv ,imonv ,monvol,
808 c igrsurf ,volmon,fr_mv,ibfv ,
809 d skew ,xframe ,gbid ,ibid ,ibid ,
810 e ibid ,ibid ,ibid ,rbid ,ibid ,
811 f ibid ,mbid ,ibid ,isolv ,ibid ,
812 g ibid ,ibid ,ibid ,ind_imp,xi_c ,
813 h f0 ,nddli_g,intp_c,irbe3 ,lrbe3,
814 i irbe2 ,lrbe2 )
815 ELSEIF (isolv==2.AND.itsk==0) THEN
816 shift=zero
817 CALL imp_lanzp(iprec ,
818 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
819 2 lt_k ,nddli ,itok ,iadi ,jdii ,
820 3 lt_i ,nnzm ,iadk ,jdik ,diag_k ,
821 4 lt_k ,x ,f ,itol ,tol ,
822 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
823 6 shift ,kcond ,l_lim ,p_mach,f_u ,
824 7 istop ,w_ddl ,a ,ar ,
825 9 ve ,ms ,xe ,d ,dr ,
826 a ndof ,ipari ,intbuf_tab ,num_imp,
827 b ns_imp,ne_imp,nsrem ,nsl ,nmonv ,
828 c imonv ,monvol,igrsurf,volmon,
829 d fr_mv ,ibfv ,skew ,xframe,ind_imp,
830 h xi_c ,f0 ,nddli_g,intp_c,irbe3 ,
831 e lrbe3 ,irbe2 ,lrbe2 )
832 ENDIF
833!$OMP END PARALLEL
834C
835C IF (IMON>0) CALL STOPTIME(TIMERS,33)
836 RETURN
837#endif
imp_lanzp
subroutine imp_lanzp(iprec, n, nnz, iadk, jdik, diag_k, lt_k, ni, itok, iadi, jdii, lt_i, nnzm, iadm, jdim, diag_m, lt_m, x, r, itol, rtol, v, w, y, itask, iprint, shift, kcond, n_max, flm, f_x, istop, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, nmonv, imonv, monvol, igrsurf, volmon, fr_mv, ibfv, skew, xframe, ind_imp, xi_c, r0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_lanz.F:53
imp_ppcgh
subroutine imp_ppcgh(iprec, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, nnzm, iadm, jdim, diag_m, lt_m, x, r, itol, tol, p, z, y, itask, iprint, n_max, eps_m, f_x, istop, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, nmonv, imonv, monvol, igrsurf, volmon, fr_mv, ibfv, skew, xframe, graphe, iad_elem, fr_elem, itab, insolv, itn, fac_k, ipiv_k, nk, mumps_par, cddlp, isolv, idsc, iddl, ikc, inloc, ind_imp, xi_c, r0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_pcg.F:2925
imp_pcgh
subroutine imp_pcgh(iprec, nddl, nnz, iadk, jdik, diag_k, lt_k, nddli, itok, iadi, jdii, lt_i, nnzm, iadm, jdim, diag_m, lt_m, x, r, itol, tol, p, z, y, itask, iprint, n_max, eps_m, f_x, istop, w_ddl, a, ar, ve, ms, xe, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, nmonv, imonv, monvol, igrsurf, volmon, fr_mv, ibfv, skew, xframe, graphe, iad_elem, fr_elem, itab, insolv, itn, fac_k, ipiv_k, nk, mumps_par, cddlp, isolv, idsc, iddl, ikc, inloc, ind_imp, xi_c, r0, nddli_g, intp_c, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_pcg.F:245
imp_workh::jdik0
integer, dimension(:), allocatable jdik0
Definition impbufdef_mod.F:584
imp_workh::iadk0
integer, dimension(:), allocatable iadk0
Definition impbufdef_mod.F:584

◆ lin_solvh1()

subroutine lin_solvh1 ( tol,
integer max_l,
integer nddl,
integer nnz,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer nddli,
integer, dimension(*) itok,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
lt_i,
diag_m,
lt_m,
x,
f,
integer itask,
integer icprec,
integer iprint,
f_u,
integer isolv,
integer iprec,
integer l_lim,
integer itol,
integer inega,
integer, dimension(*) w_ddl,
a,
ar,
ve,
ms,
xe,
d,
dr,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer nsrem,
integer nsl,
p_mach,
integer maxb,
integer istop,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) monvol,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) fr_mv,
volmon,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(*) ind_imp,
diag_i,
xi_c,
f0,
integer nddli_g,
integer intp_c,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 864 of file lin_solv.F.

878C-----------------------------------------------
879C M o d u l e s
880C-----------------------------------------------
881 USE dsgraph_mod
882 USE imp_workh
883 USE intbufdef_mod
884 USE groupdef_mod
885C-----------------------------------------------
886C I m p l i c i t T y p e s
887C-----------------------------------------------
888#include "implicit_f.inc"
889C-----------------------------------------------
890C C o m m o n B l o c k s
891C-----------------------------------------------
892#if defined(MUMPS5)
893#include "dmumps_struc.h"
894#endif
895#include "com01_c.inc"
896#include "com04_c.inc"
897#include "timeri_c.inc"
898#include "units_c.inc"
899C-----------------------------------------------
900C D u m m y A r g u m e n t s
901C-----------------------------------------------
902C----------resol [K]{X}={F}------
903 INTEGER NDDL ,NNZ ,IADK(*),JDIK(*),ITASK,IPRINT,ICPREC,
904 . ISTOP,NDDLI ,ITOK(*) ,IADI(*),JDII(*),
905 . ISOLV ,IPREC ,L_LIM ,MAXB,ITOL,INEGA,
906 . W_DDL(*),IBFV(*),MAX_L,INTP_C,NDDLI_G
907 INTEGER NDOF(*),NE_IMP(*),NSREM ,NSL,IRBE3(*) ,LRBE3(*),
908 . IPARI(*) ,NUM_IMP(*),NS_IMP(*) ,IND_IMP(*),
909 . IRBE2(*),LRBE2(*)
910 INTEGER NMONV,IMONV(*),MONVOL(*),FR_MV(*)
911C REAL
912 my_real
913 . diag_k(*),lt_k(*),lt_i(*),diag_m(*),lt_m(*),
914 . x(*) ,f(*),tol,f_u,p_mach,xi_c(*),f0(*)
915 my_real
916 . a(3,*),ar(3,*),ve(3,*),d(3,*),dr(3,*),xe(3,*),
917 . ms(*),volmon(*),skew(*) ,xframe(*),diag_i(*)
918
919 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
920 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
921#ifdef MUMPS5
922C-----------------------------------------------
923C L o c a l V a r i a b l e s
924C-----------------------------------------------
925 INTEGER I,J,NNE,NNZM,MAXC,MAXA,LEN,LENV, IDLFT0,IDLFT1
926 INTEGER SIZI(NSPMD+1),MAXS0,MAXS1,IG,IBID,IERR,ITSK
927 my_real
928 . shift ,kcond,rbid
929 TYPE(PRGRAPH) :: GBID
930 TYPE(DMUMPS_STRUC) MBID
931C
932 INTEGER OMP_GET_THREAD_NUM
933 EXTERNAL omp_get_thread_num
934C
935C------------------------------------------
936c isolv=1 => P.G.C.
937C------------------------------------------
938c iprec=2 => jacobien
939c iprec=5 => fsai static same pattern of [K}
940C------------------------------------------
941C [K]:matrice de rigidite [M]:matrice de preconditionnement
942 nne = 0
943 nnzm = nnz
944 istop = inega
945C
946 IF (iprec==2) nnzm=0
947! IF (IMON>0) CALL STARTIME(TIMERS,32)
948 IF (icprec==1) THEN
949 IF (iprec==2) THEN
950 DO i=1,nddl
951 diag_m(i) = diag_k(i)
952 ENDDO
953 IF (nsl>0)
954 . CALL imp_diags(diag_m ,ndof,nsl,ipari,intbuf_tab,irbe3,lrbe3,irbe2)
955 IF (nmonv>0)
956 . CALL monv_diag(diag_m,ndof,ipari,intbuf_tab,irbe3 ,lrbe3 ,irbe2,0)
957 IF (nspmd>1) CALL spmd_sumf_v(diag_m)
958C-------------to add //
959 DO i=1,nddl
960 IF (diag_m(i)<em20) THEN
961 nne=nne+1
962 diag_m(i)=abs(diag_m(i))
963 diag_m(i)=max(em20,diag_m(i))
964 ENDIF
965 diag_m(i) = w_ddl(i)/diag_m(i)
966 ENDDO
967 IF (nne>0.AND.isolv/=2) istop=nne
968 ELSEIF (iprec==3) THEN
969 ELSEIF (iprec==5) THEN
970C ----- approx. (by each colonne of L_T) inverse ---------
971C ----- utilise d'abord la place de [M] pour la matrice assemblee ---------
972 IF (nspmd==1) THEN
973 idlft0=0
974 idlft1=0
975 ELSE
976 CALL fr_dlft(nddl,idlft0,idlft1)
977 ENDIF
978citask0 IF (ITASK == 0) THEN
979C---------
980 IF (nsl>0)
981 . CALL imp_diags(diag_k ,ndof,nsl,ipari,intbuf_tab,irbe3,lrbe3,irbe2)
982 IF (nmonv>0)
983 . CALL monv_diag(diag_k,ndof,ipari,intbuf_tab,irbe3 ,lrbe3 ,irbe2,0)
984 DO i=1,idlft0
985 diag_m(i) = diag_k(i)
986 DO j=iadk(i),iadk(i+1)-1
987 lt_m(j)=lt_k(j)
988 ENDDO
989 ENDDO
990 DO i=idlft1+1,nddl
991 diag_m(i) = diag_k(i)
992 DO j=iadk(i),iadk(i+1)-1
993 lt_m(j)=lt_k(j)
994 ENDDO
995 ENDDO
996C
997 IF (nspmd>1) CALL spmd_sumf_k(diag_m ,lt_m )
998C---------------------
999citask0 END IF !(ITASK == 0) THEN
1000C----------------------
1001c CALL MY_BARRIER
1002C---------------------
1003 maxc=maxb
1004 IF (maxc>10000) then
1005 maxa = max_l
1006 ELSE
1007 maxa = 1+(maxc*(maxc-1))/2
1008 ENDIF
1009 maxs1=iadk(nddl+1)-iadk(idlft1+1)
1010C ----------to do // inside IMP_FSA_INVH
1011 CALL imp_fsa_invhp(
1012 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1013 2 lt_k ,diag_m,lt_m ,maxc ,maxa ,
1014 4 inega ,idlft0,idlft1,maxs1 )
1015C----------------------
1016c CALL MY_BARRIER
1017C---------------------
1018citask0 IF (ITASK == 0) THEN
1019C---------------------
1020 DO i=1,idlft0
1021 diag_m(i) = zero
1022 DO j=iadk(i),iadk(i+1)-1
1023 lt_m(j)=zero
1024 ENDDO
1025 ENDDO
1026 ig = inega
1027 IF (nspmd>1) CALL spmd_max_i(inega)
1028 IF (inega>0.AND.isolv/=2.AND.ncycle>1)istop=inega
1029 IF (nsl>0)
1030 . CALL imp_diagsn(diag_k,ndof,nsl,ipari,intbuf_tab,irbe3,lrbe3,irbe2)
1031 inega = ig
1032 IF (nmonv>0)
1033 . CALL monv_diag(diag_k,ndof,ipari,intbuf_tab,irbe3,lrbe3,irbe2,1)
1034 ELSE
1035C WRITE()''
1036 ENDIF
1037C---------------------
1038citask0 END IF !(ITASK == 0) THEN
1039
1040 ENDIF
1041C
1042 IF(nne > 0)THEN
1043 WRITE(iout,2001)nne
1044 WRITE(istdo,2001)nne
1045 ENDIF
1046! IF (IMON>0) CALL STOPTIME(TIMERS,32)
1047 IF (istop>0) RETURN
1048C
1049citask0 IF (ITASK == 0) THEN
1050 IF (intp_c<0) THEN
1051 DO i=1,nddli
1052 j=itok(i)
1053 diag_k(j)=diag_k(j)-diag_i(i)
1054 ENDDO
1055 ENDIF
1056C------
1057 CALL set_ksym(nddl,iadk,jdik,lt_k,iadk0,jdik0,lt_k0)
1058 IF (iprec == 5)
1059 1 CALL set_ksym(nddl,iadk,jdik,lt_m,iadm0,jdim0,lt_m0)
1060citask0 END IF !(ITASK == 0) THEN
1061C----------------------
1062c CALL MY_BARRIER
1063C---------------------
1064C IF (IMON>0) CALL STARTIME(TIMERS,33)
1065!$OMP PARALLEL PRIVATE(ITSK)
1066 itsk = omp_get_thread_num()
1067 IF (isolv==1.OR.isolv==7.OR.isolv==8) THEN
1068 CALL imp_pcgh( iprec ,
1069 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1070 2 lt_k ,nddli ,itok ,iadi ,jdii ,
1071 3 lt_i ,nnzm ,iadk ,jdik ,diag_m ,
1072 4 lt_m ,x ,f ,itol ,tol ,
1073 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
1074 6 l_lim ,p_mach,f_u ,istop ,
1075 8 w_ddl ,a ,ar ,ve ,ms ,
1076 9 xe ,d ,dr ,ndof ,ipari ,
1077 a intbuf_tab ,num_imp,ns_imp,ne_imp,
1078 b nsrem ,nsl ,nmonv ,imonv ,monvol,
1079 c igrsurf,volmon,fr_mv,ibfv ,
1080 d skew ,xframe ,gbid ,ibid ,ibid ,
1081 e ibid ,ibid ,ibid ,rbid ,ibid ,
1082 f ibid ,mbid ,ibid ,isolv ,ibid ,
1083 g ibid ,ibid ,ibid ,ind_imp,xi_c ,
1084 h f0 ,nddli_g,intp_c,irbe3 ,lrbe3,
1085 i irbe2 ,lrbe2 )
1086 ELSEIF (isolv == 9) THEN
1087 CALL imp_ppcgh( iprec ,
1088 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1089 2 lt_k ,nddli ,itok ,iadi ,jdii ,
1090 3 lt_i ,nnzm ,iadk ,jdik ,diag_m ,
1091 4 lt_m ,x ,f ,itol ,tol ,
1092 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
1093 6 l_lim ,p_mach,f_u ,istop ,
1094 8 w_ddl ,a ,ar ,ve ,ms ,
1095 9 xe ,d ,dr ,ndof ,ipari ,
1096 a intbuf_tab ,num_imp,ns_imp,ne_imp,
1097 b nsrem ,nsl ,nmonv ,imonv ,monvol,
1098 c igrsurf ,volmon,fr_mv,ibfv ,
1099 d skew ,xframe ,gbid ,ibid ,ibid ,
1100 e ibid ,ibid ,ibid ,rbid ,ibid ,
1101 f ibid ,mbid ,ibid ,isolv ,ibid ,
1102 g ibid ,ibid ,ibid ,ind_imp,xi_c ,
1103 h f0 ,nddli_g,intp_c,irbe3 ,lrbe3,
1104 i irbe2 ,lrbe2 )
1105 ELSEIF (isolv==2.AND.itsk==0) THEN
1106 shift=zero
1107 CALL imp_lanzp(iprec ,
1108 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1109 2 lt_k ,nddli ,itok ,iadi ,jdii ,
1110 3 lt_i ,nnzm ,iadk ,jdik ,diag_m ,
1111 4 lt_m ,x ,f ,itol ,tol ,
1112 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
1113 6 shift ,kcond ,l_lim ,p_mach,f_u ,
1114 7 istop ,w_ddl ,a ,ar ,
1115 9 ve ,ms ,xe ,d ,dr ,
1116 a ndof ,ipari ,intbuf_tab ,num_imp,
1117 b ns_imp,ne_imp,nsrem ,nsl ,nmonv ,
1118 c imonv ,monvol,igrsurf,volmon,
1119 d fr_mv ,ibfv ,skew ,xframe,ind_imp,
1120 h xi_c ,f0 ,nddli_g,intp_c,irbe3 ,
1121 e lrbe3 ,irbe2 ,lrbe2 )
1122 ENDIF
1123!$OMP END PARALLEL
1124C
1125C IF (IMON>0) CALL STOPTIME(TIMERS,33)
1126C--------------------------------------------
1127 1002 FORMAT(3x,'PRECONDITION METHOD : JACOBIEN '/)
1128 1003 FORMAT(3x,'PRECONDITION METHOD : Ic0 ')
1129 1004 FORMAT(3x,'PRECONDITION METHOD : Ic0_stab ')
1130 1009 FORMAT(3x,'PRECONDITION METHOD : FSAI_R ' )
1131 2001 FORMAT(3x,'---WARNING :',i8,3x,
1132 . 'TOO SMALL PIVOT IN FACTORIZATION'/)
1133 RETURN
1134#endif
imp_diags
subroutine imp_diags(diag_k, ndof, nsl, ipari, intbuf_tab, irbe3, lrbe3, irbe2)
Definition imp_fri.F:2175
imp_diagsn
subroutine imp_diagsn(diag_k, ndof, nsl, ipari, intbuf_tab, irbe3, lrbe3, irbe2)
Definition imp_fri.F:2289
fr_dlft
subroutine fr_dlft(nddl, idlft0, idlft1)
Definition imp_fri.F:4349
imp_fsa_invhp
subroutine imp_fsa_invhp(nddl, nnz, iadk, jdik, diag_k, lt_k, diag_m, lt_m, maxc, max_a, nne, idlft0, idlft1, max_d)
Definition imp_fsa_inv.F:1723
spmd_sumf_k
subroutine spmd_sumf_k(diag_k, l_k)
Definition imp_spmd.F:1864
spmd_sumf_v
subroutine spmd_sumf_v(v)
Definition imp_spmd.F:1650
spmd_max_i
subroutine spmd_max_i(n)
Definition imp_spmd.F:1362
max
#define max(a, b)
Definition macros.h:21
monv_diag
subroutine monv_diag(diag_k, ndof, ipari, intbuf_tab, irbe3, lrbe3, irbe2, iflag)
Definition monv_imp0.F:1578
imp_workh::jdim0
integer, dimension(:), allocatable jdim0
Definition impbufdef_mod.F:584
imp_workh::iadm0
integer, dimension(:), allocatable iadm0
Definition impbufdef_mod.F:584

◆ lin_solvhm()

subroutine lin_solvhm ( tol,
integer nddl,
integer nnz,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer nddli,
integer, dimension(*) itok,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
lt_i,
x,
f,
integer itask,
integer iprint,
f_u,
integer isolv,
integer iprec,
integer l_lim,
integer itol,
integer, dimension(*) w_ddl,
a,
ar,
ve,
ms,
xe,
d,
dr,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer nsrem,
integer nsl,
p_mach,
integer istop,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) monvol,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) fr_mv,
volmon,
integer, dimension(*) ibfv,
skew,
xframe,
type(prgraph), dimension(*) graphe,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) itab,
integer insolv,
integer itn,
fac_k,
integer, dimension(*) ipiv_k,
integer nk,
integer mumps_par,
integer, dimension(*) cddlp,
integer idsc,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) inloc,
diag_i,
integer iline,
integer ilintf,
integer, dimension(*) ind_imp,
xi_c,
f0,
integer nddli_g,
integer intp_c,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2,
integer it_pcg,
integer imumpsv )

Definition at line 1432 of file lin_solv.F.

1449C-----------------------------------------------
1450C M o d u l e s
1451C-----------------------------------------------
1452 USE dsgraph_mod
1453 USE imp_workh
1454 USE intbufdef_mod
1455 USE groupdef_mod
1456C-----------------------------------------------
1457C I m p l i c i t T y p e s
1458C-----------------------------------------------
1459#include "implicit_f.inc"
1460C-----------------------------------------------
1461C C o m m o n B l o c k s
1462C-----------------------------------------------
1463#include "com01_c.inc"
1464#include "com04_c.inc"
1465#include "timeri_c.inc"
1466#if defined(MUMPS5)
1467#include "dmumps_struc.h"
1468#endif
1469C-----------------------------------------------
1470C D u m m y A r g u m e n t s
1471C-----------------------------------------------
1472C----------resol [K]{X}={F}------wothout precoditioner----
1473 INTEGER NDDL ,NNZ ,IADK(*),JDIK(*),ITASK,IPRINT,ISTOP,
1474 . NDDLI ,ITOK(*) ,IADI(*),JDII(*),
1475 . ISOLV ,IPREC ,L_LIM,ITOL,W_DDL(*),IBFV(*)
1476 INTEGER NDOF(*),NE_IMP(*),NSREM ,NSL,NDDLI_G,
1477 . IPARI(*) ,NUM_IMP(*),NS_IMP(*),IND_IMP(*)
1478 INTEGER NMONV,IMONV(*),MONVOL(*),FR_MV(*)
1479 INTEGER IAD_ELEM(2,*), FR_ELEM(*), ITAB(*),
1480 . INSOLV, ITN, IPIV_K(*), NK, CDDLP(*),IDSC,
1481 . IDDL(*), IKC(*), INLOC(*),ILINE ,ILINTF,INTP_C,
1482 . IRBE3(*) ,LRBE3(*) ,IRBE2(*) ,LRBE2(*) ,IT_PCG,IMUMPSV
1483C REAL
1484 my_real
1485 . diag_k(*),lt_k(*),lt_i(*), x(*) ,f(*),tol,f_u,p_mach,
1486 . diag_i(*),xi_c(*),f0(*)
1487 my_real
1488 . a(3,*),ar(3,*),ve(3,*),d(3,*),dr(3,*),xe(3,*),
1489 . ms(*),volmon(*),skew(*) ,xframe(*),fac_k(*)
1490 TYPE(PRGRAPH) :: GRAPHE(*)
1491 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1492 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
1493C
1494#ifdef MUMPS5
1495 TYPE(DMUMPS_STRUC) MUMPS_PAR
1496#else
1497 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
1498 INTEGER MUMPS_PAR
1499#endif
1500C
1501#ifdef MUMPS5
1502C-----------------------------------------------
1503C L o c a l V a r i a b l e s
1504C-----------------------------------------------
1505 INTEGER I,J,NNZM,LENV,IBID,ISOL,IERR,IDS,ITSK
1506 my_real
1507 . shift,kcond,rbid
1508 INTEGER OMP_GET_THREAD_NUM
1509 EXTERNAL omp_get_thread_num
1510C
1511C-----------------------------------------------
1512 nnzm = 0
1513 isol = isolv-2
1514C------to avoid the modif of IDSC with LIN_SOLV2,LIN_SOLVP2 :issue oof nt>1
1515 ids = idsc
1516C IF (IMON>0) CALL STARTIME(TIMERS,33)
1517 IF (idsc==0) THEN
1518citask0 IF (ITASK==0) THEN
1519 IF (intp_c>=0) THEN
1520 DO i=1,nddli
1521 j=itok(i)
1522 diag_k(j)=diag_k(j)+diag_i(i)
1523 ENDDO
1524 ENDIF
1525 CALL set_ksym(nddl,iadk,jdik,lt_k,iadk0,jdik0,lt_k0)
1526citask0 END IF !(ITASK==0) THEN
1527C----------------------
1528c CALL MY_BARRIER
1529C---------------------
1530!$OMP PARALLEL PRIVATE(ITSK)
1531 itsk = omp_get_thread_num()
1532 CALL imp_pcgh( iprec ,
1533 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1534 2 lt_k ,nddli ,itok ,iadi ,jdii ,
1535 3 lt_i ,nnzm ,iadk ,jdik ,diag_k ,
1536 4 lt_k ,x ,f ,itol ,tol ,
1537 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
1538 6 l_lim ,p_mach,f_u ,istop ,
1539 8 w_ddl ,a ,ar ,ve ,ms ,
1540 9 xe ,d ,dr ,ndof ,ipari ,
1541 a intbuf_tab ,num_imp,ns_imp,ne_imp,
1542 b nsrem ,nsl ,nmonv ,imonv ,monvol,
1543 c igrsurf,volmon,fr_mv,ibfv ,
1544 d skew ,xframe ,graphe,iad_elem,fr_elem,
1545 e insolv ,itn ,fac_k ,ipiv_k,nk ,
1546 f itab ,mumps_par,cddlp,isol,idsc ,
1547 g iddl ,ikc ,inloc ,ind_imp,xi_c ,
1548 h f0 ,nddli_g,intp_c,irbe3 ,lrbe3 ,
1549 i irbe2 ,lrbe2 )
1550!$omp END parallel
1551 ELSE
1552! IF (IMON>0) CALL STARTIME(TIMERS,32)
1553 IF (nspmd == 1.AND.imumpsv==0) THEN
1554 CALL lin_solv2(
1555 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1556 2 lt_k ,nddli ,itok ,iadi ,jdii ,
1557 3 lt_i ,x ,f ,itask ,iprint ,
1558 4 isol ,istop ,graphe,itab ,insolv,
1559 5 itn ,fac_k ,ipiv_k,nk ,diag_i,
1560 6 ids )
1561 ELSE
1562 CALL lin_solvp2(graphe, f, nddl, iad_elem, fr_elem,
1563 1 diag_k, lt_k, iadk, jdik, x,
1564 2 itab, iprint, nddli, iadi, jdii,
1565 3 diag_i, lt_i, itok, insolv, itn,
1566 4 fac_k, ipiv_k, nk, mumps_par, cddlp,
1567 5 isol , ids , iddl, ikc, inloc,
1568 6 ndof , itask )
1569 END IF
1570! IF (IMON>0) CALL STOPTIME(TIMERS,32)
1571citask0 END IF !(ITASK==0) THEN
1572Cas --imcompabilite avec MONVOL-----
1573 IF (nmonv>0)THEN
1574 IF (iline==0.OR.(iline>0.AND.ilintf==0) )THEN
1575citask0 IF (ITASK==0) THEN
1576 IF (intp_c>=0) THEN
1577 DO i=1,nddli
1578 j=itok(i)
1579 diag_k(j)=diag_k(j)+diag_i(i)
1580 ENDDO
1581 ENDIF
1582citask0 END IF !(ITASK==0) THEN
1583C----------------------
1584c CALL MY_BARRIER
1585C---------------------
1586!$OMP PARALLEL PRIVATE(ITSK)
1587 itsk = omp_get_thread_num()
1588 CALL imp_pcgh( iprec ,
1589 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1590 2 lt_k ,nddli ,itok ,iadi ,jdii ,
1591 3 lt_i ,nnzm ,iadk ,jdik ,diag_k ,
1592 4 lt_k ,x ,f ,itol ,tol ,
1593 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
1594 6 l_lim ,p_mach,f_u ,istop ,
1595 8 w_ddl ,a ,ar ,ve ,ms ,
1596 9 xe ,d ,dr ,ndof ,ipari ,
1597 a intbuf_tab ,num_imp,ns_imp,ne_imp,
1598 b nsrem ,nsl ,nmonv ,imonv ,monvol,
1599 c igrsurf,volmon,fr_mv,ibfv ,
1600 d skew ,xframe ,graphe,iad_elem,fr_elem,
1601 e insolv ,itn ,fac_k ,ipiv_k,nk ,
1602 f itab ,mumps_par,cddlp,isol,idsc ,
1603 g iddl ,ikc ,inloc ,ind_imp,xi_c ,
1604 h f0 ,nddli_g,intp_c,irbe3 ,lrbe3,
1605 i irbe2 ,lrbe2 )
1606!$OMP END PARALLEL
1607 ENDIF
1608 ENDIF
1609 ENDIF
1610C
1611C----------------------
1612c CALL MY_BARRIER
1613C---------------------
1614citask0 IF (ITASK == 0) THEN
1615 IF (it_pcg<0) THEN
1616 idsc = 1
1617 it_pcg = -it_pcg
1618 ELSE
1619 idsc = 0
1620 ENDIF
1621citask0 END IF !(ITASK == 0) THEN
1622C----------------------
1623c CALL MY_BARRIER
1624C---------------------
1625C IF (IMON>0) CALL STOPTIME(TIMERS,33)
1626 RETURN
1627#endif

◆ lin_solvih2()

subroutine lin_solvih2 ( tol,
integer n_pat,
integer maxb1,
integer nddl,
integer nnz,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer nddli,
integer, dimension(*) itok,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
lt_i,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
x,
f,
integer max_l,
d_tol,
integer itask,
integer icprec,
integer iprint,
f_u,
integer isolv,
integer iprec,
integer l_lim,
integer itol,
integer inega,
integer, dimension(*) w_ddl,
a,
ar,
ve,
ms,
xe,
d,
dr,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer nsrem,
integer nsl,
p_mach,
integer maxb,
integer istop,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) monvol,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) fr_mv,
volmon,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(*) ind_imp,
diag_i,
xi_c,
f0,
integer nddli_g,
integer intp_c,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 1161 of file lin_solv.F.

1176C-----------------------------------------------
1177C M o d u l e s
1178C-----------------------------------------------
1179 USE dsgraph_mod
1180 USE imp_workh
1181 USE intbufdef_mod
1182 USE groupdef_mod
1183C-----------------------------------------------
1184C I m p l i c i t T y p e s
1185C-----------------------------------------------
1186#include "implicit_f.inc"
1187C-----------------------------------------------
1188C C o m m o n B l o c k s
1189C-----------------------------------------------
1190#include "com01_c.inc"
1191#include "com04_c.inc"
1192#include "timeri_c.inc"
1193#include "units_c.inc"
1194#if defined(MUMPS5)
1195#include "dmumps_struc.h"
1196#endif
1197#include "task_c.inc"
1198C-----------------------------------------------
1199C D u m m y A r g u m e n t s
1200C-----------------------------------------------
1201C----------resol [K]{X}={F}------
1202 INTEGER NDDL ,NNZ ,IADK(*),JDIK(*),ITASK,IPRINT,ICPREC,
1203 . ISTOP,NDDLI ,ITOK(*) ,IADI(*),JDII(*),
1204 . ISOLV ,IPREC ,L_LIM ,MAXB,ITOL,INEGA,INTP_C,
1205 . W_DDL(*),IBFV(*) ,IADM(*),JDIM(*),MAX_L,N_PAT,MAXB1
1206 INTEGER NDOF(*),NE_IMP(*),NSREM ,NSL,NDDLI_G,
1207 . IPARI(*) ,NUM_IMP(*),NS_IMP(*),IND_IMP(*) ,
1208 . IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
1209 INTEGER NMONV,IMONV(*),MONVOL(*),FR_MV(*)
1210C REAL
1211 my_real
1212 . diag_k(*),lt_k(*),lt_i(*),diag_m(*),lt_m(*),
1213 . x(*) ,f(*),tol,f_u,p_mach,d_tol,xi_c(*),f0(*)
1214 my_real
1215 . a(3,*),ar(3,*),ve(3,*),d(3,*),dr(3,*),xe(3,*),
1216 . ms(*),volmon(*),skew(*) ,xframe(*),diag_i(*)
1217
1218 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1219 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
1220#ifdef MUMPS5
1221C-----------------------------------------------
1222C L o c a l V a r i a b l e s
1223C-----------------------------------------------
1224 INTEGER I,J,NNE,NNZM,MAXC,MAXA,LEN,LENV, IDLFT0,IDLFT1
1225 INTEGER MAXS0,MAXS1,IG,IBID,IERR,ITSK
1226 my_real
1227 . shift ,kcond,fac,rbid
1228 TYPE(PRGRAPH) :: GBID
1229 TYPE(DMUMPS_STRUC) MBID
1230C
1231 INTEGER OMP_GET_THREAD_NUM
1232 EXTERNAL omp_get_thread_num
1233C
1234C------------------------------------------
1235c isolv=1 => P.G.C.
1236C------------------------------------------
1237C------------------------------------------
1238c iprec=2 => jacobien
1239c iprec=5 => fsai static same pattern of [K}
1240C------------------------------------------
1241C------------------------------------------
1242C [K]:matrice de rigidite [M]:matrice de preconditionnement
1243 istop = inega
1244C
1245! IF (IMON>0.AND.ITASK==0) CALL STARTIME(TIMERS,32)
1246 IF (icprec==1) THEN
1247 IF (iprec==5) THEN
1248C ----- approx. (by each colonne of L_T) inverse ---------
1249C ----- utilise d'abord la place de [M] pour la matrice assemblee ---------
1250 IF (nspmd==1) THEN
1251 idlft0=0
1252 idlft1=0
1253 ELSE
1254 CALL fr_dlft(nddl,idlft0,idlft1)
1255 ENDIF
1256citask0 IF (ITASK == 0) THEN
1257C-------use [M] for [K] assemblage--------------
1258 IF (nsl>0)
1259 . CALL imp_diags(diag_k ,ndof,nsl,ipari,intbuf_tab,irbe3,lrbe3,irbe2)
1260 IF (nmonv>0)
1261 . CALL monv_diag(diag_k,ndof,ipari,intbuf_tab,irbe3 ,lrbe3 ,irbe2,0)
1262 DO i=1,idlft0
1263 diag_m(i) = diag_k(i)
1264 DO j=iadk(i),iadk(i+1)-1
1265 lt_m(j)=lt_k(j)
1266 ENDDO
1267 ENDDO
1268 DO i=idlft1+1,nddl
1269 diag_m(i) = diag_k(i)
1270 DO j=iadk(i),iadk(i+1)-1
1271 lt_m(j)=lt_k(j)
1272 ENDDO
1273 ENDDO
1274C
1275 IF (nspmd>1) CALL spmd_sumf_k(diag_m ,lt_m )
1276C
1277 CALL ind_span(n_pat,idlft0,nddl,iadk,jdik,iadm,jdim,w_maxl,maxb1)
1278citask0 END IF !(ITASK == 0) THEN
1279C----------------------
1280c CALL MY_BARRIER
1281C---------------------
1282 maxc = w_maxl
1283 IF (maxc>10000) THEN
1284 maxa = max_l
1285 ELSE
1286 maxa = 1+(maxc*(maxc-1))/2
1287 ENDIF
1288 maxs1=iadk(nddl+1)-iadk(idlft1+1)
1289C---------------------
1290C----------to add // inside
1291 CALL imp_fsa_inv2hp(
1292 1 nddl ,iadk ,jdik ,diag_k ,lt_k ,
1293 2 iadm ,jdim ,diag_m ,lt_m ,maxc ,
1294 3 maxa ,inega ,idlft0 ,idlft1 ,maxs1 ,
1295 4 d_tol ,p_mach )
1296C----------------------
1297c CALL MY_BARRIER
1298C---------------------
1299citask0 IF (ITASK == 0) THEN
1300C-------
1301 DO i=1,idlft0
1302 diag_m(i) = zero
1303 DO j=iadm(i),iadm(i+1)-1
1304 lt_m(j)=zero
1305 ENDDO
1306 ENDDO
1307 ig = inega
1308 IF (nspmd>1) CALL spmd_max_i(inega)
1309 IF (inega>0.AND.isolv/=2.AND.ncycle>1)istop=inega
1310 IF (nsl>0)
1311 . CALL imp_diagsn(diag_k,ndof,nsl,ipari,intbuf_tab,irbe3,lrbe3,irbe2)
1312 inega = ig
1313 IF (nmonv>0)
1314 . CALL monv_diag(diag_k,ndof,ipari,intbuf_tab,irbe3,lrbe3,irbe2,1)
1315 ELSE
1316C WRITE()''
1317 ENDIF
1318C---------------------
1319citask0 END IF !(ITASK == 0) THEN
1320
1321 ENDIF
1322C
1323! IF (IMON>0) CALL STOPTIME(TIMERS,32)
1324 IF (istop>0) RETURN
1325C
1326citask0 IF (ITASK == 0) THEN
1327C-------
1328 nnzm = iadm(nddl+1)-iadm(1)
1329 fac=one*nnzm/nnz/nspmd
1330 IF (nspmd > 1) CALL spmd_sum_s(fac)
1331 IF (ispmd==0.AND.iprint/=0) THEN
1332 WRITE(iout,1002)fac
1333 IF (iprint<0) WRITE(istdo,1002)fac
1334 ENDIF
1335C
1336 IF (intp_c<0) THEN
1337 DO i=1,nddli
1338 j=itok(i)
1339 diag_k(j)=diag_k(j)-diag_i(i)
1340 ENDDO
1341 ENDIF
1342C
1343 CALL set_ksym(nddl,iadk,jdik,lt_k,iadk0,jdik0,lt_k0)
1344 IF (iprec == 5)
1345 1 CALL set_ksym(nddl,iadm,jdim,lt_m,iadm0,jdim0,lt_m0)
1346citask0 END IF !(ITASK == 0) THEN
1347C----------------------
1348c CALL MY_BARRIER
1349C---------------------
1350!$OMP PARALLEL PRIVATE(ITSK)
1351 itsk = omp_get_thread_num()
1352 IF (isolv==1.OR.isolv==7.OR.isolv==8) THEN
1353 CALL imp_pcgh( iprec ,
1354 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1355 2 lt_k ,nddli ,itok ,iadi ,jdii ,
1356 3 lt_i ,nnzm ,iadm ,jdim ,diag_m ,
1357 4 lt_m ,x ,f ,itol ,tol ,
1358 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
1359 6 l_lim ,p_mach,f_u ,istop ,
1360 8 w_ddl ,a ,ar ,ve ,ms ,
1361 9 xe ,d ,dr ,ndof ,ipari ,
1362 a intbuf_tab ,num_imp,ns_imp,ne_imp,
1363 b nsrem ,nsl ,nmonv ,imonv ,monvol,
1364 c igrsurf,volmon,fr_mv,ibfv ,
1365 d skew ,xframe ,gbid ,ibid ,ibid ,
1366 e ibid ,ibid ,ibid ,rbid ,ibid ,
1367 f ibid ,mbid ,ibid ,isolv ,ibid ,
1368 g ibid ,ibid ,ibid ,ind_imp,xi_c ,
1369 h f0 ,nddli_g,intp_c,irbe3 ,lrbe3,
1370 i irbe2 ,lrbe2 )
1371 ELSEIF (isolv == 9) THEN
1372 CALL imp_ppcgh( iprec ,
1373 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1374 2 lt_k ,nddli ,itok ,iadi ,jdii ,
1375 3 lt_i ,nnzm ,iadm ,jdim ,diag_m ,
1376 4 lt_m ,x ,f ,itol ,tol ,
1377 5 pcg_w1,pcg_w2,pcg_w3,itsk ,iprint ,
1378 6 l_lim ,p_mach,f_u ,istop ,
1379 8 w_ddl ,a ,ar ,ve ,ms ,
1380 9 xe ,d ,dr ,ndof ,ipari ,
1381 a intbuf_tab ,num_imp,ns_imp,ne_imp,
1382 b nsrem ,nsl ,nmonv ,imonv ,monvol,
1383 c igrsurf ,volmon,fr_mv,ibfv ,
1384 d skew ,xframe ,gbid ,ibid ,ibid ,
1385 e ibid ,ibid ,ibid ,rbid ,ibid ,
1386 f ibid ,mbid ,ibid ,isolv ,ibid ,
1387 g ibid ,ibid ,ibid ,ind_imp,xi_c ,
1388 h f0 ,nddli_g,intp_c,irbe3 ,lrbe3,
1389 i irbe2 ,lrbe2 )
1390 ELSEIF (isolv==2.AND.itsk==0) THEN
1391 shift=zero
1392 CALL imp_lanzp(iprec ,
1393 1 nddl ,nnz ,iadk ,jdik ,diag_k ,
1394 2 lt_k ,nddli ,itok ,iadi ,jdii ,
1395 3 lt_i ,nnzm ,iadm ,jdim ,diag_m ,
1396 4 lt_m ,x ,f ,itol ,tol ,
1397 5 pcg_w1,pcg_w2,pcg_w3,itask ,iprint ,
1398 6 shift ,kcond ,l_lim ,p_mach,f_u ,
1399 7 istop ,w_ddl ,a ,ar ,
1400 9 ve ,ms ,xe ,d ,dr ,
1401 a ndof ,ipari ,intbuf_tab ,num_imp,
1402 b ns_imp,ne_imp,nsrem ,nsl ,nmonv ,
1403 c imonv ,monvol,igrsurf ,volmon,
1404 d fr_mv ,ibfv ,skew ,xframe,ind_imp,
1405 h xi_c ,f0 ,nddli_g,intp_c,irbe3 ,
1406 e lrbe3 ,irbe2 ,lrbe2 )
1407 ENDIF
1408!$OMP END PARALLEL
1409C
1410C IF (IMON>0) CALL STOPTIME(TIMERS,33)
1411 1002 FORMAT(3x,'END PRECONDITION WITH RELATIVE DENSITY =',e11.4/)
1412C--------------------------------------------
1413 RETURN
1414#endif
imp_fsa_inv2hp
subroutine imp_fsa_inv2hp(nddl, iadk, jdik, diag_k, lt_k, iadm, jdim, diag_m, lt_m, maxc, max_a, nne, idlft0, idlft1, max_d, d_tol, p_mach)
Definition imp_fsa_inv.F:1814
spmd_sum_s
subroutine spmd_sum_s(s)
Definition imp_spmd.F:1037
ind_span
subroutine ind_span(nn, ndf, nddl, iadk, jdik, iadm, jdim, l_max, ndmax)
Definition ind_glob_k.F:7186
imp_workh::w_maxl
integer w_maxl
Definition impbufdef_mod.F:573

◆ lin_solvp2()

subroutine lin_solvp2 ( type(prgraph), dimension(*) graphe,
f,
integer nddl,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
diag_k,
lt_k,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
x,
integer, dimension(*) itab,
integer iprint,
integer nddli,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
diag_i,
lt_i,
integer, dimension(*) itok,
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 itask )

Definition at line 524 of file lin_solv.F.

531C-----------------------------------------------
532C M o d u l e s
533C-----------------------------------------------
534 USE dsgraph_mod
535C-----------------------------------------------
536C I m p l i c i t T y p e s
537C-----------------------------------------------
538#include "implicit_f.inc"
539C-----------------------------------------------
540C C o m m o n B l o c k s
541C-----------------------------------------------
542#if defined(MUMPS5)
543#include "dmumps_struc.h"
544#endif
545#include "com04_c.inc"
546C-----------------------------------------------
547C D u m m y A r g u m e n t s
548C-----------------------------------------------
549 INTEGER NDDL, IAD_ELEM(2,*), FR_ELEM(*), IADK(*), JDIK(*),
550 . ITAB(*), IPRINT, NDDLI, IADI(*), JDII(*), ITOK(*),
551 . INSOLV, IT, IPIV_K(*), NK, CDDLP(*), ISOLV, IDSC,
552 . IDDL(*), IKC(*), INLOC(*), NDOF(*), ITASK
553 my_real
554 . f(*), diag_k(*), lt_k(*), x(*), diag_i(*), lt_i(*),
555 . fac_k(*)
556 TYPE(PRGRAPH) :: GRAPHE(*)
557C
558#ifdef MUMPS5
559 TYPE(DMUMPS_STRUC) MUMPS_PAR
560#else
561 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
562 INTEGER MUMPS_PAR
563#endif
564
565#ifdef MUMPS5
566C-----------------------------------------------
567C L o c a l V a r i a b l e s
568C-----------------------------------------------
569 INTEGER NF, I, ITAG(NUMNOD), J
570 my_real
571 . f1(nddl)
572C---------------------------------------
573C IF (IMON>0) CALL STARTIME(33,ITASK+1)
574 IF (isolv==3) THEN
575 CALL mumpslb(f ,f1 , nddl , iad_elem , fr_elem,
576 1 iddl , ikc , inloc ,ndof ,itag )
577C
578 CALL imp_mumps2(mumps_par, cddlp, f1 , x, nddl)
579C
580 ELSEIF (isolv==4) THEN
581 nf=1
582C Division des forces exterieures sur les ddls de la frontiere par le nombre
583C de processeurs auxquels ils appartiennent (elles sont reassemblees dans DSRESOL)
584 CALL imp_dsfext(graphe , nf, f, nddl, iad_elem,
585 . fr_elem)
586C
587 IF (insolv==0) THEN
588 CALL imp_dsolv(graphe, diag_k, lt_k, iadk, jdik,
589 . nddl, nf, f, x, itab,
590 . iprint, nddli, iadi, jdii, diag_i,
591 . lt_i, itok )
592 ELSE
593 CALL imp_dsolv_iter(graphe, diag_k, lt_k, iadk, jdik,
594 . nddl, nf, f, x, itab,
595 . it, fac_k, ipiv_k, nk, iprint,
596 . nddli, iadi, jdii, diag_i, lt_i,
597 . itok )
598 ENDIF
599 ENDIF
600 IF (insolv/=0) idsc=0
601C IF (IMON>0) CALL STOPTIME(33,ITASK+1)
602C
603 RETURN
604#endif
imp_dsfext
subroutine imp_dsfext(graphe, nf, f, nddl, iad_elem, fr_elem)
Definition imp_dsfext.F:32
imp_mumps2
subroutine imp_mumps2(mumps_par, cddlp, f, x, nddl)
Definition imp_mumps.F:498
mumpslb
subroutine mumpslb(f, f1, nddl, iad_elem, fr_elem, iddl, ikc, inloc, ndof, itag)
Definition lin_solv.F:1827

◆ mumpslb()

subroutine mumpslb ( f,
f1,
integer nddl,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) inloc,
integer, dimension(*) ndof,
integer, dimension(*) itag )

Definition at line 1825 of file lin_solv.F.

1827C-----------------------------------------------
1828C M o d u l e s
1829C-----------------------------------------------
1830 USE dsgraph_mod
1831C-----------------------------------------------
1832C I m p l i c i t T y p e s
1833C-----------------------------------------------
1834#include "implicit_f.inc"
1835C-----------------------------------------------
1836C C o m m o n B l o c k s
1837C-----------------------------------------------
1838#include "com01_c.inc"
1839#include "com04_c.inc"
1840C-----------------------------------------------
1841C D u m m y A r g u m e n t s
1842C-----------------------------------------------
1843 INTEGER NDDL, IAD_ELEM(2,*), FR_ELEM(*),
1844 . IDDL(*), IKC(*), INLOC(*), NDOF(*),ITAG(*)
1845 my_real
1846 . f(*),f1(*)
1847#ifdef MUMPS5
1848C-----------------------------------------------
1849C L o c a l V a r i a b l e s
1850C-----------------------------------------------
1851 INTEGER NF, I, J, N, NKC, ND, ID
1852 INTEGER ITSK,F_NOD ,L_NOD,F_DDL ,L_DDL
1853C
1854 DO i=1 ,nddl
1855 f1(i)=f(i)
1856 ENDDO
1857 IF (nspmd > 1 ) THEN
1858 DO n=1,numnod
1859c I=INLOC(N)
1860 itag(n)=1
1861 ENDDO
1862C
1863 DO i=1,nspmd
1864 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1865 n=fr_elem(j)
1866 itag(n)=itag(n)+1
1867 ENDDO
1868 ENDDO
1869C----------------
1870 nkc=0
1871 DO n=1,numnod
1872 i=inloc(n)
1873 DO j=1,ndof(i)
1874 nd=iddl(i)+j
1875 id=nd-nkc
1876 IF (ikc(nd)>0) THEN
1877 nkc=nkc+1
1878 ELSE
1879 IF ( itag(i) > 1 ) f1(id)=f(id)/itag(i)
1880 ENDIF
1881 ENDDO
1882 ENDDO
1883 END IF !(NSPMD > 1 ) THEN
1884C
1885 RETURN
1886#endif
id
initmumps id
Definition multiplerhs_example.m:4

◆ mumpslb_hp()

subroutine mumpslb_hp ( f,
f1,
integer nddl,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) inloc,
integer, dimension(*) ndof,
integer, dimension(*) itag )

Definition at line 1751 of file lin_solv.F.

1753C-----------------------------------------------
1754C M o d u l e s
1755C-----------------------------------------------
1756 USE dsgraph_mod
1757C-----------------------------------------------
1758C I m p l i c i t T y p e s
1759C-----------------------------------------------
1760#include "implicit_f.inc"
1761C-----------------------------------------------
1762C C o m m o n B l o c k s
1763C-----------------------------------------------
1764#include "com01_c.inc"
1765#include "com04_c.inc"
1766C-----------------------------------------------
1767C D u m m y A r g u m e n t s
1768C-----------------------------------------------
1769 INTEGER NDDL, IAD_ELEM(2,*), FR_ELEM(*),
1770 . IDDL(*), IKC(*), INLOC(*), NDOF(*),ITAG(*)
1771 my_real
1772 . f(*),f1(*)
1773#ifdef MUMPS5
1774C-----------------------------------------------
1775C L o c a l V a r i a b l e s
1776C-----------------------------------------------
1777 INTEGER NF, I, J, N, NKC, ND, ID
1778 INTEGER ITSK,F_NOD ,L_NOD,F_DDL ,L_DDL
1779C
1780!$OMP PARALLEL PRIVATE(ITSK,F_NOD ,L_NOD,F_DDL ,L_DDL,N,I,J,NKC,ND,ID)
1781 CALL imp_smpini(itsk ,f_nod ,l_nod ,numnod )
1782 CALL imp_smpini(itsk ,f_ddl ,l_ddl ,nddl )
1783 DO i=f_ddl ,l_ddl
1784 f1(i)=f(i)
1785 ENDDO
1786 IF (nspmd > 1 ) THEN
1787 DO n=f_nod ,l_nod
1788 i=inloc(n)
1789 itag(i)=1
1790 ENDDO
1791C
1792 DO i=1,nspmd
1793 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1794 n=fr_elem(j)
1795 IF ( itag(n) > 0 ) itag(n)=itag(n)+1
1796 ENDDO
1797 ENDDO
1798C----------------
1799 nkc=0
1800 DO n=f_nod ,l_nod
1801 i=inloc(n)
1802 DO j=1,ndof(i)
1803 nd=iddl(i)+j
1804 id=nd-nkc
1805 IF (ikc(nd)>0) THEN
1806 nkc=nkc+1
1807 ELSE
1808 IF ( itag(i) > 1 ) f1(id)=f(id)/itag(i)
1809 ENDIF
1810 ENDDO
1811 ENDDO
1812 END IF !(NSPMD > 1 ) THEN
1813!$OMP END PARALLEL
1814C
1815 RETURN
1816#endif

◆ recu_kdis0()

subroutine recu_kdis0 ( integer, dimension(*) ndof,
d )

Definition at line 647 of file lin_solv.F.

648C-----------------------------------------------
649C M o d u l e s
650C-----------------------------------------------
651 USE imp_knon
652C-----------------------------------------------
653C I m p l i c i t T y p e s
654C-----------------------------------------------
655#include "implicit_f.inc"
656C-----------------------------------------------
657C D u m m y A r g u m e n t s
658C-----------------------------------------------
659 INTEGER NDOF(*)
660 my_real
661 . d(3,*)
662#ifdef mumps5
663C-----------------------------------------------
664C L o c a l V a r i a b l e s
665C-----------------------------------------------
666 INTEGER I,J,N,ND
667C---------------------------------
668 DO i = 1, numn_kn
669 n = in_kn(i)
670 DO j = 1, 3
671 nd = id_kn(j,i)
672 IF (nd<0) THEN
673 d(j,n) = zero
674 ENDIF
675 ENDDO
676 ENDDO
677C
678 RETURN
679#endif
imp_knon
Definition impbufdef_mod.F:488
imp_knon::numn_kn
integer numn_kn
Definition impbufdef_mod.F:490
imp_knon::id_kn
integer, dimension(:,:), allocatable id_kn
Definition impbufdef_mod.F:493
imp_knon::in_kn
integer, dimension(:), allocatable in_kn
Definition impbufdef_mod.F:492

◆ set_kisc()

subroutine set_kisc ( integer nddl,
integer nddli,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
integer, dimension(*) itok,
lt_i,
integer, dimension(*) iadk0,
integer, dimension(*) jdik0,
lt_k0 )

Definition at line 1632 of file lin_solv.F.

1634C-----------------------------------------------
1635C I m p l i c i t T y p e s
1636C-----------------------------------------------
1637#include "implicit_f.inc"
1638C-----------------------------------------------
1639C D u m m y A r g u m e n t s
1640C-----------------------------------------------
1641 INTEGER NDDL,NDDLI,IADI(*),JDII(*),IADK0(*),JDIK0(*),ITOK(*)
1642 my_real
1643 . lt_i(*),lt_k0(*)
1644C---------[I] local sym. [K0] global complete
1645#ifdef MUMPS5
1646C-----------------------------------------------
1647C L o c a l V a r i a b l e s
1648C-----------------------------------------------
1649 INTEGER I,J,K,JD,ICOL(NDDL),NRI,I0,KTOI(NDDL)
1650C----6------------------
1651 DO i = 1, nddl
1652 icol(i) = 0
1653 ktoi(i) = 0
1654 ENDDO
1655 DO i = 1, nddli
1656 k = itok(i)
1657 icol(k) = iadi(i+1) - iadi(i)
1658 ktoi(k) = i
1659 ENDDO
1660 DO i = 1, nddli
1661 DO j = iadi(i),iadi(i+1)-1
1662 jd = itok(jdii(j))
1663 icol(jd) = icol(jd) + 1
1664 ENDDO
1665 ENDDO
1666 iadk0(1) = 1
1667 DO i = 1,nddl
1668 iadk0(i+1) = iadk0(i)+icol(i)
1669 icol(i) = 0
1670 ENDDO
1671C-----------true with initial lower-triang (default)
1672 DO i0 = 1,nddl
1673 i = ktoi(i0)
1674 IF (i==0) cycle
1675 DO j=iadi(i),iadi(i+1)-1
1676 jd = itok(jdii(j))
1677 k=iadk0(i0)+j-iadi(i)
1678 jdik0(k) = jd
1679 lt_k0(k) = lt_i(j)
1680 ENDDO
1681 icol(i0) = iadi(i+1)-iadi(i)
1682 DO j=iadi(i),iadi(i+1)-1
1683 jd = itok(jdii(j))
1684 k = iadk0(jd) + icol(jd)
1685 jdik0(k) = itok(i)
1686 lt_k0(k) = lt_i(j)
1687 icol(jd) = icol(jd) + 1
1688 ENDDO
1689 ENDDO
1690C
1691 RETURN
1692#endif