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, 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)
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 367 of file h3d_nodal_tensor.F.

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
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,
anin,
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 41 of file h3d_nodal_tensor.F.

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
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
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