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_
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C G l o b a l P a r a m e t e r s
61C-----------------------------------------------
62#include "mvsiz_p.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "com04_c.inc"
67#include "param_c.inc"
68#include "scr17_c.inc"
69#include "scry_c.inc"
70#include "vect01_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 TYPE(matparam_struct_),DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
75 INTEGER IXQ(NIXQ,*), IPARG(*),
76 . NEL,IPART(LIPART1,*),IPARTQ(*),
77 . IPM(NPROPMI,*), PTQUAD(*), NSIGS, IGEO(*), NPF(*),
78 . IPARGG(*)
79 my_real MS(*), PM(NPROPM,*), X(*), VEUL(10,*),
80 . fill(numnod,*), sigi(nsigs,*),skew(lskew,*),
81 . msq(*), geo(*), wma(*), bufmat(*), tf(*),
82 . partsav(20,*) ,v(*)
83 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
84 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
85 my_real,INTENT(IN) :: facload(lfacload,*)
86 TYPE(detonators_struct_)::DETONATORS
87 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
88C-----------------------------------------------
89C L o c a l V a r i a b l e s
90C-----------------------------------------------
91 INTEGER I, NF1, IMULT, IGTYP, IP,IBID
92 INTEGER MAT(MVSIZ), NGL(MVSIZ)
93 my_real
94 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
95 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
96 . aire(mvsiz), deltax(mvsiz),
97 . sy(mvsiz), sz(mvsiz), ty(mvsiz), tz(mvsiz)
98 my_real :: tempel(nel)
99 INTEGER PID(MVSIZ), IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
100C-----------------------------------------------
101 TYPE(L_BUFEL_) ,POINTER :: LBUF
102 TYPE(G_BUFEL_) ,POINTER :: GBUF
103 TYPE(BUF_MAT_) ,POINTER :: MBUF
104C-----------------------------------------------
105C S o u r c e L i n e s
106C-----------------------------------------------
107 gbuf => elbuf_str%GBUF
108 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
109 igtyp= iparg(38)
110 nf1 = nft+1
111 ibid = 0
112 tempel(:) = zero
113c
114 CALL qcoor2(x,ixq(1,nf1),ngl,mat,
115 . pid, ix1, ix2, ix3, ix4,
116 . y1, y2, y3, y4,
117 . z1, z2, z3, z4,
118 . sy, sz, ty, tz)
119 CALL qvoli2(gbuf%VOL,ixq(1,nf1),
120 . ngl, aire,
121 . y1, y2, y3, y4,
122 . z1, z2, z3, z4)
123 IF (jeul/=0) THEN
124 CALL qdlen2(iparg(63),
125 . aire, deltax,
126 . y1, y2, y3, y4,
127 . z1, z2, z3, z4)
128 CALL edlen2(veul(1,nf1), aire, deltax)
129 ENDIF
130
131C---------------------------------------
132C MULTIMATRIAUX 1
133C---------------------------------------
134 imult=jmult
135 jmult=1
136 lbuf => elbuf_str%BUFLY(jmult)%LBUF(1,1,1)
137 mbuf => elbuf_str%BUFLY(jmult)%MAT(1,1,1)
138 mtn = iparg(25)
139
140 DO i=lft,llt
141 mat(i)=mat_param(iabs(ixq(1,nft+i)))%MULTIMAT%MID(jmult)
142 ENDDO
143
144 !------------------------------------------
145 ! MULTIMATERIAUX POUCENTAGE DE REMPLISSAGE
146 !------------------------------------------
147 CALL bimat2(gbuf%VOL, lbuf%FRAC, fill(1,1), lbuf%VOL, lbuf%OFF, ixq(1,nf1))
148 !----------------------------------------
149 ! INITIALISATION GENERALE
150 !----------------------------------------
151 ip=1
152 CALL matini(pm ,ixq ,nixq ,x ,
153 . geo ,ale_connectivity ,detonators ,iparg ,
154 . sigi ,nel ,skew ,igeo ,
155 . ipart ,ipartq ,
156 . mat ,ipm ,nsigs ,numquad ,ptquad ,
157 . ip ,ngl ,npf ,tf ,bufmat ,
158 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
159 . facload, deltax,tempel )
160 !----------------------------------------
161 ! INITIALISATION DE LA THERMIQUE ET TURBULENCE
162 !----------------------------------------
163 IF(jthe/=0) CALL atheri(mat,pm,lbuf%TEMP)
164 IF(jtur/=0) CALL aturi2(ipargg ,lbuf%RHO,pm,ixq,x,
165 . lbuf%RK,lbuf%RE, aire)
166 !------------------------------------------
167 ! INITIALISATION DE LA MATRICE DE MASSE
168 !------------------------------------------
169 IF(jlag+jale+jeul/=0)
170 . CALL qmasi2(pm,mat,ms,lbuf%VOL,msq(nf1),wma,ipartq(nft+1),partsav,
171 . ix1, ix2, ix3, ix4, x ,v)
172 !---------------------------------------
173 ! MULTIMATRIAUX 2
174 !---------------------------------------
175 IF(imult==1)RETURN
176 jmult=2
177 lbuf => elbuf_str%BUFLY(jmult)%LBUF(1,1,1)
178 mbuf => elbuf_str%BUFLY(jmult)%MAT(1,1,1)
179 mtn = iparg(26)
180
181 nf1=nft+1
182 DO i=lft,llt
183 mat(i)=mat_param(iabs(ixq(1,nft+i)))%MULTIMAT%MID(jmult)
184 ENDDO
185 !------------------------------------------
186 ! MULTIMATERIAUX POUCENTAGE DE REMPLISSAGE
187 !------------------------------------------
188 CALL bimat2( gbuf%VOL, lbuf%FRAC, fill(1,2), lbuf%VOL, lbuf%OFF, ixq(1,nf1) )
189 !----------------------------------------
190 ! initialisation generale
191 !----------------------------------------
192 ip=1
193 CALL matini(pm , ixq ,nixq ,x ,
194 . geo , ale_connectivity ,detonators,iparg ,
195 . sigi , nel ,skew ,igeo ,
196 . ipart , ipartq ,
197 . mat , ipm ,nsigs ,numquad ,ptquad ,
198 . ip , ngl ,npf ,tf ,bufmat ,
199 . gbuf , lbuf ,mbuf ,elbuf_str ,iloadp ,
200 . facload, deltax,tempel )
201 !----------------------------------------
202 ! INITIALISATION DE LA THERMIQUE ET TURBULENCE
203 !----------------------------------------
204 IF (jthe/=0) CALL atheri(mat,pm, lbuf%TEMP)
205 IF (jtur/=0) CALL aturi2(ipargg ,lbuf%RHO,pm,ixq,x,
206 . lbuf%RK,lbuf%RE, aire)
207 !------------------------------------------
208 ! INITIALISATION DE LA MATRICE DE MASSE
209 !------------------------------------------
210 IF(jlag+jale+jeul/=0)
211 . CALL qmasi2b(pm,mat,ms,lbuf%VOL,msq(nf1),wma,ipartq(nft+1),partsav,
212 . ix1, ix2, ix3, ix4 ,x ,v)
213C-----------
214 RETURN
215 END
subroutine atheri(mat, pm, temp)
Definition atheri.F:41
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:29
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)
Definition matini.F:81
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:37
subroutine qdlen2(iparg, aire, deltax, y1, y2, y3, y4, z1, z2, z3, z4)
Definition qdlen2.F:39