OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
thpout.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!|| thpout ../engine/source/output/th/thpout.F
25!||--- called by ------------------------------------------------------
26!|| hist2 ../engine/source/output/th/hist2.F
27!||--- uses -----------------------------------------------------
28!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
29!|| element_mod ../common_source/modules/elements/element_mod.F90
30!||====================================================================
31 SUBROUTINE thpout(IPARG , NTHGRP2 , ITHGRP ,GEO, IXP,
32 . ITHBUF, ELBUF_TAB, WA )
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE elbufdef_mod
37 use element_mod , only : nixp
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "task_c.inc"
48#include "param_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER IPARG(NPARG,*),ITHBUF(*)
53 INTEGER, INTENT(in) :: NTHGRP2
54 INTEGER, DIMENSION(NITHGR,*), INTENT(in) :: ITHGRP
55 INTEGER, DIMENSION(NIXP,NUMELP) ,INTENT(IN):: IXP
56 my_real
57 . wa(*)
58 my_real
59 . geo(npropg,numgeo)
60C
61 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER II,I,K,L,N,IP,IH,NG,IPT,NPT,ITY,MTE,JJ,IK,
66 . ilayer,nel,nft,igtyp,ipa,kk(3)
67 INTEGER :: NITER,IAD,NN,IADV,NVAR,ITYP,IJK,PID
68C
69 my_real
70 . area,areapt,sx,sxy,szx,idx
71 TYPE(g_bufel_) ,POINTER :: GBUF
72
73 TYPE(l_bufel_) ,POINTER :: LBUF
74C-----------------------------------------------
75 area = -huge(area)
76C-------------------------
77C ELEMENTS POUTRE
78C-------------------------
79
80 ijk = 0
81 ipa = 400
82 DO niter=1,nthgrp2
83 ityp=ithgrp(2,niter)
84 nn =ithgrp(4,niter)
85 iad =ithgrp(5,niter)
86 nvar=ithgrp(6,niter)
87 iadv=ithgrp(7,niter)
88 ii=0
89 IF(ityp==5)THEN
90! -------------------------------
91 ii=0
92 ih=iad
93
94 DO WHILE (ithbuf(ih+nn) /= ispmd .AND. ih < iad+nn)
95 ih = ih + 1
96 ENDDO
97 IF (ih >= iad+nn) GOTO 666
98C
99 DO ng=1,ngroup
100 ity = iparg(5,ng)
101 ilayer = 1
102 gbuf => elbuf_tab(ng)%GBUF
103
104 IF (ity == 5) THEN
105 mte=iparg(1,ng)
106 nel=iparg(2,ng)
107 nft=iparg(3,ng)
108 npt = iparg(6,ng)
109 igtyp =iparg(38,ng)
110 IF (igtyp == 18) THEN
111 !BUFLY => ELBUF_TAB(NG)%BUFLY(ILAYER)
112 END IF
113
114 DO i=1,3
115 kk(i) = nel*(i-1)
116 ENDDO
117
118 DO i=1,nel
119 n=i+nft
120 k=ithbuf(ih)
121 ip=ithbuf(ih+nn)
122 pid = ixp(5,nft+i)
123 IF (igtyp == 3) area = geo(1,pid)
124 IF(igtyp == 18 ) THEN
125 area = zero
126 DO ipt = 1, npt
127 area = area + geo(ipa+ipt,pid)
128 ENDDO
129 ENDIF
130
131
132 IF (k == n) THEN
133 ih=ih+1
134 ii = ((ih-1) - iad)*nvar
135 DO WHILE (ithbuf(ih+nn) /= ispmd .AND. ih < iad+nn)
136 ih = ih + 1
137 ENDDO
138
139 IF (ih > iad+nn) GOTO 666
140
141 DO l=iadv,iadv+nvar-1
142 k=ithbuf(l)
143 ijk=ijk+1
144 IF (ithbuf(l) == 1) THEN
145 wa(ijk)=gbuf%OFF(i)
146 ELSEIF(ithbuf(l) == 2)THEN
147 wa(ijk)=gbuf%FOR(kk(1)+i)
148 ELSEIF (ithbuf(l) == 3) THEN
149 wa(ijk)=gbuf%FOR(kk(2)+i)
150 ELSEIF (ithbuf(l) == 4) THEN
151 wa(ijk)=gbuf%FOR(kk(3)+i)
152 ELSEIF (ithbuf(l) == 5) THEN
153 wa(ijk)=gbuf%MOM(kk(1)+i)
154 ELSEIF (ithbuf(l) == 6) THEN
155 wa(ijk)=gbuf%MOM(kk(2)+i)
156 ELSEIF (ithbuf(l) == 7) THEN
157 wa(ijk)=gbuf%MOM(kk(3)+i)
158 ELSEIF (ithbuf(l) == 8) THEN
159 wa(ijk)=gbuf%EINT(i) + gbuf%EINT(i+nel)
160 ELSEIF (ithbuf(l) == 9) THEN
161 wa(ijk)=zero
162 IF (igtyp == 3) THEN
163 ! stress = force/area for the 3 directions
164 sx = gbuf%FOR(kk(1)+i)/area
165 wa(ijk)=sx
166 ELSEIF(igtyp == 18 ) THEN
167 IF (elbuf_tab(ng)%BUFLY(ilayer)%L_SIG > 0) THEN
168 DO ipt = 1,npt
169 areapt = geo(ipa+ipt,pid)
170 lbuf => elbuf_tab(ng)%BUFLY(ilayer)%LBUF(1,1,ipt)
171 wa(ijk) = wa(ijk)+ lbuf%SIG(kk(1)+i) * areapt/area
172 ENDDO
173 END IF !(BUFLY%L_SIG > 0)
174 END if! (IGTYP)
175 ELSEIF (ithbuf(l) == 10) THEN
176 wa(ijk)=zero
177 IF (igtyp == 3) THEN
178 ! stress = force/area for the 3 directions
179 sxy = gbuf%FOR(kk(2)+i)/area
180 wa(ijk)=sxy
181 ELSEIF(igtyp == 18 ) THEN
182 IF (elbuf_tab(ng)%BUFLY(ilayer)%L_SIG > 0) THEN
183 DO ipt = 1,npt
184 areapt = geo(ipa+ipt,pid)
185 lbuf => elbuf_tab(ng)%BUFLY(ilayer)%LBUF(1,1,ipt)
186 wa(ijk) = wa(ijk)+ lbuf%SIG(kk(2)+i)*areapt/area
187 ENDDO
188 END IF !(BUFLY%L_SIG > 0)
189 END if! (IGTYP)
190 ELSEIF (ithbuf(l) == 11) THEN
191 wa(ijk)=zero
192 IF (igtyp == 3) THEN
193 ! stress = force/area for the 3 directions
194 szx = gbuf%FOR(kk(3)+i)/area
195 wa(ijk)=szx
196 ELSEIF(igtyp == 18 ) THEN
197 IF (elbuf_tab(ng)%BUFLY(ilayer)%L_SIG > 0) THEN
198 DO ipt = 1,npt
199 areapt = geo(ipa+ipt,pid)
200 lbuf => elbuf_tab(ng)%BUFLY(ilayer)%LBUF(1,1,ipt)
201 wa(ijk) = wa(ijk)+ lbuf%SIG(kk(3)+i) * areapt/area
202 ENDDO
203 END IF !(BUFLY%L_SIG > 0)
204 END if! (IGTYP)
205 ELSEIF (ithbuf(l) > 11 .AND.ithbuf(l) <= 254 ) THEN
206 IF(igtyp == 18 ) THEN
207 idx = (ithbuf(l) - 12)/ 3
208 jj = nint(idx)
209 ipt = jj + 1
210 ik = mod((ithbuf(l) - 12),3) + 1
211 lbuf => elbuf_tab(ng)%BUFLY(ilayer)%LBUF(1,1,ipt)
212 wa(ijk) = lbuf%SIG(kk(ik)+i)
213 ENDIF
214 ELSEIF (ithbuf(l) == 255) THEN
215 wa(ijk)=zero
216 IF(igtyp == 3 ) THEN
217 IF(gbuf%G_PLA>0)THEN
218 wa(ijk)=gbuf%PLA(i)
219 ENDIF
220 ELSEIF(igtyp == 18 ) THEN
221 IF (elbuf_tab(ng)%BUFLY(ilayer)%L_PLA > 0) THEN
222 DO ipt = 1,npt
223 areapt = geo(ipa+ipt,pid)
224 lbuf => elbuf_tab(ng)%BUFLY(ilayer)%LBUF(1,1,ipt)
225 wa(ijk) = wa(ijk)+ lbuf%PLA(i) * areapt/area
226 ENDDO
227 END IF
228 END if! (IGTYP)
229 ELSEIF (ithbuf(l) > 255 .AND.ithbuf(l) <= 336 ) THEN
230 IF(igtyp == 18 ) THEN
231 IF (elbuf_tab(ng)%BUFLY(ilayer)%L_PLA > 0) THEN
232 ipt = ithbuf(l) - 255
233 lbuf => elbuf_tab(ng)%BUFLY(ilayer)%LBUF(1,1,ipt)
234 wa(ijk) = lbuf%PLA(i)
235 ENDIF
236 ENDIF
237 ELSEIF (ithbuf(l) == 337 ) THEN
238 IF(gbuf%G_EPSD>0)THEN
239 wa(ijk)=gbuf%EPSD(i)
240 ENDIF
241 ENDIF
242 ENDDO
243 ijk = ijk + 1
244 wa(ijk) = ii
245 ENDIF
246 ENDDO
247 ENDIF
248 ENDDO
249 666 continue
250! -------------------------------
251 ENDIF
252 ENDDO
253C---
254C-----------
255 RETURN
256 END SUBROUTINE thpout
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
thpout
subroutine thpout(iparg, nthgrp2, ithgrp, geo, ixp, ithbuf, elbuf_tab, wa)
Definition thpout.F:33