OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i9grd3.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!|| i9grd3 ../engine/source/interfaces/int09/i9grd3.F
25!||--- called by ------------------------------------------------------
26!|| i9wal3 ../engine/source/interfaces/int09/i9wal3.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| initbuf_mod ../engine/share/resol/initbuf.F
32!||====================================================================
33 SUBROUTINE i9grd3(IERR ,AREA ,TSTIF ,T ,VOL ,
34 2 II ,X ,IXS ,IX ,
35 3 IPARG ,PM ,ELBUF_TAB,IGROU ,IELN )
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE initbuf_mod
40 USE elbufdef_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "com04_c.inc"
50#include "param_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER II, IGROU, IELN , IERR, IX(4), IXS(NIXS),IPARG(NPARG,NGROUP)
55 my_real
56 . area, tstif, t, vol, x(3,numnod), pm(npropm,nummat)
57 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I, N1, N2, N3, N4, IE, NG,MAT, IFA
62 my_real
63 . x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4,
64 . nx, ny, nz, dx, dy, dz, norm, dist, cond
65 INTEGER :: LLT ,NFT ,MTN ,IAD ,ITY ,NPT ,JALE ,ISMSTR ,JEUL ,JTUR ,JTHE ,JLAG ,JMULT ,JHBE
66 INTEGER :: JIVF, NVAUX, JPOR, JCVT, JCLOSE, JPLASOL, IREP, IINT, IGTYP
67 INTEGER :: ISORTH, ISORTHG, ISRAT, ISROT, ICSEN, IFAILURE, JSMS
68
69C-----------------------------------------------
70 ierr = 0
71C---------------------------------
72C RECHERCHE DE L'ELEMENT DANS LE BUFFER
73C---------------------------------
74 DO 200 ng=ii/nvsiz+1,ngroup
75 CALL initbuf(iparg ,ng ,
76 2 mtn ,llt ,nft ,iad ,ity ,
77 3 npt ,jale ,ismstr ,jeul ,jtur ,
78 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
79 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
80 6 irep ,iint ,igtyp ,israt ,isrot ,
81 7 icsen ,isorth ,isorthg ,ifailure,jsms )
82 IF(ity/=1) GO TO 200
83 IF(ii>nft+llt) GO TO 200
84 IF(iparg(8,ng)==1.OR.jthe/=1)THEN
85 ierr = 1
86 RETURN
87 ENDIF
88 i = ii - nft
89 GOTO 250
90 200 CONTINUE
91 ierr = 1
92 RETURN
93 250 CONTINUE
94
95 igrou = ng
96 ieln = i
97 vol = elbuf_tab(ng)%GBUF%VOL(i)
98C----------------------
99C CONDUCTION
100C----------------------
101 n1=ix(1)
102 n2=ix(2)
103 n3=ix(3)
104 n4=ix(4)
105C
106 x1=x(1,n1)
107 y1=x(2,n1)
108 z1=x(3,n1)
109C
110 x2=x(1,n2)
111 y2=x(2,n2)
112 z2=x(3,n2)
113C
114 x3=x(1,n3)
115 y3=x(2,n3)
116 z3=x(3,n3)
117C
118 x4=x(1,n4)
119 y4=x(2,n4)
120 z4=x(3,n4)
121C------------------------------------------
122C CALCUL DE LA SURFACE VECTORIELLE (*2.)
123C------------------------------------------
124 nx=(y1-y3)*(z2-z4) - (z1-z3)*(y2-y4)
125 ny=(z1-z3)*(x2-x4) - (x1-x3)*(z2-z4)
126 nz=(x1-x3)*(y2-y4) - (y1-y3)*(x2-x4)
127 norm = sqrt(nx**2 + ny**2 + nz**2)
128C--------+---------+---------+---------+---------+---------+---------+--
129C CALCUL DE LA DISTANCE ENTRE CENTRE ET SURFACE ( * 8. )
130C-------------------------------------------------------------
131 dx = two*(x1 + x2 + x3 + x4)
132 . -x(1,ixs(2))-x(1,ixs(3))
133 . -x(1,ixs(4))-x(1,ixs(5))
134 . -x(1,ixs(6))-x(1,ixs(7))
135 . -x(1,ixs(8))-x(1,ixs(9))
136C
137 dy = two*(y1 + y2 + y3 + y4)
138 . -x(2,ixs(2))-x(2,ixs(3))
139 . -x(2,ixs(4))-x(2,ixs(5))
140 . -x(2,ixs(6))-x(2,ixs(7))
141 . -x(2,ixs(8))-x(2,ixs(9))
142C
143 dz = two*(z1 + z2 + z3 + z4)
144 . -x(3,ixs(2))-x(3,ixs(3))
145 . -x(3,ixs(4))-x(3,ixs(5))
146 . -x(3,ixs(6))-x(3,ixs(7))
147 . -x(3,ixs(8))-x(3,ixs(9))
148C
149C---------------------------------
150C CALCUL DISTANCE ET 1/4 SURFACE(SURFFACE NODALE))
151C---------------------------------
152 dist = one_over_8*(dx*nx+dy*ny+dz*nz) / max(em15,norm)
153 area = one_over_8*norm
154C---------------------------------
155C CALCUL DE LA CONDUCTIBILITE
156C---------------------------------
157 t = elbuf_tab(ng)%GBUF%TEMP(i)
158 mat =ixs(1)
159 IF(t<=pm(80,mat))THEN
160 cond=pm(75,mat)+pm(76,mat)*t
161 ELSE
162 cond=pm(77,mat)+pm(78,mat)*t
163 ENDIF
164 tstif = dist / cond
165C
166 600 CONTINUE
167C
168 RETURN
169 END
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
i9grd3
subroutine i9grd3(ierr, area, tstif, t, vol, ii, x, ixs, ix, iparg, pm, elbuf_tab, igrou, ieln)
Definition i9grd3.F:36
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