OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
imp_init.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "impl1_c.inc"
#include "impl2_c.inc"
#include "param_c.inc"
#include "scr19_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine imp_init (v, vr, iparg, ipm, igeo, elbuf_tab)
subroutine ktbuf_ini (elbuf_tab, iparg, ipm, igeo)
subroutine iktmat_ini (mtn, iktmat)
subroutine etfac_ini (iparg)

Function/Subroutine Documentation

◆ etfac_ini()

subroutine etfac_ini ( integer, dimension(nparg,ngroup) iparg)

Definition at line 387 of file imp_init.F.

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
grpreorder
subroutine grpreorder(iparg, igrouc)
Definition imp_glob_k.F:2801
imp_ktan_def
Definition impbufdef_mod.F:208
imp_ktan
Definition impbufdef_mod.F:676
imp_ktan::ktbuf_str
type(ktbuf_struct_), dimension(:), allocatable, target ktbuf_str
Definition impbufdef_mod.F:680

◆ iktmat_ini()

subroutine iktmat_ini ( integer mtn,
integer iktmat )

Definition at line 348 of file imp_init.F.

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

◆ imp_init()

subroutine imp_init ( v,
vr,
integer, dimension(nparg,ngroup) iparg,
integer, dimension(npropmi,*) ipm,
integer, dimension(*) igeo,
type(elbuf_struct_), dimension(ngroup) elbuf_tab )

Definition at line 37 of file imp_init.F.

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(*)
62 my_real
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
69 my_real
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
my_real
#define my_real
Definition cppsort.cpp:32
dyna_ini
subroutine dyna_ini(nodft, nodlt, d_al, nm_a, nm_b, v, vr)
Definition imp_dyna.F:36
ktbuf_ini
subroutine ktbuf_ini(elbuf_tab, iparg, ipm, igeo)
Definition imp_init.F:173
max
#define max(a, b)
Definition macros.h:21
imp_aspc
Definition impbufdef_mod.F:526
imp_aspc::nspcl
integer nspcl
Definition impbufdef_mod.F:527
imp_intm
Definition imp_intm.F:118
imp_intm::nz_sl
integer nz_sl
Definition imp_intm.F:173
imp_intm::nddl_si
integer nddl_si
Definition imp_intm.F:173
imp_intm::nddl_sl
integer nddl_sl
Definition imp_intm.F:173
imp_intm::nz_si
integer nz_si
Definition imp_intm.F:173
imp_kbcs
Definition impbufdef_mod.F:471
imp_kbcs::lmemn
integer lmemn
Definition impbufdef_mod.F:475
imp_kbcs::b_mcore
integer b_mcore
Definition impbufdef_mod.F:475
zeror
subroutine zeror(a, n)
Definition zero.F:39

◆ ktbuf_ini()

subroutine ktbuf_ini ( type(elbuf_struct_), dimension(ngroup) elbuf_tab,
integer, dimension(nparg,ngroup) iparg,
integer, dimension(npropmi,*) ipm,
integer, dimension(*) igeo )

Definition at line 172 of file imp_init.F.

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