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 34 of file rgwat3.F.

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