OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
auto_node_merge.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!|| auto_node_merge ../starter/source/elements/nodes/auto_node_merge.F
25!||--- called by ------------------------------------------------------
26!|| hm_preread_node ../starter/source/elements/reader/hm_preread_node.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.F
31!||====================================================================
32 SUBROUTINE auto_node_merge(IS_DYNA,NUMNUSR,NUMCNOD,NUMNOD,ITAB,X)
33C-----------------------------------------------
34 USE message_mod
35C
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER,INTENT(IN)::IS_DYNA
44 INTEGER,INTENT(IN) :: NUMNUSR, NUMCNOD
45 INTEGER,INTENT(OUT):: NUMNOD
46 INTEGER,INTENT(IN),DIMENSION(NUMNUSR+NUMCNOD) :: ITAB
47 my_real, INTENT(IN),DIMENSION(3,NUMNUSR) ::
48 . x
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I, IREF, J, STAT
53 INTEGER WORK(70000)
54 INTEGER, DIMENSION(:), ALLOCATABLE :: ITABM1, INDX
55 my_real
56 . xodusr, xmin, ymin, zmin, xmax, ymax, zmax, dx, dy, dz, tol
57C-----------------------------------------------
58C S o u r c e L i n e s
59C-----------------------------------------------
60 ALLOCATE (itabm1(2*(numnusr+numcnod)),indx(2*(numnusr+numcnod)),stat=stat)
61 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
62 . msgtype=msgerror,
63 . c1='ITABM1')
64C-----------------------------------------------
65C Possibly Merge Nodes
66 DO i = 1, numnusr
67 indx(i) = i
68 END DO
69
70 CALL my_orders(0,work,itab,indx,numnusr,1)
71
72 IF(numnusr>=1)THEN
73 itabm1(1) = itab(indx(1))
74 itabm1(numnusr+1) = indx(1)
75 ENDIF
76
77 IF(is_dyna == 0)THEN
78
79 DO i = 2, numnusr
80 itabm1(i) = itab(indx(i))
81 IF(itabm1(i)==itabm1(i-1))THEN
82 CALL ancmsg(msgid=56,
83 . msgtype=msgerror,
84 . anmode=aninfo,
85 . i1=itabm1(i))
86 END IF
87 itabm1(numnusr+i) = indx(i)
88 END DO
89 numnod = numnusr
90
91 ELSE ! IF(IS_DYNA == 0)THEN
92
93 xodusr=numnusr
94 xmin = ep20
95 xmax = -ep20
96 ymin = ep20
97 ymax = -ep20
98 zmin = ep20
99 zmax = -ep20
100 DO i = 1, numnusr
101 xmin = min(xmin,x(1,i))
102 xmax = max(xmax,x(1,i))
103 ymin = min(ymin,x(2,i))
104 ymax = max(ymax,x(2,i))
105 zmin = min(zmin,x(3,i))
106 zmax = max(zmax,x(3,i))
107 END DO
108 dx = xmax-xmin
109 dy = ymax-ymin
110 dz = zmax-zmin
111 tol = em05*(dx+dy+dz)/(three*exp(third*log(xodusr)))
112
113 i = 2
114 DO WHILE(i <= numnusr)
115
116 itabm1(i) = itab(indx(i))
117
118 iref = i-1
119 xmin = x(1,indx(iref))
120 xmax = x(1,indx(iref))
121 ymin = x(2,indx(iref))
122 ymax = x(2,indx(iref))
123 zmin = x(3,indx(iref))
124 zmax = x(3,indx(iref))
125
126 DO WHILE(i <= numnusr .AND. itabm1(i)==itabm1(iref))
127
128 xmin = min(xmin,x(1,indx(i)))
129 xmax = max(xmax,x(1,indx(i)))
130 ymin = min(ymin,x(2,indx(i)))
131 ymax = max(ymax,x(2,indx(i)))
132 zmin = min(zmin,x(3,indx(i)))
133 zmax = max(zmax,x(3,indx(i)))
134
135 indx(i) = indx(iref) ! Possibly merging a cnode and a node, or 2 cnodes
136 itabm1(numnusr+i) = indx(iref)
137
138 i = i + 1
139 itabm1(i)=itab(indx(i))
140
141 END DO
142
143 IF(i > iref+1)THEN
144
145 dx = xmax-xmin
146 dy = ymax-ymin
147 dz = zmax-zmin
148 IF(dx < tol .AND. dy < tol .AND. dz < tol)THEN
149 CALL ancmsg(msgid=1891,
150 . msgtype=msgwarning,
151 . anmode=aninfo_blind_1,
152 . i1=itabm1(i-1),i2=i-iref,i3=itabm1(i-1),r1=tol)
153 ELSE
154 CALL ancmsg(msgid=56,
155 . msgtype=msgerror,
156 . anmode=aninfo,
157 . i1=itabm1(i-1))
158 END IF
159
160 ELSE ! IF(I > IREF+1)THEN
161
162 itabm1(numnusr+i) = indx(i)
163 i = i + 1
164
165 END IF
166
167 END DO ! DO WHILE(I <= NUMNUSR)
168
169 numnod = 1
170 DO i=2,numnusr
171 IF(itabm1(numnusr+i) == itabm1(numnusr+i-1)) cycle ! Twice the same ID
172 numnod = numnod + 1
173 ENDDO
174
175 END IF ! IF(IS_DYNA == 0)THEN
176C-----------------------------------------------
177 DO i = 1, numnusr+numcnod
178 indx(i) = i
179 END DO
180
181 CALL my_orders(0,work,itab,indx,numnusr+numcnod,1)
182
183 IF(numnusr+numcnod>=1)THEN
184 itabm1(1) = itab(indx(1))
185 itabm1(numnusr+numcnod+1) = indx(1)
186 ENDIF
187
188 DO i = 2, numnusr+numcnod
189 itabm1(i) = itab(indx(i))
190 IF(itabm1(i)==itabm1(i-1))THEN
191 IF((indx(i-1) < numnusr .AND. indx(i) > numnusr) .OR.
192 . (indx(i-1) > numnusr .AND. indx(i) < numnusr)) THEN
193C A Node and a Cnode have the same ID
194 CALL ancmsg(msgid=1889,
195 . msgtype=msgerror,
196 . anmode=aninfo,
197 . i1=itabm1(i))
198 ELSEIF(indx(i-1) > numnusr .AND. indx(i) > numnusr)THEN
199C Two Cnode shave the same ID
200 CALL ancmsg(msgid=1890,
201 . msgtype=msgerror,
202 . anmode=aninfo,
203 . i1=itabm1(i))
204 END IF
205 END IF
206 itabm1(numnusr+numcnod+i) = indx(i)
207 END DO
208C-----------------------------------------------
209 numnod = numnod + numcnod
210 DEALLOCATE(itabm1,indx)
211 RETURN
212 END
213
auto_node_merge
subroutine auto_node_merge(is_dyna, numnusr, numcnod, numnod, itab, x)
Definition auto_node_merge.F:33
my_real
#define my_real
Definition cppsort.cpp:32
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
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