OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_nodal_tensor.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

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)
subroutine get_tm_gps (values, tm_nsig, nnod, iok_part, igpstag)

Function/Subroutine Documentation

◆ get_tm_gps()

subroutine get_tm_gps ( intent(out) values,
intent(inout) tm_nsig,
integer nnod,
integer, dimension(nnod), intent(inout) iok_part,
integer, dimension(nnod), intent(in) igpstag )

Definition at line 369 of file h3d_nodal_tensor.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20

◆ h3d_nodal_tensor()

subroutine h3d_nodal_tensor ( type (elbuf_struct_), dimension(ngroup) elbuf_tab,
nodal_tensor,
integer ifunc,
integer, dimension(nparg,*) iparg,
geo,
mass,
pm,
integer, dimension(*) itab,
integer, dimension(*) node_id,
integer info1,
integer info2,
integer, dimension(*) is_written_node,
integer, dimension(*) h3d_part,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
temp,
integer, dimension(*) iflow,
rflow,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer nv46,
integer, dimension(*) monvol,
volmon,
diag_sms,
ms,
pdama2,
x,
stifr,
stifn,
a,
d,
v,
cont,
fcontg,
fint,
fext,
character(len=ncharline100) keyword,
bufmat,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
integer, dimension(numsph), intent(in) ipartsp,
integer, dimension(numelr), intent(in) ipartr,
integer, dimension(numelp), intent(in) ipartp,
integer, dimension(numelt), intent(in) ipartt,
integer, dimension(numels), intent(in) iparts,
integer, dimension(numelq), intent(in) ipartq,
integer, dimension(nisp,numsph), intent(in) kxsp,
integer, intent(in) n_h3d_part_list )

Definition at line 42 of file h3d_nodal_tensor.F.

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
get_tm_gps
subroutine get_tm_gps(values, tm_nsig, nnod, iok_part, igpstag)
Definition h3d_nodal_tensor.F:370
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
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