OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
iniebcsp.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!|| iniebcsp ../starter/source/boundary_conditions/ebcs/iniebcsp.F
25!||--- called by ------------------------------------------------------
26!|| iniebcsp0 ../starter/source/boundary_conditions/ebcs/iniebcsp0.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE iniebcsp(NSEG,NOD,ISEG,IELEM,IRECT,LISTE,LA,IPARG,ELBUF_STR,P0,X)
30C-----------------------------------------------
31C M o d u l e s
32C-----------------------------------------------
33 USE elbufdef_mod
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "param_c.inc"
42#include "com01_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER NSEG,NOD,ISEG(NSEG),IRECT(4,NSEG),LISTE(NOD),IPARG(NPARG,*), IELEM(NSEG)
47 my_real la(3,nod),p0(nod),x(3,*)
48 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER N1,N2,N3,N4,I,N,IS,KSEG,NG1,NG2,NG3,NG4,ESEG,EAD,KTY,KLT,MFT,II(6)
53 my_real orient, fac, x13,y13,z13,x24,y24,z24, nx,ny,nz,p
54 TYPE(g_bufel_) ,POINTER :: GBUF
55C-----------------------------------------------
56 gbuf => elbuf_str%GBUF
57C Initialisation de la surface nodale
58 DO i=1,nod
59 la(1,i)=zero
60 la(2,i)=zero
61 la(3,i)=zero
62 ENDDO
63C
64 DO is=1,nseg
65
66 kseg = abs(iseg(is))
67 orient = zero
68 IF(kseg /= 0)orient=float(iseg(is)/kseg)
69
70 n1=irect(1,is)
71 n2=irect(2,is)
72 n3=irect(3,is)
73 n4=irect(4,is)
74
75 IF(n4==0 .OR. n4==n3) THEN
76 fac=one_over_6*orient
77 n4=n3
78 ELSE
79 fac=one_over_8*orient
80 ENDIF
81C
82 ng1=liste(n1)
83 ng2=liste(n2)
84 ng3=liste(n3)
85 ng4=liste(n4)
86 x13=x(1,ng3)-x(1,ng1)
87 y13=x(2,ng3)-x(2,ng1)
88 z13=x(3,ng3)-x(3,ng1)
89 x24=x(1,ng4)-x(1,ng2)
90 y24=x(2,ng4)-x(2,ng2)
91 z24=x(3,ng4)-x(3,ng2)
92c
93 nx=(y13*z24-z13*y24)*fac
94 ny=(z13*x24-x13*z24)*fac
95 nz=(x13*y24-y13*x24)*fac
96c
97 la(1,n1)=la(1,n1)+nx
98 la(2,n1)=la(2,n1)+ny
99 la(3,n1)=la(3,n1)+nz
100 la(1,n2)=la(1,n2)+nx
101 la(2,n2)=la(2,n2)+ny
102 la(3,n2)=la(3,n2)+nz
103 la(1,n3)=la(1,n3)+nx
104 la(2,n3)=la(2,n3)+ny
105 la(3,n3)=la(3,n3)+nz
106C
107 IF(n4/=n3) THEN
108 la(1,n4)=la(1,n4)+nx
109 la(2,n4)=la(2,n4)+ny
110 la(3,n4)=la(3,n4)+nz
111 ENDIF
112 ENDDO
113C
114C Calcul pression initiale nodale
115C
116 DO i=1,nod
117 p0(i)=zero
118 ENDDO
119
120 mft = 0
121 klt = 0
122 kty = 0
123 DO is=1,nseg
124 kseg=abs(iseg(is))
125 orient=zero
126 IF(kseg /= 0)orient=float(iseg(is)/kseg)
127c pression voisin
128 eseg=ielem(is)
129 DO n=1,ngroup
130 kty = iparg(5,n)
131 klt = iparg(2,n)
132 mft = iparg(3,n)
133 IF (kty==1 .AND. eseg<=klt+mft) GOTO 60
134 ENDDO
135 60 CONTINUE
136!
137 DO i=1,6
138 ii(i) = klt*(i-1)
139 ENDDO
140!
141 ead = eseg-mft
142 p = -(gbuf%SIG(ii(1)+ead)+gbuf%SIG(ii(2)+ead)+gbuf%SIG(ii(3)+ead))*third
143
144c write(6,*)'NG',N,KTY,KLT,MFT,IPARG(4,N)
145c write (6,*)'voisin',IS,KSEG,ESEG,P
146c write(6,*)'sig',(GBUF%SIG(EAD+I),I=1,3)
147c
148 n1=irect(1,is)
149 n2=irect(2,is)
150 n3=irect(3,is)
151 n4=irect(4,is)
152 IF(n4==0 .OR. n4==n3) THEN
153 fac=one_over_6*orient
154 n4=n3
155 ELSE
156 fac=one_over_8*orient
157 ENDIF
158c
159 ng1=liste(n1)
160 ng2=liste(n2)
161 ng3=liste(n3)
162 ng4=liste(n4)
163 x13=x(1,ng3)-x(1,ng1)
164 y13=x(2,ng3)-x(2,ng1)
165 z13=x(3,ng3)-x(3,ng1)
166 x24=x(1,ng4)-x(1,ng2)
167 y24=x(2,ng4)-x(2,ng2)
168 z24=x(3,ng4)-x(3,ng2)
169c
170 nx=(y13*z24-z13*y24)*fac
171 ny=(z13*x24-x13*z24)*fac
172 nz=(x13*y24-y13*x24)*fac
173c
174 p0(n1)=p0(n1)+p*(nx*la(1,n1)+ny*la(2,n1)+nz*la(3,n1))
175 p0(n2)=p0(n2)+p*(nx*la(1,n2)+ny*la(2,n2)+nz*la(3,n2))
176 p0(n3)=p0(n3)+p*(nx*la(1,n3)+ny*la(2,n3)+nz*la(3,n3))
177 IF(n4/=n3) THEN
178 p0(n4)=p0(n4)+p*(nx*la(1,n4)+ny*la(2,n4)+nz*la(3,n4))
179 ENDIF
180 ENDDO
181
182
183 END
my_real
#define my_real
Definition cppsort.cpp:32
iniebcsp
subroutine iniebcsp(nseg, nod, iseg, ielem, irect, liste, la, iparg, elbuf_str, p0, x)
Definition iniebcsp.F:30