OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inter_count_node_curv.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "impl1_c.inc"
#include "ige3d_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine inter_count_node_curv (nin, itask, ipari, intbuf_tab, x, inter_struct)

Function/Subroutine Documentation

◆ inter_count_node_curv()

subroutine inter_count_node_curv ( integer, intent(in) nin,
integer, intent(in) itask,
integer, dimension(npari,ninter), intent(in) ipari,
type(intbuf_struct_), dimension(ninter) intbuf_tab,
intent(in) x,
type(inter_struct_type), dimension(ninter), intent(inout) inter_struct )

Definition at line 38 of file inter_count_node_curv.F.

40!$COMMENT
41! INTER_COUNT_NODE_CURV description :
42! compute the number of main node & compute the curv for each interface
43!
44! INTER_CURV_COMPUTATION organization :
45! loop over the main nodes & secondary nodes to save the position if ICONV/=0
46! and count the number of active main nodes
47!$ENDCOMMENT
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE intbufdef_mod
52 USE inter_struct_mod
53 USE inter_sorting_mod
54 USE message_mod
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59#include "comlock.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "com04_c.inc"
64#include "param_c.inc"
65#include "task_c.inc"
66#include "impl1_c.inc"
67#include "ige3d_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER, INTENT(in) :: ITASK,NIN
72 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI ! interface data
73 TYPE(INTBUF_STRUCT_),DIMENSION(NINTER) :: INTBUF_TAB ! interface data
74 my_real, DIMENSION(3,NUMNOD), INTENT(in) :: x ! position
75 TYPE(inter_struct_type), DIMENSION(NINTER), INTENT(inout) :: INTER_STRUCT ! structure for interface
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER :: FIRST, LAST
80 INTEGER :: I,J
81 INTEGER :: NOD,SHIFT
82 INTEGER :: NSN,NMN,NRTM,NRTM_T
83 INTEGER :: ADRESS,ESHIFT
84 INTEGER :: ICURV
85 INTEGER :: NMN_L
86 INTEGER :: NOINT
87 my_real :: curv_max_local,curv_max_max,tzinf
88 my_real :: dx,dy,dz
89 my_real :: mx,my,mz
90 my_real, DIMENSION(3) :: max_limit,min_limit
91 my_real, DIMENSION(3) :: max_limit_main,min_limit_main
92 my_real, dimension(3) :: max_limit_s,min_limit_s
93 my_real, DIMENSION(3) :: sigma,sigma2
94! ----------------------------------------
95 inter_struct(nin)%CURV_MAX_MAX = zero
96 inter_struct(nin)%NMN_G = 0
97
98 max_limit(1:3) = -ep30
99 min_limit(1:3) = ep30
100
101 IF(itask==0) THEN
102 inter_struct(nin)%BOX_LIMIT_MAIN(1:3) = -ep30
103 inter_struct(nin)%BOX_LIMIT_MAIN(4:6) = ep30
104 inter_struct(nin)%BOX_LIMIT_MAIN(7:12) = zero
105 nrtm = ipari(4,nin)
106 IF(.NOT.ALLOCATED(inter_struct(nin)%CURV_MAX)) ALLOCATE(inter_struct(nin)%CURV_MAX(nrtm))
107 ENDIF
108
109 CALL my_barrier()
110
111 ! ------------------
112 nsn = ipari(5,nin)
113 nmn = ipari(6,nin)
114 nmn_l = 0
115 first = 1+itask*nmn/nthread
116 last = (itask+1)*nmn/nthread
117 sigma = zero
118 sigma2 = zero
119 DO i=first,last
120 nod = intbuf_tab(nin)%MSR(i)
121 IF(nod>0) THEN
122 DO j=1,3
123 max_limit(j) = max(max_limit(j),x(j,nod))
124 min_limit(j) = min(min_limit(j),x(j,nod))
125 sigma(j) = sigma(j) + x(j,nod)
126 sigma2(j) = sigma2(j) + x(j,nod)**2
127 ENDDO
128 nmn_l = nmn_l + 1
129 ENDIF
130 IF(inconv==1) THEN
131 IF( nod>0 ) THEN
132 IF(nsn+nmn < numnod+numfakenodigeo) THEN
133 shift = (i+nsn-1)*3
134 ELSE
135 shift = (nod-1)*3
136 ENDIF
137 intbuf_tab(nin)%XSAV(1+shift)=x(1,nod)
138 intbuf_tab(nin)%XSAV(2+shift)=x(2,nod)
139 intbuf_tab(nin)%XSAV(3+shift)=x(3,nod)
140 ENDIF
141 ENDIF
142 ENDDO
143 max_limit_main(1:3) = max_limit(1:3)
144 min_limit_main(1:3) = min_limit(1:3)
145
146 ! ------------------
147 ! MIN/MAX secondary node computation
148 max_limit_s(1:3) = -ep30
149 min_limit_s(1:3) = ep30
150 first = 1+itask*nsn/nthread
151 last = (itask+1)*nsn/nthread
152 do i=first,last
153 nod = intbuf_tab(nin)%nsv(i)
154 if(intbuf_tab(nin)%stfns(i)/=0) then
155 max_limit_s(1) = max(max_limit_s(1),x(1,nod))
156 max_limit_s(2) = max(max_limit_s(2),x(2,nod))
157 max_limit_s(3) = max(max_limit_s(3),x(3,nod))
158
159 min_limit_s(1) = min(min_limit_s(1),x(1,nod))
160 min_limit_s(2) = min(min_limit_s(2),x(2,nod))
161 min_limit_s(3) = min(min_limit_s(3),x(3,nod))
162 endif
163 enddo
164
165 IF(inconv==1) THEN
166 first = 1+itask*nsn/nthread
167 last = (itask+1)*nsn/nthread
168 DO i=first,last
169 nod = intbuf_tab(nin)%NSV(i)
170 IF(nsn+nmn < numnod+numfakenodigeo) THEN
171 shift = (i-1)*3
172 ELSE
173 shift = (nod-1)*3
174 ENDIF
175 IF( nod>0.AND.nod<=(numnod+numfakenodigeo) ) THEN
176 intbuf_tab(nin)%XSAV(1+shift)=x(1,nod)
177 intbuf_tab(nin)%XSAV(2+shift)=x(2,nod)
178 intbuf_tab(nin)%XSAV(3+shift)=x(3,nod)
179 ENDIF
180 ENDDO
181 ENDIF
182 icurv = ipari(39,nin)
183 nrtm = ipari(4,nin)
184 nrtm_t = nrtm/nthread
185 eshift = itask*nrtm_t
186 adress = 1 + itask*(ipari(4,nin)/nthread)
187 IF(itask==nthread-1) nrtm_t= nrtm - adress + 1
188 curv_max_local = zero
189 CALL inter_curv_computation(icurv,nrtm_t,
190 . intbuf_tab(nin)%IRECTM(1+4*eshift),curv_max_local,
191 . inter_struct(nin)%CURV_MAX(adress),x)
192
193
194 ! ------------------
195#include "lockon.inc"
196 inter_struct(nin)%BOX_LIMIT_MAIN(1) = max(inter_struct(nin)%BOX_LIMIT_MAIN(1),max_limit_main(1))
197 inter_struct(nin)%BOX_LIMIT_MAIN(2) = max(inter_struct(nin)%BOX_LIMIT_MAIN(2),max_limit_main(2))
198 inter_struct(nin)%BOX_LIMIT_MAIN(3) = max(inter_struct(nin)%BOX_LIMIT_MAIN(3),max_limit_main(3))
199
200 inter_struct(nin)%BOX_LIMIT_MAIN(4) = min(inter_struct(nin)%BOX_LIMIT_MAIN(4),min_limit_main(1))
201 inter_struct(nin)%BOX_LIMIT_MAIN(5) = min(inter_struct(nin)%BOX_LIMIT_MAIN(5),min_limit_main(2))
202 inter_struct(nin)%BOX_LIMIT_MAIN(6) = min(inter_struct(nin)%BOX_LIMIT_MAIN(6),min_limit_main(3))
203
204 inter_struct(nin)%CURV_MAX_MAX = max(inter_struct(nin)%CURV_MAX_MAX,curv_max_local)
205
206 inter_struct(nin)%BOX_LIMIT_MAIN(7) = inter_struct(nin)%BOX_LIMIT_MAIN(7)+sigma(1)
207 inter_struct(nin)%BOX_LIMIT_MAIN(8) = inter_struct(nin)%BOX_LIMIT_MAIN(8)+sigma(2)
208 inter_struct(nin)%BOX_LIMIT_MAIN(9) = inter_struct(nin)%BOX_LIMIT_MAIN(9)+sigma(3)
209 inter_struct(nin)%BOX_LIMIT_MAIN(10)= inter_struct(nin)%BOX_LIMIT_MAIN(10)+sigma2(1)
210 inter_struct(nin)%BOX_LIMIT_MAIN(11)= inter_struct(nin)%BOX_LIMIT_MAIN(11)+sigma2(2)
211 inter_struct(nin)%BOX_LIMIT_MAIN(12)= inter_struct(nin)%BOX_LIMIT_MAIN(12)+sigma2(3)
212 inter_struct(nin)%NMN_G = inter_struct(nin)%NMN_G + nmn_l
213
214 box_limit(1) = max(box_limit(1),max_limit_main(1),max_limit_s(1))
215 box_limit(2) = max(box_limit(2),max_limit_main(2),max_limit_s(2))
216 box_limit(3) = max(box_limit(3),max_limit_main(3),max_limit_s(3))
217
218 box_limit(4) = min(box_limit(4),min_limit_main(1),min_limit_s(1))
219 box_limit(5) = min(box_limit(5),min_limit_main(2),min_limit_s(2))
220 box_limit(6) = min(box_limit(6),min_limit_main(3),min_limit_s(3))
221#include "lockoff.inc"
222 ! ------------------
223 CALL my_barrier
224
225!$OMP MASTER
226 IF(abs(inter_struct(nin)%BOX_LIMIT_MAIN(6)-inter_struct(nin)%BOX_LIMIT_MAIN(3))>2*ep30.OR.
227 + abs(inter_struct(nin)%BOX_LIMIT_MAIN(5)-inter_struct(nin)%BOX_LIMIT_MAIN(2))>2*ep30.OR.
228 + abs(inter_struct(nin)%BOX_LIMIT_MAIN(4)-inter_struct(nin)%BOX_LIMIT_MAIN(1))>2*ep30)THEN
229 noint = ipari(15,nin)
230 CALL ancmsg(msgid=87,anmode=aninfo,
231 . i1=noint,c1='(I7BUCE)')
232 CALL arret(2)
233 END IF
234C
235 tzinf = intbuf_tab(nin)%VARIABLES(tzinf_index)
236 curv_max_max = inter_struct(nin)%CURV_MAX_MAX
237 inter_struct(nin)%BOX_LIMIT_MAIN(1)=inter_struct(nin)%BOX_LIMIT_MAIN(1)+tzinf+curv_max_max
238 inter_struct(nin)%BOX_LIMIT_MAIN(2)=inter_struct(nin)%BOX_LIMIT_MAIN(2)+tzinf+curv_max_max
239 inter_struct(nin)%BOX_LIMIT_MAIN(3)=inter_struct(nin)%BOX_LIMIT_MAIN(3)+tzinf+curv_max_max
240 inter_struct(nin)%BOX_LIMIT_MAIN(4)=inter_struct(nin)%BOX_LIMIT_MAIN(4)-tzinf-curv_max_max
241 inter_struct(nin)%BOX_LIMIT_MAIN(5)=inter_struct(nin)%BOX_LIMIT_MAIN(5)-tzinf-curv_max_max
242 inter_struct(nin)%BOX_LIMIT_MAIN(6)=inter_struct(nin)%BOX_LIMIT_MAIN(6)-tzinf-curv_max_max
243
244C Computation of standard deviation of X master
245C use the formula dev = sum(xi²)-n.m²
246C mean value m by direction
247 mx=inter_struct(nin)%BOX_LIMIT_MAIN(7)/max(inter_struct(nin)%NMN_G,1)
248 my=inter_struct(nin)%BOX_LIMIT_MAIN(8)/max(inter_struct(nin)%NMN_G,1)
249 mz=inter_struct(nin)%BOX_LIMIT_MAIN(9)/max(inter_struct(nin)%NMN_G,1)
250
251C standard deviation by direction
252
253 dx=sqrt(max(inter_struct(nin)%BOX_LIMIT_MAIN(10)/max(inter_struct(nin)%NMN_G,1)-mx**2,zero))
254 dy=sqrt(max(inter_struct(nin)%BOX_LIMIT_MAIN(11)/max(inter_struct(nin)%NMN_G,1)-my**2,zero))
255 dz=sqrt(max(inter_struct(nin)%BOX_LIMIT_MAIN(12)/max(inter_struct(nin)%NMN_G,1)-mz**2,zero))
256
257C Computation of new boundary of the domain mean values +/- 2 sigma
258C => 95% of the population for normal distribution
259 inter_struct(nin)%BOX_LIMIT_MAIN(7) = min(mx+2*dx,inter_struct(nin)%BOX_LIMIT_MAIN(1))
260 inter_struct(nin)%BOX_LIMIT_MAIN(8) = min(my+2*dy,inter_struct(nin)%BOX_LIMIT_MAIN(2))
261 inter_struct(nin)%BOX_LIMIT_MAIN(9) = min(mz+2*dz,inter_struct(nin)%BOX_LIMIT_MAIN(3))
262 inter_struct(nin)%BOX_LIMIT_MAIN(10) = max(mx-2*dx,inter_struct(nin)%BOX_LIMIT_MAIN(4))
263 inter_struct(nin)%BOX_LIMIT_MAIN(11) = max(my-2*dy,inter_struct(nin)%BOX_LIMIT_MAIN(5))
264 inter_struct(nin)%BOX_LIMIT_MAIN(12) = max(mz-2*dz,inter_struct(nin)%BOX_LIMIT_MAIN(6))
265C
266 IF(abs(inter_struct(nin)%BOX_LIMIT_MAIN(10)-inter_struct(nin)%BOX_LIMIT_MAIN(7))<em10)THEN
267 inter_struct(nin)%BOX_LIMIT_MAIN(10)=inter_struct(nin)%BOX_LIMIT_MAIN(4)
268 inter_struct(nin)%BOX_LIMIT_MAIN(7)=inter_struct(nin)%BOX_LIMIT_MAIN(1)
269 END IF
270 IF(abs(inter_struct(nin)%BOX_LIMIT_MAIN(11)-inter_struct(nin)%BOX_LIMIT_MAIN(8))<em10)THEN
271 inter_struct(nin)%BOX_LIMIT_MAIN(11)=inter_struct(nin)%BOX_LIMIT_MAIN(5)
272 inter_struct(nin)%BOX_LIMIT_MAIN(8)=inter_struct(nin)%BOX_LIMIT_MAIN(2)
273 END IF
274 IF(abs(inter_struct(nin)%BOX_LIMIT_MAIN(12)-inter_struct(nin)%BOX_LIMIT_MAIN(9))<em10)THEN
275 inter_struct(nin)%BOX_LIMIT_MAIN(12)=inter_struct(nin)%BOX_LIMIT_MAIN(6)
276 inter_struct(nin)%BOX_LIMIT_MAIN(9)=inter_struct(nin)%BOX_LIMIT_MAIN(3)
277 END IF
278!$OMP END MASTER
279 ! ------------------
280 CALL my_barrier()
281
282 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
inter_curv_computation
subroutine inter_curv_computation(icurv, nrtm_t, irect, c_max_local, curv_max, x)
Definition inter_curv_computation.F:29
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_struct_mod
Definition inter_struct_mod.F:49
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
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31