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

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_skin_off (elbuf_tab, iparg, ixs, ixs10, tag_skins6, skin_off)

Function/Subroutine Documentation

◆ h3d_skin_off()

subroutine h3d_skin_off ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,ngroup), intent(in) iparg,
integer, dimension(nixs,numels), intent(in) ixs,
integer, dimension(6,numels10), intent(in) ixs10,
integer, dimension(numels), intent(in) tag_skins6,
intent(out) skin_off )

Definition at line 34 of file h3d_skin_off.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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