OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_bcs.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!|| sms_bcs ../engine/source/ams/sms_bcs.F
25!||--- called by ------------------------------------------------------
26!|| sms_encin_2 ../engine/source/ams/sms_encin_2.F
27!|| sms_mass_scale_2 ../engine/source/ams/sms_mass_scale_2.F
28!|| sms_pcg ../engine/source/ams/sms_pcg.F
29!||--- calls -----------------------------------------------------
30!|| sms_bcs1v ../engine/source/ams/sms_bcs.F
31!||====================================================================
32 SUBROUTINE sms_bcs(NODFT ,NODLT ,INDX1 ,ICODT ,ISKEW ,
33 2 SKEW ,A ,NODLAST )
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"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER NODLAST
46 INTEGER NODFT,NODLT,INDX1(*),ICODT(*),ISKEW(*)
47 my_real
48 . a(3,*),skew(lskew,*)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I, N, NINDX,
53 . indx(1024),l,j
54C-----------------------------------------------
55C DO 420 I = NODFT,NODLT,1024
56 DO 420 i = nodft,nodlast,1024
57 nindx = 0
58C DO 400 N=I,MIN(NODLT,I+1023)
59 DO 400 j=i,min(nodlast,i+1023)
60 n=indx1(j)
61 IF (icodt(n)/=0)THEN
62 nindx = nindx + 1
63 indx(nindx) = n
64 ENDIF
65 400 CONTINUE
66 CALL sms_bcs1v(nindx,indx,iskew,icodt,
67 . a ,skew )
68 420 CONTINUE
69C
70 RETURN
71 END
72!||====================================================================
73!|| sms_bcs1v ../engine/source/ams/sms_bcs.F
74!||--- called by ------------------------------------------------------
75!|| sms_bcs ../engine/source/ams/sms_bcs.F
76!||====================================================================
77 SUBROUTINE sms_bcs1v(NINDX,INDX,ISKEW,ICODT,
78 . A ,SKEW )
79C-----------------------------------------------
80C I m p l i c i t T y p e s
81C-----------------------------------------------
82#include "implicit_f.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER NINDX, INDX(*), ISKEW(*), ICODT(*)
87C REAL
88 my_real
89 . a(3,*), skew(lskew,*)
90C-----------------------------------------------
91C C o m m o n B l o c k s
92C-----------------------------------------------
93#include "param_c.inc"
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 INTEGER N, K, L, ISK, LCOD
98C REAL
99 my_real
100 . aa
101C-----------------------------------------------
102#include "vectorize.inc"
103 DO k = 1, nindx
104 l = indx(k)
105 isk =iskew(l)
106 lcod=icodt(l)
107 IF(isk==1) THEN
108C------------------
109C REPERE GLOBAL
110C------------------
111 IF(lcod==1)THEN
112 a(3,l)=zero
113 ELSEIF(lcod==2)THEN
114 a(2,l)=zero
115 ELSEIF(lcod==3)THEN
116 a(2,l)=zero
117 a(3,l)=zero
118 ELSEIF(lcod==4)THEN
119 a(1,l)=zero
120 ELSEIF(lcod==5)THEN
121 a(1,l)=zero
122 a(3,l)=zero
123 ELSEIF(lcod==6)THEN
124 a(1,l)=zero
125 a(2,l)=zero
126 ELSEIF(lcod==7)THEN
127 a(1,l)=zero
128 a(2,l)=zero
129 a(3,l)=zero
130 ENDIF
131C
132 ELSE
133C-------------------
134C REPERE OBLIQUE
135C-------------------
136 IF(lcod==1)THEN
137 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
138 a(1,l)=a(1,l)-skew(7,isk)*aa
139 a(2,l)=a(2,l)-skew(8,isk)*aa
140 a(3,l)=a(3,l)-skew(9,isk)*aa
141 ELSEIF(lcod==2)THEN
142 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
143 a(1,l)=a(1,l)-skew(4,isk)*aa
144 a(2,l)=a(2,l)-skew(5,isk)*aa
145 a(3,l)=a(3,l)-skew(6,isk)*aa
146 ELSEIF(lcod==3)THEN
147 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
148 a(1,l)=a(1,l)-skew(7,isk)*aa
149 a(2,l)=a(2,l)-skew(8,isk)*aa
150 a(3,l)=a(3,l)-skew(9,isk)*aa
151 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
152 a(1,l)=a(1,l)-skew(4,isk)*aa
153 a(2,l)=a(2,l)-skew(5,isk)*aa
154 a(3,l)=a(3,l)-skew(6,isk)*aa
155 ELSEIF(lcod==4)THEN
156 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
157 a(1,l)=a(1,l)-skew(1,isk)*aa
158 a(2,l)=a(2,l)-skew(2,isk)*aa
159 a(3,l)=a(3,l)-skew(3,isk)*aa
160 ELSEIF(lcod==5)THEN
161 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
162 a(1,l)=a(1,l)-skew(7,isk)*aa
163 a(2,l)=a(2,l)-skew(8,isk)*aa
164 a(3,l)=a(3,l)-skew(9,isk)*aa
165 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
166 a(1,l)=a(1,l)-skew(1,isk)*aa
167 a(2,l)=a(2,l)-skew(2,isk)*aa
168 a(3,l)=a(3,l)-skew(3,isk)*aa
169 ELSEIF(lcod==6)THEN
170 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
171 a(1,l)=a(1,l)-skew(1,isk)*aa
172 a(2,l)=a(2,l)-skew(2,isk)*aa
173 a(3,l)=a(3,l)-skew(3,isk)*aa
174 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
175 a(1,l)=a(1,l)-skew(4,isk)*aa
176 a(2,l)=a(2,l)-skew(5,isk)*aa
177 a(3,l)=a(3,l)-skew(6,isk)*aa
178 ELSEIF(lcod==7)THEN
179 a(1,l)=zero
180 a(2,l)=zero
181 a(3,l)=zero
182 ENDIF
183C
184 END IF
185C
186 ENDDO
187C
188 RETURN
189 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
sms_bcs1v
subroutine sms_bcs1v(nindx, indx, iskew, icodt, a, skew)
Definition sms_bcs.F:79
sms_bcs
subroutine sms_bcs(nodft, nodlt, indx1, icodt, iskew, skew, a, nodlast)
Definition sms_bcs.F:34