OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ale_check_lag.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!|| ale_check_lag ../starter/source/ale/ale_check_lag.F
25!||--- called by ------------------------------------------------------
26!|| alelec ../starter/source/ale/alelec.F
27!|| r2r_group ../starter/source/coupling/rad2rad/r2r_group.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE ale_check_lag(NALE,IXS,IXQ,IXC,IXT,IXTG,PM,ITAB,NALE_R2R,FLAG_R2R,IGEO)
34C-----------------------------------------------
35C D e s c r i p t i o n
36C-----------------------------------------------
37C This subroutine is ensuring that no lagrangian elem is connected to an Eulerian component.
38C NALE is marking nodes : 0 - Lagrange
39C 1 - ALE
40C 2 - EULER
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE message_mod
45 use element_mod , only : nixs,nixq,nixc,nixt,nixtg
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "param_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER,INTENT(INOUT) :: NALE(NUMNOD)
60 INTEGER,INTENT(IN) :: IXS(NIXS,NUMELS), IXQ(NIXQ,NUMELQ), IXC(NIXC,NUMELC), IXT(NIXT,NUMELT), IXTG(NIXTG,NUMELTG)
61 INTEGER,INTENT(IN) :: ITAB(NUMNOD), NALE_R2R(*),FLAG_R2R, IGEO(NPROPGI,NUMGEO)
62 my_real,INTENT(IN) :: pm(npropm,nummat)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER M, IAL, I, N, JWARN, IMAT, IPROP
67 INTEGER JALE_FROM_MAT, JALE_FROM_PROP
68C-----------------------------------------------
69C S o u r c e L i n e s
70C-----------------------------------------------
71
72C--------------------------------------------------------------
73C LAGRANGIAN CONDITION FOR NODES ON QUADS
74C--------------------------------------------------------------
75 jwarn=0
76 IF(numelq /= 0)THEN
77 DO m=1,numelq
78 imat = iabs(ixq(1,m)) !/EULER/MAT or /ALE/MAT
79 iprop = iabs(ixq(6,m))!/PROP/TYPE14 (IALE_FLAG)
80 IF(imat == 0)cycle
81 jale_from_mat = nint(pm(72,imat))
82 jale_from_prop = igeo(62,iprop)
83 ial = jale_from_mat + jale_from_prop
84 IF(ial /= 0)cycle
85 DO i=2,5
86 n=ixq(i,m)
87 IF(iabs(nale(n)) == 2)THEN
88 jwarn=1
89 !WARNING NODE CONNECTS LAGRANGIAN QUAD TO EULERIAN QUAD
90 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='QUAD')
91 ENDIF
92 nale(n)=0
93 ENDDO !I=2,5
94 ENDDO !M=1,NUMELQ
95 ENDIF !IF(NUMELQ /= 0)
96 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1, prmod=msg_print,c1='QUAD',c2='QUAD')
97
98C--------------------------------------------------------------
99C LAGRANGIAN CONDITION FOR NODES ON 3D LAGRANGIANS ELEMS
100C--------------------------------------------------------------
101 IF(numels /= 0)THEN
102 DO m=1,numels
103 imat = iabs(ixs(1,m)) !/EULER/MAT or /ALE/MAT
104 iprop = iabs(ixs(10,m))!/PROP/TYPE14 (IALE_FLAG)
105 IF(imat == 0)cycle
106 jale_from_mat = nint(pm(72,imat))
107 jale_from_prop = igeo(62,iprop)
108 ial = jale_from_mat + jale_from_prop
109 IF(ial /= 0)cycle
110 DO i=2,9
111 n=ixs(i,m)
112 IF(iabs(nale(n)) == 2)THEN
113 jwarn=1
114 !WARNING NODE CONNECTS LAGRANGIAN SOLID TO EULERIAN SOLID
115 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='SOLID')
116 ENDIF
117 nale(n)=0
118 ENDDO !I=2,9
119 ENDDO !M=1,NUMELS
120 ENDIF !IF(NUMELS /= 0)
121 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,prmod=msg_print,c1='SOLID',c2='SOLID')
122
123C---------------------------------------------------
124C LAGRANGIAN CONDITION FOR NODES ON SHELLS
125C---------------------------------------------------
126 IF(numelc /= 0)THEN
127 DO m=1,numelc
128 DO i=2,5
129 n=ixc(i,m)
130 IF(iabs(nale(n)) == 2)THEN
131 jwarn=1
132 !WARNING NODE CONNECTS SHELL (LAGRANGIAN) TO EULERIAN SOLID
133 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='SHELL')
134 ENDIF
135 nale(n)=0
136 ENDDO !I=2,5
137 ENDDO !M=1,NUMELC
138 ENDIF !IF(NUMELC /= 0)
139 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,prmod=msg_print,c1='SHELL',c2='SOLID')
140
141C---------------------------------------------------
142C LAGRANGIAN CONDITION FOR NODES ON 3-NODE-SHELLS
143C---------------------------------------------------
144 IF(numeltg /= 0 .AND. n2d == 0)THEN
145 DO m=1,numeltg
146 DO i=2,4
147 n=ixtg(i,m)
148 IF(iabs(nale(n)) == 2)THEN
149 jwarn=1
150 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='SH3N')
151 ENDIF
152 nale(n)=0
153 ENDDO
154 ENDDO
155 ENDIF
156 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,prmod=msg_print,c1='SHELL-3N',c2='SOLID')
157
158C---------------------------------------------------
159C LAGRANGIAN CONDITION FOR NODES ON TRUSSES
160C---------------------------------------------------
161 IF(numelt /= 0)THEN
162 DO m=1,numelt
163 DO i=2,3
164 n=ixt(i,m)
165 IF(iabs(nale(n)) == 2)THEN
166 jwarn=1
167 !WARNING NODE CONNECTS TRUSS (LAGRANGIAN) TO EULERIAN PART
168 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='TRUSS')
169 ENDIF
170 nale(n)=0
171 ENDDO !I=2,3
172 ENDDO !M=1,NUMELT
173 ENDIF !IF(NUMELT /= 0)
174 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,prmod=msg_print,c1='TRUSS',c2='PART')
175
176C---------------------------------------------------
177 !WARNING LAGRANGIAN PART CONNECTED TO EULERIAN PART
178C---------------------------------------------------
179 IF(jwarn == 1) THEN
180 CALL ancmsg(msgid=337,msgtype=msgwarning, anmode=aninfo)
181 ENDIF
182
183C---------------------------------------------------
184C MULTIDOMAINS : SYNCHRONISATION OF NALE FOR COMMON NODES
185C---------------------------------------------------
186 IF(iale /= 0)THEN !this subroutine alebcs is also now called even if IALE=0 and IEULER=1, this block was previously only treated if IALE /= 0
187 !-----------------------------------!
188 IF (flag_r2r > 0) THEN
189 DO n=1,numnod
190 nale(n) = nale_r2r(n)*nale(n)
191 END DO
192 ENDIF
193 !-----------------------------------!
194 ENDIF
195C-----------------------------------------------
196 RETURN
197 END
ale_check_lag
subroutine ale_check_lag(nale, ixs, ixq, ixc, ixt, ixtg, pm, itab, nale_r2r, flag_r2r, igeo)
Definition ale_check_lag.F:34
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1257
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895