OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_skin_scalar.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_skin_scalar ../engine/source/output/h3d/h3d_results/h3d_skin_scalar.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!|| h3d_fld_strain ../engine/source/output/h3d/h3d_results/h3d_fld_strain.F
29!|| h3d_fld_tsh ../engine/source/output/h3d/h3d_results/h3d_fld_tsh.F
30!|| h3d_pre_skin_scalar ../engine/source/output/h3d/h3d_results/h3d_skin_scalar.F
31!|| h3d_sol_skin_scalar ../engine/source/output/h3d/h3d_results/h3d_sol_skin_scalar.F
32!|| initbuf ../engine/share/resol/initbuf.F
33!||--- uses -----------------------------------------------------
34!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
35!|| h3d_inc_mod ../engine/share/modules/h3d_inc_mod.F
36!|| h3d_mod ../engine/share/modules/h3d_mod.F
37!|| initbuf_mod ../engine/share/resol/initbuf.F
38!|| loads_mod ../common_source/modules/loads/loads_mod.F90
39!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
40!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
41!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
42!|| pblast_mod ../common_source/modules/loads/pblast_mod.F90
43!|| schlieren_mod ../engine/share/modules/schlieren_mod.F
44!|| sensor_mod ../common_source/modules/sensor_mod.F90
45!|| table_mod ../engine/share/modules/table_mod.F
46!||====================================================================
47 SUBROUTINE h3d_skin_scalar(
48 . ELBUF_TAB ,SKIN_SCALAR ,IFUNC ,IPARG ,GEO ,
49 . IXS ,IXS10 ,IXS16 , IXS20 ,PM ,
50 . IPM ,IGEO ,X ,V ,W ,
51 . IPARTS ,H3D_PART ,
52 . IS_WRITTEN_SKIN ,INFO1 ,KEYWORD , H3D_DATA ,
53 6 IAD_ELEM ,FR_ELEM , WEIGHT ,TAG_SKINS6,
54 7 NPF ,TF ,BUFMAT,IBCL ,ILOADP ,LLOADP ,FAC ,
55 8 NSENSOR,SENSOR_TAB,TAGNCONT ,LOADP_HYD_INTER,XFRAME,FORC ,
56 9 NODAL_IPART ,IMAPSKP ,LOADS ,TABLE, IFRAME,MAT_PARAM,D,PBLAST)
57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE initbuf_mod
61 USE mat_elem_mod
62 USE schlieren_mod
63 USE h3d_mod
64 USE multi_fvm_mod
65 USE sensor_mod
66 USE h3d_inc_mod
67 USE table_mod
68 USE loads_mod
69 USE names_and_titles_mod, ONLY: ncharline100
70 USE elbufdef_mod
71 USE pblast_mod
72C-----------------------------------------------
73C I m p l i c i t T y p e s
74C-----------------------------------------------
75#include "implicit_f.inc"
76C-----------------------------------------------
77C C o m m o n B l o c k s
78C-----------------------------------------------
79#include "vect01_c.inc"
80#include "mvsiz_p.inc"
81#include "com01_c.inc"
82#include "com04_c.inc"
83#include "param_c.inc"
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87 INTEGER ,INTENT(IN) :: NSENSOR
88 my_real
89 . SKIN_SCALAR(*),X(3,*),V(3,*),W(3,*),GEO(NPROPG,*),PM(NPROPM,*),
90 . TF(*),BUFMAT(*)
91 my_real, INTENT(IN) :: D(3,NUMNOD)
92 INTEGER , DIMENSION(NUMSKINP0), INTENT(IN) :: IMAPSKP
93 INTEGER IPARG(NPARG,*),IXS(NIXS,*),IFUNC,IXS10(*),IXS16(*), IXS20(*),
94 . IPM(NPROPMI,*),IGEO(NPROPGI,*),IPARTS(*),
95 . H3D_PART(*),IS_WRITTEN_SKIN(*),INFO1,
96 . iad_elem(*),fr_elem(*), weight(*),tag_skins6(*),npf(*)
97 INTEGER LLOADP(*)
98 INTEGER ILOADP(SIZLOADP,*),IBCL(NIBCLD,*),NODAL_IPART(*)
99 INTEGER TAGNCONT(NLOADP_HYD_INTER,NUMNOD),LOADP_HYD_INTER(NLOADP_HYD)
100 my_real
101 . fac(lfacload,nloadp),xframe(nxframe,*),forc(*)
102 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
103 CHARACTER(LEN=NCHARLINE100)::KEYWORD
104 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
105 TYPE (H3D_DATABASE) :: H3D_DATA
106 TYPE (LOADS_) , INTENT(IN) :: LOADS
107 INTEGER , DIMENSION(LISKN,NUMFRAM+1) ,INTENT(IN) :: IFRAME
108 TYPE (TTABLE) ,DIMENSION(NTABLE) ,INTENT(IN) :: TABLE
109 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
110 TYPE (PBLAST_),INTENT(IN) :: PBLAST
111C-----------------------------------------------
112C L o c a l V a r i a b l e s
113C-----------------------------------------------
114 my_real
115 . value(mvsiz),rindx,strain(3,mvsiz),f_exp,f_gauss(9)
116 INTEGER I,I1,II,J,NG,NEL,NPTR,NPTS,NPTT,NLAY,L,IFAIL,ILAY,
117 . ir,is,it,il,mlw, nuvar,ius,lenf,ptf,ptm,pts,nfail,
118 . n,nn,k,k1,k2,jturb,mt,imid,ialel,ipid,ish3n,nni,
119 . nn1,nn2,nn3,nn4,nn5,nn6,nn9,nf,buf,nvarf,
120 . offset,ihbe,nptm,npg, mpt,ipt,iadd,iadr,ipmat,ifailt,
121 . iigeo,iadi,isubstack,ithk,nb_plyoff,iuvar,idx,ipos,itrimat,
122 . ialefvm_flg, imat,iadbuf,nuparam,iok_part(mvsiz),
123 . mlwi,pid,mid,mx,kcvt,ior_tsh,icstr
124 INTEGER
125 . is_written_value(mvsiz),nfrac,iu(4),iv,nb_face,kface,nskin
126 INTEGER NGL(MVSIZ)
127 TYPE(G_BUFEL_) ,POINTER :: GBUF
128 TYPE(L_BUFEL_) ,POINTER :: LBUF
129 TYPE(BUF_MAT_) ,POINTER :: MBUF
130 TYPE(BUF_LAY_) ,POINTER :: BUFLY
131 TYPE(BUF_FAIL_) ,POINTER :: FBUF
132 DATA F_GAUSS /
133 9 1.000000000000000,1.732050807568877,1.290994448735806,
134 9 1.161256338324528,1.103533701926633,1.072421119155361,
135 9 1.053620970803647,1.041352247171806,1.032886870574820/
136C-----------------------------------------------
137 nskin = 0
138 is_written_skin(1:numskin) = 0
139 IF (numskin> numskinp) THEN
140 DO ng=1,ngroup
141C
142 CALL initbuf( iparg ,ng ,
143 2 mlw ,nel ,nft ,iad ,ity ,
144 3 npt ,jale ,ismstr ,jeul ,jtur ,
145 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
146 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
147 6 irep ,iint ,igtyp ,israt ,isrot ,
148 7 icsen ,isorth ,isorthg ,ifailure,jsms )
149C
150 IF (mlw == 13 .OR. mlw == 0) cycle
151C-----------------------------------------------
152C THICK-SHELL
153C-----------------------------------------------
154! 8--------------7
155! / | /|
156! 5--------------|6
157! | | | |
158! | 4-----------|-3
159! | / |/
160! 1--------------2
161 IF (ity == 1.AND.(igtyp==20 .OR. igtyp==21 .OR. igtyp==22)) THEN
162 nft = iparg(3,ng)
163 icstr = iparg(17,ng)
164 llt=nel
165 nlay = elbuf_tab(ng)%NLAY
166 nptr = elbuf_tab(ng)%NPTR
167 npts = elbuf_tab(ng)%NPTS
168 nptt = elbuf_tab(ng)%NPTT
169 ior_tsh = 0
170 IF (igtyp == 21) THEN
171 ior_tsh = 1
172 ELSEIF (igtyp == 22) THEN
173 ior_tsh = 2
174 END IF
175 IF (kcvt==1.AND.ior_tsh/=0) kcvt=2
176c
177 DO i=1,nel
178 value(i) = zero
179 is_written_value(i) = 0
180 iok_part(i) = 0
181 IF( h3d_part(iparts(nft+i)) == 1) iok_part(i) = 1
182 ENDDO
183 mlwi = mlw
184 IF (igtyp == 22 .AND. nlay>9) THEN
185 f_exp = one
186 ELSE
187 f_exp = f_gauss(nlay)
188 END IF
189 IF (jhbe==14.OR.jhbe==16) f_exp = f_exp/(nptr*npts)
190C-----------------------------------------------
191 IF (keyword == 'FLDZ/OUTER') THEN
192 is_written_value(1:nel) = 1
193 mx = ixs(1,1 + nft)
194 ngl(1:nel) =ixs(nixs,1 + nft:nel + nft)
195 it = 1
196C-----------------------------------------------
197 ilay=1
198C-------- grp skin_inf first
199 IF (igtyp == 22) THEN
200 pid = ixs(nixs-1,1 + nft)
201 mid = igeo(100+ilay,pid)
202 mlwi=nint(pm(19,mid))
203 END IF
204 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
205 . jhbe,mlwi,ilay,kcvt,ior_tsh,
206 . icstr,nptr,npts,nel,f_exp,strain )
207C---------- F.I. uses also average strain to be consisting
208 ir = 1
209 is = 1
210 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
211 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
212 DO ifail=1,nfail
213 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
214 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
215 . ir,is,it,ilay,ifail,
216 . npf,tf,ngl,strain,nel )
217 DO i=1,nel
218 rindx = fbuf%FLOC(ifail)%INDX(i)
219 value(i) = max(value(i),rindx)
220 is_written_value(i) = 1
221 ENDDO
222 ENDIF
223 END DO
224C------
225 DO i=1,nel
226 skin_scalar(nskin+i) = value(i)
227 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
228 END DO
229 nskin = nskin + nel
230C-------- grp skin_up
231 ilay=nlay
232 value(1:nel) = zero
233 IF (igtyp == 22) THEN
234 pid = ixs(nixs-1,1 + nft)
235 mid = igeo(100+ilay,pid)
236 mlwi=nint(pm(19,mid))
237 END IF
238 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
239 . jhbe,mlwi,ilay,kcvt,ior_tsh,
240 . icstr,nptr,npts,nel,f_exp,strain )
241 ir = 1
242 is = 1
243 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
244 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
245 DO ifail=1,nfail
246 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
247 DO i=1,nel
248 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
249 . ir,is,it,ilay,ifail,
250 . npf,tf,ngl,strain,nel )
251 rindx = fbuf%FLOC(ifail)%INDX(i)
252 value(i) = max(value(i),rindx)
253 is_written_value(i) = 1
254 ENDDO
255 ENDIF
256 END DO
257 DO i=1,nel
258 skin_scalar(nskin+i) = value(i)
259 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
260 END DO
261 nskin = nskin + nel
262C-----------------------------------------------
263 ELSEIF (keyword == 'FLDZ/OUTER_AVERAGE') THEN
264 is_written_value(1:nel) = 1
265 mx = ixs(1,1 + nft)
266 ngl(1:nel) =ixs(nixs,1 + nft:nel + nft)
267 it = 1
268C-----------------------------------------------
269 ilay=(1+nlay)/2
270C-------- grp skin_inf first
271 IF (igtyp == 22) THEN
272 pid = ixs(nixs-1,1 + nft)
273 mid = igeo(100+ilay,pid)
274 mlwi=nint(pm(19,mid))
275 END IF
276 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
277 . jhbe,mlwi,ilay,kcvt,ior_tsh,
278 . icstr,nptr,npts,nel,f_exp,strain )
279C------
280 ir = 1
281 is = 1
282 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
283 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
284 DO ifail=1,nfail
285 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
286 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
287 . ir,is,it,ilay,ifail,
288 . npf,tf,ngl,strain,nel )
289 DO i=1,nel
290 rindx = fbuf%FLOC(ifail)%INDX(i)
291 value(i) = max(value(i),rindx)
292 is_written_value(i) = 1
293 ENDDO
294 ENDIF
295 END DO
296C------
297 DO i=1,nel
298 skin_scalar(nskin+i) = value(i)
299 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
300 END DO
301 nskin = nskin + nel
302C-------- grp skin_up
303 ilay=(1+nlay)/2
304 value(1:nel) = zero
305 IF (igtyp == 22) THEN
306 pid = ixs(nixs-1,1 + nft)
307 mid = igeo(100+ilay,pid)
308 mlwi=nint(pm(19,mid))
309 END IF
310 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
311 . jhbe,mlwi,ilay,kcvt,ior_tsh,
312 . icstr,nptr,npts,nel,f_exp,strain )
313 ir = 1
314 is = 1
315 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
316 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
317 DO ifail=1,nfail
318 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
319 DO i=1,nel
320 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
321 . ir,is,it,ilay,ifail,
322 . npf,tf,ngl,strain,nel )
323 rindx = fbuf%FLOC(ifail)%INDX(i)
324 value(i) = max(value(i),rindx)
325 is_written_value(i) = 1
326 ENDDO
327 ENDIF
328 END DO
329 DO i=1,nel
330 skin_scalar(nskin+i) = value(i)
331 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
332 END DO
333 nskin = nskin + nel
334C-----------------------------------------------
335 ELSEIF (keyword == 'FLDF/OUTER') THEN
336 is_written_value(1:nel) = 1
337 mx = ixs(1,1 + nft)
338 ngl(1:nel) =ixs(nixs,1 + nft:nel + nft)
339C-----------------------------------------------
340 ilay=1
341 it = 1
342 IF (igtyp == 22) THEN
343 pid = ixs(nixs-1,1 + nft)
344 mid = igeo(100+ilay,pid)
345 mlwi=nint(pm(19,mid))
346 END IF
347 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
348 . jhbe,mlwi,ilay,kcvt,ior_tsh,
349 . icstr,nptr,npts,nel,f_exp,strain )
350C-------- grp skin_inf first
351 ir = 1
352 is = 1
353 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
354 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
355 DO ifail=1,nfail
356 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
357 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
358 . ir,is,it,ilay,ifail,
359 . npf,tf,ngl,strain,nel )
360 DO i=1,nel
361 value(i) = max(value(i),fbuf%FLOC(ifail)%DAM(i))
362 is_written_value(i) = 1
363 ENDDO
364 ENDIF
365 END DO
366C------
367 DO i=1,nel
368 n = i + nft
369 skin_scalar(nskin+i) = value(i)
370 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
371 END DO
372 nskin = nskin + nel
373C-------- grp skin_up
374 ilay=nlay
375 it = 1
376 value(1:nel) = zero
377 IF (igtyp == 22) THEN
378 pid = ixs(nixs-1,1 + nft)
379 mid = igeo(100+ilay,pid)
380 mlwi=nint(pm(19,mid))
381 END IF
382 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
383 . jhbe,mlwi,ilay,kcvt,ior_tsh,
384 . icstr,nptr,npts,nel,f_exp,strain )
385 ir = 1
386 is = 1
387 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
388 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
389 DO ifail=1,nfail
390 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
391 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
392 . ir,is,it,ilay,ifail,
393 . npf,tf,ngl,strain,nel )
394 DO i=1,nel
395 value(i) = max(value(i),fbuf%FLOC(ifail)%DAM(i))
396 is_written_value(i) = 1
397 ENDDO
398 ENDIF
399 END DO
400 DO i=1,nel
401 n = i + nft
402 skin_scalar(nskin+i) = value(i)
403 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
404 END DO
405 nskin = nskin + nel
406C------------to get right NSKIN for next case
407 ELSEIF (keyword == 'FLDF/OUTER_AVERAGE') THEN
408 is_written_value(1:nel) = 1
409 mx = ixs(1,1 + nft)
410 ngl(1:nel) =ixs(nixs,1 + nft:nel + nft)
411C-----------------------------------------------
412 ilay=(1+nlay)/2
413 it = 1
414 IF (igtyp == 22) THEN
415 pid = ixs(nixs-1,1 + nft)
416 mid = igeo(100+ilay,pid)
417 mlwi=nint(pm(19,mid))
418 END IF
419 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
420 . jhbe,mlwi,ilay,kcvt,ior_tsh,
421 . icstr,nptr,npts,nel,f_exp,strain )
422C-------- grp skin_inf first
423 ir = 1
424 is = 1
425 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
426 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
427 DO ifail=1,nfail
428 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
429 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
430 . ir,is,it,ilay,ifail,
431 . npf,tf,ngl,strain,nel )
432 DO i=1,nel
433 value(i) = max(value(i),fbuf%FLOC(ifail)%DAM(i))
434 is_written_value(i) = 1
435 ENDDO
436 ENDIF
437 END DO
438C------
439 DO i=1,nel
440 n = i + nft
441 skin_scalar(nskin+i) = value(i)
442 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
443 END DO
444 nskin = nskin + nel
445C-------- grp skin_up
446 ilay=(1+nlay)/2
447 it = 1
448 value(1:nel) = zero
449 IF (igtyp == 22) THEN
450 pid = ixs(nixs-1,1 + nft)
451 mid = igeo(100+ilay,pid)
452 mlwi=nint(pm(19,mid))
453 END IF
454 CALL h3d_fld_strain(elbuf_tab(ng),x ,ixs ,
455 . jhbe,mlwi,ilay,kcvt,ior_tsh,
456 . icstr,nptr,npts,nel,f_exp,strain )
457 ir = 1
458 is = 1
459 fbuf => elbuf_tab(ng)%BUFLY(ilay)%FAIL(ir,is,it)
460 nfail = elbuf_tab(ng)%BUFLY(ilay)%NFAIL
461 DO ifail=1,nfail
462 IF (fbuf%FLOC(ifail)%ILAWF == 7) THEN ! check /FLD model
463 CALL h3d_fld_tsh(elbuf_tab(ng),mat_param(mx)%FAIL(ifail),
464 . ir,is,it,ilay,ifail,
465 . npf,tf,ngl,strain,nel )
466 DO i=1,nel
467 value(i) = max(value(i),fbuf%FLOC(ifail)%DAM(i))
468 is_written_value(i) = 1
469 ENDDO
470 ENDIF
471 END DO
472 DO i=1,nel
473 n = i + nft
474 skin_scalar(nskin+i) = value(i)
475 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_value(i)
476 END DO
477 nskin = nskin + nel
478C------------to get right NSKIN for next case
479 ELSE
480 nskin = nskin + 2*nel
481 END IF !(KEYWORD
482 END IF !(ITY == 1.AND.(IGTYP==20 .OR. IGTYP==21 .OR. IGTYP==22)) THEN
483 END DO !NG=1,NGROUP
484 END IF !(NUMSKIN> NUMSKINP) THEN
485C------for solid elements
486 IF (numskin> (nskin+numskinp))
487 . CALL h3d_sol_skin_scalar(
488 . elbuf_tab,skin_scalar, iparg ,ixs ,x ,pm ,
489 4 iparts ,igeo ,ixs10 ,ixs16 , ixs20 ,
490 5 is_written_skin ,h3d_part,info1 ,keyword ,nskin ,
491 6 iad_elem ,fr_elem , weight ,tag_skins6,
492 7 npf ,tf ,mat_param)
493C------for solid elements
494 IF (numskinp> 0)
495 . CALL h3d_pre_skin_scalar(skin_scalar,nodal_ipart,
496 . is_written_skin ,h3d_part,info1 ,keyword ,
497 . ibcl,iloadp,lloadp,fac ,npf,tf ,sensor_tab,
498 . tagncont,loadp_hyd_inter,forc,xframe ,x ,v ,
499 . imapskp,nskin ,nsensor,loads ,table, iframe,d,
500 . pblast)
501C-----------------------------------------------
502 RETURN
503 END
504!||====================================================================
505!|| h3d_pre_skin_scalar ../engine/source/output/h3d/h3d_results/h3d_skin_scalar.F
506!||--- called by ------------------------------------------------------
507!|| h3d_skin_scalar ../engine/source/output/h3d/h3d_results/h3d_skin_scalar.F
508!||--- calls -----------------------------------------------------
509!|| finter ../engine/source/tools/curve/finter.F
510!|| finter_smooth ../engine/source/tools/curve/finter_smooth.F
511!|| get_u_numsens ../engine/source/user_interface/usensor.F
512!|| get_u_sens_fpar ../engine/source/user_interface/usensor.F
513!|| get_u_sens_ipar ../engine/source/user_interface/usensor.F
514!|| get_u_sens_value ../engine/source/user_interface/usensor.F
515!|| press_seg3 ../engine/source/loads/general/load_pcyl/press_seg3.F
516!|| set_u_sens_value ../engine/source/user_interface/usensor.F
517!||--- uses -----------------------------------------------------
518!|| h3d_inc_mod ../engine/share/modules/h3d_inc_mod.F
519!|| h3d_mod ../engine/share/modules/h3d_mod.F
520!|| loads_mod ../common_source/modules/loads/loads_mod.F90
521!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
522!|| pblast_mod ../common_source/modules/loads/pblast_mod.F90
523!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
524!|| sensor_mod ../common_source/modules/sensor_mod.F90
525!|| table_mod ../engine/share/modules/table_mod.F
526!||====================================================================
527 SUBROUTINE h3d_pre_skin_scalar(SKIN_SCALAR,NODAL_IPART,
528 . IS_WRITTEN_SKIN ,H3D_PART,INFO1 ,KEYWORD ,
529 . IB ,ILOADP,LLOADP,FAC ,NPC,TF ,SENSOR_TAB,
530 . TAGNCONT,LOADP_HYD_INTER,FORC,XFRAME,X ,V ,
531 . IMAPSKP, NSKIN ,NSENSOR ,LOADS ,TABLE,IFRAME,DIS,
532 . PBLAST)
533C-----------------------------------------------
534C M o d u l e s
535C-----------------------------------------------
536 USE h3d_mod
537 USE pinchtype_mod
538 USE pblast_mod
539 USE sensor_mod
540 USE h3d_inc_mod
541 USE loads_mod
542 USE table_mod
543 USE names_and_titles_mod, ONLY: ncharline100
544C-----------------------------------------------
545C I m p l i c i t T y p e s
546C-----------------------------------------------
547#include "implicit_f.inc"
548#include "param_c.inc"
549C-----------------------------------------------
550C C o m m o n B l o c k s
551C-----------------------------------------------
552#include "com04_c.inc"
553#include "com08_c.inc"
554#include "tabsiz_c.inc"
555C-----------------------------------------------
556C E x t e r n a l F u n c t i o n s
557C-----------------------------------------------
558 INTEGER GET_U_NUMSENS,GET_U_SENS_FPAR,GET_U_SENS_IPAR,
559 . GET_U_SENS_VALUE,SET_U_SENS_VALUE
560 EXTERNAL GET_U_NUMSENS,GET_U_SENS_FPAR,GET_U_SENS_IPAR,
561 . GET_U_SENS_VALUE,SET_U_SENS_VALUE
562C-----------------------------------------------,
563C D u m m y A r g u m e n t s
564C-----------------------------------------------
565 INTEGER ,INTENT(IN) :: NSENSOR
566 my_real
567 . SKIN_SCALAR(*),TF(*),X(3,*),V(3,*)
568 my_real, INTENT(IN) :: DIS(3,NUMNOD)
569 CHARACTER(LEN=NCHARLINE100) :: KEYWORD
570 TYPE (H3D_DATABASE) :: H3D_DATA
571 INTEGER , DIMENSION(NUMSKINP0), INTENT(IN) :: IMAPSKP
572 integer
573 . h3d_part(*),is_written_skin(*),info1,npc(*)
574 INTEGER LLOADP(SLLOADP),NSKIN
575 INTEGER ILOADP(SIZLOADP,*),IB(NIBCLD,*)
576 INTEGER TAGNCONT(NLOADP_HYD_INTER,NUMNOD),
577 . LOADP_HYD_INTER(NLOADP_HYD),NODAL_IPART(*)
578 my_real
579 . fac(lfacload,nloadp),xframe(nxframe,*),forc(lfaccld,*)
580 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
581 TYPE (LOADS_) , INTENT(IN) :: LOADS
582 INTEGER , DIMENSION(LISKN,NUMFRAM+1) ,INTENT(IN) :: IFRAME
583 TYPE (TTABLE) ,DIMENSION(NTABLE) ,INTENT(IN) :: TABLE
584 TYPE(pblast_), INTENT(IN) :: PBLAST
585C-----------------------------------------------
586C L o c a l V a r i a b l e s
587C-----------------------------------------------
588 INTEGER NL, N1, ISK, N2, N3, N4, N5,
589 . iad ,np ,ifunc ,npres,nskin0,nskin1,n1fram,dir_hsp,i,n
590 INTEGER K1, K2, K3, ISENS,K,LL,IERR,
591 . N_OLD, ISMOOTH,IDEL,NINTERP ,NPL,TAGN1,TAGN2,TAGN3,TAGN4,
592 . fun_cx,fun_vel,dir_vel,ifra2, ianim,ijk,up_bound,
593 . iz_update,abac_id,isiz_seg,ierr1,
594 . phi_i, id, user_id, ita_shift,ndt,ndt0,
595 . niter,iter,imodel,il,is,segcont,fun_hsp,ifra1,ifload,np0,npi
596 my_real
597 . nx, ny, nz, axi, aa, a0, vv, fx, fy, fz, ax, dydx, ts,
598 . sixth,x_old, f1, f2,xsens,fcx,fcy,fcypinch,fp,
599 . fcx1,fcy1,fcx2,fcy2,vx,vy,vz,vel,vseg,norm
600 my_real finter, zfx,zfy,zfz, zzfx,zzfy,zzfz,ps, zx,zy,zz,finter_smooth
601c
602 my_real coormean,ymean,zmean,pvel,nsign,dnorm,
603 . xdet,ydet,zdet,tdet,wtnt,pmin,dx,dy,dz,normd, p,
604 . fac_m_bb, fac_l_bb, fac_t_bb, fac_p_bb, fac_i_bb, t0inf_loc, ta_shift, tt_star
605
606 INTEGER :: IFUN,IFRA,M1,M2,NDIM,NPOINT, IIOUT,SHIFT,FUNCTYPE
607 my_real :: A11,A12,A21,A22,B1,B2,DET,LEN,DIRX,DIRY,DIRZ,
608 . BETA,GAMMA,R,S,RMAX,XFACR,XFACT,YFAC,SEGP,PRESS,DISP
609 my_real, DIMENSION(3) :: P0,DIR,A,B,C,D,M
610
611 EXTERNAL finter,finter_smooth
612C=======================================================================
613C---- fill SKIN_SCALAR(*) w/ IS_WRITTEN_SKIN(*)=1
614 IF (keyword /= 'PEXT') RETURN
615 is_written_skin(nskin+1:numskin) = 0
616 skin_scalar(nskin+1:numskin)=zero
617 np0= 0
618 nskin0 = nskin
619C-----Force (pressure) first
620 n_old = 0
621 x_old = zero
622 DO nl=1,nconld-nploadpinch
623 n1 = ib(1,nl)
624 n2 = ib(2,nl)
625 n3 = ib(3,nl)
626 n4 = ib(4,nl)
627 n5 = ib(5,nl)
628 idel = ib(8,nl)
629 functype= ib(9,nl)
630 fcy = forc(1,nl)
631 fcx = forc(2,nl)
632 IF (n1==0.OR.n2==0.OR.n3==0.OR.n4==-1) cycle
633C--------default zero
634 np0 = np0 + 1
635 nskin = nskin0+ imapskp(np0)
636 IF (nodal_ipart(n1)>0) THEN
637 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
638 END IF
639 isens = 0
640 xsens = one
641 DO k=1,nsensor
642 IF(ib(6,nl)==sensor_tab(k)%SENS_ID) isens=k
643 ENDDO
644 IF(isens==0)THEN
645 ts=tt
646 ELSE
647 ts = tt-sensor_tab(isens)%TSTART
648 ENDIF
649 IF(idel > 0 .OR. ts < zero) cycle ! SEGMENT DELETED,SENSOR
650 IF (functype == 1) THEN
651 IF(n_old/=n5.OR.x_old/=ts) THEN
652 ismooth = 0
653 IF (n5 > 0) ismooth = npc(2*nfunct+n5+1)
654 IF (ismooth == 0) THEN
655 f1 = finter(n5,ts*fcx,npc,tf,dydx)
656 ELSE
657 f1 = finter_smooth(n5,ts*fcx,npc,tf,dydx)
658 ENDIF ! IF (ISMOOTH == 0)
659 n_old = n5
660 x_old = ts
661 ENDIF
662 ELSE IF(functype == 2) THEN
663 IF(n_old/=n5) THEN
664 disp = (dis(3,n1)+dis(3,n2)+dis(3,n3)+dis(3,n4))/4.0
665 ismooth = 0
666 IF (n5 > 0) ismooth = npc(2*nfunct+n5+1)
667 IF (ismooth == 0) THEN
668 f1 = finter(n5,disp*fcx,npc,tf,dydx)
669 ELSE
670 f1 = finter_smooth(n5,disp*fcx,npc,tf,dydx)
671 ENDIF ! IF (ISMOOTH == 0)
672 n_old = n5
673 x_old = disp
674 ENDIF
675 ELSE IF(functype == 3) THEN
676 IF(n_old/=n5) THEN
677 vel = (v(3,n1)+v(3,n2)+v(3,n3)+v(3,n4))/4.0
678 ismooth = 0
679 IF (n5 > 0) ismooth = npc(2*nfunct+n5+1)
680 IF (ismooth == 0) THEN
681 f1 = finter(n5,vel*fcx,npc,tf,dydx)
682 ELSE
683 f1 = finter_smooth(n5,vel*fcx,npc,tf,dydx)
684 ENDIF ! IF (ISMOOTH == 0)
685 n_old = n5
686 x_old = vel
687 ENDIF
688 ENDIF
689 aa = fcy*f1*xsens
690 skin_scalar(nskin)=aa
691 END DO
692C----------load_pressure
693 shift = nloadp_f+pblast%NLOADP_B
694 DO np=1+shift,nloadp_hyd+shift
695 isiz_seg = iloadp(1,np)/4
696 ifunc = iloadp(3,np)
697 iad = iloadp(4,np)
698 ninterp = iloadp(5,np)
699 isens = iloadp(7,np)
700 ifload = iloadp(10,np)
701 fcy = fac(1,np)
702 fcx = fac(2,np)
703C--------default zero
704 DO n=1, isiz_seg
705 n1 = lloadp(iad+4*(n-1))
706 n2 = lloadp(iad+4*(n-1)+1)
707 n3 = lloadp(iad+4*(n-1)+2)
708 n4 = lloadp(iad+4*(n-1)+3)
709 IF (n1==0.OR.n2==0.OR.n3==0) cycle
710 nskin = nskin0+ imapskp(np0+n)
711 IF (nodal_ipart(n1)>0) THEN
712 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
713 END IF
714 ENDDO
715C
716 IF(isens==0)THEN
717 ts=tt
718 ELSE
719 ts = tt-sensor_tab(isens)%TSTART
720 ENDIF
721 DO n=1, isiz_seg
722 n1 = lloadp(iad+4*(n-1))
723 n2 = lloadp(iad+4*(n-1)+1)
724 n3 = lloadp(iad+4*(n-1)+2)
725 n4 = lloadp(iad+4*(n-1)+3)
726 IF (n1==0.OR.n2==0.OR.n3==0) cycle
727
728 np0 = np0 + 1
729 IF(ts<zero) cycle
730 nskin = nskin0+ imapskp(np0)
731 f1 = finter(ifunc,ts*fcx,npc,tf,dydx)
732 aa = fcy*f1
733C----------------
734C Check if segment is in contact
735C----------------
736 segcont = 0
737
738 tagn1 = 0
739 tagn2 = 0
740 tagn3 = 0
741 tagn4 = 0
742 fp = one
743 IF(ninterp > 0 ) THEN
744 npl = loadp_hyd_inter(np)
745 IF(n4/=0) THEN
746 segcont = tagncont(npl,n1) + tagncont(npl,n2) +
747 . tagncont(npl,n3)+tagncont(npl,n4)
748 IF(segcont >= 2 .AND.ifload==1) THEN
749 segcont = 1
750 ELSEIF(segcont <= 1.AND.ifload==2) THEN
751 segcont = 1
752 ELSE
753 segcont = 0
754 ENDIF
755 ELSE
756 segcont = tagncont(npl,n1) + tagncont(npl,n2) +
757 . tagncont(npl,n3)
758 IF(segcont >= 2 .AND.ifload==1) THEN
759 segcont = 1
760 ELSEIF(segcont <= 1.AND.ifload==2) THEN
761 segcont = 1
762 ELSE
763 segcont = 0
764 ENDIF
765 ENDIF
766c IF (FP==ZERO) FP = ONE
767 ENDIF
768 IF (segcont==1) aa = zero
769 skin_scalar(nskin)=skin_scalar(nskin)+aa*fp
770 END DO !N=1, NPRES/4
771 END DO !NP=1,NLOADP_HYD
772C---------pfluid
773 DO nl=1,nloadp_f
774C--------default zero
775 isiz_seg = iloadp(1,nl)/4
776 iad = iloadp(4,nl)
777 DO n=1, isiz_seg
778 n1 = lloadp(iad+4*(n-1))
779 n2 = lloadp(iad+4*(n-1)+1)
780 n3 = lloadp(iad+4*(n-1)+2)
781 n4 = lloadp(iad+4*(n-1)+3)
782 IF (n1==0.OR.n2==0.OR.n3==0) cycle
783 nskin = nskin0+ imapskp(np0+n)
784 IF (nodal_ipart(n1)>0) THEN
785 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
786 END IF
787 ENDDO
788 fun_hsp=iloadp(7,nl)
789 dir_hsp=iloadp(8,nl)
790 ifra1=iloadp(9,nl)
791 fcy = fac(1,nl)
792 fcx = fac(2,nl)
793 fun_cx=iloadp(10,nl)
794 fcy1 = fac(3,nl)
795 fcx1 = fac(4,nl)
796 fun_vel=iloadp(11,nl)
797 fcy2 = fac(5,nl)
798 fcx2 = fac(6,nl)
799 ! To avoid a check bound issue when the velocity options are not set in the input,
800 ! the DIR_VEL variable is bounded to a minimal value of 1
801 dir_vel=max(iloadp(12,nl),1)
802 ifra2=iloadp(13,nl)
803 isens=0
804 xsens = one
805 DO k=1,nsensor
806 IF(iloadp(6,nl)==sensor_tab(k)%SENS_ID) isens=k
807 ENDDO
808 IF(isens==0)THEN
809 ts=tt
810 ELSE
811 ts = tt-sensor_tab(isens)%TSTART
812 ENDIF
813 DO i = 1,isiz_seg
814 n1=lloadp(iloadp(4,nl)+4*(i-1))
815 n2=lloadp(iloadp(4,nl)+4*(i-1)+1)
816 n3=lloadp(iloadp(4,nl)+4*(i-1)+2)
817 n4=lloadp(iloadp(4,nl)+4*(i-1)+3)
818 IF (n1==0.OR.n2==0.OR.n3==0) cycle
819 np0 = np0 + 1
820 IF(ts < zero) cycle
821 nskin = nskin0+ imapskp(np0)
822C
823 aa = zero
824 vel = zero
825 pvel=zero
826C------ ----------
827C
828 IF(n4/=0 .AND. n1/=n2 .AND. n1/=n3 .AND. n1/=n4 .AND.
829 . n2/=n3 .AND. n2/=n4 .AND. n3/=n4 )THEN
830C
831 k1=3*dir_hsp-2
832 k2=3*dir_hsp-1
833 k3=3*dir_hsp
834 ! hydrostatic pressure
835 IF(fun_hsp /=0)THEN
836 coormean = (xframe(k1,ifra1)*(x(1,n1)+x(1,n2)+x(1,n3)+x(1,n4))/four)+
837 . (xframe(k2,ifra1)*(x(2,n1)+x(2,n2)+x(2,n3)+x(2,n4))/four)+
838 . (xframe(k3,ifra1)*(x(3,n1)+x(3,n2)+x(3,n3)+x(3,n4))/four)
839 aa = fcy*finter(fun_hsp,(coormean-xframe(9+dir_hsp,ifra1))*fcx,npc,tf,dydx)
840 ENDIF
841 nx= (x(2,n3)-x(2,n1))*(x(3,n4)-x(3,n2)) - (x(3,n3)-x(3,n1))*(x(2,n4)-x(2,n2))
842 ny= (x(3,n3)-x(3,n1))*(x(1,n4)-x(1,n2)) - (x(1,n3)-x(1,n1))*(x(3,n4)-x(3,n2))
843 nz= (x(1,n3)-x(1,n1))*(x(2,n4)-x(2,n2)) - (x(2,n3)-x(2,n1))*(x(1,n4)-x(1,n2))
844 norm = sqrt(nx*nx+ny*ny+nz*nz)
845 aa = aa * half * norm
846C vel pressure
847 k1=3*dir_vel-2
848 k2=3*dir_vel-1
849 k3=3*dir_vel
850c
851 nsign = (nx * xframe(k1,ifra2) +
852 . ny * xframe(k2,ifra2) +
853 . nz * xframe(k3,ifra2))
854 IF(nsign/=zero) nsign = sign(one,nsign)
855C
856 vseg= (xframe(k1,ifra2)*
857 . (v(1,n1) + v(1,n2) + v(1,n3) + v(1,n4)) /four)+
858 . (xframe(k2,ifra2)*
859 . (v(2,n1) + v(2,n2) + v(2,n3) + v(2,n4)) /four)+
860 . (xframe(k3,ifra2)*
861 . (v(3,n1) + v(3,n2) + v(3,n3) + v(3,n4)) /four)
862
863 IF(fun_vel /=0)THEN
864 vel = fcy2*finter(fun_vel,tt*fcx2,npc,tf,dydx)- vseg
865 ELSE
866 vel = - vseg
867 ENDIF
868 IF(fun_cx /=0)
869 . pvel = ( (-(nx/norm)*vel*xframe(k1,ifra2)-
870 . (ny/norm)*vel*xframe(k2,ifra2)-
871 . (nz/norm)*vel*xframe(k3,ifra2))**2 )* fcy1*
872 . finter(fun_cx,tt*fcx1,npc,tf,dydx)/two
873C
874 ELSE
875 IF(n1 == n2)THEN
876 n2 = n3
877 n3 = n4
878 n4 = 0
879 ELSEIF(n1 == n3)THEN
880 n3 = n4
881 n4 = 0
882 ELSEIF(n1 == n4)THEN
883 n4 = 0
884 ELSEIF(n2 == n3)THEN
885 n3 = n4
886 n4 = 0
887 ELSEIF(n2 == n4)THEN
888 n2 = n3
889 n3 = n4
890 n4 = 0
891 ELSEIF(n3 == n4)THEN
892 n4 = 0
893 ENDIF
894 IF (n4==0) n4=n3
895C true triangles.
896 IF(fun_hsp /=0)THEN
897 k1=3*dir_hsp-2
898 k2=3*dir_hsp-1
899 k3=3*dir_hsp
900 ! hydrostatic pressure
901 coormean = (xframe(k1,ifra1)*(x(1,n1)+x(1,n2)+x(1,n3))/three)+
902 . (xframe(k2,ifra1)*(x(2,n1)+x(2,n2)+x(2,n3))/three)+
903 . (xframe(k3,ifra1)*(x(3,n1)+x(3,n2)+x(3,n3))/three)
904 aa = fcy*finter(fun_hsp,(coormean-xframe(9+dir_hsp,ifra1))*fcx,npc,tf,dydx)
905 ENDIF
906 nx= (x(2,n3)-x(2,n1))*(x(3,n4)-x(3,n2)) - (x(3,n3)-x(3,n1))*(x(2,n4)-x(2,n2))
907 ny= (x(3,n3)-x(3,n1))*(x(1,n4)-x(1,n2)) - (x(1,n3)-x(1,n1))*(x(3,n4)-x(3,n2))
908 nz= (x(1,n3)-x(1,n1))*(x(2,n4)-x(2,n2)) - (x(2,n3)-x(2,n1))*(x(1,n4)-x(1,n2))
909 norm = sqrt(nx*nx+ny*ny+nz*nz)
910 aa = aa * half * norm
911C vel pressure
912 k1=3*dir_vel-2
913 k2=3*dir_vel-1
914 k3=3*dir_vel
915c
916 nsign = (nx * xframe(k1,ifra2) +
917 . ny * xframe(k2,ifra2) +
918 . nz * xframe(k3,ifra2))
919 IF(nsign/=zero) nsign = sign(one,nsign)
920C
921 vseg= (xframe(k1,ifra2)*
922 . (v(1,n1) + v(1,n2) + v(1,n3)) /three)+
923 . (xframe(k2,ifra2)*
924 . (v(2,n1) + v(2,n2) + v(2,n3)) /three)+
925 . (xframe(k3,ifra2)*
926 . (v(3,n1) + v(3,n2) + v(3,n3)) /three)
927
928 IF(fun_vel /=0)THEN
929 vel = fcy2*finter(fun_vel,tt*fcx2,npc,tf,dydx)- vseg
930 ELSE
931 vel = - vseg
932 ENDIF
933 IF(fun_cx /=0)
934 . pvel = ( (-(nx/norm)*vel*xframe(k1,ifra2)-
935 . (ny/norm)*vel*xframe(k2,ifra2)-
936 . (nz/norm)*vel*xframe(k3,ifra2))**2 )* fcy1*
937 . finter(fun_cx,tt*fcx1,npc,tf,dydx)/two
938 ENDIF
939 skin_scalar(nskin)=skin_scalar(nskin)-aa+pvel*nsign
940 END DO
941 END DO
942C---------pblast
943 DO nl=1+nloadp_f,nloadp_f+pblast%NLOADP_B
944C--------default zero
945 isiz_seg = iloadp(1,nl)/4
946 iad = iloadp(4,nl)
947 DO n=1, isiz_seg
948 n1 = lloadp(iad+4*(n-1))
949 n2 = lloadp(iad+4*(n-1)+1)
950 n3 = lloadp(iad+4*(n-1)+2)
951 n4 = lloadp(iad+4*(n-1)+3)
952 IF (n1==0.OR.n2==0.OR.n3==0) cycle
953 nskin = nskin0+ imapskp(np0+n)
954 IF (nodal_ipart(n1)>0) THEN
955 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
956 END IF
957 ENDDO
958 il = nl-nloadp_f
959 tdet = fac(01,nl)
960 id = iloadp(08,nl) !user_id
961 DO i = 1,isiz_seg
962 np0 = np0 + 1
963 IF (tt<tdet) cycle
964 nskin = nskin0+ imapskp(np0)
965 p = pblast%PBLAST_TAB(il)%PRES(i)
966 skin_scalar(nskin)= skin_scalar(nskin)-p
967 enddo!next I
968 END DO
969C---------/LOAD/PCYL
970 DO nl=1,loads%NLOAD_CYL
971C--------default zero
972 isiz_seg = loads%LOAD_CYL(nl)%NSEG
973 DO n=1, isiz_seg
974 n1 = loads%LOAD_CYL(nl)%SEGNOD(n,1)
975 n2 = loads%LOAD_CYL(nl)%SEGNOD(n,2)
976 n3 = loads%LOAD_CYL(nl)%SEGNOD(n,3)
977 n4 = loads%LOAD_CYL(nl)%SEGNOD(n,4)
978 IF (n1==0.OR.n2==0.OR.n3==0) cycle
979 nskin = nskin0+ imapskp(np0+n)
980 IF (nodal_ipart(n1)>0) THEN
981 IF (h3d_part(nodal_ipart(n1))==1) is_written_skin(nskin)=1
982 END IF
983 ENDDO
984 isens = loads%LOAD_CYL(nl)%ISENS
985 iiout = 0
986 IF (isens > 0) THEN
987 IF (sensor_tab(isens)%STATUS == 0) THEN
988 np0 = np0 + isiz_seg
989 cycle
990 END IF
991 END IF
992 ifra = loads%LOAD_CYL(nl)%IFRAME + 1
993 xfacr= loads%LOAD_CYL(nl)%XSCALE_R
994 xfact= loads%LOAD_CYL(nl)%XSCALE_T
995 yfac = loads%LOAD_CYL(nl)%YSCALE
996 ifun = loads%LOAD_CYL(nl)%ITABLE
997 ndim = table(ifun)%NDIM
998 npoint = SIZE(table(ifun)%X(1)%VALUES)
999 rmax = table(ifun)%X(1)%VALUES(npoint)
1000 m1 = iframe(1,ifra)
1001 m2 = iframe(2,ifra)
1002 dirx = x(1,m1) - x(1,m2)
1003 diry = x(2,m1) - x(2,m2)
1004 dirz = x(3,m1) - x(3,m2)
1005 len = sqrt(dirx**2 + diry**2 + dirz**2)
1006 ! SEGP beam axis
1007 dir(1) = dirx / len
1008 dir(2) = diry / len
1009 dir(3) = dirz / len
1010 p0(1) = x(1,m2)
1011 p0(2) = x(2,m2)
1012 p0(3) = x(3,m2)
1013 !---------------------------------------------
1014 ! LOOP ON SEGMENTS (4N or 3N)
1015 !---------------------------------------------
1016 DO n = 1,isiz_seg
1017 n1 = loads%LOAD_CYL(nl)%SEGNOD(n,1)
1018 n2 = loads%LOAD_CYL(nl)%SEGNOD(n,2)
1019 n3 = loads%LOAD_CYL(nl)%SEGNOD(n,3)
1020 n4 = loads%LOAD_CYL(nl)%SEGNOD(n,4)
1021 press = zero
1022 a(1) = x(1,n1)
1023 a(2) = x(2,n1)
1024 a(3) = x(3,n1)
1025 b(1) = x(1,n2)
1026 b(2) = x(2,n2)
1027 b(3) = x(3,n2)
1028 c(1) = x(1,n3)
1029 c(2) = x(2,n3)
1030 c(3) = x(3,n3)
1031 np0 = np0 + 1
1032 IF (n4 == 0) THEN ! 3 node segment
1033 CALL press_seg3(a ,b ,c ,p0 ,dir ,
1034 . ifun ,table ,xfacr ,xfact ,segp )
1035 press = abs(segp) * yfac
1036c
1037 ELSE ! 4 node segment
1038 d(1) = x(1,n4)
1039 d(2) = x(2,n4)
1040 d(3) = x(3,n4)
1041 m(1) = (x(1,n1) + x(1,n2) + x(1,n3) + x(1,n4)) * fourth
1042 m(2) = (x(2,n1) + x(2,n2) + x(2,n3) + x(2,n4)) * fourth
1043 m(3) = (x(3,n1) + x(3,n2) + x(3,n3) + x(3,n4)) * fourth
1044c 1st internal triangle
1045 CALL press_seg3(a ,b ,m ,p0 ,dir ,
1046 . ifun ,table ,xfacr ,xfact ,segp )
1047 press = press + segp * fourth
1048c 2nd internal triangle
1049 CALL press_seg3(b ,c ,m ,p0 ,dir ,
1050 . ifun ,table ,xfacr ,xfact ,segp )
1051 press = press + segp * fourth
1052c 3rd internal triangle
1053 CALL press_seg3(c ,d ,m ,p0 ,dir ,
1054 . ifun ,table ,xfacr ,xfact ,segp )
1055 press = press + segp * fourth
1056c 4th internal triangle
1057 CALL press_seg3(d ,a ,m ,p0 ,dir ,
1058 . ifun ,table ,xfacr ,xfact ,segp )
1059 press = abs(press) * yfac
1060 END IF ! seg 4 node
1061 nskin = nskin0+ imapskp(np0)
1062 skin_scalar(nskin)= skin_scalar(nskin)+press
1063 enddo!next N
1064 END DO
1065C
1066 RETURN
1067 END
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
h3d_fld_strain
subroutine h3d_fld_strain(elbuf_tab, x, ixs, jhbe, mlwi, ilay, kcvt, ior_tsh, icstr, nptr, npts, nel, f_exp, evar)
Definition h3d_fld_strain.F:37
h3d_fld_tsh
subroutine h3d_fld_tsh(elbuf_tab, fail, ir, is, it, ilay, ifail, npf, tf, ngl, evar, nel)
Definition h3d_fld_tsh.F:36
h3d_pre_skin_scalar
subroutine h3d_pre_skin_scalar(skin_scalar, nodal_ipart, is_written_skin, h3d_part, info1, keyword, ib, iloadp, lloadp, fac, npc, tf, sensor_tab, tagncont, loadp_hyd_inter, forc, xframe, x, v, imapskp, nskin, nsensor, loads, table, iframe, dis, pblast)
Definition h3d_skin_scalar.F:533
h3d_skin_scalar
subroutine h3d_skin_scalar(elbuf_tab, skin_scalar, ifunc, iparg, geo, ixs, ixs10, ixs16, ixs20, pm, ipm, igeo, x, v, w, iparts, h3d_part, is_written_skin, info1, keyword, h3d_data, iad_elem, fr_elem, weight, tag_skins6, npf, tf, bufmat, ibcl, iloadp, lloadp, fac, nsensor, sensor_tab, tagncont, loadp_hyd_inter, xframe, forc, nodal_ipart, imapskp, loads, table, iframe, mat_param, d, pblast)
Definition h3d_skin_scalar.F:57
h3d_sol_skin_scalar
subroutine h3d_sol_skin_scalar(elbuf_tab, skin_scalar, iparg, ixs, x, pm, iparts, igeo, ixs10, ixs16, ixs20, is_written_skin, h3d_part, info1, keyword, nskin, iad_elem, fr_elem, weight, tag_skins6, npf, tf, mat_param)
Definition h3d_sol_skin_scalar.F:44
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
h3d_inc_mod
Definition h3d_inc_mod.F:42
h3d_inc_mod::numskinp
integer numskinp
Definition h3d_inc_mod.F:44
h3d_mod
Definition h3d_mod.F:308
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
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::nploadpinch
integer nploadpinch
Definition pinchtype_mod.F:74
schlieren_mod
Definition schlieren_mod.F:46
table_mod
Definition table_mod.F:112
press_seg3
subroutine press_seg3(a, b, c, n1, dir, ifunc, table, xfacr, xfact, press)
Definition press_seg3.F:37