OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
thnst.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "param_c.inc"
#include "scr23_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine thnst (elbuf_tab, iparg, nthgrp2, ithgrp, ithbuf, geo, kxx, wa)
subroutine xth (nuvar, uvar, nuvarn, uvarn, wwa, nx, ii, ist)

Function/Subroutine Documentation

◆ thnst()

subroutine thnst ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, intent(in) nthgrp2,
integer, dimension(nithgr,*), intent(in) ithgrp,
integer, dimension(*) ithbuf,
geo,
integer, dimension(nixx,*) kxx,
wa )

Definition at line 32 of file thnst.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
nvar
integer function nvar(text)
Definition nvar.F:32
xth
subroutine xth(nuvar, uvar, nuvarn, uvarn, wwa, nx, ii, ist)
Definition thnst.F:190

◆ xth()

subroutine xth ( integer nuvar,
uvar,
integer nuvarn,
uvarn,
wwa,
integer nx,
integer ii,
integer ist )

Definition at line 188 of file thnst.F.

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