OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inisoldist.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!|| inisoldist ../starter/source/initial_conditions/inivol/inisoldist.F
25!||--- called by ------------------------------------------------------
26!|| init_inivol ../starter/source/initial_conditions/inivol/init_inivol.F90
27!||--- calls -----------------------------------------------------
28!|| qcoor2 ../starter/source/elements/solid_2d/quad/qcoor2.F
29!|| ratio_fill ../starter/source/initial_conditions/inivol/ratio_fill.F
30!|| s4coor3 ../starter/source/elements/solid/solide4/s4coor3.F
31!|| scoor3 ../starter/source/elements/solid/solide/scoor3.F
32!|| srcoor3 ../starter/source/elements/solid/solide/srcoor3.F
33!||--- uses -----------------------------------------------------
34!|| inivol_def_mod ../starter/share/modules1/inivol_mod.F
35!||====================================================================
36 SUBROUTINE inisoldist(
37 . IFILL ,IXS ,X ,GEO ,NG ,
38 . IPARG ,IDP ,IPART_ ,XREFS ,GLOB_THERM,
39 . NTRACE ,NTRACE0 ,DIS ,NSOLTOSF ,NBIP ,
40 . NNOD2SURF ,INOD2SURF ,KNOD2SURF ,SURF_ELTYP,SURF_NODES,
41 . JMID ,IPHASE ,INPHASE ,KVOL ,SURF_TYPE ,
42 . IAD_BUFR ,BUFSF ,NOD_NORMAL,ISOLNOD ,NBSUBMAT ,
43 . FILL_RATIO ,ICUMU ,IDC ,NBCONTY ,NSEG ,
44 . IDSURF ,SWIFTSURF ,SEGTOSURF ,IGRSURF ,IVOLSURF ,
45 . NSURF_INVOL,IXQ ,IXTG ,ITYP ,NEL , NUMEL_TOT,
46 . NUM_INIVOL ,INIVOL ,I_INIVOL)
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE groupdef_mod
51 USE inivol_def_mod , ONLY : inivol_struct_
52 use glob_therm_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C G l o b a l P a r a m e t e r s
59C-----------------------------------------------
60#include "mvsiz_p.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com01_c.inc"
65#include "com04_c.inc"
66#include "param_c.inc"
67#include "vect01_c.inc"
68#include "tabsiz_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER,INTENT(IN) :: I_INIVOL !< inivol identifier
73 INTEGER,INTENT(IN) :: NUM_INIVOL !< number of inivol options
74 TYPE (INIVOL_STRUCT_), DIMENSION(NUM_INIVOL), INTENT(INOUT) :: INIVOL !< inivol data structure
75 INTEGER,INTENT(IN) :: NG
76 INTEGER NTRACE,NTRACE0,IDC,NBCONTY,NSEG, IVOLSURF(NSURF),NUMEL_TOT,NEL
77 INTEGER,TARGET :: IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),IXTG(NIXTG,NUMELTG)
78 INTEGER IPARG(NPARG,NGROUP),IPART_(*),
79 . IDP,IFILL,NSOLTOSF(NBCONTY,NUMNOD),
80 . NNOD2SURF,KNOD2SURF(NUMNOD+1),JMID,
81 . IPHASE(NBSUBMAT+1,NUMEL_TOT),INPHASE(NTRACE,NEL),
82 . inod2surf(nnod2surf,numnod),isolnod,icumu,surf_type,iad_bufr,
83 . surf_eltyp(nseg),surf_nodes(nseg,4),nbip(nbsubmat,numel_tot),
84 . idsurf,swiftsurf(nsurf),segtosurf(*),nsurf_invol,
85 . ityp
86 my_real x(3,numnod),geo(npropg,*),xrefs(8,3,*),
87 . dis(nsurf_invol,numnod),kvol(nbsubmat,numel_tot),bufsf(*),
88 . nod_normal(3,numnod),fill_ratio
89 INTEGER, INTENT(IN) :: NBSUBMAT
90 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
91 TYPE(glob_therm_) ,intent(in) :: glob_therm
92C-----------------------------------------------
93C L o c a l V a r i a b l e s
94C-----------------------------------------------
95 INTEGER,POINTER :: pIXQ,pIXTG,pIXS
96 INTEGER NF1,I,II,JHBE
97 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
98 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),
99 . ix5(mvsiz),ix6(mvsiz),ix7(mvsiz),ix8(mvsiz)
100
101 INTEGER IBID
102 my_real
103 . X1(MVSIZ),X2(MVSIZ),X3(MVSIZ),X4(MVSIZ),X5(MVSIZ),X6(MVSIZ),
104 . X7(MVSIZ),X8(MVSIZ),Y1(MVSIZ),Y2(MVSIZ),Y3(MVSIZ),Y4(MVSIZ),
105 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
106 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
107 . rx(mvsiz) ,ry(mvsiz),rz(mvsiz) ,s_x(mvsiz) ,
108 . s_y(mvsiz) ,s_z(mvsiz),tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
109 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),
110 . e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
111 . e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
112 . f1x(mvsiz),f1y(mvsiz),f1z(mvsiz),
113 . f2x(mvsiz),f2y(mvsiz),f2z(mvsiz)
114
115 my_real rbid
116 DOUBLE PRECISION
117 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
118 . XD5(MVSIZ), XD6(MVSIZ), XD7(MVSIZ), XD8(MVSIZ),
119 . YD1(MVSIZ), YD2(MVSIZ), YD3(MVSIZ), YD4(MVSIZ),
120 . YD5(MVSIZ), YD6(MVSIZ), YD7(MVSIZ), YD8(MVSIZ),
121 . ZD1(MVSIZ), ZD2(MVSIZ), ZD3(MVSIZ), ZD4(MVSIZ),
122 . ZD5(MVSIZ), ZD6(MVSIZ), ZD7(MVSIZ), ZD8(MVSIZ)
123C-----------------------------------------------
124C S o u r c e L i n e s
125C-----------------------------------------------
126 rbid = zero
127 ibid = 0
128
129 jhbe = iparg(23,ng)
130 jcvt = iparg(37,ng)
131
132 !common variables required for s*coor3 subroutine
133 nft=iparg(3,ng)
134 nf1=nft+1
135 lft=1
136 llt=nel
137 ity=ityp
138
139
140
141 IF(n2d == 0)THEN
142 IF ( isolnod == 4 )THEN
143 CALL s4coor3(x ,xrefs(1,1,nf1),ixs(1,nf1),ngl ,
144 . mat ,pid ,ix1 ,ix2 ,ix3 ,ix4 ,
145 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
146 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 )
147 ELSEIF (isolnod == 8) THEN
148 IF (jcvt == 0) THEN
149 CALL scoor3( x ,xrefs(1,1,nf1) ,ixs(1,nf1) ,geo ,mat ,pid ,ngl ,
150 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8,
151 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
152 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
153 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
154 . rx ,ry ,rz ,s_x ,s_y ,s_z ,tx ,ty ,tz ,
155 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
156 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,rbid ,rbid,glob_therm%NINTEMP,
157 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
158 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
159 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
160 ELSE
161 CALL srcoor3( x ,xrefs(1,1,nf1) ,ixs(1,nf1) ,geo ,mat ,pid ,ngl ,jhbe ,
162 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
163 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
164 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
165 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
166 . rx ,ry ,rz ,s_x ,s_y ,s_z ,tx ,ty ,tz ,
167 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
168 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,rbid ,rbid ,glob_therm%NINTEMP,
169 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
170 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
171 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
172 ENDIF
173 ENDIF
174 ELSEIF(n2d > 0)THEN
175 IF(ityp == 7)THEN
176 DO ii = 1, nel
177 i = ii + nft
178 ix1(ii) = ixtg(1 + 1, i)
179 ix2(ii) = ixtg(1 + 2, i)
180 ix3(ii) = ixtg(1 + 3, i)
181 x1(ii) = zero
182 x2(ii) = zero
183 x3(ii) = zero
184 y1(ii) = x(2, ixtg(1 + 1, i))
185 z1(ii) = x(3, ixtg(1 + 1, i))
186 y2(ii) = x(2, ixtg(1 + 2, i))
187 z2(ii) = x(3, ixtg(1 + 2, i))
188 y3(ii) = x(2, ixtg(1 + 3, i))
189 z3(ii) = x(3, ixtg(1 + 3, i))
190 ngl(ii) = ixtg(6, i)
191 ENDDO
192 ELSEIF(ityp == 2)THEN
193 DO ii = 1, nel
194 x1(ii) = zero
195 x2(ii) = zero
196 x3(ii) = zero
197 x4(ii) = zero
198 ENDDO
199 CALL qcoor2(x, ixq(1, nf1), ngl, mat, pid,
200 . ix1, ix2, ix3, ix4,
201 . y1, y2, y3, y4,
202 . z1, z2, z3, z4,
203 . s_y, s_z, ty, tz)
204 ENDIF
205 ENDIF
206C-----------
207 NULLIFY(pixs)
208 NULLIFY(pixq)
209 NULLIFY(pixtg)
210 IF(numels>0) pixs => ixs(1,nf1)
211 IF(numelq>0) pixq => ixq(1,nf1)
212 IF(n2d>0 .AND. numeltg>0) pixtg => ixtg(1,nf1)
213
214 CALL ratio_fill(
215 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
216 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
217 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
218 . idp ,x ,
219 . pixs ,ipart_(nf1),ifill ,ntrace ,ntrace0 ,dis ,nsoltosf ,
220 . nnod2surf ,inod2surf ,knod2surf ,jmid ,iphase(1,nf1) ,inphase ,kvol(1,nf1) ,
221 . surf_type ,iad_bufr ,bufsf ,nod_normal ,isolnod ,nbsubmat ,fill_ratio ,icumu ,
222 . nseg ,surf_eltyp ,surf_nodes,nbconty ,idc ,nbip(1,nf1) ,idsurf ,swiftsurf ,
223 . segtosurf ,igrsurf ,ivolsurf ,nsurf_invol,pixq ,pixtg ,ityp ,nel ,
224 . numel_tot ,num_inivol ,inivol ,i_inivol)
225C-----------------------------------------------------------------
226 RETURN
227 END
my_real
#define my_real
Definition cppsort.cpp:32
inisoldist
subroutine inisoldist(ifill, ixs, x, geo, ng, iparg, idp, ipart_, xrefs, glob_therm, ntrace, ntrace0, dis, nsoltosf, nbip, nnod2surf, inod2surf, knod2surf, surf_eltyp, surf_nodes, jmid, iphase, inphase, kvol, surf_type, iad_bufr, bufsf, nod_normal, isolnod, nbsubmat, fill_ratio, icumu, idc, nbconty, nseg, idsurf, swiftsurf, segtosurf, igrsurf, ivolsurf, nsurf_invol, ixq, ixtg, ityp, nel, numel_tot, num_inivol, inivol, i_inivol)
Definition inisoldist.F:47
groupdef_mod
Definition groupdef_mod.F:662
inivol_def_mod
Definition inivol_mod.F:45
inivol_def_mod::inivol
type(inivol_struct_), dimension(:), allocatable inivol
Definition inivol_mod.F:84
ratio_fill
subroutine ratio_fill(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, idp, x, ixs, ipart_, ifill, ntrace, ntrace0, dis, nsoltosf, nnod2surf, inod2surf, knod2surf, jmid, iphase, inphase, kvol, surf_type, iad_bufr, bufsf, nod_normal, isolnod, nbsubmat, fill_ratio, icumu, nseg, surf_eltyp, surf_nodes, nbconty, idc, nbip, idsurf, swiftsurf, segtosurf, igrsurf, ivolsurf, nsurf_invol, ixq, ixtg, ityp, nel, numel_tot, num_inivol, inivol, i_inivol)
Definition ratio_fill.F:42
s4coor3
subroutine s4coor3(x, xrefs, ixs, ngl, mxt, ngeo, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
Definition s4coor3.F:40
scoor3
subroutine scoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition scoor3.F:52
srcoor3
subroutine srcoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, jhbe, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition srcoor3.F:52
qcoor2
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
inivol_def_mod::inivol_struct_
Definition inivol_mod.F:70