OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgwat2.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!|| rgwat2 ../engine/source/interfaces/int09/rgwat2.F
25!||--- called by ------------------------------------------------------
26!|| rgwath ../engine/source/interfaces/int09/rgwath.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!|| spmd_extag ../engine/source/mpi/fluid/spmd_cfd.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!|| initbuf_mod ../engine/share/resol/initbuf.F
34!||====================================================================
35 SUBROUTINE rgwat2(
36 1 X ,NELW ,NE ,IXQ ,
37 4 ELBUF_TAB,IPARG,PM ,NTAG ,TEMP ,
38 5 TSTIF ,E ,IAD_ELEM,FR_ELEM )
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE initbuf_mod
43 USE elbufdef_mod
44 use element_mod , only : nixq
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(*) ,IXQ(NIXQ,*),
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, IE, NG, MAT, IFA, LENR,
69 . IFACE(2,4)
70 my_real
71 . y1, y2, z1, z2,
72 . ny, nz, 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
79 TYPE(g_bufel_) ,POINTER :: GBUF
80c---
81 DATA IFACE/ 2, 3, 3, 4, 4, 5, 5, 2/
82C----------------------
83C counting elements per node
84C for friction energy
85C----------------------
86 i = 0
87 DO 100 ie=1,ne
88 ii = nelw(ie)/10
89 ifa = nelw(ie) - 10*ii
90 n1 = ixq(iface(1,ifa),ii)
91 n2 = ixq(iface(2,ifa),ii)
92 IF(ntag(n1)>0) ntag(n1) = ntag(n1) + 1
93 IF(ntag(n2)>0) ntag(n2) = ntag(n2) + 1
94 100 CONTINUE
95C
96C Comm SPMD NTAG: Cumulation at the boundary points + initial tag
97C
98 IF(nspmd>1)THEN
99 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
100 CALL spmd_extag(ntag,iad_elem,fr_elem,lenr)
101 END IF
102C----------------------
103C PONT THERMIQUE
104C----------------------
105 DO 600 ie=1,ne
106 ii = nelw(ie)/10
107 ifa = nelw(ie)-10*ii
108 n1 = ixq(iface(1,ifa),ii)
109 n2 = ixq(iface(2,ifa),ii)
110 IF(ntag(n1)+ntag(n2)>0)THEN
111C---------------------------------
112C search for the element in the buffer
113C---------------------------------
114 DO 200 ng=ii/nvsiz,ngroup
115 CALL initbuf(iparg ,ng ,
116 2 mtn ,llt ,nft ,iad ,ity ,
117 3 npt ,jale ,ismstr ,jeul ,jtur ,
118 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
119 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
120 6 irep ,iint ,igtyp ,israt ,isrot ,
121 7 icsen ,isorth ,isorthg ,ifailure,jsms )
122 IF(ity/=2) GO TO 200
123 IF(ii>nft+llt) GO TO 200
124 IF(iparg(8,ng)==1) GO TO 600
125 IF(jthe/=1) GO TO 600
126 i = ii - nft
127 GOTO 250
128 200 CONTINUE
129 250 CONTINUE
130c
131 gbuf => elbuf_tab(ng)%GBUF
132c
133 vol = gbuf%VOL(i)
134 tempe= gbuf%TEMP(i)
135C
136 ee = zero
137 phi = zero
138C----------------------
139C friction energy
140C----------------------
141 IF(ntag(n1)>1) ee = ee + e(n1) / (ntag(n1)-1)
142 IF(ntag(n2)>1) ee = ee + e(n2) / (ntag(n2)-1)
143C----------------------
144C CONDUCTION
145C----------------------
146 y1=x(2,n1)
147 z1=x(3,n1)
148C
149 y2=x(2,n2)
150 z2=x(3,n2)
151C------------------------------------------
152C calculation of the vector surface
153C------------------------------------------
154 ny= (z2-z1)
155 nz=-(y2-y1)
156C--------+---------+---------+---------+---------+---------+---------+--
157C calculation of the distance between center and surface (*4.)
158C-------------------------------------------------------------
159 dy = two*(y1 + y2)
160 . -x(2,ixq(2,ii))-x(2,ixq(3,ii))
161 . -x(2,ixq(4,ii))-x(2,ixq(5,ii))
162C
163 dz = two*(z1 + z2)
164 . -x(3,ixq(2,ii))-x(3,ixq(3,ii))
165 . -x(3,ixq(4,ii))-x(3,ixq(5,ii))
166C
167 dd= dy**2+dz**2
168C---------------------------------
169C calculation of gradient * surface
170C---------------------------------
171 grad = four*(dy*ny+dz*nz) / max(em15,dd)
172 mat =ixq(1,ie)
173 IF(tempe<=pm(80,mat))THEN
174 coef=pm(75,mat)+pm(76,mat)*tempe
175 ELSE
176 coef=pm(77,mat)+pm(78,mat)*tempe
177 ENDIF
178 tstife = coef * grad
179C---------------------------------
180C calculation of the flux
181C---------------------------------
182 phi = tstife*tstif*(temp-tempe)
183 2 / max(em20,(tstife+tstif))
184 phi = phi * dt1
185 + * ( min(ntag(n1),1) + min(ntag(n2),1) )
186 + / two
187C---------------------------------
188C ENERGIE / VOLUME
189C---------------------------------
190 phi = (phi + ee) / max(vol,em20)
191 gbuf%EINT(i) = gbuf%EINT(i) + phi
192 ENDIF
193 600 CONTINUE
194C
195 RETURN
196 END
my_real
#define my_real
Definition cppsort.cpp:32
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
rgwat2
subroutine rgwat2(x, nelw, ne, ixq, elbuf_tab, iparg, pm, ntag, temp, tstif, e, iad_elem, fr_elem)
Definition rgwat2.F:39
spmd_extag
subroutine spmd_extag(ntag, iad_elem, fr_elem, lenr)
Definition spmd_cfd.F:1547