OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_skin_off.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_off ../engine/source/output/h3d/h3d_results/h3d_skin_off.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| element_mod ../common_source/modules/elements/element_mod.F90
32!|| h3d_inc_mod ../engine/share/modules/h3d_inc_mod.F
33!|| initbuf_mod ../engine/share/resol/initbuf.F
34!||====================================================================
35 SUBROUTINE h3d_skin_off(ELBUF_TAB,IPARG,IXS,IXS10,
36 . TAG_SKINS6,SKIN_OFF)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE initbuf_mod
41 USE elbufdef_mod
42 USE h3d_inc_mod
43 use element_mod , only : nixs
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "param_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58C REAL
59 INTEGER, DIMENSION(NPARG,NGROUP),INTENT(IN):: IPARG
60 INTEGER, DIMENSION(NIXS,NUMELS),INTENT(IN):: IXS
61 INTEGER, DIMENSION(6,NUMELS10),INTENT(IN):: IXS10
62 INTEGER, DIMENSION(NUMELS),INTENT(IN):: TAG_SKINS6
63 my_real, DIMENSION(NUMSKIN),INTENT(OUT):: skin_off
64 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I,NSKIN,ISOLNOD,ICS,NG,N,J
69 INTEGER
70 . mlw ,nel ,nft ,iad ,ity ,
71 . npt ,jale ,ismstr ,jeul ,jtur ,
72 . jthe ,jlag ,jmult ,jhbe ,jivf ,
73 . nvaux ,jpor ,kcvt ,jclose ,jplasol ,
74 . irep ,iint ,igtyp ,israt ,isrot ,
75 . icsen ,isorth ,isorthg ,ifailure,jsms ,
76 . nn,n1
77 INTEGER NC(10,MVSIZ),PWR(7),LL
78 INTEGER FACES(4,6),NS(4),JJ,II,K1,K2,TIA4S(3,4)
79 TYPE(g_bufel_) ,POINTER :: GBUF
80 DATA pwr/1,2,4,8,16,32,64/
81 DATA faces/4,3,2,1,
82 . 5,6,7,8,
83 . 1,2,6,5,
84 . 3,4,8,7,
85 . 2,3,7,6,
86 . 1,5,8,4/
87 DATA tia4s/3,5,6,
88 . 2,4,5,
89 . 1,6,4,
90 . 4,6,5/
91C-----------------------------------------------
92 nskin =0
93 IF (numskin> numskinp) THEN
94 DO ng=1,ngroup
95 isolnod = iparg(28,ng)
96 ics = iparg(17,ng)
97 CALL initbuf(iparg ,ng ,
98 2 mlw ,nel ,nft ,iad ,ity ,
99 3 npt ,jale ,ismstr ,jeul ,jtur ,
100 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
101 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
102 6 irep ,iint ,igtyp ,israt ,isrot ,
103 7 icsen ,isorth ,isorthg ,ifailure,jsms )
104!
105 gbuf => elbuf_tab(ng)%GBUF
106 IF(mlw == 13 .OR. mlw == 0) cycle
107C-----------------------------------------------
108C THICK-SHELL
109C-----------------------------------------------
110! 8--------------7
111! / | /|
112! 5--------------|6
113! | | | |
114! | 4-----------|-3
115! | / |/
116! 1--------------2
117 IF (ity == 1.AND.(igtyp==20 .OR. igtyp==21 .OR. igtyp==22)) THEN
118
119C-------- grp skin_inf first
120 DO i=1,nel
121 skin_off(nskin+i) = nint(min(gbuf%OFF(i),one))
122 END DO
123 nskin = nskin + nel
124C-------- grp skin_sup
125 DO i=1,nel
126 skin_off(nskin+i) = nint(min(gbuf%OFF(i),one))
127 END DO
128 nskin = nskin + nel
129C-----------------------------------------------
130 ENDIF !IF (ITY == 1.AND.(IGTYP==20
131 END DO ! NG=1,NGROUP
132 END IF !(NUMSKIN> NUMSKINP) THEN
133C------SOLID elements
134 nft = nskin
135 IF (numskin> (nskin+numskinp)) THEN
136C
137 DO ng=1,ngroup
138 CALL initbuf(iparg ,ng ,
139 2 mlw ,nel ,nft ,iad ,ity ,
140 3 npt ,jale ,ismstr ,jeul ,jtur ,
141 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
142 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
143 6 irep ,iint ,igtyp ,israt ,isrot ,
144 7 icsen ,isorth ,isorthg ,ifailure,jsms )
145!
146 gbuf => elbuf_tab(ng)%GBUF
147 IF(mlw == 13 .OR. mlw == 0.OR.ity /= 1) cycle
148C------
149 IF (igtyp==6 .OR. igtyp==14 ) THEN
150 isolnod = iparg(28,ng)
151 ics = iparg(17,ng)
152 IF(isolnod == 4)THEN
153C---------each face
154 DO i=1,nel
155 n = i + nft
156 ll=tag_skins6(n)
157 jj = 5
158 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
159C---------3,2,1
160 nskin = nskin + 1
161 skin_off(nskin) = nint(min(gbuf%OFF(i),one))
162 END IF
163C---------2,3 ,4
164 jj = 4
165 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
166 nskin = nskin + 1
167 skin_off(nskin) = nint(min(gbuf%OFF(i),one))
168 END IF
169C---------1,4,3
170 jj = 3
171 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
172 nskin = nskin + 1
173 skin_off(nskin) = nint(min(gbuf%OFF(i),one))
174 END IF
175C---------1,2,4
176 jj = 6
177 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
178 nskin = nskin + 1
179 skin_off(nskin) = nint(min(gbuf%OFF(i),one))
180 END IF
181 ENDDO
182 ELSEIF(isolnod == 6)THEN
183 ELSEIF(isolnod == 10)THEN
184C---------each face 4x4
185 DO i=1,nel
186 n = i + nft
187 ll=tag_skins6(n)
188C---------1,2,3
189 jj = 5
190 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
191 DO j=1,4
192 nskin = nskin + 1
193 skin_off(nskin) = nint(min(gbuf%OFF(i),one))
194 END DO
195 END IF
196C---------2,3 ,4
197 jj = 4
198 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
199 DO j=1,4
200 nskin = nskin + 1
201 skin_off(nskin) = nint(min(gbuf%OFF(i),one))
202 END DO
203 END IF
204C---------1,4,3
205 jj = 3
206 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
207 DO j=1,4
208 nskin = nskin + 1
209 skin_off(nskin) = nint(min(gbuf%OFF(i),one))
210 END DO
211 END IF
212C---------1,2,4
213 jj = 6
214 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
215 DO j=1,4
216 nskin = nskin + 1
217 skin_off(nskin) = nint(min(gbuf%OFF(i),one))
218 END DO
219 END IF
220 ENDDO
221C-----------S8 (&degenerated),S20
222 ELSE
223 DO i=1,nel
224 n = i + nft
225 nc(1:8,i) = ixs(2:9,n)
226 ll=tag_skins6(n)
227C--------per face :
228 DO jj=1,6
229 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
230 DO ii=1,4
231 ns(ii)=nc(faces(ii,jj),i)
232 END DO
233C---------for degenerated cases
234 DO k1=1,3
235 DO k2=k1+1,4
236 IF(ns(k2)==ns(k1))ns(k2)=0
237 END DO
238 END DO
239 nn=0
240 DO k1=1,4
241 n1=ns(k1)
242 IF(n1/=0)THEN
243 nn=nn+1
244 ns(nn)= n1
245 END IF
246 END DO
247 IF (nn>2) THEN
248 nskin = nskin + 1
249 skin_off(nskin) = nint(min(gbuf%OFF(i),one))
250 END IF
251 ENDDO
252 ENDDO
253 ENDIF
254 ENDIF !IF (IGTYP==
255 END DO ! NG=1,NGROUP
256 END IF !(NUMSKIN> (NSKIN+NUMSKINP)) THEN
257C------to show pressure
258 nft = nskin
259 IF (numskinp>0) THEN
260 DO i=nft+1,numskin
261 skin_off(i) = one
262 END DO
263 END IF
264C-----------
265 RETURN
266 END
my_real
#define my_real
Definition cppsort.cpp:32
h3d_skin_off
subroutine h3d_skin_off(elbuf_tab, iparg, ixs, ixs10, tag_skins6, skin_off)
Definition h3d_skin_off.F:37
min
#define min(a, b)
Definition macros.h:20
h3d_inc_mod
Definition h3d_inc_mod.F:42
h3d_inc_mod::numskinp
integer numskinp
Definition h3d_inc_mod.F:44
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