OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spechan.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!|| spechan ../engine/source/elements/sph/spechan.F
25!||--- called by ------------------------------------------------------
26!|| sphprep ../engine/source/elements/sph/sphprep.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 spechan(
34 1 X ,V ,MS ,SPBUF ,ITAB ,
35 2 KXSP ,IXSP ,NOD2SP ,ISPCOND ,XFRAME ,
36 3 ISORTSP ,IPARG ,ELBUF_TAB,WSP2SORT,NP2SORTF,
37 4 NP2SORTL)
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 "vect01_c.inc"
51#include "com01_c.inc"
52#include "sphcom.inc"
53#include "param_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER KXSP(NISP,*),IXSP(KVOISPH,*),NOD2SP(*),ITAB(*),
58 . ISPCOND(NISPCOND,*), ISORTSP, IPARG(NPARG,*),
59 . WSP2SORT(*), NP2SORTF, NP2SORTL
60C REAL
61 my_real
62 . x(3,*), v(3,*), ms(*), spbuf(nspbuf,*),xframe(nxframe,*)
63 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION (NGROUP) :: ELBUF_TAB
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER K,N,INOD,JS,
68 . IS,IC,NC,ISLIDE,ILEV,
69 . NG,NEL,I,II(6),NS,J
70 my_real
71 . xi,yi,zi,
72 . vxi,vyi,vzi,
73 . ox,oy,oz,ux,uy,uz,vx,vy,vz,wx,wy,wz,
74 . xs,ys,zs,vxs,vys,vzs,vn,dd,di,
75 . txx,txy,txz,tyy,tyz,tzz,
76 . uxx,uxy,uxz,uyx,uyy,uyz,uzx,uzy,uzz,
77 . vxx,vxy,vxz,vyy,vyz,vzz
78 TYPE(g_bufel_) ,POINTER :: GBUF
79C-----------------------------------------------
80 VX = zero
81 vy = zero
82 vz = zero
83 DO nc=1,nspcond
84 ilev=ispcond(1,nc)
85 IF(ilev==1)THEN
86 is =ispcond(3,nc)
87 ic =ispcond(2,nc)
88 islide=ispcond(5,nc)
89 ox=xframe(10,is)
90 oy=xframe(11,is)
91 oz=xframe(12,is)
92 ux=xframe(3*(ic-1)+1,is)
93 uy=xframe(3*(ic-1)+2,is)
94 uz=xframe(3*(ic-1)+3,is)
95 IF(islide==1)THEN
96 IF (ic==1) THEN
97 vx=xframe(4,is)
98 vy=xframe(5,is)
99 vz=xframe(6,is)
100 wx=xframe(7,is)
101 wy=xframe(8,is)
102 wz=xframe(9,is)
103 ELSEIF (ic==2) THEN
104 vx=xframe(7,is)
105 vy=xframe(8,is)
106 vz=xframe(9,is)
107 wx=xframe(1,is)
108 wy=xframe(2,is)
109 wz=xframe(3,is)
110 ELSEIF (ic==3) THEN
111 vx=xframe(1,is)
112 vy=xframe(2,is)
113 vz=xframe(3,is)
114 wx=xframe(4,is)
115 wy=xframe(5,is)
116 wz=xframe(6,is)
117 ENDIF
118 ENDIF
119 DO ns =np2sortf,np2sortl
120 n=wsp2sort(ns)
121 inod=kxsp(3,n)
122 xi =x(1,inod)
123 yi =x(2,inod)
124 zi =x(3,inod)
125 vxi=v(1,inod)
126 vyi=v(2,inod)
127 vzi=v(3,inod)
128 di =spbuf(1,n)
129 dd=(xi-ox)*ux+(yi-oy)*uy+(zi-oz)*uz
130 IF(dd<-em20*di)THEN
131C--------------------------------
132C Echange les positions et les vitesses
133 xs=xi-two*dd*ux
134 ys=yi-two*dd*uy
135 zs=zi-two*dd*uz
136 IF(islide==0)THEN
137 vxs=-vxi
138 vys=-vyi
139 vzs=-vzi
140 ELSE
141 vn=vxi*ux+vyi*uy+vzi*uz
142 vxs=vxi-two*vn*ux
143 vys=vyi-two*vn*uy
144 vzs=vzi-two*vn*uz
145 ENDIF
146 x(1,inod)=xs
147 x(2,inod)=ys
148 x(3,inod)=zs
149 v(1,inod)=vxs
150 v(2,inod)=vys
151 v(3,inod)=vzs
152C looses extra forces
153C A(1,INOD)=0.
154C A(2,INOD)=0.
155C A(3,INOD)=0.
156C--------------------------------
157C Echange les contraintes
158 IF(islide==1)THEN
159C-----------
160C Recherche du groupe d'appartenance.
161 ng=mod(kxsp(2,n),ngroup+1)
162 IF(ng>0)THEN
163 CALL initbuf(iparg ,ng ,
164 2 mtn ,nel ,nft ,iad ,ity ,
165 3 npt ,jale ,ismstr ,jeul ,jtur ,
166 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
167 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
168 6 irep ,iint ,igtyp ,israt ,isrot ,
169 7 icsen ,isorth ,isorthg ,ifailure,jsms )
170 gbuf => elbuf_tab(ng)%GBUF
171 DO j=1,6
172 ii(j) = nel*(j-1)
173 ENDDO
174C-----------
175 i = n-nft
176 txx= gbuf%SIG(ii(1)+i)
177 tyy= gbuf%SIG(ii(2)+i)
178 tzz= gbuf%SIG(ii(3)+i)
179 txy= gbuf%SIG(ii(4)+i)
180 tyz= gbuf%SIG(ii(5)+i)
181 txz= gbuf%SIG(ii(6)+i)
182C----------
183C Changmnt de repere.
184 uxx=txx*ux+txy*uy+txz*uz
185 uxy=txx*vx+txy*vy+txz*vz
186 uxz=txx*wx+txy*wy+txz*wz
187 uyx=txy*ux+tyy*uy+tyz*uz
188 uyy=txy*vx+tyy*vy+tyz*vz
189 uyz=txy*wx+tyy*wy+tyz*wz
190 uzx=txz*ux+tyz*uy+tzz*uz
191 uzy=txz*vx+tyz*vy+tzz*vz
192 uzz=txz*wx+tyz*wy+tzz*wz
193 vxx=ux*uxx+uy*uyx+uz*uzx
194 vxy=ux*uxy+uy*uyy+uz*uzy
195 vxz=ux*uxz+uy*uyz+uz*uzz
196 vyy=vx*uxy+vy*uyy+vz*uzy
197 vyz=vx*uxz+vy*uyz+vz*uzz
198 vzz=wx*uxz+wy*uyz+wz*uzz
199C----------
200C Symetrie.
201 vxy=-vxy
202 vxz=-vxz
203C----------
204C Back to global system.
205 uxx=vxx*ux+vxy*vx+vxz*wx
206 uxy=vxx*uy+vxy*vy+vxz*wy
207 uxz=vxx*uz+vxy*vz+vxz*wz
208 uyx=vxy*ux+vyy*vx+vyz*wx
209 uyy=vxy*uy+vyy*vy+vyz*wy
210 uyz=vxy*uz+vyy*vz+vyz*wz
211 uzx=vxz*ux+vyz*vx+vzz*wx
212 uzy=vxz*uy+vyz*vy+vzz*wy
213 uzz=vxz*uz+vyz*vz+vzz*wz
214 txx=ux*uxx+vx*uyx+wx*uzx
215 txy=ux*uxy+vx*uyy+wx*uzy
216 txz=ux*uxz+vx*uyz+wx*uzz
217 tyy=uy*uxy+vy*uyy+wy*uzy
218 tyz=uy*uxz+vy*uyz+wy*uzz
219 tzz=uz*uxz+vz*uyz+wz*uzz
220C
221 gbuf%SIG(ii(1)+i) = txx
222 gbuf%SIG(ii(2)+i) = tyy
223 gbuf%SIG(ii(3)+i) = tzz
224 gbuf%SIG(ii(4)+i) = txy
225 gbuf%SIG(ii(5)+i) = tyz
226 gbuf%SIG(ii(6)+i) = txz
227 ENDIF
228 ENDIF
229 ENDIF
230 ENDDO
231 ENDIF
232 ENDDO
233C-------------------------------------------
234 RETURN
235 END
my_real
#define my_real
Definition cppsort.cpp:32
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
spechan
subroutine spechan(x, v, ms, spbuf, itab, kxsp, ixsp, nod2sp, ispcond, xframe, isortsp, iparg, elbuf_tab, wsp2sort, np2sortf, np2sortl)
Definition spechan.F:38