OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_sol_skin_scalar1.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr19_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_sol_skin_scalar1 (elbuf_tab, iparg, iparts, ixs, ixs10, skin_scalar, tag_skins6, t6gps, x, npf, tf, h3d_part, is_written_skin, keyword, nskin, mat_param)

Function/Subroutine Documentation

◆ h3d_sol_skin_scalar1()

subroutine h3d_sol_skin_scalar1 ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(*) iparts,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
dimension(*), target skin_scalar,
integer, dimension(*) tag_skins6,
dimension(6,*), target t6gps,
dimension(3,*), target x,
integer, dimension(*) npf,
dimension(*), target tf,
integer, dimension(*) h3d_part,
integer, dimension(*) is_written_skin,
character(len=ncharline100) keyword,
integer nskin,
type (matparam_struct_), dimension(nummat), intent(in) mat_param )

Definition at line 38 of file h3d_sol_skin_scalar1.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE initbuf_mod
46 USE mat_elem_mod
47 USE elbufdef_mod
48 USE names_and_titles_mod, ONLY: ncharline100
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "param_c.inc"
60#include "scr19_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64C REAL
65 INTEGER IPARG(NPARG,*),IXS(NIXS,*),IPARTS(*),
66 . IXS10(6,*) ,TAG_SKINS6(*) ,NSKIN , NPF(*),H3D_PART(*),
67 . IS_WRITTEN_SKIN(*)
68 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
69 my_real,INTENT(IN),TARGET :: tf(*)
70 my_real,INTENT(IN),TARGET :: t6gps(6,*),x(3,*)
71 my_real,INTENT(OUT),TARGET :: skin_scalar(*)
72 CHARACTER(LEN=NCHARLINE100):: KEYWORD
73 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I,ISOLNOD,ICS,NG,N,J
78 INTEGER
79 . MLW ,NEL ,NFT ,IAD ,ITY ,
80 . NPT ,JALE ,ISMSTR ,JEUL ,JTUR ,
81 . JTHE ,JLAG ,JMULT ,JHBE ,JIVF ,
82 . NVAUX ,JPOR ,KCVT ,JCLOSE ,JPLASOL ,
83 . IREP ,IINT ,IGTYP ,ISRAT ,ISROT ,
84 . ICSEN ,ISORTH ,ISORTHG ,IFAILURE,JSMS ,
85 . NN,NN1,N1,IOK_PART(MVSIZ),IS_WRITTEN_VALUE(MVSIZ)
86 INTEGER NC(10,MVSIZ),PWR(7),LL,IXSK(5,6*MVSIZ)
87 INTEGER FACES(4,6),NS(4),JJ,II,K1,K2,T3(3),T6(6),TIA4S(3,4)
88 INTEGER IFUNC(MAXFUNC),IDEB
89 INTEGER NPAR,NFUNC,MX,NSK,IL,IR,IS,IT,NFAIL,IFAIL,NSKI,NIPAR
90 my_real evar(3,mvsiz),value(mvsiz)
91 TYPE(BUF_LAY_) ,POINTER :: BUFLY
92 TYPE(BUF_FAIL_) ,POINTER :: FBUF
93 DATA pwr/1,2,4,8,16,32,64/
94 DATA faces/4,3,2,1,
95 . 5,6,7,8,
96 . 1,2,6,5,
97 . 3,4,8,7,
98 . 2,3,7,6,
99 . 1,5,8,4/
100 DATA tia4s/3,5,6,
101 . 2,4,5,
102 . 1,6,4,
103 . 4,6,5/
104C----tetra4:-------------------------------------------
105c N8=N4 FACES : 2 2 1 1
106c N7=N3 4 3 3 4
107c N6=N3 1 1 3 4
108c N5=N4 2 2 4 3
109c N4=N2 1 2 3 3
110c N3=N2 1 4 4 2
111c N2=N1
112c N1=N1
113C
114 DO ng=1,ngroup
115 CALL initbuf(iparg ,ng ,
116 2 mlw ,nel ,nft ,iad ,ity ,
117 3 npt ,jale ,ismstr ,jeul ,jtur ,
118 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
119 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
120 6 irep ,iint ,igtyp ,israt ,isrot ,
121 7 icsen ,isorth ,isorthg ,ifailure,jsms )
122!
123 IF(mlw == 13 .OR. mlw == 0.OR.ity /= 1) cycle
124C------
125 IF (igtyp==6 .OR. igtyp==14 ) THEN
126 isolnod = iparg(28,ng)
127 ics = iparg(17,ng)
128 nsk = 0
129 iok_part(1:nel) = 0
130 IF(isolnod == 4)THEN
131 DO i=1,nel
132 n = i + nft
133 nc(1,i)=ixs(2,n)
134 nc(2,i)=ixs(4,n)
135 nc(3,i)=ixs(7,n)
136 nc(4,i)=ixs(6,n)
137 ENDDO
138C---------each face
139 DO i=1,nel
140 n = i + nft
141 ll=tag_skins6(n)
142 jj = 5
143 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
144C---------3,2,1
145 nsk = nsk + 1
146 ixsk(1,nsk) = iparts(n)
147 ixsk(2,nsk) = nc(3,i)
148 ixsk(3,nsk) = nc(2,i)
149 ixsk(4,nsk) = nc(1,i)
150 ixsk(5,nsk) = ixsk(4,nsk)
151 END IF
152C---------2,3 ,4
153 jj = 4
154 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
155 nsk = nsk + 1
156 ixsk(1,nsk) = iparts(n)
157 ixsk(2,nsk) = nc(2,i)
158 ixsk(3,nsk) = nc(3,i)
159 ixsk(4,nsk) = nc(4,i)
160 ixsk(5,nsk) = ixsk(4,nsk)
161 END IF
162C---------1,4,3
163 jj = 3
164 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
165 nsk = nsk + 1
166 ixsk(1,nsk) = iparts(n)
167 ixsk(2,nsk) = nc(1,i)
168 ixsk(3,nsk) = nc(4,i)
169 ixsk(4,nsk) = nc(3,i)
170 ixsk(5,nsk) = ixsk(4,nsk)
171 END IF
172C---------1,2,4
173 jj = 6
174 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
175 nsk = nsk + 1
176 ixsk(1,nsk) = iparts(n)
177 ixsk(2,nsk) = nc(1,i)
178 ixsk(3,nsk) = nc(2,i)
179 ixsk(4,nsk) = nc(4,i)
180 ixsk(5,nsk) = ixsk(4,nsk)
181 END IF
182 ENDDO
183 ELSEIF(isolnod == 6)THEN
184 ELSEIF(isolnod == 10)THEN
185 DO i=1,nel
186 n = i + nft
187 nc(1,i)=ixs(2,n)
188 nc(2,i)=ixs(4,n)
189 nc(3,i)=ixs(7,n)
190 nc(4,i)=ixs(6,n)
191 nn1 = n - numels8
192 nc(5:10,i) = ixs10(1:6,nn1)
193 ENDDO
194C---------each face 4x4
195 DO i=1,nel
196 n = i + nft
197 ll=tag_skins6(n)
198C---------1,2,3
199 jj = 5
200 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
201 t6(1:3) = nc(1:3,i)
202 t6(4:6) = nc(5:7,i)
203 DO j=1,4
204 nsk = nsk + 1
205 ixsk(1,nsk) = iparts(n)
206 t3(1:3) = t6(tia4s(1:3,j))
207 ixsk(2:4,nsk) = t3(1:3)
208 ixsk(5,nsk) = ixsk(4,nsk)
209 END DO
210 END IF
211C---------2,3 ,4
212 jj = 4
213 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
214 t6(1:3) = nc(2:4,i)
215 t6(4) = nc(6,i)
216 t6(5) = nc(10,i)
217 t6(6) = nc(9,i)
218 DO j=1,4
219 nsk = nsk + 1
220 ixsk(1,nsk) = h3d_part(iparts(n))
221 t3(1:3) = t6(tia4s(1:3,j))
222 ixsk(2:4,nsk) = t3(1:3)
223 ixsk(5,nsk) = ixsk(4,nsk)
224 END DO
225 END IF
226C---------1,4,3
227 jj = 3
228 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
229 t6(1) = nc(3,i)
230 t6(2) = nc(1,i)
231 t6(3) = nc(4,i)
232 t6(4) = nc(7,i)
233 t6(5) = nc(8,i)
234 t6(6) = nc(10,i)
235 DO j=1,4
236 nsk = nsk + 1
237 ixsk(1,nsk) = iparts(n)
238 t3(1:3) = t6(tia4s(1:3,j))
239 ixsk(2:4,nsk) = t3(1:3)
240 ixsk(5,nsk) = ixsk(4,nsk)
241 END DO
242 END IF
243C---------1,2,4
244 jj = 6
245 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
246 t6(1:2) = nc(1:2,i)
247 t6(3) = nc(4,i)
248 t6(4) = nc(5,i)
249 t6(5) = nc(9,i)
250 t6(6) = nc(8,i)
251 DO j=1,4
252 nsk = nsk + 1
253 ixsk(1,nsk) = iparts(n)
254 t3(1:3) = t6(tia4s(1:3,j))
255 ixsk(2:4,nsk) = t3(1:3)
256 ixsk(5,nsk) = ixsk(4,nsk)
257 END DO
258 END IF
259 ENDDO
260C-----------S8 (&degenerated),S20
261 ELSE
262 DO i=1,nel
263 n = i + nft
264 nc(1:8,i) = ixs(2:9,n)
265 ll=tag_skins6(n)
266C--------per face :
267 DO jj=1,6
268 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
269 DO ii=1,4
270 ns(ii)=nc(faces(ii,jj),i)
271 END DO
272C---------for degenerated cases
273 DO k1=1,3
274 DO k2=k1+1,4
275 IF(ns(k2)==ns(k1))ns(k2)=0
276 END DO
277 END DO
278 nn=0
279 DO k1=1,4
280 n1=ns(k1)
281 IF(n1/=0)THEN
282 nn=nn+1
283 ns(nn)= n1
284 END IF
285 END DO
286 IF (nn>2) THEN
287 nsk = nsk + 1
288 ixsk(1,nsk) = iparts(n)
289 ixsk(2:4,nsk) = ns(1:3)
290 IF (nn > 3) THEN
291 ixsk(5,nsk) = ns(4)
292 ELSE
293 ixsk(5,nsk) = ixsk(4,nsk)
294 END IF
295 END IF
296 ENDDO
297 ENDDO
298 ENDIF
299C----------- NSK could be > mvsiz
300 IF (nsk>0) THEN
301 il = 1
302 ir = 1
303 is = 1
304 it = 1
305 bufly => elbuf_tab(ng)%BUFLY(il)
306 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
307 fbuf => bufly%FAIL(ir,is,it)
308 mx = ixs(1,1+nft)
309 ideb = 0
310 DO ii=1,nsk,mvsiz
311 nski = min(nsk-ideb,mvsiz)
312 n = 1+ideb
313 CALL tens3dto2d(nski,ixsk(:,n),x,t6gps,evar)
314 DO i=1,nski
315 value(i) = zero
316 is_written_value(i) = 0
317 iok_part(i) = h3d_part(ixsk(1,i+ideb))
318 ENDDO
319C-----------------------------------------------
320 IF (keyword == 'FLDZ/OUTER') THEN
321C-----------------------------------------------
322 is_written_value(1:nski) = 1
323 DO ifail=1,nfail
324 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
325 npar = mat_param(mx)%FAIL(ifail)%NUPARAM
326 nfunc = mat_param(mx)%FAIL(ifail)%NFUNC
327 nipar = mat_param(mx)%FAIL(ifail)%NIPARAM
328 DO i=1,nfunc
329 ifunc(i) = mat_param(mx)%FAIL(ifail)%IFUNC(i)
330 END DO
331 CALL idx_fld_sol(
332 1 nski ,npar ,nfunc ,ifunc ,
333 2 npf ,tf ,mat_param(mx)%FAIL(ifail)%UPARAM,
334 3 evar ,VALUE ,nipar ,mat_param(mx)%FAIL(ifail)%IPARAM,
335 4 bufly%LBUF(ir,is,it)%PLA)
336C
337 ENDIF
338 ENDDO
339 DO i=1,nski
340 skin_scalar(nskin+i) = value(i)
341 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
342 END DO
343C-----------------------------------------------
344 ELSEIF (keyword == 'FLDF/OUTER') THEN
345C-----------------------------------------------
346 is_written_value(1:nski) = 1
347 DO ifail=1,nfail
348 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
349 npar = mat_param(mx)%FAIL(ifail)%NUPARAM
350 nipar = mat_param(mx)%FAIL(ifail)%NIPARAM
351 nfunc = mat_param(mx)%FAIL(ifail)%NFUNC
352 DO i=1,nfunc
353 ifunc(i) = mat_param(mx)%FAIL(ifail)%IFUNC(i)
354 END DO
355 CALL dam_fld_sol(
356 1 nski ,npar ,nfunc ,ifunc ,
357 2 npf ,tf ,mat_param(mx)%FAIL(ifail)%UPARAM,
358 3 evar ,VALUE ,nipar ,mat_param(mx)%FAIL(ifail)%IPARAM,
359 4 bufly%LBUF(ir,is,it)%PLA)
360C
361 ENDIF
362 ENDDO
363 DO i=1,nski
364 skin_scalar(nskin+i) = value(i)
365 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
366 END DO
367 END IF !(KEYWORD == 'FLDZ/OUTER') THEN
368 nskin = nskin + nski
369 ideb = ideb + nski
370 END DO ! II=1,NSK,MVSIZ
371 END IF !(NSK>0) THEN
372 ENDIF !IF (IGTYP==
373 END DO ! NG=1,NGROUP
374C-----------
375 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
tens3dto2d
subroutine tens3dto2d(nel, ixc, x, ten3, ten2)
Definition h3d_skin_tensor.F:820
idx_fld_sol
subroutine idx_fld_sol(nel, nuparam, nfunc, ifunc, npf, tf, uparam, eps3, fld_idx, niparam, iparam, pla)
Definition h3d_sol_skin_scalar.F:154
dam_fld_sol
subroutine dam_fld_sol(nel, nuparam, nfunc, ifunc, npf, tf, uparam, eps3, dam, niparam, iparam, pla)
Definition h3d_sol_skin_scalar.F:355
min
#define min(a, b)
Definition macros.h:20
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002