OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
thnst.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!|| thnst ../engine/source/output/th/thnst.F
25!||--- called by ------------------------------------------------------
26!|| hist2 ../engine/source/output/th/hist2.F
27!||--- calls -----------------------------------------------------
28!|| xth ../engine/source/output/th/thnst.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!||====================================================================
32 SUBROUTINE thnst(ELBUF_TAB,IPARG,NTHGRP2, ITHGRP,ITHBUF,
33 . GEO ,KXX, WA )
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE elbufdef_mod
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 "task_c.inc"
47#include "param_c.inc"
48#include "scr23_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER IPARG(NPARG,*),ITHBUF(*),KXX(NIXX,*)
53 INTEGER, INTENT(in) :: NTHGRP2
54 INTEGER, DIMENSION(NITHGR,*), INTENT(in) :: ITHGRP
55 my_real
56 . geo(npropg,*),wa(*)
57C
58 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER II, I, J, N, IH, NG, ITY, MTE, NB0, NB1, NB2, NB3,
63 . nb4, nb5, nnb3, mb1, mb2, mb3, mb4, mb5, k, ist, ip, l,
64 . lwa, imat, iprop, nx, igtyp, nuvar, nuvarn,nel,nft,
65 . kvar,kvarn
66 INTEGER :: NITER,IAD,NN,IADV,NVAR,ITYP,IJK
67 my_real
68 . wwa(100)
69C
70 TYPE(g_bufel_) ,POINTER :: GBUF
71C-------------------------
72C ELEMENTS NSTRANDS
73C-------------------------
74
75 ijk = 0
76 DO niter=1,nthgrp2
77 ityp=ithgrp(2,niter)
78 nn =ithgrp(4,niter)
79 iad =ithgrp(5,niter)
80 nvar=ithgrp(6,niter)
81 iadv=ithgrp(7,niter)
82 ii=0
83 IF(ityp==100)THEN
84! -------------------------------
85 ii=0
86 ih=iad
87
88 DO WHILE (ithbuf(ih+nn) /= ispmd .AND. ih < iad+nn)
89 ih = ih + 1
90 ENDDO
91 IF (ih >= iad+nn) GOTO 666
92
93 DO ng=1,ngroup
94 ity=iparg(5,ng)
95 IF (ity == 100) THEN
96C multi-purpose elements are nstrands elements only (to be modified).
97 nel=iparg(2,ng)
98 nft=iparg(3,ng)
99 gbuf => elbuf_tab(ng)%GBUF
100
101 DO i=1,nel
102 n =i+nft
103 k =ithbuf(ih)
104 IF (k == n) THEN
105 nx =kxx(3,n)
106 iprop =kxx(2,n)
107 nuvar =nint(geo(25,iprop))
108 nuvarn=nint(geo(35,iprop))
109
110 kvar = nuvar*(i-1)+1
111 kvarn = nuvarn*nx*(i-1)+1
112C
113C initial total length UVAR(NB1:NB1)
114 nb1=1
115C previous elongation UVAR(NB2:NB2)
116 nb2=nb1+1
117C previous force average UVAR(NB3:NB3)
118 nb3=nb2+1
119C initial nodes masses UVARN(MB1:MB1+NX-1)
120 mb1=1
121C forces into strands UVARN(MB2:MB2+NX-1)
122 mb2=mb1+nx
123C strands initial length UVARN(MB3:MB3+NX-1)
124 mb3=mb2+nx
125C strands elongations UVARN(MB4:MB4+NX-1)
126 mb4=mb3+nx
127C strands internal energy UVARN(MB5:MB5+NX-1)
128 mb5=mb4+nx
129 ii = (ih - iad)*nvar
130 DO j=1,nn
131
132C loop over strands into the ONE NSTRAND TH group.
133C strand to save:
134 ist=ithbuf(ih+3*nn)
135 wwa(1) = gbuf%OFF(i)
136C force into strand :
137 CALL xth(nuvar,gbuf%VAR(kvar),nuvarn,gbuf%VARN(kvarn),wwa,
138 . nx ,2 ,ist )
139 wwa(3) =zero
140 wwa(4) =zero
141 wwa(5) =zero
142 wwa(6) =zero
143 wwa(7) =zero
144C strand elongation :
145 CALL xth(nuvar,gbuf%VAR(kvar),nuvarn,gbuf%VARN(kvarn),wwa,
146 . nx ,8 ,ist )
147
148 wwa(9) =zero
149 wwa(10)=zero
150 wwa(11)=zero
151 wwa(12)=zero
152 wwa(13)=zero
153C strand internal energy :
154 CALL xth(nuvar,gbuf%VAR(kvar),nuvarn,gbuf%VARN(kvarn),wwa,
155 . nx ,14 ,ist )
156 wwa(15)=zero
157 wwa(16)=zero
158 DO l=iadv,iadv+nvar-1
159 k=ithbuf(l)
160 ijk=ijk+1
161 wa(ijk)=wwa(k)
162 ENDDO
163 ih=ih+1
164 ENDDO ! DO J=1,NN
165 ijk = ijk + 1
166 wa(ijk) = ii
167 ENDIF ! IF (K == N)
168 ENDDO ! DO I=1,NEL
169 ENDIF ! IF (ITY == 100)
170 ENDDO ! DO NG=1,NGROUP
171 666 continue
172! -------------------------------
173 ENDIF
174 ENDDO
175C
176 RETURN
177 END SUBROUTINE thnst
178
179
180
181
182
183!||====================================================================
184!|| xth ../engine/source/output/th/thnst.F
185!||--- called by ------------------------------------------------------
186!|| thnst ../engine/source/output/th/thnst.F
187!||====================================================================
188 SUBROUTINE xth(NUVAR ,UVAR ,NUVARN ,UVARN ,WWA,
189 . NX ,II ,IST )
190C-----------------------------------------------
191C I m p l i c i t T y p e s
192C-----------------------------------------------
193#include "implicit_f.inc"
194C-----------------------------------------------
195C D u m m y A r g u m e n t s
196C-----------------------------------------------
197 INTEGER NUVAR,NUVARN,NX,II,IST
198 my_real
199 . uvar(nuvar),uvarn(nuvarn*nx),wwa(100)
200C-----------------------------------------------
201C L o c a l V a r i a b l e s
202C-----------------------------------------------
203 INTEGER NB1,NB2,NB3,MB1,MB2,MB3,MB4,MB5
204C-----------------------------------------------
205C initial total length UVAR(NB1:NB1)
206 nb1=1
207C previous elongation UVAR(NB2:NB2)
208 nb2=nb1+1
209C previous force UVAR(NB3:NB3)
210 nb3=nb2+1
211C initial nodes masses UVARN(MB1:MB1+NX-1)
212 mb1=1
213C forces into strands UVARN(MB2:MB2+NX-1)
214C using UVARN(MB2:MB2+NX-2) only.
215 mb2=mb1+nx
216C strands initial length UVARN(MB3:MB3+NX-1)
217C using UVARN(MB3:MB3+NX-2) only.
218 mb3=mb2+nx
219C strands elongations UVARN(MB4:MB4+NX-1)
220C using UVARN(MB4:MB4+NX-2) only.
221 mb4=mb3+nx
222C strands internal energy UVARN(MB5:MB5+NX-1)
223C using UVARN(MB5:MB5+NX-2) only.
224 mb5=mb4+nx
225C-----------------------------------------------
226 IF (ii == 2) THEN ! force into strand
227 wwa(ii) = uvar(nb3) + uvarn(mb2+ist-1)
228 ELSEIF (ii == 8) THEN ! strand elongation
229 wwa(ii) = uvarn(mb4+ist-1)
230 ELSEIF (ii == 14) THEN ! strand internal energy
231 wwa(ii) = uvarn(mb5+ist-1)
232 ENDIF
233C-----
234 RETURN
235 END
my_real
#define my_real
Definition cppsort.cpp:32
xth
subroutine xth(nuvar, uvar, nuvarn, uvarn, wwa, nx, ii, ist)
Definition thnst.F:190
thnst
subroutine thnst(elbuf_tab, iparg, nthgrp2, ithgrp, ithbuf, geo, kxx, wa)
Definition thnst.F:34