OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25buce_crit.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "vectorize.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i25buce_crit (x, nsv, msr, nsn, nmn, itask, xsav, nin, stfn, v, xslv_g, xmsr_g, vslv_g, vmsr_g)

Function/Subroutine Documentation

◆ i25buce_crit()

subroutine i25buce_crit ( x,
integer, dimension(*) nsv,
integer, dimension(*) msr,
integer nsn,
integer nmn,
integer itask,
xsav,
integer nin,
stfn,
v,
xslv_g,
xmsr_g,
vslv_g,
vmsr_g )

Definition at line 28 of file i25buce_crit.F.

32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36#include "comlock.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "com01_c.inc"
41#include "com04_c.inc"
42#include "task_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER NSN,NMN,ITASK,NIN,NSV(*),MSR(*)
47 my_real
48 . x(3,*), v(3,*), xsav(3,*), stfn(*),
49 . xslv_g(*),xmsr_g(*), vslv_g(*), vmsr_g(*)
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER NSNF, NMNF, NSNL, NMNL, I, J, II
54 my_real
55 . xslv(18),xmsr(12), vslv(6), vmsr(6)
56C-----------------------------------------------
57C
58C 0- calculation of the criterion to know whether to sort or not
59C
60C
61 xslv(1) = -ep30
62 xslv(2) = -ep30
63 xslv(3) = -ep30
64 xslv(4) = ep30
65 xslv(5) = ep30
66 xslv(6) = ep30
67
68 xmsr(1) = -ep30
69 xmsr(2) = -ep30
70 xmsr(3) = -ep30
71 xmsr(4) = ep30
72 xmsr(5) = ep30
73 xmsr(6) = ep30
74
75 vslv(1) = -ep30
76 vslv(2) = -ep30
77 vslv(3) = -ep30
78 vslv(4) = ep30
79 vslv(5) = ep30
80 vslv(6) = ep30
81
82 vmsr(1) = -ep30
83 vmsr(2) = -ep30
84 vmsr(3) = -ep30
85 vmsr(4) = ep30
86 vmsr(5) = ep30
87 vmsr(6) = ep30
88
89 nsnf = 1 + itask*nsn / nthread
90 nsnl = (itask+1)*nsn / nthread
91 nmnf = 1 + itask*nmn / nthread
92 nmnl = (itask+1)*nmn / nthread
93
94C=======================================================================
95 IF(nsn+nmn < numnod)THEN
96C
97#include "vectorize.inc"
98 DO i=nsnf,nsnl
99 j=nsv(i)
100 IF(stfn(i)/=zero .AND. j<=numnod) THEN
101
102 xslv(1) =max(xslv(1),x(1,j)-xsav(1,i))
103 xslv(2) =max(xslv(2),x(2,j)-xsav(2,i))
104 xslv(3) =max(xslv(3),x(3,j)-xsav(3,i))
105 xslv(4) =min(xslv(4),x(1,j)-xsav(1,i))
106 xslv(5) =min(xslv(5),x(2,j)-xsav(2,i))
107 xslv(6) =min(xslv(6),x(3,j)-xsav(3,i))
108
109 vslv(1)=max(vslv(1),v(1,j))
110 vslv(2)=max(vslv(2),v(2,j))
111 vslv(3)=max(vslv(3),v(3,j))
112 vslv(4)=min(vslv(4),v(1,j))
113 vslv(5)=min(vslv(5),v(2,j))
114 vslv(6)=min(vslv(6),v(3,j))
115 ENDIF
116 END DO
117#include "vectorize.inc"
118 DO i=nmnf,nmnl
119 ii = i+nsn
120 j=msr(i)
121 IF(j>0) THEN
122
123 xmsr(1) =max(xmsr(1),x(1,j)-xsav(1,ii))
124 xmsr(2) =max(xmsr(2),x(2,j)-xsav(2,ii))
125 xmsr(3) =max(xmsr(3),x(3,j)-xsav(3,ii))
126 xmsr(4) =min(xmsr(4),x(1,j)-xsav(1,ii))
127 xmsr(5) =min(xmsr(5),x(2,j)-xsav(2,ii))
128 xmsr(6) =min(xmsr(6),x(3,j)-xsav(3,ii))
129
130 vmsr(1)=max(vmsr(1),v(1,j))
131 vmsr(2)=max(vmsr(2),v(2,j))
132 vmsr(3)=max(vmsr(3),v(3,j))
133 vmsr(4)=min(vmsr(4),v(1,j))
134 vmsr(5)=min(vmsr(5),v(2,j))
135 vmsr(6)=min(vmsr(6),v(3,j))
136 ENDIF
137 END DO
138 ELSE
139C
140#include "vectorize.inc"
141 DO i=nsnf,nsnl
142 j=nsv(i)
143 IF(stfn(i)/=zero .AND. j<=numnod) THEN
144
145 xslv(1)=max(xslv(1),x(1,j)-xsav(1,j))
146 xslv(2)=max(xslv(2),x(2,j)-xsav(2,j))
147 xslv(3)=max(xslv(3),x(3,j)-xsav(3,j))
148 xslv(4)=min(xslv(4),x(1,j)-xsav(1,j))
149 xslv(5)=min(xslv(5),x(2,j)-xsav(2,j))
150 xslv(6)=min(xslv(6),x(3,j)-xsav(3,j))
151
152 vslv(1)=max(vslv(1),v(1,j))
153 vslv(2)=max(vslv(2),v(2,j))
154 vslv(3)=max(vslv(3),v(3,j))
155 vslv(4)=min(vslv(4),v(1,j))
156 vslv(5)=min(vslv(5),v(2,j))
157 vslv(6)=min(vslv(6),v(3,j))
158C
159
160 ENDIF
161 END DO
162#include "vectorize.inc"
163 DO i=nmnf,nmnl
164 j=msr(i)
165 IF(j>0) THEN
166
167 xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,j))
168 xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,j))
169 xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,j))
170 xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,j))
171 xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,j))
172 xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,j))
173
174 vmsr(1)=max(vmsr(1),v(1,j))
175 vmsr(2)=max(vmsr(2),v(2,j))
176 vmsr(3)=max(vmsr(3),v(3,j))
177 vmsr(4)=min(vmsr(4),v(1,j))
178 vmsr(5)=min(vmsr(5),v(2,j))
179 vmsr(6)=min(vmsr(6),v(3,j))
180 ENDIF
181 ENDDO
182 ENDIF
183C dist is calculated once for all interfaces in comcrit (see below)
184C
185 IF(nspmd==1) THEN
186C Deplace treatment in SPMD_Get_Stif in SPMD
187 DO i=nsnf,nsnl
188 stfn(i)=max(stfn(i),zero)
189 ENDDO
190 ENDIF
191C
192#include "lockon.inc"
193C
194 xslv_g(1)=max(xslv_g(1),xslv(1))
195 xslv_g(2)=max(xslv_g(2),xslv(2))
196 xslv_g(3)=max(xslv_g(3),xslv(3))
197 xslv_g(4)=min(xslv_g(4),xslv(4))
198 xslv_g(5)=min(xslv_g(5),xslv(5))
199 xslv_g(6)=min(xslv_g(6),xslv(6))
200
201 xmsr_g(1)=max(xmsr_g(1),xmsr(1))
202 xmsr_g(2)=max(xmsr_g(2),xmsr(2))
203 xmsr_g(3)=max(xmsr_g(3),xmsr(3))
204 xmsr_g(4)=min(xmsr_g(4),xmsr(4))
205 xmsr_g(5)=min(xmsr_g(5),xmsr(5))
206 xmsr_g(6)=min(xmsr_g(6),xmsr(6))
207
208 vslv_g(1)=max(vslv_g(1),vslv(1))
209 vslv_g(2)=max(vslv_g(2),vslv(2))
210 vslv_g(3)=max(vslv_g(3),vslv(3))
211 vslv_g(4)=min(vslv_g(4),vslv(4))
212 vslv_g(5)=min(vslv_g(5),vslv(5))
213 vslv_g(6)=min(vslv_g(6),vslv(6))
214 vmsr_g(1)=max(vmsr_g(1),vmsr(1))
215 vmsr_g(2)=max(vmsr_g(2),vmsr(2))
216 vmsr_g(3)=max(vmsr_g(3),vmsr(3))
217 vmsr_g(4)=min(vmsr_g(4),vmsr(4))
218 vmsr_g(5)=min(vmsr_g(5),vmsr(5))
219 vmsr_g(6)=min(vmsr_g(6),vmsr(6))
220C
221#include "lockoff.inc"
222C
223 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21