OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2mom27p_cin.F File Reference
#include "implicit_f.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i2mom27p_cin (nsn, nmn, ar, irect, crst, msr, nsv, irtl, in, ms, a, x, weight, stifr, fskyi2, stifn, iadi2, i0, nir, i2size, idel2, smass, siner, miner, adi, indxc, iadx, h3d_data, msegtyp2, csts_bis)

Function/Subroutine Documentation

◆ i2mom27p_cin()

subroutine i2mom27p_cin ( integer nsn,
integer nmn,
ar,
integer, dimension(4,*) irect,
crst,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
in,
ms,
a,
x,
integer, dimension(*) weight,
stifr,
fskyi2,
stifn,
integer, dimension(nir,*) iadi2,
integer i0,
integer nir,
integer i2size,
integer idel2,
smass,
siner,
miner,
adi,
integer, dimension(nsn) indxc,
integer, dimension(nsn) iadx,
type (h3d_database) h3d_data,
integer, dimension(*) msegtyp2,
csts_bis )

Definition at line 31 of file i2mom27p_cin.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE h3d_mod
41 USE outmax_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER NSN, NMN, I0 ,NIR ,I2SIZE, IDEL2,
50 . IRECT(4,*), MSR(*), NSV(*), IRTL(*), WEIGHT(*),
51 . IADI2(NIR,*),INDXC(NSN),IADX(NSN),MSEGTYP2(*)
52C REAL
53 my_real
54 . a(3,*), ar(3,*),crst(2,*), ms(*),
55 . x(3,*),in(*),stifr(*), fskyi2(i2size,*), stifn(*),
56 . smass(*), siner(*), miner(*), adi(*), csts_bis(2,*)
57 TYPE (H3D_DATABASE) :: H3D_DATA
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "scr14_c.inc"
62#include "scr16_c.inc"
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I, J, K, II, L, NN, I0BASE, JJ
67C REAL
68 my_real
69 . ss, st, xmsi, fxi, fyi, fzi, mxi, myi, mzi,ins,
70 . x0,x1,x2,x3,x4,y0,y1,y2,y3,y4,z0,z1,z2,z3,z4,aa,
71 . xc0,yc0,zc0,sp,sm,tp,tm,xc,yc,zc,
72 . stf,ai,inmx,h(4),h2(4)
73C=======================================================================
74 i0base = i0
75C MINER(II) initialise a MS(J) dans resol_init
76 IF(anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
77 DO ii=1,nmn
78 j=msr(ii)
79 adi(j) = adi(j)*miner(ii)
80 ENDDO
81 ENDIF
82#include "vectorize.inc"
83 DO ii=1,nmn
84 j=msr(ii)
85 in(j)=max(em20,in(j))
86 ENDDO
87C
88#include "vectorize.inc"
89 DO ii=1,nsn
90 k = indxc(ii)
91 IF (k == 0) cycle
92 i = nsv(k)
93 IF (i > 0) THEN
94 IF (weight(i)==1) THEN
95 l=irtl(ii)
96C
97 IF (irect(3,l) == irect(4,l)) THEN
98C-- Shape functions of triangles
99 h(1) = crst(1,ii)
100 h(2) = crst(2,ii)
101 h(3) = one-crst(1,ii)-crst(2,ii)
102 h(4) = zero
103 h2(1) = csts_bis(1,ii)
104 h2(2) = csts_bis(2,ii)
105 h2(3) = one-csts_bis(1,ii)-csts_bis(2,ii)
106 h2(4) = zero
107 ELSE
108C-- Shape functions of quadrangles
109 ss=crst(1,ii)
110 st=crst(2,ii)
111 sp=one + ss
112 sm=one - ss
113 tp=fourth*(one + st)
114 tm=fourth*(one - st)
115 h(1)=tm*sm
116 h(2)=tm*sp
117 h(3)=tp*sp
118 h(4)=tp*sm
119
120C Additional form functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
121 ss=csts_bis(1,ii)
122 st=csts_bis(2,ii)
123 sp=one + ss
124 sm=one - ss
125 tp=fourth*(one + st)
126 tm=fourth*(one - st)
127 h2(1)=tm*sm
128 h2(2)=tm*sp
129 h2(3)=tp*sp
130 h2(4)=tp*sm
131 ENDIF
132C
133 x0 = x(1,i)
134 y0 = x(2,i)
135 z0 = x(3,i)
136C
137 x1 = x(1,irect(1,l))
138 y1 = x(2,irect(1,l))
139 z1 = x(3,irect(1,l))
140 x2 = x(1,irect(2,l))
141 y2 = x(2,irect(2,l))
142 z2 = x(3,irect(2,l))
143 x3 = x(1,irect(3,l))
144 y3 = x(2,irect(3,l))
145 z3 = x(3,irect(3,l))
146 x4 = x(1,irect(4,l))
147 y4 = x(2,irect(4,l))
148 z4 = x(3,irect(4,l))
149C
150 xc = x1 * h(1) + x2 * h(2) + x3 * h(3) + x4 * h(4)
151 yc = y1 * h(1) + y2 * h(2) + y3 * h(3) + y4 * h(4)
152 zc = z1 * h(1) + z2 * h(2) + z3 * h(3) + z4 * h(4)
153C
154 xc0=x0-xc
155 yc0=y0-yc
156 zc0=z0-zc
157C
158 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
159 ins = in(i) + aa * ms(i)
160 stf = stifr(i) + aa * stifn(i)
161C
162 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
163 ai=aa * ms(i)
164 adi(irect(1,l))=adi(irect(1,l))+ai*h(1)
165 adi(irect(2,l))=adi(irect(2,l))+ai*h(2)
166 adi(irect(3,l))=adi(irect(3,l))+ai*h(3)
167 adi(irect(4,l))=adi(irect(4,l))+ai*h(4)
168 END IF
169C
170 fxi=a(1,i)
171 fyi=a(2,i)
172 fzi=a(3,i)
173C
174 mxi = ar(1,i) + yc0 * fzi - zc0 * fyi
175 myi = ar(2,i) + zc0 * fxi - xc0 * fzi
176 mzi = ar(3,i) + xc0 * fyi - yc0 * fxi
177C
178 IF ((h3d_data%N_VECT_CONT2M > 0).AND.(msegtyp2(l) == 1)) THEN
179 mcont2(1,i) = -ar(1,i)*weight(i)
180 mcont2(2,i) = -ar(2,i)*weight(i)
181 mcont2(3,i) = -ar(3,i)*weight(i)
182 DO j=1,nir
183 jj = irect(j,l)
184 mcont2(1,jj) = mcont2(1,jj) + mxi*h(j)
185 mcont2(2,jj) = mcont2(2,jj) + myi*h(j)
186 mcont2(3,jj) = mcont2(3,jj) + mzi*h(j)
187 ENDDO
188 ENDIF
189C
190 i0 = i0base + iadx(k)
191 DO j = 1,nir
192 IF (msegtyp2(l) == 1) THEN
193 nn = iadi2(j,i0)
194 fskyi2(6,nn) = mxi*h(j)
195 fskyi2(7,nn) = myi*h(j)
196 fskyi2(8,nn) = mzi*h(j)
197 fskyi2(9,nn) = ins*h2(j)
198 fskyi2(10,nn)= stf*abs(h(j))
199 ELSE
200 nn = iadi2(j,i0)
201 fskyi2(6,nn) = zero
202 fskyi2(7,nn) = zero
203 fskyi2(8,nn) = zero
204 fskyi2(9,nn) = zero
205 fskyi2(10,nn)= zero
206 END IF
207 ENDDO
208 ENDIF
209 stifr(i)=em20
210 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
211 in(i)=zero
212 stifn(i)=em20
213 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
214 ms(i)=zero
215 a(1,i)=zero
216 a(2,i)=zero
217 a(3,i)=zero
218c
219C stokage ZERO pour noeuds delete par idel2
220 ELSEIF(weight(-i)==1) THEN
221 i0 = i0base + iadx(k)
222 nn = iadi2(1,i0)
223 fskyi2(6,nn) = zero
224 fskyi2(7,nn) = zero
225 fskyi2(8,nn) = zero
226 fskyi2(9,nn) = zero
227 fskyi2(10,nn) = zero
228 nn = iadi2(2,i0)
229 fskyi2(6,nn) = zero
230 fskyi2(7,nn) = zero
231 fskyi2(8,nn) = zero
232 fskyi2(9,nn) = zero
233 fskyi2(10,nn) = zero
234 nn = iadi2(3,i0)
235 fskyi2(6,nn) = zero
236 fskyi2(7,nn) = zero
237 fskyi2(8,nn) = zero
238 fskyi2(9,nn) = zero
239 fskyi2(10,nn) = zero
240 nn = iadi2(4,i0)
241 fskyi2(6,nn) = zero
242 fskyi2(7,nn) = zero
243 fskyi2(8,nn) = zero
244 fskyi2(9,nn) = zero
245 fskyi2(10,nn) = zero
246 ENDIF
247 ENDDO
248C
249 IF(anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
250#include "vectorize.inc"
251 DO ii=1,nmn
252 j=msr(ii)
253 adi(j) = adi(j)/max(em20,miner(ii))
254 ENDDO
255 ENDIF
256c-----------
257 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308
outmax_mod
Definition outmax_mod.F:52