OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_shell_vector_1.F File Reference
#include "implicit_f.inc"
#include "vect01_c.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_shell_vector_1 (elbuf_tab, shell_vector, ifunc, iparg, geo, ixq, ixc, ixtg, pm, el2fa, nbf, iadp, nbf_l, ehour, anim, nbpart, iadg, ipm, igeo, thke, err_thk_sh4, err_thk_sh3, invert, x, v, w, nv46, nercvois, nesdvois, lercvois, lesdvois, stack, id_elem, ity_elem, info1, info2, is_written_shell, ipartc, iparttg, layer_input, ipt_input, ply_input, gauss_input, iuvar_input, h3d_part, keyword, d, ng, multi_fvm)

Function/Subroutine Documentation

◆ h3d_shell_vector_1()

subroutine h3d_shell_vector_1 ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
shell_vector,
integer ifunc,
integer, dimension(nparg,ngroup) iparg,
geo,
integer, dimension(nixq,numelq) ixq,
integer, dimension(nixc,numelc) ixc,
integer, dimension(nixtg,numeltg) ixtg,
pm,
integer, dimension(*) el2fa,
integer nbf,
integer, dimension(*) iadp,
integer nbf_l,
ehour,
anim,
integer nbpart,
integer, dimension(nspmd,*) iadg,
integer, dimension(npropmi,nummat) ipm,
integer, dimension(npropgi,numgeo) igeo,
thke,
err_thk_sh4,
err_thk_sh3,
integer, dimension(*) invert,
x,
v,
w,
integer nv46,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
type (stack_ply) stack,
integer, dimension(*) id_elem,
integer, dimension(*) ity_elem,
integer info1,
integer info2,
integer, dimension(*) is_written_shell,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
integer layer_input,
integer ipt_input,
integer ply_input,
integer gauss_input,
integer iuvar_input,
integer, dimension(*) h3d_part,
character(len=ncharline100) keyword,
d,
integer ng,
type (multi_fvm_struct), intent(in) multi_fvm )

Definition at line 40 of file h3d_shell_vector_1.F.

