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 39 of file h3d_shell_vector_1.F.

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