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