OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spsgsym.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!|| spsgsym ../engine/source/elements/sph/spsgsym.F
25!||--- called by ------------------------------------------------------
26!|| forintp ../engine/source/elements/forintp.F
27!||--- uses -----------------------------------------------------
28!|| sphbox ../engine/share/modules/sphbox.F
29!||====================================================================
30 SUBROUTINE spsgsym(
31 1 ISPCOND ,XFRAME ,ISPSYM ,XSPSYM ,VSPSYM ,
32 2 WA ,WASIGSM ,WASPACT ,WAR )
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE sphbox
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "sphcom.inc"
45#include "param_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER ISPCOND(NISPCOND,*), ISPSYM(NSPCOND,*), WASPACT(*)
50C REAL
51 my_real
52 . xframe(nxframe,*) ,xspsym(3,*) ,vspsym(3,*), wa(kwasph,*),
53 . wasigsm(6,*), war(10,*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER IC,NC,IS,SM,JS,ISLIDE,SS
58 my_real
59 . sxx,sxy,sxz,syy,syz,szz,
60 . txx,txy,txz,tyy,tyz,tzz,
61 . ox,oy,oz,ux,uy,uz,vx,vy,vz,wx,wy,wz,
62 . uxx,uxy,uxz,uyx,uyy,uyz,uzx,uzy,uzz,
63 . vxx,vxy,vxz,vyy,vyz,vzz
64C-----------------------------------------------
65C Prepare les contraintes sur les particules symetriques.
66C-----------------------------------------------
67 DO nc=1,nspcond
68 ic=ispcond(2,nc)
69 is=ispcond(3,nc)
70 islide=ispcond(5,nc)
71 IF (ic==1) THEN
72 ox=xframe(10,is)
73 oy=xframe(11,is)
74 oz=xframe(12,is)
75 ux=xframe(1,is)
76 uy=xframe(2,is)
77 uz=xframe(3,is)
78 vx=xframe(4,is)
79 vy=xframe(5,is)
80 vz=xframe(6,is)
81 wx=xframe(7,is)
82 wy=xframe(8,is)
83 wz=xframe(9,is)
84 ELSEIF (ic==2) THEN
85 ox=xframe(10,is)
86 oy=xframe(11,is)
87 oz=xframe(12,is)
88 ux=xframe(4,is)
89 uy=xframe(5,is)
90 uz=xframe(6,is)
91 vx=xframe(7,is)
92 vy=xframe(8,is)
93 vz=xframe(9,is)
94 wx=xframe(1,is)
95 wy=xframe(2,is)
96 wz=xframe(3,is)
97 ELSEIF (ic==3) THEN
98 ox=xframe(10,is)
99 oy=xframe(11,is)
100 oz=xframe(12,is)
101 ux=xframe(7,is)
102 uy=xframe(8,is)
103 uz=xframe(9,is)
104 vx=xframe(1,is)
105 vy=xframe(2,is)
106 vz=xframe(3,is)
107 wx=xframe(4,is)
108 wy=xframe(5,is)
109 wz=xframe(6,is)
110 ENDIF
111 DO ss=1,nsphact
112 sm=waspact(ss)
113 js=ispsym(nc,sm)
114 IF(js>0)THEN
115 txx=wa(1,sm)
116 tyy=wa(2,sm)
117 tzz=wa(3,sm)
118 txy=wa(4,sm)
119 tyz=wa(5,sm)
120 txz=wa(6,sm)
121 IF(islide==0)THEN
122C----------
123 wasigsm(1,js)=txx
124 wasigsm(2,js)=tyy
125 wasigsm(3,js)=tzz
126 wasigsm(4,js)=txy
127 wasigsm(5,js)=tyz
128 wasigsm(6,js)=txz
129 ELSE
130C----------
131C Changmnt de repere.
132 uxx=txx*ux+txy*uy+txz*uz
133 uxy=txx*vx+txy*vy+txz*vz
134 uxz=txx*wx+txy*wy+txz*wz
135 uyx=txy*ux+tyy*uy+tyz*uz
136 uyy=txy*vx+tyy*vy+tyz*vz
137 uyz=txy*wx+tyy*wy+tyz*wz
138 uzx=txz*ux+tyz*uy+tzz*uz
139 uzy=txz*vx+tyz*vy+tzz*vz
140 uzz=txz*wx+tyz*wy+tzz*wz
141 vxx=ux*uxx+uy*uyx+uz*uzx
142 vxy=ux*uxy+uy*uyy+uz*uzy
143 vxz=ux*uxz+uy*uyz+uz*uzz
144 vyy=vx*uxy+vy*uyy+vz*uzy
145 vyz=vx*uxz+vy*uyz+vz*uzz
146 vzz=wx*uxz+wy*uyz+wz*uzz
147C----------
148C Symetrie.
149 vxy=-vxy
150 vxz=-vxz
151C----------
152C Back to global system.
153 uxx=vxx*ux+vxy*vx+vxz*wx
154 uxy=vxx*uy+vxy*vy+vxz*wy
155 uxz=vxx*uz+vxy*vz+vxz*wz
156 uyx=vxy*ux+vyy*vx+vyz*wx
157 uyy=vxy*uy+vyy*vy+vyz*wy
158 uyz=vxy*uz+vyy*vz+vyz*wz
159 uzx=vxz*ux+vyz*vx+vzz*wx
160 uzy=vxz*uy+vyz*vy+vzz*wy
161 uzz=vxz*uz+vyz*vz+vzz*wz
162 txx=ux*uxx+vx*uyx+wx*uzx
163 txy=ux*uxy+vx*uyy+wx*uzy
164 txz=ux*uxz+vx*uyz+wx*uzz
165 tyy=uy*uxy+vy*uyy+wy*uzy
166 tyz=uy*uxz+vy*uyz+wy*uzz
167 tzz=uz*uxz+vz*uyz+wz*uzz
168C
169 wasigsm(1,js)=txx
170 wasigsm(2,js)=tyy
171 wasigsm(3,js)=tzz
172 wasigsm(4,js)=txy
173 wasigsm(5,js)=tyz
174 wasigsm(6,js)=txz
175 ENDIF
176 ENDIF
177 ENDDO
178C
179C Particules symetriques de particules remotes
180C
181 DO ss=1,nsphr
182 js=ispsymr(nc,ss)
183 IF(js>0)THEN
184 txx=war(1,ss)
185 tyy=war(2,ss)
186 tzz=war(3,ss)
187 txy=war(4,ss)
188 tyz=war(5,ss)
189 txz=war(6,ss)
190 IF(islide==0)THEN
191C----------
192 wasigsm(1,js)=txx
193 wasigsm(2,js)=tyy
194 wasigsm(3,js)=tzz
195 wasigsm(4,js)=txy
196 wasigsm(5,js)=tyz
197 wasigsm(6,js)=txz
198 ELSE
199C----------
200C Changmnt de repere.
201 uxx=txx*ux+txy*uy+txz*uz
202 uxy=txx*vx+txy*vy+txz*vz
203 uxz=txx*wx+txy*wy+txz*wz
204 uyx=txy*ux+tyy*uy+tyz*uz
205 uyy=txy*vx+tyy*vy+tyz*vz
206 uyz=txy*wx+tyy*wy+tyz*wz
207 uzx=txz*ux+tyz*uy+tzz*uz
208 uzy=txz*vx+tyz*vy+tzz*vz
209 uzz=txz*wx+tyz*wy+tzz*wz
210 vxx=ux*uxx+uy*uyx+uz*uzx
211 vxy=ux*uxy+uy*uyy+uz*uzy
212 vxz=ux*uxz+uy*uyz+uz*uzz
213 vyy=vx*uxy+vy*uyy+vz*uzy
214 vyz=vx*uxz+vy*uyz+vz*uzz
215 vzz=wx*uxz+wy*uyz+wz*uzz
216C----------
217C Symetrie.
218 vxy=-vxy
219 vxz=-vxz
220C----------
221C Back to global system.
222 uxx=vxx*ux+vxy*vx+vxz*wx
223 uxy=vxx*uy+vxy*vy+vxz*wy
224 uxz=vxx*uz+vxy*vz+vxz*wz
225 uyx=vxy*ux+vyy*vx+vyz*wx
226 uyy=vxy*uy+vyy*vy+vyz*wy
227 uyz=vxy*uz+vyy*vz+vyz*wz
228 uzx=vxz*ux+vyz*vx+vzz*wx
229 uzy=vxz*uy+vyz*vy+vzz*wy
230 uzz=vxz*uz+vyz*vz+vzz*wz
231 txx=ux*uxx+vx*uyx+wx*uzx
232 txy=ux*uxy+vx*uyy+wx*uzy
233 txz=ux*uxz+vx*uyz+wx*uzz
234 tyy=uy*uxy+vy*uyy+wy*uzy
235 tyz=uy*uxz+vy*uyz+wy*uzz
236 tzz=uz*uxz+vz*uyz+wz*uzz
237C
238 wasigsm(1,js)=txx
239 wasigsm(2,js)=tyy
240 wasigsm(3,js)=tzz
241 wasigsm(4,js)=txy
242 wasigsm(5,js)=tyz
243 wasigsm(6,js)=txz
244 END IF
245 END IF
246 END DO
247C
248 ENDDO
249C----------------------------------
250 RETURN
251 END
my_real
#define my_real
Definition cppsort.cpp:32
sphbox::ispsymr
integer, dimension(:,:), allocatable ispsymr
Definition sphbox.F:93
sphbox::nsphr
integer nsphr
Definition sphbox.F:83
spsgsym
subroutine spsgsym(ispcond, xframe, ispsym, xspsym, vspsym, wa, wasigsm, waspact, war)
Definition spsgsym.F:33