OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
imp_init.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| imp_init ../engine/source/implicit/imp_init.F
25!||--- called by ------------------------------------------------------
26!|| resol_init ../engine/source/engine/resol_init.F
27!||--- calls -----------------------------------------------------
28!|| dyna_ini ../engine/source/implicit/imp_dyna.F
29!|| ktbuf_ini ../engine/source/implicit/imp_init.F
30!|| zeror ../engine/source/system/zero.F
31!||--- uses -----------------------------------------------------
32!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
33!|| imp_aspc ../engine/share/modules/impbufdef_mod.F
34!|| imp_intm ../engine/share/modules/imp_intm.F
35!|| imp_kbcs ../engine/share/modules/impbufdef_mod.f
36!||====================================================================
37 SUBROUTINE imp_init(V,VR,IPARG,IPM,IGEO,ELBUF_TAB)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE imp_aspc
42 USE imp_kbcs
43 USE imp_intm
44 USE elbufdef_mod
45C----6------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "com08_c.inc"
55#include "impl1_c.inc"
56#include "impl2_c.inc"
57#include "param_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER IPARG(NPARG,NGROUP),IPM(NPROPMI,*),IGEO(*)
63 . v(3,*),vr(3,*)
64 TYPE(elbuf_struct_), DIMENSION(NGROUP) :: ELBUF_TAB
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER K0,IDEFKZ,IER1,IER2,IFSTRUN
70 . trest,cs1(2)
71 REAL FLMIN
72C----------------------------------------------------------
73C INIT IMPLICIT
74C----------------------------------------------------------
75 imconv=1
76 inconv =1
77C ADD FOR SOLVER AUTO SELECTION
78 ifstrun = 1
79
80 IF(impl_s==1.OR.neig>0)THEN
81 idefkz=0
82 IF (neig>0.AND.kz_tol==zero) idefkz=1
83 nnsiz=1024
84 ikpat=0
85 trest=tstop-tt
86 IF (d_tol==zero.AND.n_pat>1) d_tol=-one
87 IF (d_tol==zero) d_tol=three*em5
88 IF (iprec==5)ikpat=1
89 IF (iprec==6) THEN
90 iprec=5
91 ikpat=2
92 ENDIF
93 IF (sk_int==zero) sk_int=onep01
94C--------direct-----
95 IF (dt_imp==zero.OR.dt_imp>=trest) dt_imp=trest
96 IF (iline==1) THEN
97 dt_imp=trest
98 IF (kz_tol==zero) kz_tol=two*em4
99 ELSE
100C--------non-linear-----
101 IF (kz_tol==zero) kz_tol=five*em4
102 ENDIF
103 IF (isprb==1.AND.idyna==0) THEN
104 CALL zeror(v,numnod)
105 IF (iroddl/=0) CALL zeror(vr,numnod)
106 ENDIF
107 IF (nexp==0.OR.idyna==1) nexp=1
108 IF (intp_c>=0)THEN
109 IF (nspmd>1)THEN
110 IF (isolv>=2) intp_c = 1
111 ELSE
112 intp_c = 0
113 ENDIF
114 ENDIF
115 ENDIF
116 IF (neig>0) THEN
117 IF (idefkz==1) kz_tol=ten
118C IKG=0
119 ikpat=0
120 ikpat=1
121 IF (iautspc==1) iautspc=0
122 ENDIF
123
124 IF (idyna>0)CALL dyna_ini(1 ,numnod ,hht_a ,newm_a,newm_b,v,vr)
125C
126 nspcl = 0
127 IF (b_mcore<0) THEN
128 lmemn=1000000
129 ELSE
130 lmemn = 2*lmemv/3
131 ENDIF
132C
133C IF(INTP_C<0) IRREF = MAX(2,IRREF)
134C IF(IRREF==1.AND.IDYNA>0) IRREF = 4
135C
136 nddl_si = 0
137 nddl_sl = 0
138 nz_si = 0
139 nz_sl = 0
140C
141 ihelas=0
142 IF (ikt > 0 .OR.isprb==1) CALL ktbuf_ini(elbuf_tab,iparg ,ipm ,igeo)
143C
144 idtfix=0
145 IF (nitol==123) THEN
146 n_tol=max(n_tole,n_tolf,n_tolu)
147 ELSEIF (nitol==12) THEN
148 n_tol=max(n_tole,n_tolf)
149 ELSEIF (nitol==23) THEN
150 n_tol=max(n_tolf,n_tolu)
151 ELSEIF (nitol==13) THEN
152 n_tol=max(n_tole,n_tolu)
153 ENDIF
154C
155 RETURN
156 END
157C-----------------------------------------------
158!||====================================================================
159!|| ktbuf_ini ../engine/source/implicit/imp_init.F
160!||--- called by ------------------------------------------------------
161!|| imp_init ../engine/source/implicit/imp_init.F
162!||--- calls -----------------------------------------------------
163!|| ancmsg ../engine/source/output/message/message.F
164!|| arret ../engine/source/system/arret.F
165!|| grpreorder ../engine/source/implicit/imp_glob_k.F
166!||--- uses -----------------------------------------------------
167!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
168!|| imp_ktan ../engine/share/modules/impbufdef_mod.F
169!|| imp_ktan_def ../engine/share/modules/impbufdef_mod.F
170!|| message_mod ../engine/share/message_module/message_mod.f
171!||====================================================================
172 SUBROUTINE ktbuf_ini(ELBUF_TAB, IPARG ,IPM ,IGEO)
173C-----------------------------------------------
174C M o d u l e s
175C-----------------------------------------------
176 USE imp_ktan
177 USE message_mod
178 USE imp_ktan_def
179 USE elbufdef_mod
180C-----------------------------------------------
181C I m p l i c i t T y p e s
182C-----------------------------------------------
183#include "implicit_f.inc"
184C-----------------------------------------------
185C C o m m o n B l o c k s
186C-----------------------------------------------
187#include "com01_c.inc"
188#include "param_c.inc"
189#include "scr19_c.inc"
190#include "units_c.inc"
191#include "impl1_c.inc"
192C-----------------------------------------------
193C D u m m y A r g u m e n t s
194C-----------------------------------------------
195 INTEGER IPARG(NPARG,NGROUP),IPM(NPROPMI,*),IGEO(*)
196C-----------------------------------------------
197C L o c a l V a r i a b l e s
198C-----------------------------------------------
199 INTEGER I,IFA,IR,IS,IT,NG,BUFLEN,ERR,
200 . NEL,NPT,NPG,MLW,ISORTH,ISRATE,ISROT,IREP,ISIGV,IGTYP,
201 . ISTRA,IFAIL,NFAIL,IEOS,IXFEM,NLAY,NPTR,NPTS,NPTT,NVAR,
202 . NFT,NFT0,KFTS,ITY,JALE,OFF,ISS,ICPRE,NSG,ICNOD,ISNOD,JEUL,
203 . JHBE,JIVF,JPOR,IPLA,L_ETFAC,L_SIGE,L_A_KT,L_SUBKT,LENF,
204 . IGROUC(NGROUP),IG
205 TYPE(ktbuf_struct_) , POINTER :: KTBUF
206 TYPE(l_ktbufep_) , POINTER :: LBUF
207 TYPE(mlaw_tag_) , POINTER :: MTAG
208 TYPE(elbuf_struct_) , DIMENSION(NGROUP) :: ELBUF_TAB
209C=======================================================================
210c Element KT Buffer ini Routine (Solid,Shell)
211c------
212c 1) allocation of KTBUF_STR
213C=======================================================================
214 ALLOCATE (ktbuf_str(ngroup), stat=err)
215c-------------------------------------------------
216 lenf =0
217 CALL grpreorder(iparg, igrouc)
218 DO ig = 1,ngroup
219 ng = igrouc(ig)
220 mlw = iparg(1,ng) ! type de loi mat
221 nel = iparg(2,ng)
222 nft = iparg(3,ng)
223 npt = iparg(6,ng)
224 off = iparg(8,ng)
225 ity = iparg(5,ng)
226 jhbe = iparg(23,ng)
227 npg = iparg(48,ng)
228 nlay = 1
229 nptr = 1
230 npts = 1
231 nptt = 1
232c
233 IF (mlw == 0 .OR. mlw == 13 .OR. off==1) cycle
234c-------------------------------------------------
235 l_etfac = 0
236 l_sige = 0
237 l_a_kt = 0
238 l_subkt = 0
239c----------------------------------------------------
240 IF (ity == 1) THEN ! solides
241
242 nlay = elbuf_tab(ng)%NLAY
243 nptr = elbuf_tab(ng)%NPTR
244 npts = elbuf_tab(ng)%NPTS
245 nptt = elbuf_tab(ng)%NPTT
246c Compatibility :S8(HA8,HC8),S4,S10,S20,SC6
247 isnod = iparg(28,ng)
248 ipla = iparg(29,ng)
249 isrot = iparg(41,ng)
250C create a int table law type-----
251 IF (isnod==8 .AND. jhbe/=14 .AND. jhbe/=17) THEN
252 WRITE(iout,*)' **WARNING : ONLY ISOLID=14,17 ARE AVAILABLE',
253 1 ' WITH CONSISTING TANGENT MATRIX, OPTION IGNORED. '
254 WRITE(istdo,*)' **WARNING : ONLY ISOLID=14,17 ARE AVAILABLE',
255 1 ' WITH CONSISTING TANGENT MATRIX, OPTION IGNORED. '
256C--------add warning for HEPH-HSEPH-S8--
257 ELSE
258 IF (mlw==42.OR.mlw==62.OR.mlw==69.OR.mlw==82) THEN
259 l_etfac=1
260 IF (ihelas ==0 ) ihelas=1
261 ELSEIF (mlw==2.OR.mlw==36) THEN
262 l_etfac=1
263 l_sige = 6
264 l_a_kt = 1
265 ENDIF
266 END IF
267C---- shell 3n,4n
268 ELSEIF(ity==3.OR.ity==7) THEN
269c Compatibility :QEPH,QBAT,C3
270 IF (jhbe==11) THEN
271C-------for the case when DKT18 was available for implicit
272 nptr = 1
273 npts = npg
274 nptt = npt
275 ELSE
276 nptr = 1
277 npts = 1
278 nptt = npt
279 ENDIF
280 IF (nptt == 0 .AND. mlw /= 1) THEN
281 CALL ancmsg(msgid=227,anmode=aninfo,
282 . c1='FOR IMPLICIT NONLINEAR')
283 CALL arret(2)
284 ENDIF
285C create a int table law type-----
286 IF (mlw==78) THEN
287 l_etfac=1
288 ELSEIF (mlw==2.OR.mlw==36) THEN
289C------resulting model is not available
290 l_etfac=1
291 l_sige = 5 ! (4 : HK, 5: HH)
292 l_a_kt = 1
293 END IF !(MLW==2.OR.MLW==36) THEN
294 ENDIF ! el type
295c -------------------------------------------------
296c allocation des sub-structures de l'element buffer
297c-------------------------------------------------
298 IF (ity /=1 .AND.ity /=3 .AND.ity /=7 ) cycle
299 ALLOCATE (ktbuf_str(ng)%MLAW_TAG(0:maxlaw) ,stat=err)
300 ALLOCATE (ktbuf_str(ng)%ETFAC(nel*l_etfac) ,stat=err)
301 ALLOCATE (ktbuf_str(ng)%KTBUFEP(nptr,npts,nptt) ,stat=err)
302
303 IF (l_etfac>0) ktbuf_str(ng)%ETFAC = one
304 mtag => ktbuf_str(ng)%MLAW_TAG(mlw)
305 mtag%L_ETFAC=l_etfac
306 mtag%L_A_KT =l_a_kt
307 mtag%L_SIGE =l_sige
308 mtag%L_SUBKT=l_subkt
309C LENF = LENF + 4
310c-------------------------------------------------
311c Local variables per integration point
312c-------------------------------------------------
313 DO ir = 1,nptr
314 DO is = 1,npts
315 DO it = 1,nptt
316c GBUF => KTBUF_STR(NG)%KTBUFG(IR,IS,IT)
317c ALLOCATE(GBUF%ETFAC(NEL*L_ETFAC), STAT=ERR)
318c GBUF%ETFAC = ONE
319 lbuf => ktbuf_str(ng)%KTBUFEP(ir,is,it)
320 ALLOCATE(lbuf%A_KT(nel*l_a_kt), stat=err)
321 lbuf%A_KT = zero
322 ALLOCATE(lbuf%SIGE(nel*l_sige), stat=err)
323 lbuf%SIGE = zero
324 lenf = lenf + nel*(l_etfac+l_a_kt+l_sige)
325 ENDDO
326 ENDDO
327 ENDDO
328c-------------------------------------------------
329 IF (err /= 0) THEN
330 CALL ancmsg(msgid=19,anmode=aninfo,
331 . c1='FOR IMPLICIT NONLINEAR')
332 CALL arret(2)
333 ENDIF
334 ENDDO
335C IF (LENF==0 .AND. IKT > 0 ) IKT=0
336C-----
337 RETURN
338 END SUBROUTINE ktbuf_ini
339!||====================================================================
340!|| iktmat_ini ../engine/source/implicit/imp_init.F
341!||--- called by ------------------------------------------------------
342!|| get_etfac_s ../engine/source/elements/solid/solide8z/get_etfac_s.F
343!|| put_etfac ../engine/source/elements/solid/solide8z/put_etfac.f
344!||--- uses -----------------------------------------------------
345!|| imp_ktan ../engine/share/modules/impbufdef_mod.F
346!|| imp_ktan_def ../engine/share/modules/impbufdef_mod.F
347!||====================================================================
348 SUBROUTINE iktmat_ini(MTN,IKTMAT)
349C-----------------------------------------------
350C M o d u l e s
351C-----------------------------------------------
352 USE imp_ktan
353 USE imp_ktan_def
354C-----------------------------------------------
355C I m p l i c i t T y p e s
356C-----------------------------------------------
357#include "implicit_f.inc"
358C-----------------------------------------------
359C C o m m o n B l o c k s
360C-----------------------------------------------
361#include "impl1_c.inc"
362C-----------------------------------------------
363C D u m m y A r g u m e n t s
364C-----------------------------------------------
365 INTEGER MTN,IKTMAT
366C-----------------------------------------------
367C L o c a l V a r i a b l e s
368C-----------------------------------------------
369 IF (ikt == 0 .AND. mtn /=78 ) THEN
370 iktmat = 0
371 ELSE
372 iktmat = ihelas+ktbuf_str(ng_imp)%MLAW_TAG(mtn)%L_ETFAC
373 END IF
374C
375 RETURN
376 END SUBROUTINE iktmat_ini
377!||====================================================================
378!|| etfac_ini ../engine/source/implicit/imp_init.F
379!||--- called by ------------------------------------------------------
380!|| imp_solv ../engine/source/implicit/imp_solv.f
381!||--- calls -----------------------------------------------------
382!|| grpreorder ../engine/source/implicit/imp_glob_k.F
383!||--- uses -----------------------------------------------------
384!|| imp_ktan ../engine/share/modules/impbufdef_mod.F
385!|| imp_ktan_def ../engine/share/modules/impbufdef_mod.F
386!||====================================================================
387 SUBROUTINE etfac_ini(IPARG )
388C-----------------------------------------------
389C M o d u l e s
390C-----------------------------------------------
391 USE imp_ktan
392 USE imp_ktan_def
393C-----------------------------------------------
394C I m p l i c i t T y p e s
395C-----------------------------------------------
396#include "implicit_f.inc"
397C-----------------------------------------------
398C C o m m o n B l o c k s
399C-----------------------------------------------
400#include "com01_c.inc"
401#include "param_c.inc"
402#include "impl1_c.inc"
403C-----------------------------------------------
404C D u m m y A r g u m e n t s
405C-----------------------------------------------
406 INTEGER IPARG(NPARG,NGROUP)
407C-----------------------------------------------
408C L o c a l V a r i a b l e s
409C-----------------------------------------------
410 INTEGER I,IFA,IR,IS,IT,NG,NEL,MLW,JHBE,L_ETFAC,ISNOD,
411 . ITY,OFF,IGROUC(NGROUP),IG
412C=======================================================================
413 IF (ikt == 0) RETURN
414 CALL grpreorder(iparg, igrouc)
415 DO ig = 1,ngroup
416 ng = igrouc(ig)
417 mlw = iparg(1,ng) ! type de loi mat
418 nel = iparg(2,ng)
419 off = iparg(8,ng)
420 ity = iparg(5,ng)
421 jhbe = iparg(23,ng)
422 IF (mlw == 0 .OR. mlw == 13 .OR. off==1) cycle
423c-------------------------------------------------
424 l_etfac = 0
425c----------------------------------------------------
426 IF (ity == 1) THEN ! solides
427 isnod = iparg(28,ng)
428 IF (isnod==8 .AND. jhbe/=14 .AND. jhbe/=17) cycle
429 IF (mlw==42.OR.mlw==62.OR.mlw==69.OR.mlw==82) THEN
430 l_etfac=1
431 ELSEIF (mlw==2.OR.mlw==36) THEN
432 l_etfac=1
433 ENDIF ! el type
434C---- shell 3n,4n
435 ELSEIF(ity==3.OR.ity==7) THEN
436 IF (mlw==2.OR.mlw==36.OR.mlw==78) l_etfac=1
437 ENDIF ! el type
438c -------------------------------------------------
439c allocation des sub-structures de l'element buffer
440c-------------------------------------------------
441 IF (ity /=1 .AND.ity /=3 .AND.ity /=7 ) cycle
442 IF (l_etfac>0) THEN
443 DO i=1,nel
444 ktbuf_str(ng)%ETFAC(i) = one
445 END DO
446 END IF
447 END DO !IG = 1,NGROUP
448C-----
449 RETURN
450 END SUBROUTINE etfac_ini
451
#define my_real
Definition cppsort.cpp:32
subroutine dyna_ini(nodft, nodlt, d_al, nm_a, nm_b, v, vr)
Definition imp_dyna.F:36
subroutine grpreorder(iparg, igrouc)
subroutine etfac_ini(iparg)
Definition imp_init.F:388
subroutine imp_init(v, vr, iparg, ipm, igeo, elbuf_tab)
Definition imp_init.F:38
subroutine ktbuf_ini(elbuf_tab, iparg, ipm, igeo)
Definition imp_init.F:173
subroutine iktmat_ini(mtn, iktmat)
Definition imp_init.F:349
subroutine imp_solv(timers, python, icode, iskew, iskwn, ipart, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg1, itab, itabm1, npc, ibcl, ibfv, sensor_tab, nnlink, lnlink, iparg, igrv, ipari, intbuf_tab, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, icodt, icodr, isky, adsky, iads_f, ilink, llink, weight, itask, ibvel, lbvel, fbvel, x, d, v, vr, dr, thke, damp, ms, in, pm, skews, geo, eani, bufmat, bufgeo, bufsf, tf, forc, vel, fsav, agrv, fr_wave, parts0, elbuf, rby, rivet, fr_elem, iad_elem, wa, a, ar, stifn, stifr, partsav, fsky, fskyi, iframe, xframe, w16, iactiv, fskym, igeo, ipm, wfext, nodft, nodlt, nint7, num_imp, ns_imp, ne_imp, ind_imp, it, rwbuf, lprw, fr_wall, nbintc, intlist, fopt, rwsav, fsavd, graphe, fac_k, ipiv_k, nkcond, nsensor, monvol, igrsurf, fr_mv, volmon, dirul, nodglob, mumps_par, cddlp, isendto, irecvfrom, newfront, imsch, i2msch, isizxv, ilenxv, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, kinet, num_imp1, temp, dt2prev, waint, lgrav, sh4tree, sh3tree, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, irbe3, lrbe3, frbe3, fr_i2m, iad_i2m, fr_rbe3m, iad_rbe3m, frwl6, irbe2, lrbe2, intbuf_tab_c, ikine, diag_sms, icfield, lcfield, cfield, count_remslv, count_remslve, elbuf_tab, elbuf_imp, xdp, weight_md, stack, dimfb, fbsav6, stabsen, tabsensor, drape_sh4n, drape_sh3n, h3d_data, multi_fvm, igrbric, igrsh4n, igrsh3n, igrbeam, forneqs, maxdgap, nddl0, nnzk0, it_t, impbuf_tab, cptreac, fthreac, nodreac, drapeg, interfaces, th_surf, dpl0cld, vel0cld, snpc, stf, glob_therm, wfext_md)
Definition imp_solv.F:173
#define max(a, b)
Definition macros.h:21
integer nspcl
integer nz_sl
Definition imp_intm.F:173
integer nddl_si
Definition imp_intm.F:173
integer nddl_sl
Definition imp_intm.F:173
integer nz_si
Definition imp_intm.F:173
integer lmemn
integer b_mcore
type(ktbuf_struct_), dimension(:), allocatable, target ktbuf_str
subroutine put_etfac(nel, et, mtn)
Definition put_etfac.F:36
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
subroutine arret(nn)
Definition arret.F:87
subroutine zeror(a, n)
Definition zero.F:39