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