OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_nodal_tensor.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_nodal_tensor ../engine/source/output/h3d/h3d_results/h3d_nodal_tensor.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!|| get_tm_gps ../engine/source/output/h3d/h3d_results/h3d_nodal_tensor.F
29!|| h3d_write_tensor ../engine/source/output/h3d/h3d_results/h3d_write_tensor.F
30!|| spmd_exch_nodarea2 ../engine/source/mpi/anim/spmd_exch_nodarea2.F
31!|| spmd_exch_nodareai ../engine/source/mpi/anim/spmd_exch_nodareai.F
32!|| tensgps1 ../engine/source/output/anim/generate/tensor6.f
33!|| tensgps2 ../engine/source/output/anim/generate/tensor6.F
34!|| tensgps3 ../engine/source/output/anim/generate/tensor6.F
35!|| tensgpstrain ../engine/source/output/anim/generate/tensgpstrain.F
36!||--- uses -----------------------------------------------------
37!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
38!|| element_mod ../common_source/modules/elements/element_mod.F90
39!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
40!|| outmax_mod ../common_source/modules/outmax_mod.F
41!||====================================================================
42 SUBROUTINE h3d_nodal_tensor(
43 . ELBUF_TAB, NODAL_TENSOR, IFUNC , IPARG , GEO ,
44 . MASS , PM , ITAB , NODE_ID ,
45 . INFO1 , INFO2 , IS_WRITTEN_NODE, H3D_PART , IPARTC ,
46 . IPARTTG , IXC , IXTG , TEMP , IFLOW ,
47 . RFLOW , IXS , IXQ , NV46,MONVOL, VOLMON ,
48 . DIAG_SMS , MS , PDAMA2 , X ,
49 . STIFR , STIFN , A , D , V ,
50 . CONT , FCONTG , FINT , FEXT , KEYWORD ,
51 . BUFMAT , IXS10 , IXS16 , IXS20 , IXT ,
52 . IXP , IXR , IAD_ELEM , FR_ELEM , WEIGHT ,
53 . IPARTSP , IPARTR , IPARTP , IPARTT , IPARTS ,
54 . IPARTQ , KXSP , N_H3D_PART_LIST)
55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE names_and_titles_mod, ONLY: ncharline100
59 USE elbufdef_mod
60 USE outmax_mod
61 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "com01_c.inc"
70#include "com04_c.inc"
71#include "param_c.inc"
72#include "sphcom.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
77 my_real
78 . NODAL_TENSOR(*),MASS(*),GEO(NPROPG,*),
79 . PM(NPROPM,*),TEMP(*),RFLOW(*),VOLMON(*), DIAG_SMS(*),MS(*),
80 . PDAMA2(2,*),X(*),STIFR(*),STIFN(*),A(3,*),D(3,*),V(3,*),
81 . CONT(3,*),FCONTG(3,*), FINT(3,*), FEXT(3,*),BUFMAT(*)
82 INTEGER IPARG(NPARG,*),IFUNC,NODE_ID(*),
83 . INFO1,INFO2,IS_WRITTEN_NODE(*),H3D_PART(*),ITAB(*),
84 . IXC(NIXC,*),IXTG(NIXTG,*),IPARTC(*),IPARTTG(*),IFLOW(*),
85 . IXS(NIXS,*),IXQ(NIXQ,*),NV46,MONVOL(*),
86 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,
87 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IAD_ELEM(2,*),FR_ELEM(*),WEIGHT(*)
88 CHARACTER(LEN=NCHARLINE100) :: KEYWORD
89 INTEGER ,INTENT(IN) :: IPARTSP(NUMSPH),IPARTR(NUMELR),IPARTP(NUMELP),
90 . IPARTT(NUMELT),IPARTS(NUMELS),IPARTQ(NUMELQ)
91 INTEGER ,INTENT(IN) :: KXSP(NISP,NUMSPH)
92 INTEGER ,INTENT(IN) :: N_H3D_PART_LIST
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 INTEGER I, J, N, LENR
97 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGPS, IOK_PART
98 my_real
99 . , DIMENSION(:,:), ALLOCATABLE :: AFLU, VFLU,VALUES
100 my_real
101 . , DIMENSION(:), ALLOCATABLE :: vgps
102C-----------------------------------------------
103C
104 ALLOCATE(aflu(3,numnod))
105 ALLOCATE(vflu(3,numnod))
106 ALLOCATE(itagps(numnod))
107 ALLOCATE(vgps(numnod))
108 ALLOCATE(values(6,numnod))
109 ALLOCATE(iok_part(numnod))
110
111
112 values(1:6,1:numnod) = zero
113c
114 DO i=1,numnod
115 node_id(i) = itab(i)
116 iok_part(i) = 0
117 is_written_node(i) = 0
118 ENDDO
119C
120 IF(n_h3d_part_list .NE. 0)THEN
121 DO i=1,numsph
122 IF ( h3d_part(ipartsp(i)) == 1) THEN
123 IF(kxsp(2,i) > 0 )iok_part(kxsp(2,i)) = 1
124 ENDIF
125 ENDDO
126c
127 DO i=1,numelr
128 IF ( h3d_part(ipartr(i)) == 1) THEN
129 DO j=2,4
130 IF(ixr(j,i) > 0 )iok_part(ixr(j,i)) = 1
131 ENDDO
132 ENDIF
133 ENDDO
134c
135 DO i=1,numelp
136 IF ( h3d_part(ipartp(i)) == 1) THEN
137 DO j=2,4
138 IF(ixp(j,i) > 0 )iok_part(ixp(j,i)) = 1
139 ENDDO
140 ENDIF
141 ENDDO
142c
143 DO i=1,numelt
144 IF ( h3d_part(ipartt(i)) == 1) THEN
145 DO j=2,4
146 IF(ixt(j,i) > 0 )iok_part(ixt(j,i)) = 1
147 ENDDO
148 ENDIF
149 ENDDO
150c
151 DO i=1,numelc
152 IF ( h3d_part(ipartc(i)) == 1) THEN
153 DO j=2,5
154 IF(ixc(j,i) > 0 )iok_part(ixc(j,i)) = 1
155 ENDDO
156 ENDIF
157 ENDDO
158c
159 DO i=1,numeltg
160 IF ( h3d_part(iparttg(i)) == 1) THEN
161 DO j=2,4
162 IF(ixtg(j,i) > 0 )iok_part(ixtg(j,i)) = 1
163 ENDDO
164 ENDIF
165 ENDDO
166c
167 DO i=1,numels
168 IF ( h3d_part(iparts(i)) == 1) THEN
169 DO j=2,9
170 IF(ixs(j,i) > 0 )iok_part(ixs(j,i)) = 1
171 ENDDO
172 ENDIF
173 ENDDO
174c
175 DO i=1,numelq
176 IF ( h3d_part(ipartq(i)) == 1) THEN
177 DO j=2,5
178 IF(ixq(j,i) > 0 )iok_part(ixq(j,i)) = 1
179 ENDDO
180 ENDIF
181 ENDDO
182 ELSE
183 iok_part(1:numnod) = 1
184 ENDIF
185C
186C-----------------------------------------------
187 IF(keyword == 'GPS') THEN
188C-----------------------------------------------
189 DO n=1,numnod
190 itagps(n) = 0
191 ENDDO
192 DO j=1,3
193 DO n=1,numnod
194 vflu(j,n) = zero
195 aflu(j,n) = zero
196 ENDDO
197 ENDDO
198 CALL tensgps3(elbuf_tab,vflu ,aflu ,iparg ,geo ,
199 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
200 . ixc ,ixtg ,ixt ,ixp ,ixr ,
201 . x ,itagps ,pm )
202
203 IF(nspmd > 1)THEN
204 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
205 CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
206 DO j=1,3
207 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
208 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j)
209 ENDDO
210 ENDIF
211 DO j=1,3
212 DO n=1,numnod
213 IF (itagps(n)>0) values(j,n)=vflu(j,n)/itagps(n)
214 ENDDO
215 ENDDO
216 DO j=4,6
217 DO n=1,numnod
218 IF (itagps(n)>0) values(j,n)=aflu(j-3,n)/itagps(n)
219 ENDDO
220 ENDDO
221C-----------------------------------------------
222 ELSEIF(keyword == 'GPS1') THEN
223C-----------------------------------------------
224 DO n=1,numnod
225 itagps(n) = 0
226 ENDDO
227 DO j=1,3
228 DO n=1,numnod
229 vflu(j,n) = zero
230 aflu(j,n) = zero
231 ENDDO
232 ENDDO
233 CALL tensgps1(vflu ,aflu ,iparg ,geo ,
234 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
235 . ixc ,ixtg ,ixt ,ixp ,ixr ,
236 . x ,itagps ,elbuf_tab)
237
238 IF(nspmd > 1)THEN
239 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
240 CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
241 DO j=1,3
242 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
243 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j)
244 ENDDO
245 ENDIF
246
247 DO j=1,3
248 DO n=1,numnod
249 IF (itagps(n)>0) values(j,n)=vflu(j,n)/itagps(n)
250 ENDDO
251 ENDDO
252 DO j=4,6
253 DO n=1,numnod
254 IF (itagps(n)>0) values(j,n)=aflu(j-3,n)/itagps(n)
255 ENDDO
256 ENDDO
257C-----------------------------------------------
258 ELSEIF(keyword == 'GPS2') THEN
259C-----------------------------------------------
260 DO n=1,numnod
261 vgps(n) = zero
262 ENDDO
263 DO j=1,3
264 DO n=1,numnod
265 vflu(j,n) = zero
266 aflu(j,n) = zero
267 ENDDO
268 ENDDO
269 CALL tensgps2(vflu ,aflu ,iparg ,geo ,
270 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
271 . ixc ,ixtg ,ixt ,ixp ,ixr ,
272 . x ,vgps ,elbuf_tab )
273
274 IF(nspmd > 1)THEN
275 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
276 CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
277 DO j=1,3
278 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
279 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j)
280 ENDDO
281 ENDIF
282
283 DO j=1,3
284 DO n=1,numnod
285 IF (vgps(n)>zero) values(j,n)=vflu(j,n)/vgps(n)
286 ENDDO
287 ENDDO
288 DO j=4,6
289 DO n=1,numnod
290 IF (vgps(n)>zero) values(j,n)=aflu(j-3,n)/vgps(n)
291 ENDDO
292 ENDDO
293C-----------------------------------------------
294 ELSEIF(keyword == 'GPSTRAIN') THEN
295C-----------------------------------------------
296 DO n=1,numnod
297 itagps(n) = 0
298 ENDDO
299 DO j=1,3
300 DO n=1,numnod
301 vflu(j,n) = zero
302 aflu(j,n) = zero
303 ENDDO
304 ENDDO
305 CALL tensgpstrain(elbuf_tab,vflu ,aflu ,iparg ,geo ,
306 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
307 . ixc ,ixtg ,ixt ,ixp ,ixr ,
308 . x ,itagps ,pm )
309
310 IF(nspmd > 1)THEN
311 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
312 CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
313 DO j=1,3
314 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
315 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j)
316 ENDDO
317 ENDIF
318
319 DO j=1,3
320 DO n=1,numnod
321 IF (itagps(n)>0) values(j,n)=vflu(j,n)/itagps(n)
322 ENDDO
323 ENDDO
324 DO j=4,6
325 DO n=1,numnod
326 IF (itagps(n)>0) values(j,n)=aflu(j-3,n)/itagps(n)
327 ENDDO
328 ENDDO
329C-----------------------------------------------
330 ELSEIF(keyword == 'GPS/TMAX') THEN
331C-----------------------------------------------
332 CALL get_tm_gps(values,tm_nsig1,numnod,iok_part,igpstag)
333C-----------------------------------------------
334 ELSEIF(keyword == 'GPS/TMIN') THEN
335C-----------------------------------------------
336 CALL get_tm_gps(values,tm_nsig3,numnod,iok_part,igpstag)
337C-----------------------------------------------
338 ELSEIF(keyword == 'GPSTRAIN/TMAX') THEN
339C-----------------------------------------------
340 CALL get_tm_gps(values,tm_nstra1,numnod,iok_part,igpstratag)
341C-----------------------------------------------
342 ELSEIF(keyword == 'GPSTRAIN/TMIN') THEN
343C-----------------------------------------------
344 CALL get_tm_gps(values,tm_nstra3,numnod,iok_part,igpstratag)
345C
346C-----------------------------------------------
347C
348 ENDIF
349
350
351
352 CALL h3d_write_tensor(iok_part,is_written_node,nodal_tensor,numnod,0,0,
353 . values,iok_part)
354
355 DEALLOCATE(aflu)
356 DEALLOCATE(vflu)
357 DEALLOCATE(vgps)
358 DEALLOCATE(itagps)
359 DEALLOCATE(values)
360 DEALLOCATE(iok_part)
361
362 RETURN
363 END
364!||====================================================================
365!|| get_tm_gps ../engine/source/output/h3d/h3d_results/h3d_nodal_tensor.F
366!||--- called by ------------------------------------------------------
367!|| h3d_nodal_tensor ../engine/source/output/h3d/h3d_results/h3d_nodal_tensor.F
368!||====================================================================
369 SUBROUTINE get_tm_gps(VALUES,TM_NSIG,NNOD,IOK_PART,IGPSTAG)
370C-----------------------------------------------------------------------
371C I m p l i c i t T y p e s
372C-----------------------------------------------
373#include "implicit_f.inc"
374C-----------------------------------------------
375C D u m m y A r g u m e n t s
376C-----------------------------------------------
377 INTEGER NNOD
378 my_real, DIMENSION(6,NNOD) ,INTENT(OUT):: VALUES
379 my_real, DIMENSION(NNOD,6) ,INTENT(INOUT):: TM_NSIG
380 INTEGER, DIMENSION(NNOD) ,INTENT(IN):: IGPSTAG
381 INTEGER, DIMENSION(NNOD) ,INTENT(INOUT):: IOK_PART
382C-----------------------------------------------
383C L o c a l V a r i a b l e s
384C-----------------------------------------------
385 INTEGER I
386 my_real
387 . S(3),NORM2
388C-----------------------------------------------
389C S o u r c e L i n e s
390C-----------------------------------------------
391 DO i=1,nnod
392 iok_part(i) = min(iok_part(i),igpstag(i))
393 IF (igpstag(i)==0) cycle
394 values(1:6,i) = tm_nsig(i,1:6)
395 ENDDO
396C
397 RETURN
398 END
get_tm_gps
subroutine get_tm_gps(values, tm_nsig, nnod, iok_part, igpstag)
Definition h3d_nodal_tensor.F:370
h3d_nodal_tensor
subroutine h3d_nodal_tensor(elbuf_tab, nodal_tensor, ifunc, iparg, geo, mass, pm, itab, node_id, info1, info2, is_written_node, h3d_part, ipartc, iparttg, ixc, ixtg, temp, iflow, rflow, ixs, ixq, nv46, monvol, volmon, diag_sms, ms, pdama2, x, stifr, stifn, a, d, v, cont, fcontg, fint, fext, keyword, bufmat, ixs10, ixs16, ixs20, ixt, ixp, ixr, iad_elem, fr_elem, weight, ipartsp, ipartr, ipartp, ipartt, iparts, ipartq, kxsp, n_h3d_part_list)
Definition h3d_nodal_tensor.F:55
h3d_write_tensor
subroutine h3d_write_tensor(iok_part, is_written, tensor, nel, offset, nft, value, is_written_tensor)
Definition h3d_write_tensor.F:35
min
#define min(a, b)
Definition macros.h:20
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
outmax_mod
Definition outmax_mod.F:52
outmax_mod::igpstratag
integer, dimension(:), allocatable igpstratag
Definition outmax_mod.F:71
outmax_mod::igpstag
integer, dimension(:), allocatable igpstag
Definition outmax_mod.F:71
spmd_exch_nodarea2
subroutine spmd_exch_nodarea2(nodarea, iad_elem, fr_elem, lenr, weight, jj)
Definition spmd_exch_nodarea2.F:39
spmd_exch_nodareai
subroutine spmd_exch_nodareai(nodareai, iad_elem, fr_elem, lenr, weight)
Definition spmd_exch_nodareai.F:38
tensgpstrain
subroutine tensgpstrain(elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
Definition tensgpstrain.F:44
tensgps1
subroutine tensgps1(func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, elbuf_tab)
Definition tensor6.F:3412
tensgps3
subroutine tensgps3(elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
Definition tensor6.F:3916
tensgps2
subroutine tensgps2(func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, vgps, elbuf_tab)
Definition tensor6.F:3658