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 29 of file s6cumu3.F.

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