OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_solid_vector.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_solid_vector ../engine/source/output/h3d/h3d_results/h3d_solid_vector.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!|| h3d_write_vector ../engine/source/output/h3d/h3d_results/h3d_write_vector.F
29!|| initbuf ../engine/share/resol/initbuf.F
30!||--- uses -----------------------------------------------------
31!|| aleanim_mod ../common_source/modules/aleanim_mod.F
32!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!|| h3d_mod ../engine/share/modules/h3d_mod.F
35!|| initbuf_mod ../engine/share/resol/initbuf.F
36!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
37!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
38!|| schlieren_mod ../engine/share/modules/schlieren_mod.F
39!|| stack_mod ../engine/share/modules/stack_mod.F
40!||====================================================================
41 SUBROUTINE h3d_solid_vector(
42 . ELBUF_TAB ,SOLID_VECTOR ,IFUNC ,IPARG ,GEO ,
43 . IXQ ,IXS ,IXTG ,PM ,
44 . EL2FA ,NBF ,IADP ,
45 . NBF_L ,EHOUR ,ANIM ,NBPART ,IADG ,
46 . IPM ,IGEO ,THKE ,ERR_THK_SH4 ,ERR_THK_SH3 ,
47 . INVERT ,X ,V ,W ,
48 . NV46 ,NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS ,
49 . STACK ,ID_ELEM ,ITY_ELEM ,IPARTS ,LAYER_INPUT ,
50 . IR_INPUT ,IS_INPUT ,IT_INPUT ,IUVAR_INPUT ,H3D_PART ,
51 . IS_WRITTEN_SOLID,INFO1 ,KEYWORD ,FANI_CELL ,
52 . H3D_DATA ,MULTI_FVM)
53C-----------------------------------------------
54C M o d u l e s
55C-----------------------------------------------
56 USE initbuf_mod
57 USE elbufdef_mod
58 USE schlieren_mod
59 USE stack_mod
60 USE h3d_mod
61 USE multi_fvm_mod
62 USE aleanim_mod , ONLY : fani_cell_
64 use element_mod , only : nixs,nixq,nixtg
65C-----------------------------------------------
66C I m p l i c i t T y p e s
67C-----------------------------------------------
68#include "implicit_f.inc"
69C-----------------------------------------------
70C C o m m o n B l o c k s
71C-----------------------------------------------
72#include "vect01_c.inc"
73#include "mvsiz_p.inc"
74#include "com01_c.inc"
75#include "com04_c.inc"
76#include "scr14_c.inc"
77#include "param_c.inc"
78C-----------------------------------------------
79C D u m m y A r g u m e n t s
80C-----------------------------------------------
82 . solid_vector(3,*),x(3,numnod),v(3,numnod),w(3,numnod),thke(*),ehour(*),geo(npropg,numgeo),
83 . anim(*),pm(npropm,nummat),err_thk_sh4(*), err_thk_sh3(*)
84 INTEGER IPARG(NPARG,NGROUP),IXS(NIXS,NUMELS),IXTG(NIXTG,NUMELTG),EL2FA(*),
85 . IXQ(NIXQ,NUMELQ),IFUNC,NBF,
86 . IADP(*),NBF_L, NBPART,IADG(NSPMD,*),IPM(NPROPMI,NUMMAT),
87 . IGEO(NPROPGI,NUMGEO),INVERT(*), NV46,ID_ELEM(*),ITY_ELEM(*),IPARTS(*),
88 . H3D_PART(*),IS_WRITTEN_SOLID(*),INFO1,LAYER_INPUT,IR_INPUT,IS_INPUT,IT_INPUT,
89 . IUVAR_INPUT
90 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
91 TYPE (STACK_PLY) :: STACK
92 CHARACTER(LEN=NCHARLINE100) :: KEYWORD
93 TYPE(FANI_CELL_), INTENT(IN) :: FANI_CELL
94 TYPE (H3D_DATABASE) :: H3D_DATA
95 TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
96C-----------------------------------------------
97C L o c a l V a r i a b l e s
98C-----------------------------------------------
99 my_real VALUE(3)
100 INTEGER I,NG,NEL,NPTR,NPTS,NPTT,NLAY,ILAY,IR,IS,IT,MLW,OFFSET,
101 . nercvois(*),nesdvois(*),lercvois(*),lesdvois(*),iuvar,
102 . isolnod,ivisc,nptg,tshell,tsh_ort,iok_part(mvsiz),jj(6),is_written_value(mvsiz)
103 TYPE(g_bufel_) ,POINTER :: GBUF
104 TYPE(l_bufel_) ,POINTER :: LBUF
105 TYPE(buf_mat_) ,POINTER :: MBUF
106C-----------------------------------------------
107 DO i=1,numels
108 is_written_solid(i) = 0
109 ENDDO
110C
111c
112 DO ng=1,ngroup
113
114 CALL initbuf(iparg ,ng ,
115 2 mlw ,nel ,nft ,iad ,ity ,
116 3 npt ,jale ,ismstr ,jeul ,jtur ,
117 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
118 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
119 6 irep ,iint ,igtyp ,israt ,isrot ,
120 7 icsen ,isorth ,isorthg ,ifailure,jsms )
121 IF (mlw /= 13) THEN
122 nft = iparg(3,ng)
123 isolnod = iparg(28,ng)
124 ivisc = iparg(61,ng)
125 iok_part(1:nel) = 0
126 lft=1
127 llt=nel
128c
129 DO i=1,6
130 jj(i) = nel*(i-1)
131 ENDDO
132c
133 value(1:3) = zero
134 DO i=1,nel
135 is_written_value(i) = 0
136 ENDDO
137C-----------------------------------------------
138 IF (ity == 1) THEN
139c SOLID ELEMENTS
140 IF (jcvt==1.AND.isorth/=0) jcvt=2
141C-----------------------------------------------
142 gbuf => elbuf_tab(ng)%GBUF
143 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
144 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
145 nlay = elbuf_tab(ng)%NLAY
146 nptr = elbuf_tab(ng)%NPTR
147 npts = elbuf_tab(ng)%NPTS
148 nptt = elbuf_tab(ng)%NPTT
149 nptg = nptt*npts*nptr*nlay
150 tshell = 0
151 tsh_ort = 0
152 IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) tshell = 1
153 IF (igtyp==21 .OR. igtyp==22) tsh_ort = 1
154 IF (ity == 1) offset = 0
155c
156 DO i=1,nel
157 IF (ity == 1) THEN
158 id_elem(offset+nft+i) = ixs(nixs,nft+i)
159 ity_elem(offset+nft+i) = 1
160 IF( h3d_part(iparts(nft+i)) == 1) iok_part(i) = 1
161 ENDIF
162 ENDDO
163c
164 ilay = layer_input
165 iuvar = iuvar_input
166 ir = ir_input
167 is = is_input
168 it = it_input
169 IF (ilay == -2) ilay = 1
170 IF (ilay == -3) ilay = nlay
171C--------------------------------------------------
172 IF (keyword == 'VECT/VEL') THEN
173C--------------------------------------------------
174 IF (mlw == 151) THEN
175 DO i = 1, nel
176 value(1) = multi_fvm%VEL(1, i + nft)
177 value(2) = multi_fvm%VEL(2, i + nft)
178 value(3) = multi_fvm%VEL(3, i + nft)
179 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,VALUE)
180 ENDDO
181 ELSE
182 DO i=1,nel
183 IF(gbuf%G_MOM>0 )THEN
184 value(1) = gbuf%MOM(jj(1) + i) / gbuf%RHO(i)
185 value(2) = gbuf%MOM(jj(2) + i) / gbuf%RHO(i)
186 value(3) = gbuf%MOM(jj(3) + i) / gbuf%RHO(i)
187 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,VALUE)
188 ENDIF
189 ENDDO
190 ENDIF
191 ENDIF
192C--------------------------------------------------
193 IF (keyword == 'VECT/CONT') THEN
194C--------------------------------------------------
195 IF (mlw == 151) THEN
196 DO i = 1, nel
197 value(1) = fani_cell%F18(1,i+nft)
198 value(2) = fani_cell%F18(2,i+nft)
199 value(3) = fani_cell%F18(3,i+nft)
200 CALL h3d_write_vector(iok_part,is_written_solid,solid_vector,i,offset,nft,VALUE)
201 ENDDO
202 ENDIF
203 ENDIF
204C--------------------------------------------------
205 IF (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_solid,solid_vector,i,offset,nft,VALUE)
213 ENDDO
214 ENDIF
215 ENDIF
216C--------------------------------------------------
217 ENDIF
218 ENDIF
219
220 enddo!next NG
221C-----------------------------------------------
222 RETURN
223 END
#define my_real
Definition cppsort.cpp:32
subroutine h3d_solid_vector(elbuf_tab, solid_vector, ifunc, iparg, geo, ixq, ixs, 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, iparts, layer_input, ir_input, is_input, it_input, iuvar_input, h3d_part, is_written_solid, info1, keyword, fani_cell, h3d_data, multi_fvm)
subroutine h3d_write_vector(iok_part, is_written, vector, i, offset, nft, value)
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
integer, parameter ncharline100