OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
binit2.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!|| binit2 ../starter/source/ale/bimat/binit2.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| atheri ../starter/source/ale/atheri.F
29!|| aturi2 ../starter/source/ale/ale2d/aturi2.F
30!|| bimat2 ../starter/source/ale/bimat/bimat2.F
31!|| edlen2 ../starter/source/ale/ale2d/edlen2.F
32!|| matini ../starter/source/materials/mat_share/matini.F
33!|| qcoor2 ../starter/source/elements/solid_2d/quad/qcoor2.F
34!|| qdlen2 ../starter/source/elements/solid_2d/quad/qdlen2.f
35!|| qmasi2 ../starter/source/elements/solid_2d/quad/qmasi2.F
36!|| qmasi2b ../starter/source/elements/solid_2d/quad/qmasi2b.F
37!|| qvoli2 ../starter/source/elements/solid_2d/quad/qvoli2.F
38!||--- uses -----------------------------------------------------
39!|| detonators_mod ../starter/share/modules1/detonators_mod.F
40!||====================================================================
41 SUBROUTINE binit2(ELBUF_STR ,MS ,IXQ ,PM ,X ,
42 . DETONATORS,VEUL ,ALE_CONNECTIVITY ,IPARG ,FILL ,
43 . SIGI ,BUFMAT ,NEL ,MAT_PARAM ,
44 . SKEW ,MSQ ,IPART ,IPARTQ ,
45 . GEO ,IGEO ,IPM ,
46 . NSIGS ,WMA ,PTQUAD ,NPF ,TF ,
47 . IPARGG ,ILOADP ,FACLOAD ,PARTSAV ,V)
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE elbufdef_mod
54 USE matparam_def_mod, ONLY : matparam_struct_
55 use element_mod , only : nixq
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C G l o b a l P a r a m e t e r s
62C-----------------------------------------------
63#include "mvsiz_p.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "com04_c.inc"
68#include "param_c.inc"
69#include "scr17_c.inc"
70#include "scry_c.inc"
71#include "vect01_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 TYPE(matparam_struct_),DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
76 INTEGER IXQ(NIXQ,*), IPARG(*),
77 . NEL,IPART(LIPART1,*),IPARTQ(*),
78 . IPM(NPROPMI,*), PTQUAD(*), NSIGS, IGEO(*), NPF(*),
79 . IPARGG(*)
80 my_real MS(*), PM(NPROPM,*), X(*), VEUL(10,*),
81 . fill(numnod,*), sigi(nsigs,*),skew(lskew,*),
82 . msq(*), geo(*), wma(*), bufmat(*), tf(*),
83 . partsav(20,*) ,v(*)
84 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
85 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
86 my_real,INTENT(IN) :: facload(lfacload,*)
87 TYPE(detonators_struct_)::DETONATORS
88 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
89C-----------------------------------------------
90C L o c a l V a r i a b l e s
91C-----------------------------------------------
92 INTEGER I, NF1, IMULT, IGTYP, IP,IBID
93 INTEGER MAT(MVSIZ), NGL(MVSIZ)
94 my_real
95 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
96 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
97 . aire(mvsiz), deltax(mvsiz),
98 . sy(mvsiz), sz(mvsiz), ty(mvsiz), tz(mvsiz)
99 my_real :: tempel(nel)
100 INTEGER PID(MVSIZ), IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
101C-----------------------------------------------
102 TYPE(L_BUFEL_) ,POINTER :: LBUF
103 TYPE(G_BUFEL_) ,POINTER :: GBUF
104 TYPE(BUF_MAT_) ,POINTER :: MBUF
105C-----------------------------------------------
106C S o u r c e L i n e s
107C-----------------------------------------------
108 gbuf => elbuf_str%GBUF
109 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
110 igtyp= iparg(38)
111 nf1 = nft+1
112 ibid = 0
113 tempel(:) = zero
114c
115 CALL qcoor2(x,ixq(1,nf1),ngl,mat,
116 . pid, ix1, ix2, ix3, ix4,
117 . y1, y2, y3, y4,
118 . z1, z2, z3, z4,
119 . sy, sz, ty, tz)
120 CALL qvoli2(gbuf%VOL,ixq(1,nf1),
121 . ngl, aire,
122 . y1, y2, y3, y4,
123 . z1, z2, z3, z4)
124 IF (jeul/=0) THEN
125 CALL qdlen2(iparg(63),
126 . aire, deltax,
127 . y1, y2, y3, y4,
128 . z1, z2, z3, z4)
129 CALL edlen2(veul(1,nf1), aire, deltax)
130 ENDIF
131
132C---------------------------------------
133C MULTIMATRIAUX 1
134C---------------------------------------
135 imult=jmult
136 jmult=1
137 lbuf => elbuf_str%BUFLY(jmult)%LBUF(1,1,1)
138 mbuf => elbuf_str%BUFLY(jmult)%MAT(1,1,1)
139 mtn = iparg(25)
140
141 DO i=lft,llt
142 mat(i)=mat_param(iabs(ixq(1,nft+i)))%MULTIMAT%MID(jmult)
143 ENDDO
144
145 !------------------------------------------
146 ! multimaterials filling percentage
147 !------------------------------------------
148 CALL bimat2(gbuf%VOL, lbuf%FRAC, fill(1,1), lbuf%VOL, lbuf%OFF, ixq(1,nf1))
149 !----------------------------------------
150 ! INITIALISATION GENERALE
151 !----------------------------------------
152 ip=1
153 CALL matini(pm ,ixq ,nixq ,x ,
154 . geo ,ale_connectivity ,detonators ,iparg ,
155 . sigi ,nel ,skew ,igeo ,
156 . ipart ,ipartq ,
157 . mat ,ipm ,nsigs ,numquad ,ptquad ,
158 . ip ,ngl ,npf ,tf ,bufmat ,
159 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
160 . facload, deltax,tempel ,mat_param )
161 !----------------------------------------
162 ! initialization of thermal and turbulence
163 !----------------------------------------
164 IF(jthe/=0) CALL atheri(mat,pm,lbuf%TEMP)
165 IF(jtur/=0) CALL aturi2(ipargg ,lbuf%RHO,pm,ixq,x,
166 . lbuf%RK,lbuf%RE, aire)
167 !------------------------------------------
168 ! initialization of the mass matrix
169 !------------------------------------------
170 IF(jlag+jale+jeul/=0)
171 . CALL qmasi2(pm,mat,ms,lbuf%VOL,msq(nf1),wma,ipartq(nft+1),partsav,
172 . ix1, ix2, ix3, ix4, x ,v)
173 !---------------------------------------
174 ! MULTIMATRIAUX 2
175 !---------------------------------------
176 IF(imult==1)RETURN
177 jmult=2
178 lbuf => elbuf_str%BUFLY(jmult)%LBUF(1,1,1)
179 mbuf => elbuf_str%BUFLY(jmult)%MAT(1,1,1)
180 mtn = iparg(26)
181
182 nf1=nft+1
183 DO i=lft,llt
184 mat(i)=mat_param(iabs(ixq(1,nft+i)))%MULTIMAT%MID(jmult)
185 ENDDO
186 !------------------------------------------
187 ! multimaterials filling percentage
188 !------------------------------------------
189 CALL bimat2( gbuf%VOL, lbuf%FRAC, fill(1,2), lbuf%VOL, lbuf%OFF, ixq(1,nf1) )
190 !----------------------------------------
191 ! INITIALISATION GENERALE
192 !----------------------------------------
193 ip=1
194 CALL matini(pm , ixq ,nixq ,x ,
195 . geo , ale_connectivity ,detonators,iparg ,
196 . sigi , nel ,skew ,igeo ,
197 . ipart , ipartq ,
198 . mat , ipm ,nsigs ,numquad ,ptquad ,
199 . ip , ngl ,npf ,tf ,bufmat ,
200 . gbuf , lbuf ,mbuf ,elbuf_str ,iloadp ,
201 . facload, deltax,tempel ,mat_param )
202 !----------------------------------------
203 ! initialization of thermal and turbulence
204 !----------------------------------------
205 IF (jthe/=0) CALL atheri(mat,pm, lbuf%TEMP)
206 IF (jtur/=0) CALL aturi2(ipargg ,lbuf%RHO,pm,ixq,x,
207 . lbuf%RK,lbuf%RE, aire)
208 !------------------------------------------
209 ! initialization of the mass matrix
210 !------------------------------------------
211 IF(jlag+jale+jeul/=0)
212 . CALL qmasi2b(pm,mat,ms,lbuf%VOL,msq(nf1),wma,ipartq(nft+1),partsav,
213 . ix1, ix2, ix3, ix4 ,x ,v)
214C-----------
215 RETURN
216 END
subroutine atheri(mat, pm, temp)
Definition atheri.F:42
subroutine aturi2(iparg, rho, pm, ix, x, rk, re, aire)
Definition aturi2.F:32
subroutine bimat2(volt, alph, fill, vol, off, ix)
Definition bimat2.F:30
subroutine binit2(elbuf_str, ms, ixq, pm, x, detonators, veul, ale_connectivity, iparg, fill, sigi, bufmat, nel, mat_param, skew, msq, ipart, ipartq, geo, igeo, ipm, nsigs, wma, ptquad, npf, tf, ipargg, iloadp, facload, partsav, v)
Definition binit2.F:48
subroutine edlen2(veul, aire, deltax)
Definition edlen2.F:31
subroutine matini(pm, ix, nix, x, geo, ale_connectivity, detonators, iparg, sigi, nel, skew, igeo, ipart, ipartel, mat, ipm, nsig, nums, pt, ipt, ngl, npf, tf, bufmat, gbuf, lbuf, mbuf, elbuf_str, iloadp, facload, ddeltax, tempel, mat_param)
Definition matini.F:83
subroutine qmasi2(pm, mat, ms, vol, msq, wma, ipart, partsav, ix1, ix2, ix3, ix4, x, v)
Definition qmasi2.F:33
subroutine qmasi2b(pm, mat, ms, vol, msq, wma, ipart, partsav, ix1, ix2, ix3, ix4, x, v)
Definition qmasi2b.F:31
subroutine qvoli2(volu, ixq, ngl, aire, y1, y2, y3, y4, z1, z2, z3, z4)
Definition qvoli2.F:40
subroutine qcoor2(x, ixq, ngl, mxt, pid, ix1, ix2, ix3, ix4, y1, y2, y3, y4, z1, z2, z3, z4, sy, sz, ty, tz)
Definition qcoor2.F:38
subroutine qdlen2(iparg, aire, deltax, y1, y2, y3, y4, z1, z2, z3, z4)
Definition qdlen2.F:39
program starter
Definition starter.F:39