OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgwat3.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rgwat3 (x, nelw, ne, ixs, elbuf_tab, iparg, pm, ntag, temp, tstif, e, iad_elem, fr_elem)

Function/Subroutine Documentation

◆ rgwat3()

subroutine rgwat3 ( x,
integer, dimension(*) nelw,
integer ne,
integer, dimension(nixs,*) ixs,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
pm,
integer, dimension(*) ntag,
temp,
tstif,
e,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem )

Definition at line 35 of file rgwat3.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE initbuf_mod
43 USE elbufdef_mod
44 use element_mod , only : nixs
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "com08_c.inc"
54#include "param_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER NE
59 INTEGER IPARG(NPARG,*), NELW(*) ,IXS(NIXS,*),
60 . NTAG(*), IAD_ELEM(2,*), FR_ELEM(*)
61 my_real
62 . pm(npropm,*), x(3,*),e(*),
63 . temp,tstif
64 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I, II, N1, N2, N3, N4, IE, NG, MAT, IFA, LENR,
69 . IFACE(4,6)
70 my_real
71 . x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4,
72 . nx, ny, nz, dx, dy, dz, dd, grad, phi, tempe, vol,
73 . tstife, coef,ee
74 INTEGER :: LLT ,NFT ,MTN ,IAD ,ITY ,NPT ,JALE ,ISMSTR ,JEUL ,JTUR ,JTHE ,JLAG ,JMULT ,JHBE
75 INTEGER :: JIVF, NVAUX, JPOR, JCVT, JCLOSE, JPLASOL, IREP, IINT, IGTYP
76 INTEGER :: ISORTH, ISORTHG, ISRAT, ISROT, ICSEN, IFAILURE, JSMS
77
78 TYPE(G_BUFEL_) ,POINTER :: GBUF
79c---
80 DATA iface/ 2, 3, 4, 5,
81 . 5, 4, 8, 9,
82 . 6, 9, 8, 7,
83 . 3, 2, 6, 7,
84 . 4, 3, 7, 8,
85 . 2, 5, 9, 6/
86 i = 0
87C----------------------
88C counting elements per node
89C for friction energy
90C----------------------
91 DO 100 ie=1,ne
92 ii = nelw(ie)/10
93 ifa = nelw(ie) - 10*ii
94 n1 = ixs(iface(1,ifa),ii)
95 n2 = ixs(iface(2,ifa),ii)
96 n3 = ixs(iface(3,ifa),ii)
97 n4 = ixs(iface(4,ifa),ii)
98 IF(ntag(n1)>0) ntag(n1) = ntag(n1) + 1
99 IF(ntag(n2)>0) ntag(n2) = ntag(n2) + 1
100 IF(ntag(n3)>0) ntag(n3) = ntag(n3) + 1
101 IF(ntag(n4)>0) ntag(n4) = ntag(n4) + 1
102 100 CONTINUE
103C
104C Comm SPMD NTAG: Cumulation at the boundary points + TAG Initial Tag into account
105C
106 IF(nspmd>1)THEN
107 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
108 CALL spmd_extag(ntag,iad_elem,fr_elem,lenr)
109 END IF
110C----------------------
111C PONT THERMIQUE
112C----------------------
113 DO 600 ie=1,ne
114 ii = nelw(ie)/10
115 ifa = nelw(ie) - 10*ii
116 n1 = ixs(iface(1,ifa),ii)
117 n2 = ixs(iface(2,ifa),ii)
118 n3 = ixs(iface(3,ifa),ii)
119 n4 = ixs(iface(4,ifa),ii)
120 IF(ntag(n1)+ntag(n2)+ntag(n3)+ntag(n4)>0)THEN
121C---------------------------------
122C search for the element in the buffer
123C---------------------------------
124 DO 200 ng=ii/nvsiz,ngroup
125 CALL initbuf(iparg ,ng ,
126 2 mtn ,llt ,nft ,iad ,ity ,
127 3 npt ,jale ,ismstr ,jeul ,jtur ,
128 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
129 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
130 6 irep ,iint ,igtyp ,israt ,isrot ,
131 7 icsen ,isorth ,isorthg ,ifailure,jsms )
132 IF(ity/=1) GO TO 200
133 IF(ii>nft+llt) GO TO 200
134 IF(iparg(8,ng)==1) GO TO 600
135 IF(jthe/=1) GO TO 600
136 i = ii - nft
137 GOTO 250
138 200 CONTINUE
139 250 CONTINUE
140c
141 gbuf => elbuf_tab(ng)%GBUF
142c
143 vol = gbuf%VOL(i)
144C
145 ee = zero
146 phi = zero
147C----------------------
148C friction energy
149C----------------------
150 IF(ntag(n1)>1) ee = ee + e(n1) / (ntag(n1)-1)
151 IF(ntag(n2)>1) ee = ee + e(n2) / (ntag(n2)-1)
152 IF(ntag(n3)>1) ee = ee + e(n3) / (ntag(n3)-1)
153 IF(ntag(n4)>1) ee = ee + e(n4) / (ntag(n4)-1)
154C----------------------
155C CONDUCTION
156C----------------------
157C
158 x1=x(1,n1)
159 y1=x(2,n1)
160 z1=x(3,n1)
161C
162 x2=x(1,n2)
163 y2=x(2,n2)
164 z2=x(3,n2)
165C
166 x3=x(1,n3)
167 y3=x(2,n3)
168 z3=x(3,n3)
169C
170 x4=x(1,n4)
171 y4=x(2,n4)
172 z4=x(3,n4)
173C------------------------------------------
174C calculation of the vector surface (*2.)
175C------------------------------------------
176 nx=(y3-y1)*(z2-z4) - (z3-z1)*(y2-y4)
177 ny=(z3-z1)*(x2-x4) - (x3-x1)*(z2-z4)
178 nz=(x3-x1)*(y2-y4) - (y3-y1)*(x2-x4)
179C--------+---------+---------+---------+---------+---------+---------+--
180C calculation of the distance between center and surface (*8.)
181C-------------------------------------------------------------
182 dx = two*(x1 + x2 + x3 + x4)
183 . -x(1,ixs(2,ii))-x(1,ixs(3,ii))
184 . -x(1,ixs(4,ii))-x(1,ixs(5,ii))
185 . -x(1,ixs(6,ii))-x(1,ixs(7,ii))
186 . -x(1,ixs(8,ii))-x(1,ixs(9,ii))
187C
188 dy = two*(y1 + y2 + y3 + y4)
189 . -x(2,ixs(2,ii))-x(2,ixs(3,ii))
190 . -x(2,ixs(4,ii))-x(2,ixs(5,ii))
191 . -x(2,ixs(6,ii))-x(2,ixs(7,ii))
192 . -x(2,ixs(8,ii))-x(2,ixs(9,ii))
193C
194 dz = two*(z1 + z2 + z3 + z4)
195 . -x(3,ixs(2,ii))-x(3,ixs(3,ii))
196 . -x(3,ixs(4,ii))-x(3,ixs(5,ii))
197 . -x(3,ixs(6,ii))-x(3,ixs(7,ii))
198 . -x(3,ixs(8,ii))-x(3,ixs(9,ii))
199C
200 dd=dx**2+dy**2+dz**2
201C---------------------------------
202C calculation of gradient * surface
203C---------------------------------
204 grad = four*(dx*nx+dy*ny+dz*nz) / max(em15,dd)
205C---------------------------------
206C calculation of the flux
207C---------------------------------
208 tempe=gbuf%TEMP(i)
209 mat =ixs(1,ie)
210 IF(tempe<=pm(80,mat))THEN
211 coef=pm(75,mat)+pm(76,mat)*tempe
212 ELSE
213 coef=pm(77,mat)+pm(78,mat)*tempe
214 ENDIF
215 tstife = coef * grad
216C
217 phi = tstife*tstif*(temp-tempe)
218 2 / max(em20,(tstife+tstif))
219 phi = phi * dt1 *
220 + ( min(ntag(n1),1) + min(ntag(n2),1)
221 + + min(ntag(n3),1) + min(ntag(n4),1) )
222 + / four
223C---------------------------------
224C ENERGIE / VOLUME
225C---------------------------------
226 phi = (phi + ee) / max(vol,em20)
227 gbuf%EINT(i) = gbuf%EINT(i) + phi
228 ENDIF
229C
230 600 CONTINUE
231C-----------
232 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
iface
integer function iface(ip, n)
Definition iface.F:36
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
spmd_extag
subroutine spmd_extag(ntag, iad_elem, fr_elem, lenr)
Definition spmd_cfd.F:1547