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!|| initbuf_mod ../engine/share/resol/initbuf.F
33!||====================================================================
34 SUBROUTINE rgwat2(
35 1 X ,NELW ,NE ,IXQ ,
36 4 ELBUF_TAB,IPARG,PM ,NTAG ,TEMP ,
37 5 TSTIF ,E ,IAD_ELEM,FR_ELEM )
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(*) ,IXQ(NIXQ,*),
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, IE, NG, MAT, IFA, LENR,
67 . IFACE(2,4)
68 my_real
69 . y1, y2, y3, y4, z1, z2, z3, z4,
70 . ny, nz, 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
77 TYPE(g_bufel_) ,POINTER :: GBUF
78c---
79 DATA IFACE/ 2, 3, 3, 4, 4, 5, 5, 2/
80C----------------------
81C DECOMPTE DES ELEMENTS PAR NOEUD
82C POUR ENERGIE DE FROTTEMENT
83C----------------------
84 i = 0
85 DO 100 ie=1,ne
86 ii = nelw(ie)/10
87 ifa = nelw(ie) - 10*ii
88 n1 = ixq(iface(1,ifa),ii)
89 n2 = ixq(iface(2,ifa),ii)
90 IF(ntag(n1)>0) ntag(n1) = ntag(n1) + 1
91 IF(ntag(n2)>0) ntag(n2) = ntag(n2) + 1
92 100 CONTINUE
93C
94C Comm SPMD NTAG : cumul aux points frontiere + prise en compte tag initial
95C
96 IF(nspmd>1)THEN
97 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
98 CALL spmd_extag(ntag,iad_elem,fr_elem,lenr)
99 END IF
100C----------------------
101C PONT THERMIQUE
102C----------------------
103 DO 600 ie=1,ne
104 ii = nelw(ie)/10
105 ifa = nelw(ie)-10*ii
106 n1 = ixq(iface(1,ifa),ii)
107 n2 = ixq(iface(2,ifa),ii)
108 IF(ntag(n1)+ntag(n2)>0)THEN
109C---------------------------------
110C RECHERCHE DE L'ELEMENT DANS LE BUFFER
111C---------------------------------
112 DO 200 ng=ii/nvsiz,ngroup
113 CALL initbuf(iparg ,ng ,
114 2 mtn ,llt ,nft ,iad ,ity ,
115 3 npt ,jale ,ismstr ,jeul ,jtur ,
116 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
117 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
118 6 irep ,iint ,igtyp ,israt ,isrot ,
119 7 icsen ,isorth ,isorthg ,ifailure,jsms )
120 IF(ity/=2) GO TO 200
121 IF(ii>nft+llt) GO TO 200
122 IF(iparg(8,ng)==1) GO TO 600
123 IF(jthe/=1) GO TO 600
124 i = ii - nft
125 GOTO 250
126 200 CONTINUE
127 250 CONTINUE
128c
129 gbuf => elbuf_tab(ng)%GBUF
130c
131 vol = gbuf%VOL(i)
132 tempe= gbuf%TEMP(i)
133C
134 ee = zero
135 phi = zero
136C----------------------
137C ENERGIE DE FROTTEMENT
138C----------------------
139 IF(ntag(n1)>1) ee = ee + e(n1) / (ntag(n1)-1)
140 IF(ntag(n2)>1) ee = ee + e(n2) / (ntag(n2)-1)
141C----------------------
142C CONDUCTION
143C----------------------
144 y1=x(2,n1)
145 z1=x(3,n1)
146C
147 y2=x(2,n2)
148 z2=x(3,n2)
149C------------------------------------------
150C CALCUL DE LA SURFACE VECTORIELLE
151C------------------------------------------
152 ny= (z2-z1)
153 nz=-(y2-y1)
154C--------+---------+---------+---------+---------+---------+---------+--
155C CALCUL DE LA DISTANCE ENTRE CENTRE ET SURFACE ( * 4. )
156C-------------------------------------------------------------
157 dy = two*(y1 + y2)
158 . -x(2,ixq(2,ii))-x(2,ixq(3,ii))
159 . -x(2,ixq(4,ii))-x(2,ixq(5,ii))
160C
161 dz = two*(z1 + z2)
162 . -x(3,ixq(2,ii))-x(3,ixq(3,ii))
163 . -x(3,ixq(4,ii))-x(3,ixq(5,ii))
164C
165 dd= dy**2+dz**2
166C---------------------------------
167C CALCUL DU GRADIENT * SURFACE
168C---------------------------------
169 grad = four*(dy*ny+dz*nz) / max(em15,dd)
170 mat =ixq(1,ie)
171 IF(tempe<=pm(80,mat))THEN
172 coef=pm(75,mat)+pm(76,mat)*tempe
173 ELSE
174 coef=pm(77,mat)+pm(78,mat)*tempe
175 ENDIF
176 tstife = coef * grad
177C---------------------------------
178C CALCUL DU FLUX
179C---------------------------------
180 phi = tstife*tstif*(temp-tempe)
181 2 / max(em20,(tstife+tstif))
182 phi = phi * dt1
183 + * ( min(ntag(n1),1) + min(ntag(n2),1) )
184 + / two
185C---------------------------------
186C ENERGIE / VOLUME
187C---------------------------------
188 phi = (phi + ee) / max(vol,em20)
189 gbuf%EINT(i) = gbuf%EINT(i) + phi
190 ENDIF
191 600 CONTINUE
192C
193 RETURN
194 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:38
spmd_extag
subroutine spmd_extag(ntag, iad_elem, fr_elem, lenr)
Definition spmd_cfd.F:1545