OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
imp_fac_ic.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23C ------incomplete cholesky using jennings diagnal modif----
24!||====================================================================
25!|| imp_fac_icj ../engine/source/implicit/imp_fac_ic.F
26!||--- called by ------------------------------------------------------
27!|| imp_fsai ../engine/source/implicit/imp_fsa_inv.F
28!||--- calls -----------------------------------------------------
29!|| err_mem ../engine/source/implicit/lin_solv.F
30!||====================================================================
31 SUBROUTINE imp_fac_icj(
32 1 NDDL ,NNZ ,IADK ,JDIK ,DIAG_K ,
33 2 LT_K ,IADM ,JDIM ,DIAG_M,LT_M ,
34 3 PSI ,NNZM ,MAX_L ,ISKY ,LI ,
35 4 NNE )
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER NDDL ,NNZ ,IADK(*) ,JDIK(*),NNZM ,IADM(*),JDIM(*),
44 . NNE,ISKY(*),MAX_L
45C REAL
46 my_real
47 . diag_k(*), diag_m(*), lt_k(*) ,lt_m(*) ,psi ,li(*)
48C-----------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 INTEGER I,J,K,REJ,MAXK,
52 1 K0 ,J0 ,K1, KFT,LSKY
53 my_real
54 . AII,AJJ,LKIK,S, FAC
55C-----------------------------
56C PSI = SQRT(PSI)
57 rej = 0
58 maxk = 0
59 nne = 0
60 nnzm = 0
61 iadm(1)=1
62 DO i=1,nddl
63 diag_m(i) = diag_k(i)
64 isky(i)=i
65 li(i)=zero
66 ENDDO
67C
68 DO i=1,nddl
69 aii = diag_m(i)
70 k0 = iadk(i+1) - 1
71 IF (k0>0) THEN
72 j0 = jdik(k0)
73 IF (j0>maxk) maxk=j0
74 ENDIF
75 DO j = iadk(i),k0
76 k1= jdik(j)
77 li(k1) = lt_k(j)
78C----------ISKY(J)=I for LT_K(I,J)-----
79 IF (isky(k1)==k1) isky(k1)=i
80 ENDDO
81 kft =isky(i)
82 DO k = kft,i-1
83 lsky = isky(k)
84C IF (LSKY>=IADM(K+1)) write(*,*)'found 1',i
85 IF (lsky<iadm(k+1).AND.jdim(lsky)==i) THEN
86 lkik = lt_m(lsky)/diag_m(k)
87 aii = aii -lt_m(lsky)*lkik
88 isky(k)=lsky+1
89 DO j = isky(k),iadm(k+1)-1
90 k1= jdim(j)
91C----------voir ici quand ca tombre sur diagonal---
92 li(k1) = li(k1)-lkik*lt_m(j)
93 ENDDO
94 ENDIF
95 ENDDO
96 DO 100 j = i+1 , maxk
97 IF (isky(j)==j) GOTO 100
98 s = li(j)
99 IF (s/=zero) THEN
100 li(j)=zero
101 ajj = diag_m(j)
102 IF (psi==zero) THEN
103 nnzm = nnzm +1
104 IF (nnzm>max_l) CALL err_mem(nnzm)
105 lt_m(nnzm)=s
106 jdim(nnzm)=j
107 ELSEIF (s*s<psi*aii*ajj) THEN
108 s =abs(s)
109 fac = sqrt(aii/ajj)
110 aii = aii +s*fac
111 diag_m(j) = ajj +s/fac
112 rej = rej +1
113 ELSE
114 nnzm = nnzm +1
115 IF (nnzm>max_l) CALL err_mem(nnzm)
116 lt_m(nnzm)=s
117 jdim(nnzm)=j
118 ENDIF
119 ENDIF
120 100 CONTINUE
121 IF (aii<em20) THEN
122 nne=nne+1
123 aii=sign(max(abs(aii),em20),aii)
124 ENDIF
125 diag_m(i) = one/aii
126 iadm(i+1)=nnzm+1
127 DO j = iadm(i),nnzm
128 lt_m(j)=lt_m(j)*diag_m(i)
129 ENDDO
130 isky(i)=iadm(i)
131 IF (isky(i)>nnzm) isky(i)= iadm(i)
132 ENDDO
133c IF (NNE>0) then
134c write(*,*)'--WARNING: PIVOT PROBLEM',NNE
135c DO I=1,NDDL
136c write(*,*)'diag,i,iadm=',DIAG_M(I),I,IADM(I)
137c ENDDO
138c DO J=1,NNZM
139c write(*,*)'LT_M,i,j=',LT_M(J),J,JDIM(J)
140c ENDDO
141c endif
142 RETURN
143 END
144!||====================================================================
145!|| diagmod ../engine/source/implicit/imp_fac_ic.F
146!||====================================================================
147 SUBROUTINE diagmod(J0, J1, LI, DIAG_M ,AII,ISKY)
148C-----------------------------------------------
149C I m p l i c i t T y p e s
150C-----------------------------------------------
151#include "implicit_f.inc"
152C-----------------------------------------------
153C D u m m y A r g u m e n t s
154C-----------------------------------------------
155 INTEGER J0, J1,ISKY(*)
156C REAL
157 my_real
158 . DIAG_M(*), LI(*) ,AII
159C-----------------------------------------------
160C L o c a l V a r i a b l e s
161C-----------------------------------------------
162 INTEGER J
163 my_real
164 . AJJ,S,FAC
165C-----------------------------------------------
166 DO j = j0, j1
167 IF (isky(j)/=j) THEN
168 s = li(j)
169 IF (s/=zero) THEN
170 ajj = diag_m(j)
171 s =abs(s)
172 fac = sqrt(abs(aii/ajj))
173 aii = aii +s*fac
174 IF (abs(aii)<ep30) THEN
175 ELSE
176 ENDIF
177 diag_m(j) = ajj +s/fac
178 ENDIF
179 ENDIF
180 ENDDO
181C
182 RETURN
183 END
184
diagmod
subroutine diagmod(j0, j1, li, diag_m, aii, isky)
Definition imp_fac_ic.F:148
imp_fac_icj
subroutine imp_fac_icj(nddl, nnz, iadk, jdik, diag_k, lt_k, iadm, jdim, diag_m, lt_m, psi, nnzm, max_l, isky, li, nne)
Definition imp_fac_ic.F:36
err_mem
subroutine err_mem(mem)
Definition lin_solv.F:617
max
#define max(a, b)
Definition macros.h:21