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