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