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
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "param_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER,INTENT(INOUT) :: NALE(NUMNOD)
59 INTEGER,INTENT(IN) :: IXS(NIXS,NUMELS), IXQ(NIXQ,NUMELQ), IXC(NIXC,NUMELC), IXT(NIXT,NUMELT), IXTG(NIXTG,NUMELTG)
60 INTEGER,INTENT(IN) :: ITAB(NUMNOD), NALE_R2R(*),FLAG_R2R, IGEO(NPROPGI,NUMGEO)
61 my_real,INTENT(IN) :: pm(npropm,nummat)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER M, IAL, I, N, JWARN, IMAT, IPROP
66 INTEGER JALE_FROM_MAT, JALE_FROM_PROP
67C-----------------------------------------------
68C S o u r c e L i n e s
69C-----------------------------------------------
70
71C--------------------------------------------------------------
72C LAGRANGIAN CONDITION FOR NODES ON QUADS
73C--------------------------------------------------------------
74 jwarn=0
75 IF(numelq /= 0)THEN
76 DO m=1,numelq
77 imat = iabs(ixq(1,m)) !/EULER/MAT or /ALE/MAT
78 iprop = iabs(ixq(6,m))!/PROP/TYPE14 (IALE_FLAG)
79 IF(imat == 0)cycle
80 jale_from_mat = nint(pm(72,imat))
81 jale_from_prop = igeo(62,iprop)
82 ial = jale_from_mat + jale_from_prop
83 IF(ial /= 0)cycle
84 DO i=2,5
85 n=ixq(i,m)
86 IF(iabs(nale(n)) == 2)THEN
87 jwarn=1
88 !WARNING NODE CONNECTS LAGRANGIAN QUAD TO EULERIAN QUAD
89 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='QUAD')
90 ENDIF
91 nale(n)=0
92 ENDDO !I=2,5
93 ENDDO !M=1,NUMELQ
94 ENDIF !IF(NUMELQ /= 0)
95 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1, prmod=msg_print,c1='QUAD',c2='QUAD')
96
97C--------------------------------------------------------------
98C LAGRANGIAN CONDITION FOR NODES ON 3D LAGRANGIANS ELEMS
99C--------------------------------------------------------------
100 IF(numels /= 0)THEN
101 DO m=1,numels
102 imat = iabs(ixs(1,m)) !/EULER/MAT or /ALE/MAT
103 iprop = iabs(ixs(10,m))!/PROP/TYPE14 (IALE_FLAG)
104 IF(imat == 0)cycle
105 jale_from_mat = nint(pm(72,imat))
106 jale_from_prop = igeo(62,iprop)
107 ial = jale_from_mat + jale_from_prop
108 IF(ial /= 0)cycle
109 DO i=2,9
110 n=ixs(i,m)
111 IF(iabs(nale(n)) == 2)THEN
112 jwarn=1
113 !WARNING NODE CONNECTS LAGRANGIAN SOLID TO EULERIAN SOLID
114 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='SOLID')
115 ENDIF
116 nale(n)=0
117 ENDDO !I=2,9
118 ENDDO !M=1,NUMELS
119 ENDIF !IF(NUMELS /= 0)
120 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,prmod=msg_print,c1='SOLID',c2='SOLID')
121
122C---------------------------------------------------
123C LAGRANGIAN CONDITION FOR NODES ON SHELLS
124C---------------------------------------------------
125 IF(numelc /= 0)THEN
126 DO m=1,numelc
127 DO i=2,5
128 n=ixc(i,m)
129 IF(iabs(nale(n)) == 2)THEN
130 jwarn=1
131 !WARNING NODE CONNECTS SHELL (LAGRANGIAN) TO EULERIAN SOLID
132 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='SHELL')
133 ENDIF
134 nale(n)=0
135 ENDDO !I=2,5
136 ENDDO !M=1,NUMELC
137 ENDIF !IF(NUMELC /= 0)
138 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,prmod=msg_print,c1='SHELL',c2='SOLID')
139
140C---------------------------------------------------
141C LAGRANGIAN CONDITION FOR NODES ON 3-NODE-SHELLS
142C---------------------------------------------------
143 IF(numeltg /= 0 .AND. n2d == 0)THEN
144 DO m=1,numeltg
145 DO i=2,4
146 n=ixtg(i,m)
147 IF(iabs(nale(n)) == 2)THEN
148 jwarn=1
149 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='SH3N')
150 ENDIF
151 nale(n)=0
152 ENDDO
153 ENDDO
154 ENDIF
155 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,prmod=msg_print,c1='SHELL-3N',c2='SOLID')
156
157C---------------------------------------------------
158C LAGRANGIAN CONDITION FOR NODES ON TRUSSES
159C---------------------------------------------------
160 IF(numelt /= 0)THEN
161 DO m=1,numelt
162 DO i=2,3
163 n=ixt(i,m)
164 IF(iabs(nale(n)) == 2)THEN
165 jwarn=1
166 !WARNING NODE CONNECTS TRUSS (LAGRANGIAN) TO EULERIAN PART
167 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,i1=itab(n),prmod=msg_cumu,c1='TRUSS')
168 ENDIF
169 nale(n)=0
170 ENDDO !I=2,3
171 ENDDO !M=1,NUMELT
172 ENDIF !IF(NUMELT /= 0)
173 CALL ancmsg(msgid=336,msgtype=msgwarning,anmode=aninfo_blind_1,prmod=msg_print,c1='TRUSS',c2='PART')
174
175C---------------------------------------------------
176 !WARNING LAGRANGIAN PART CONNECTED TO EULERIAN PART
177C---------------------------------------------------
178 IF(jwarn == 1) THEN
179 CALL ancmsg(msgid=337,msgtype=msgwarning, anmode=aninfo)
180 ENDIF
181
182C---------------------------------------------------
183C MULTIDOMAINS : SYNCHRONISATION OF NALE FOR COMMON NODES
184C---------------------------------------------------
185 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
186 !-----------------------------------!
187 IF (flag_r2r > 0) THEN
188 DO n=1,numnod
189 nale(n) = nale_r2r(n)*nale(n)
190 END DO
191 ENDIF
192 !-----------------------------------!
193 ENDIF
194C-----------------------------------------------
195 RETURN
196 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:1249
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:889
starter
program starter
Definition starter.F:39