OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s6cumu3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "scr18_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine s6cumu3 (offg, e, nc1, nc2, nc3, nc4, nc5, nc6, stifn, sti, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, nel, jthe, fthe, them, condn, conde, ifthe, icondn, nodadt_therm)

Function/Subroutine Documentation

◆ s6cumu3()

subroutine s6cumu3 ( offg,
e,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, dimension(*) nc3,
integer, dimension(*) nc4,
integer, dimension(*) nc5,
integer, dimension(*) nc6,
stifn,
sti,
f11,
f21,
f31,
f12,
f22,
f32,
f13,
f23,
f33,
f14,
f24,
f34,
f15,
f25,
f35,
f16,
f26,
f36,
integer, intent(in) nel,
integer, intent(in) jthe,
dimension(ifthe), intent(inout) fthe,
dimension(mvsiz,6), intent(inout) them,
dimension(icondn), intent(inout) condn,
dimension(mvsiz), intent(inout) conde,
integer, intent(in) ifthe,
integer, intent(in) icondn,
integer, intent(in) nodadt_therm )

Definition at line 28 of file s6cumu3.F.

39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43#include "comlock.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com01_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER, INTENT(IN) :: NEL,JTHE,IFTHE,ICONDN
56 INTEGER, INTENT(IN) :: NODADT_THERM
57 INTEGER NC1(*), NC2(*), NC3(*), NC4(*), NC5(*), NC6(*)
58C REAL
59 my_real
60 . offg(*),e(3,*),stifn(*),sti(*),
61 . f11(*),f21(*),f31(*),f12(*),f22(*),f32(*),
62 . f13(*),f23(*),f33(*),f14(*),f24(*),f34(*),
63 . f15(*),f25(*),f35(*),f16(*),f26(*),f36(*)
64 my_real, INTENT(INOUT) :: them(mvsiz,6),fthe(ifthe),
65 . condn(icondn),conde(mvsiz)
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "scr18_c.inc"
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I, J
74C-----------------------------------------------
75 my_real
76 . off_l
77C-----------------------------------------------
78 off_l = zero
79 DO i=1,nel
80 off_l = min(off_l,offg(i))
81 ENDDO
82 IF(off_l<zero)THEN
83 DO i=1,nel
84 IF(offg(i)<zero)THEN
85 f11(i)=zero
86 f21(i)=zero
87 f31(i)=zero
88 f12(i)=zero
89 f22(i)=zero
90 f32(i)=zero
91 f13(i)=zero
92 f23(i)=zero
93 f33(i)=zero
94 f14(i)=zero
95 f24(i)=zero
96 f34(i)=zero
97 f15(i)=zero
98 f25(i)=zero
99 f35(i)=zero
100 f16(i)=zero
101 f26(i)=zero
102 f36(i)=zero
103 sti(i)=zero
104 ENDIF
105 ENDDO
106 ENDIF
107 IF (jthe < 0) THEN
108 IF (off_l<=zero) THEN
109 DO j=1,6
110 DO i=1,nel
111 IF(offg(i)<=zero)THEN
112 them(i,j)=zero
113 ENDIF
114 ENDDO
115 ENDDO
116 ENDIF
117 IF (nodadt_therm == 1) THEN
118 IF(off_l<zero)THEN
119 DO i=1,nel
120 IF(offg(i)<zero)THEN
121 conde(i)=zero
122 ENDIF
123 ENDDO
124 ENDIF
125 ENDIF
126 ENDIF
127C
128C because 2*Mnodal = 2*Melement/6
129 DO i=1,nel
130 sti(i)=third*sti(i)
131 END DO
132 IF (nodadt_therm == 1) THEN
133 DO i = 1,nel
134 conde(i) = one_over_6*conde(i)
135 END DO
136 ENDIF
137C
138 DO i=1,nel
139C
140 IF(jthe >= 0) THEN
141C
142 e(1,nc1(i))=e(1,nc1(i))+f11(i)
143 e(2,nc1(i))=e(2,nc1(i))+f21(i)
144 e(3,nc1(i))=e(3,nc1(i))+f31(i)
145 stifn(nc1(i))=stifn(nc1(i))+sti(i)
146C
147 e(1,nc2(i))=e(1,nc2(i))+f12(i)
148 e(2,nc2(i))=e(2,nc2(i))+f22(i)
149 e(3,nc2(i))=e(3,nc2(i))+f32(i)
150 stifn(nc2(i))=stifn(nc2(i))+sti(i)
151C
152 e(1,nc3(i))=e(1,nc3(i))+f13(i)
153 e(2,nc3(i))=e(2,nc3(i))+f23(i)
154 e(3,nc3(i))=e(3,nc3(i))+f33(i)
155 stifn(nc3(i))=stifn(nc3(i))+sti(i)
156C
157 e(1,nc5(i))=e(1,nc5(i))+f15(i)
158 e(2,nc5(i))=e(2,nc5(i))+f25(i)
159 e(3,nc5(i))=e(3,nc5(i))+f35(i)
160 stifn(nc5(i))=stifn(nc5(i))+sti(i)
161C
162 e(1,nc4(i))=e(1,nc4(i))+f14(i)
163 e(2,nc4(i))=e(2,nc4(i))+f24(i)
164 e(3,nc4(i))=e(3,nc4(i))+f34(i)
165 stifn(nc4(i))=stifn(nc4(i))+sti(i)
166C
167 e(1,nc6(i))=e(1,nc6(i))+f16(i)
168 e(2,nc6(i))=e(2,nc6(i))+f26(i)
169 e(3,nc6(i))=e(3,nc6(i))+f36(i)
170 stifn(nc6(i))=stifn(nc6(i))+sti(i)
171CCC
172 ELSE
173C
174 e(1,nc1(i))=e(1,nc1(i))+f11(i)
175 e(2,nc1(i))=e(2,nc1(i))+f21(i)
176 e(3,nc1(i))=e(3,nc1(i))+f31(i)
177 stifn(nc1(i))=stifn(nc1(i))+sti(i)
178 fthe(nc1(i)) = fthe(nc1(i)) + them(i,1)
179 IF(nodadt_therm == 1) condn(nc1(i))= condn(nc1(i))+ conde(i)
180C
181 e(1,nc2(i))=e(1,nc2(i))+f12(i)
182 e(2,nc2(i))=e(2,nc2(i))+f22(i)
183 e(3,nc2(i))=e(3,nc2(i))+f32(i)
184 stifn(nc2(i))=stifn(nc2(i))+sti(i)
185 fthe(nc2(i)) = fthe(nc2(i)) + them(i,2)
186 IF(nodadt_therm == 1) condn(nc2(i))= condn(nc2(i))+ conde(i)
187C
188 e(1,nc3(i))=e(1,nc3(i))+f13(i)
189 e(2,nc3(i))=e(2,nc3(i))+f23(i)
190 e(3,nc3(i))=e(3,nc3(i))+f33(i)
191 stifn(nc3(i))=stifn(nc3(i))+sti(i)
192 fthe(nc3(i)) = fthe(nc3(i)) + them(i,3)
193 IF(nodadt_therm == 1) condn(nc3(i))= condn(nc3(i))+ conde(i)
194C
195 e(1,nc5(i))=e(1,nc5(i))+f15(i)
196 e(2,nc5(i))=e(2,nc5(i))+f25(i)
197 e(3,nc5(i))=e(3,nc5(i))+f35(i)
198 stifn(nc5(i))=stifn(nc5(i))+sti(i)
199 fthe(nc5(i)) = fthe(nc5(i)) + them(i,5)
200 IF(nodadt_therm == 1) condn(nc5(i))= condn(nc5(i))+ conde(i)
201C
202 e(1,nc4(i))=e(1,nc4(i))+f14(i)
203 e(2,nc4(i))=e(2,nc4(i))+f24(i)
204 e(3,nc4(i))=e(3,nc4(i))+f34(i)
205 stifn(nc4(i))=stifn(nc4(i))+sti(i)
206 fthe(nc4(i)) = fthe(nc4(i)) + them(i,4)
207 IF(nodadt_therm == 1) condn(nc4(i))= condn(nc4(i))+ conde(i)
208C
209 e(1,nc6(i))=e(1,nc6(i))+f16(i)
210 e(2,nc6(i))=e(2,nc6(i))+f26(i)
211 e(3,nc6(i))=e(3,nc6(i))+f36(i)
212 stifn(nc6(i))=stifn(nc6(i))+sti(i)
213 fthe(nc6(i)) = fthe(nc6(i)) + them(i,6)
214 IF(nodadt_therm == 1)condn(nc6(i))= condn(nc6(i))+ conde(i)
215C
216 ENDIF
217C
218 ENDDO
219 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20