OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s8ederipr3.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!|| s8ederipr3 ../engine/source/elements/solid/solide8e/s8ederipr3.F
25!||--- called by ------------------------------------------------------
26!|| s8eforc3 ../engine/source/elements/solid/solide8e/s8eforc3.F
27!|| s8sforc3 ../engine/source/elements/solid/solide8s/s8sforc3.F
28!||--- uses -----------------------------------------------------
29!|| message_mod ../engine/share/message_module/message_mod.F
30!||====================================================================
31 SUBROUTINE s8ederipr3(
32 1 OFFG, VOLDP, NGL, WI,
33 2 AJ1, AJ2, AJ3, AJ4,
34 3 AJ5, AJ6, AJ7, AJ8,
35 4 AJ9, AJI1, AJI2, AJI3,
36 5 AJI4, AJI5, AJI6, AJI7,
37 6 AJI8, AJI9, NNEGA, INDEX,
38 7 IPT, NEL)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "comlock.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "units_c.inc"
56#include "scr17_c.inc"
57#include "impl1_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER, INTENT(IN) :: NEL
62 INTEGER NNEGA,INDEX(*),IPT
63C REAL
64 my_real
65 . OFFG(*),WI,
66 . AJ1(*),AJ2(*),AJ3(*),
67 . AJ4(*),AJ5(*),AJ6(*),
68 . aj7(*),aj8(*),aj9(*),
69 . aji1(*), aji2(*), aji3(*),
70 . aji4(*), aji5(*), aji6(*),
71 . aji7(*), aji8(*), aji9(*)
72 DOUBLE PRECISION
73 . VOLDP(*)
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER NGL(*), I, J ,ICOR
78C REAL
79C 12
80 my_real
81 . vol(mvsiz),det(mvsiz) ,dett(mvsiz) ,
82 . jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz),
83 . jac_38_29(mvsiz), jac_19_37(mvsiz), jac_27_18(mvsiz),
84 . jac_26_35(mvsiz), jac_34_16(mvsiz), jac_15_24(mvsiz)
85 DOUBLE PRECISION
86 . DETDP
87C-----------------------------------------------
88C
89 DO i=1,nel
90 jac_59_68(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)
91 jac_67_49(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)
92 jac_38_29(i)=(-aj2(i)*aj9(i)+aj3(i)*aj8(i))
93 jac_19_37(i)=( aj1(i)*aj9(i)-aj3(i)*aj7(i))
94 jac_27_18(i)=(-aj1(i)*aj8(i)+aj2(i)*aj7(i))
95 jac_26_35(i)=( aj2(i)*aj6(i)-aj3(i)*aj5(i))
96 jac_34_16(i)=(-aj1(i)*aj6(i)+aj3(i)*aj4(i))
97 jac_15_24(i)=( aj1(i)*aj5(i)-aj2(i)*aj4(i))
98 jac_48_57(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)
99 ENDDO
100C
101 DO i=1,nel
102 detdp=one_over_512*(aj1(i)*jac_59_68(i)+aj2(i)*jac_67_49(i)+aj3(i)*jac_48_57(i))
103 det(i)=detdp
104 voldp(i)= wi*detdp
105 vol(i)= voldp(i)
106 ENDDO
107C
108 icor = 0
109 DO i=1,nel
110 IF(offg(i)==zero)THEN
111 det(i)=one
112 IF (vol(i)<=zero) THEN
113 vol(i)=one
114 voldp(i)= one
115 END IF
116 ELSEIF (vol(i)<=zero ) THEN
117 icor=1
118 ENDIF
119 ENDDO
120 IF (icor>0.AND.inconv==1) THEN
121 DO i=1,nel
122 IF (offg(i) /= two .AND.offg(i) /= zero ) THEN
123 nnega=nnega+1
124 index(nnega)=i
125 offg(i) = two
126 END IF
127 ENDDO
128 END IF
129C
130 IF (icor>0.AND.impl_s>0) THEN
131 DO i=1,nel
132 IF(vol(i)<=zero)THEN
133 voldp(i)= em20
134 det(i)= em20
135 IF (imp_chk>0) THEN
136#include "lockon.inc"
137 WRITE(iout ,2001) ngl(i)
138#include "lockoff.inc"
139 idel7nok = 1
140 imp_ir = imp_ir + 1
141 ELSEIF (imconv==1.AND.abs(offg(i))/=two) THEN
142c#include "lockon.inc"
143c WRITE(ISTDO,2000) NGL(I)
144c WRITE(IOUT ,2000) NGL(I)
145c#include "lockoff.inc"
146c IDEL7NOK = 1
147 ENDIF
148 ENDIF
149 ENDDO
150 END IF
151C
152C
153 DO i=1,nel
154 dett(i)=one_over_512/det(i)
155 aji1(i)=dett(i)*jac_59_68(i)
156 aji4(i)=dett(i)*jac_67_49(i)
157 aji7(i)=dett(i)*jac_48_57(i)
158 aji2(i)=dett(i)*jac_38_29(i)
159 aji5(i)=dett(i)*jac_19_37(i)
160 aji8(i)=dett(i)*jac_27_18(i)
161 aji3(i)=dett(i)*jac_26_35(i)
162 aji6(i)=dett(i)*jac_34_16(i)
163 aji9(i)=dett(i)*jac_15_24(i)
164 ENDDO
165C
166 RETURN
167 2000 FORMAT(/' ZERO OR NEGATIVE SUB-VOLUME : DELETE 3D-ELEMENT NB',
168 . i10/)
169 2001 FORMAT(/' ZERO OR NEGATIVE SOLID SUB-VOLUME : ELEMENT NB:',
170 . i10/)
171 END
message_mod
Definition message_mod.F:1249
s8ederipr3
subroutine s8ederipr3(offg, voldp, ngl, wi, aj1, aj2, aj3, aj4, aj5, aj6, aj7, aj8, aj9, aji1, aji2, aji3, aji4, aji5, aji6, aji7, aji8, aji9, nnega, index, ipt, nel)
Definition s8ederipr3.F:39