52C-----------------------------------------------
53C M o d u l e s
54C-----------------------------------------------
55 USE initbuf_mod
56 USE elbufdef_mod
57 USE schlieren_mod
58 USE stack_mod
59 USE multi_fvm_mod
60 USE alefvm_mod , only:alefvm_param
61 USE names_and_titles_mod, ONLY: ncharline100
62 use element_mod , only : nixq,nixc,nixtg
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "vect01_c.inc"
71#include "mvsiz_p.inc"
72#include "com01_c.inc"
73#include "com04_c.inc"
74#include "param_c.inc"
75C-----------------------------------------------
76C D u m m y A r g u m e n t s
77C-----------------------------------------------
78 my_real
79 . shell_vector(3,*),x(3,numnod),v(3,numnod),w(3,numnod),d(3,numnod),thke(*),ehour(*),geo(npropg,numgeo),
80 . anim(*),pm(npropm,nummat),err_thk_sh4(*), err_thk_sh3(*)
81 INTEGER IPARG(NPARG,NGROUP),IXC(NIXC,NUMELC),IXTG(NIXTG,NUMELTG),EL2FA(*),
82 . IXQ(NIXQ,NUMELQ),IFUNC,NBF,
83 . IADP(*),NBF_L, NBPART,IADG(NSPMD,*),IPM(NPROPMI,NUMMAT),
84 . IGEO(NPROPGI,NUMGEO),INVERT(*), NV46,ID_ELEM(*),ITY_ELEM(*),
85 . INFO1,INFO2,IS_WRITTEN_SHELL(*),IPARTC(*),IPARTTG(*),H3D_PART(*),
86 . LAYER_INPUT ,IPT_INPUT,GAUSS_INPUT,PLY_INPUT,IUVAR_INPUT,NG
87 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
88 TYPE (STACK_PLY) :: STACK
89 CHARACTER(LEN=NCHARLINE100)::KEYWORD
90 TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 my_real value(3),p
95 INTEGER I, NEL, NPTR, NPTS, NPTT, NLAY, ILAY, MLW, JTURB,
96 . OFFSET,IHBE,NPG,MPT,IPT,ISUBSTACK,ITHK,NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*)
97 INTEGER NPT_ALL,IPLY,
98 . IOK_PART(MVSIZ),JJ(5),IUVAR,
99 . IS_WRITTEN_VALUE(MVSIZ)
100
101 TYPE(G_BUFEL_) ,POINTER :: GBUF
102
103
104C-----------------------------------------------
105
106 CALL initbuf(iparg ,ng ,
107 2 mlw ,nel ,nft ,iad ,ity ,
108 3 npt ,jale ,ismstr ,jeul ,jturb ,
109 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
110 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
111 6 irep ,iint ,igtyp ,israt ,isrot ,
112 7 icsen ,isorth ,isorthg ,ifailure,jsms )
113
114 IF(mlw /= 13) THEN
115
116 nft = iparg(3,ng)
117 iad = iparg(4,ng)
118 isubstack = iparg(71,ng)
119
120 iok_part(1:nel) = 0
121!
122 DO i=1,5
123 jj(i) = nel*(i-1)
124 ENDDO
125c
126 DO i=1,nel
127 is_written_value(i) = 0
128 ENDDO
129C-----------------------------------------------
130C COQUES 3 N 4 N
131C-----------------------------------------------
132 IF (ity == 3.OR.ity == 7) THEN
133
134 gbuf => elbuf_tab(ng)%GBUF
135 npt = iparg(6,ng)
136 ihbe = iparg(23,ng)
137 irep = iparg(35,ng)
138 igtyp = iparg(38,ng)
139 ithk = iparg(28,ng)
140 mpt = iabs(npt)
141 nptr = elbuf_tab(ng)%NPTR
142 npts = elbuf_tab(ng)%NPTS
143 nptt = elbuf_tab(ng)%NPTT
144 nlay = elbuf_tab(ng)%NLAY
145 npg = nptr*npts
146c
147 IF (ity == 3) offset = 0
148 IF (ity == 7) offset = numelc
149c
150 DO i=1,nel
151 IF (ity == 3) THEN
152 id_elem(offset+nft+i) = ixc(nixc,nft+i)
153 ity_elem(offset+nft+i) = 3
154 IF( h3d_part(ipartc(nft+i)) == 1) iok_part(i) = 1
155 ELSEIF (ity == 7) THEN
156 id_elem(offset+nft+i) = ixtg(nixtg,nft+i)
157 ity_elem(offset+nft+i) = 7
158 IF( h3d_part(iparttg(nft+i)) == 1) iok_part(i) = 1
159 ENDIF
160 ENDDO
161C
162 IF (igtyp == 51 .OR. igtyp == 52) THEN
163 npt_all = 0
164 DO ipt=1,nlay
165 npt_all = npt_all + elbuf_tab(ng)%BUFLY(ipt)%NPTT
166 ENDDO
167 IF (nlay == 1) mpt = max(1,npt_all)
168 ENDIF
169c
170 ilay = layer_input
171 ipt = ipt_input
172 iply = ply_input
173c IG = IGAUSS_INPUT
174 iuvar = iuvar_input
175 IF (ilay == -2) ilay = 1
176 IF (ilay == -3) ilay = nlay
177 IF (ipt == -2) ipt = 1
178 IF (ipt == -3) ipt = npt
179 value(1:3) = zero
180C---------------------
181 DO i=1,nel
182 shell_vector(1:3,offset+nft+i) = zero ! Default = zero in all cases !
183 ENDDO
184c
185C--------------------------------------------------
186 IF (keyword == 'VECT/VEL') THEN
187C--------------------------------------------------
188 IF (mlw == 151) THEN
189 DO i = 1, nel
190 value(1) = multi_fvm%VEL(1, i + nft)
191 value(2) = multi_fvm%VEL(2, i + nft)
192 value(3) = multi_fvm%VEL(3, i + nft)
193 CALL h3d_write_vector(iok_part,is_written_shell,shell_vector,i,offset,nft,
194 . VALUE)
195 ENDDO
196 ELSE
197 DO i=1,nel
198 IF(gbuf%G_MOM>0 .AND. alefvm_param%IEnabled > 0)THEN
199 value(1) = gbuf%MOM(jj(1) + i) / gbuf%RHO(i)
200 value(2) = gbuf%MOM(jj(2) + i) / gbuf%RHO(i)
201 value(3) = gbuf%MOM(jj(3) + i) / gbuf%RHO(i)
202 CALL h3d_write_vector(iok_part,is_written_shell,shell_vector,i,offset,nft,VALUE)
203 ENDIF
204 ENDDO
205 ENDIF
206C--------------------------------------------------
207 ELSEIF (keyword == 'VECT/ACC') THEN
208C--------------------------------------------------
209 IF (mlw == 151 .AND. ALLOCATED(multi_fvm%ACC)) THEN
210 DO i = 1, nel
211 value(1) = multi_fvm%ACC(1, i + nft)
212 value(2) = multi_fvm%ACC(2, i + nft)
213 value(3) = multi_fvm%ACC(3, i + nft)
214 CALL h3d_write_vector(iok_part,is_written_shell,shell_vector,i,offset,nft,VALUE)
215 ENDDO
216 ENDIF
217C--------------------------------------------------
218 ENDIF ! KEYWORD
219 ENDIF ! ITY
220c
221C-----------------------------------------------
222 ENDIF ! MLW /= 13
223C-----------------------------------------------
224 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
h3d_write_vector
subroutine h3d_write_vector(iok_part, is_written, vector, i, offset, nft, value)
Definition h3d_write_vector.F:36
max
#define max(a, b)
Definition macros.h:21
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
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
schlieren_mod
Definition schlieren_mod.F:46
stack_mod
Definition stack_mod.F:75