OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
auto_node_merge.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine auto_node_merge (is_dyna, numnusr, numcnod, numnod, itab, x)

Function/Subroutine Documentation

◆ auto_node_merge()

subroutine auto_node_merge ( integer, intent(in) is_dyna,
integer, intent(in) numnusr,
integer, intent(in) numcnod,
integer, intent(out) numnod,
integer, dimension(numnusr+numcnod), intent(in) itab,
dimension(3,numnusr) x )

Definition at line 32 of file auto_node_merge.F.

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
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