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) :: x
48C-----------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 INTEGER I, IREF, STAT
52 INTEGER WORK(70000)
53 INTEGER, DIMENSION(:), ALLOCATABLE :: ITABM1, INDX
54 my_real :: xodusr, xmin, ymin, zmin, xmax, ymax, zmax, dx, dy, dz, tol
55C-----------------------------------------------
56C S o u r c e L i n e s
57C-----------------------------------------------
58 ALLOCATE (itabm1(2*(numnusr+numcnod)),indx(2*(numnusr+numcnod)),stat=stat)
59 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
60 . msgtype=msgerror,
61 . c1='ITABM1')
62C-----------------------------------------------
63C Possibly Merge Nodes
64 DO i = 1, numnusr
65 indx(i) = i
66 END DO
67
68 CALL my_orders(0,work,itab,indx,numnusr,1)
69
70 IF(numnusr>=1)THEN
71 itabm1(1) = itab(indx(1))
72 itabm1(numnusr+1) = indx(1)
73 ENDIF
74
75 IF(is_dyna == 0)THEN
76
77 DO i = 2, numnusr
78 itabm1(i) = itab(indx(i))
79 IF(itabm1(i)==itabm1(i-1))THEN
80 CALL ancmsg(msgid=56,
81 . msgtype=msgerror,
82 . anmode=aninfo,
83 . i1=itabm1(i))
84 END IF
85 itabm1(numnusr+i) = indx(i)
86 END DO
87 numnod = numnusr
88
89 ELSE ! IF(IS_DYNA == 0)THEN
90
91 xodusr=numnusr
92 xmin = ep20
93 xmax = -ep20
94 ymin = ep20
95 ymax = -ep20
96 zmin = ep20
97 zmax = -ep20
98 DO i = 1, numnusr
99 xmin = min(xmin,x(1,i))
100 xmax = max(xmax,x(1,i))
101 ymin = min(ymin,x(2,i))
102 ymax = max(ymax,x(2,i))
103 zmin = min(zmin,x(3,i))
104 zmax = max(zmax,x(3,i))
105 END DO
106 dx = xmax-xmin
107 dy = ymax-ymin
108 dz = zmax-zmin
109 tol = em05*(dx+dy+dz)/(three*exp(third*log(xodusr)))
110
111 i = 2
112 DO WHILE(i <= numnusr)
113
114 itabm1(i) = itab(indx(i))
115
116 iref = i-1
117 xmin = x(1,indx(iref))
118 xmax = x(1,indx(iref))
119 ymin = x(2,indx(iref))
120 ymax = x(2,indx(iref))
121 zmin = x(3,indx(iref))
122 zmax = x(3,indx(iref))
123
124 DO WHILE(i <= numnusr .AND. itabm1(i)==itabm1(iref))
125
126 xmin = min(xmin,x(1,indx(i)))
127 xmax = max(xmax,x(1,indx(i)))
128 ymin = min(ymin,x(2,indx(i)))
129 ymax = max(ymax,x(2,indx(i)))
130 zmin = min(zmin,x(3,indx(i)))
131 zmax = max(zmax,x(3,indx(i)))
132
133 indx(i) = indx(iref) ! Possibly merging a cnode and a node, or 2 cnodes
134 itabm1(numnusr+i) = indx(iref)
135
136 i = i + 1
137 itabm1(i)=itab(indx(i))
138
139 END DO
140
141 IF(i > iref+1)THEN
142
143 dx = xmax-xmin
144 dy = ymax-ymin
145 dz = zmax-zmin
146 IF(dx < tol .AND. dy < tol .AND. dz < tol)THEN
147 CALL ancmsg(msgid=1891,
148 . msgtype=msgwarning,
149 . anmode=aninfo_blind_1,
150 . i1=itabm1(i-1),i2=i-iref,i3=itabm1(i-1),r1=tol)
151 ELSE
152 CALL ancmsg(msgid=56,
153 . msgtype=msgerror,
154 . anmode=aninfo,
155 . i1=itabm1(i-1))
156 END IF
157
158 ELSE ! IF(I > IREF+1)THEN
159
160 itabm1(numnusr+i) = indx(i)
161 i = i + 1
162
163 END IF
164
165 END DO ! DO WHILE(I <= NUMNUSR)
166
167 numnod = 1
168 DO i=2,numnusr
169 IF(itabm1(numnusr+i) == itabm1(numnusr+i-1)) cycle ! Twice the same ID
170 numnod = numnod + 1
171 ENDDO
172
173 END IF ! IF(IS_DYNA == 0)THEN
174C-----------------------------------------------
175 DO i = 1, numnusr+numcnod
176 indx(i) = i
177 END DO
178
179 CALL my_orders(0,work,itab,indx,numnusr+numcnod,1)
180
181 IF(numnusr+numcnod>=1)THEN
182 itabm1(1) = itab(indx(1))
183 itabm1(numnusr+numcnod+1) = indx(1)
184 ENDIF
185
186 DO i = 2, numnusr+numcnod
187 itabm1(i) = itab(indx(i))
188 IF(itabm1(i)==itabm1(i-1))THEN
189 IF((indx(i-1) < numnusr .AND. indx(i) > numnusr) .OR.
190 . (indx(i-1) > numnusr .AND. indx(i) < numnusr)) THEN
191C A Node and a Cnode have the same ID
192 CALL ancmsg(msgid=1889,
193 . msgtype=msgerror,
194 . anmode=aninfo,
195 . i1=itabm1(i))
196 ELSEIF(indx(i-1) > numnusr .AND. indx(i) > numnusr)THEN
197C Two Cnode shave the same ID
198 CALL ancmsg(msgid=1890,
199 . msgtype=msgerror,
200 . anmode=aninfo,
201 . i1=itabm1(i))
202 END IF
203 END IF
204 itabm1(numnusr+numcnod+i) = indx(i)
205 END DO
206C-----------------------------------------------
207 numnod = numnod + numcnod
208 DEALLOCATE(itabm1,indx)
209 RETURN
210 END
211
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:274
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: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