OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i16tri.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!|| i16tri ../engine/source/interfaces/int16/i16tri.F
25!||--- called by ------------------------------------------------------
26!|| i16buce ../engine/source/interfaces/int16/i16buce.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| i16cut ../engine/source/interfaces/int16/i16tri.F
31!|| i16sto ../engine/source/interfaces/int16/i16tri.F
32!||--- uses -----------------------------------------------------
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!|| message_mod ../engine/share/message_module/message_mod.F
35!||====================================================================
36 SUBROUTINE i16tri(
37 1 BPE ,PE ,BPN ,PN ,NSN ,
38 2 TZINF ,IXS ,IXS16 ,IXS20 ,NELEM ,
39 3 NSV ,MAXSIZ ,CAND_N ,CAND_E ,MINBOX ,
40 5 CONT ,NB_N_B ,EMINX ,I_STOK_GLOB,NME ,
41 6 ITASK ,NOINT ,X ,V ,A ,
42 7 MX_CAND,IXS10 ,ESH_T )
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE message_mod
47 use element_mod , only : nixs
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "comlock.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com08_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER MAXSIZ,NB_N_B,I_STOK_GLOB,NME,NSN ,ITASK,NOINT ,MX_CAND,
65 . BPE(*),PE(*),BPN(*),PN(*),IXS(NIXS,*),IXS16(8,*),
66 . NSV(*),CAND_N(*),CAND_E(*),NELEM(*),IXS20(12,*),
67 . ESH_T, IXS10(6,*)
68C REAL
69 my_real
70 . x(3,*),v(3,*),a(3,*),eminx(6,*),
71 . minbox,tzinf,xmin,ymin,zmin,xmax,ymax,zmax
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I_ADD_MAX
76 PARAMETER (I_ADD_MAX = 1001)
77 integer i,j,i_add,i_stok,l,nb_nc,nb_ec,cont
78 INTEGER ADD(2,I_ADD_MAX) ,PROV_N(MVSIZ),PROV_E(MVSIZ)
79 my_real
80 . XYZM(6,I_ADD_MAX-1)
81C
82C------------------------------------
83C---------------------------------
84C calculation of the domain bounds
85C---------------------------------
86 xmin = ep30
87 ymin = ep30
88 zmin = ep30
89 xmax = -ep30
90 ymax = -ep30
91 zmax = -ep30
92C
93 nb_ec = nme
94 DO l=1,nb_ec
95 i = l + esh_t
96 bpe(l) = i
97C
98 xmin = min( xmin , eminx(1,i) )
99 ymin = min( ymin , eminx(2,i) )
100 zmin = min( zmin , eminx(3,i) )
101 xmax = max( xmax , eminx(4,i) )
102 ymax = max( ymax , eminx(5,i) )
103 zmax = max( zmax , eminx(6,i) )
104C
105 ENDDO
106C
107 xmin = xmin - tzinf
108 ymin = ymin - tzinf
109 zmin = zmin - tzinf
110 xmax = xmax + tzinf
111 ymax = ymax + tzinf
112 zmax = zmax + tzinf
113C
114C-----initialization of addresses and x, y, z
115C
116C ADDE ADDN X Y Z
117C 1 1 XMIN YMIN ZMIN
118C 1 1 XMAX YMAX ZMAX
119 i_stok = 0
120 add(1,1) = 0
121 add(2,1) = 0
122 add(1,2) = 0
123 add(2,2) = 0
124 i_add = 1
125 xyzm(1,i_add) = xmin
126 xyzm(2,i_add) = ymin
127 xyzm(3,i_add) = zmin
128 xyzm(4,i_add) = xmax
129 xyzm(5,i_add) = ymax
130 xyzm(6,i_add) = zmax
131 nb_nc = 0
132 DO i=1,nsn
133 j=nsv(i)
134 IF(x(1,j)+dt2*(v(1,j)+dt12*a(1,j))>=xmin.AND.
135 . x(1,j)+dt2*(v(1,j)+dt12*a(1,j))<=xmax.AND.
136 . x(2,j)+dt2*(v(2,j)+dt12*a(2,j))>=ymin.AND.
137 . x(2,j)+dt2*(v(2,j)+dt12*a(2,j))<=ymax.AND.
138 . x(3,j)+dt2*(v(3,j)+dt12*a(3,j))>=zmin.AND.
139 . x(3,j)+dt2*(v(3,j)+dt12*a(3,j))<=zmax)THEN
140 nb_nc=nb_nc+1
141 bpn(nb_nc) = i
142 ENDIF
143 ENDDO
144ctmp+++
145c WRITE(istdo,*)'CONT = ',CONT
146c WRITE(istdo,*)'I_ADD = ',I_ADD
147c WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
148c WRITE(istdo,*)'NB_EC = ',NB_EC
149c WRITE(istdo,*)'NB_NC = ',NB_NC
150c WRITE(istdo,*)'XYZM(1,I_ADD) = ',XYZM(1,I_ADD)
151c WRITE(istdo,*)'XYZM(2,I_ADD) = ',XYZM(2,I_ADD)
152c WRITE(istdo,*)'XYZM(3,I_ADD) = ',XYZM(3,I_ADD)
153c WRITE(istdo,*)'XYZM(4,I_ADD) = ',XYZM(4,I_ADD)
154c WRITE(istdo,*)'XYZM(5,I_ADD) = ',XYZM(5,I_ADD)
155c WRITE(istdo,*)'XYZM(6,I_ADD) = ',XYZM(6,I_ADD)
156c WRITE(istdo,*)'tzinf = ',tzinf
157c WRITE(istdo,*)'eminx(4,i) = ',(eminx(4,i),i=1,NB_EC)
158ctmp---
159C-----------------------------------------------
160C loop over the boxes
161C-----------------------------------------------
162 DO WHILE (cont==1)
163C-----------------------------------------------
164C Decouption of space by 2 following x y or z
165C-----------------------------------------------
166 CALL i16cut(
167 1 bpe ,pe ,bpn ,pn ,add ,
168 2 x ,nb_nc ,nb_ec ,xyzm ,i_add ,
169 3 nsv ,maxsiz ,cand_n ,cand_e ,minbox ,
170 4 cont ,nb_n_b ,i_add_max,eminx ,nelem ,
171 5 i_stok ,ixs ,ixs16 ,ixs20 ,tzinf ,
172 6 i_stok_glob,prov_n ,prov_e ,v ,a ,
173 7 mx_cand ,ixs10 )
174 ENDDO
175C-----------------------------------------------
176C end or error test
177C-----------------------------------------------
178C CONT = 0 ==> FIN
179C CONT = -1 ==> PAS ASSEZ DE MEMOIRE PILE
180C CONT = -2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
181C CONT = -3 ==> TROP NIVEAUX PILE
182 IF(cont==0)THEN
183 IF(i_stok/=0)CALL i16sto(
184 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
185 2 cont ,mx_cand )
186 RETURN
187 ENDIF
188 IF(cont==-1)THEN
189 CALL ancmsg(msgid=85,anmode=aninfo,i1=noint)
190 CALL arret(2)
191 ELSEIF(cont==-2) THEN
192 CALL ancmsg(msgid=86,anmode=aninfo,i1=noint)
193 CALL arret(2)
194 ELSEIF(cont==-3)THEN
195 CALL ancmsg(msgid=90,anmode=aninfo,i1=noint)
196 CALL arret(2)
197 ENDIF
198C
199C
200 RETURN
201 END
202!||====================================================================
203!|| i16cut ../engine/source/interfaces/int16/i16tri.F
204!||--- called by ------------------------------------------------------
205!|| i16tri ../engine/source/interfaces/int16/i16tri.F
206!||--- calls -----------------------------------------------------
207!|| i16sto ../engine/source/interfaces/int16/i16tri.F
208!||--- uses -----------------------------------------------------
209!|| element_mod ../common_source/modules/elements/element_mod.F90
210!||====================================================================
211 SUBROUTINE i16cut(
212 1 BPE ,PE ,BPN ,PN ,ADD ,
213 2 X ,NB_NC ,NB_EC ,XYZM ,I_ADD ,
214 3 NSV ,MAXSIZ ,CAND_N ,CAND_E ,MINBOX ,
215 4 CONT ,NB_N_B ,I_ADD_MAX,EMINX ,NELEM ,
216 5 I_STOK ,IXS ,IXS16 ,IXS20 ,TZINF ,
217 6 I_STOK_GLOB,PROV_N ,PROV_E ,V ,A ,
218 7 MX_CAND ,IXS10 )
219 use element_mod , only : nixs
220C-----------------------------------------------
221C I m p l i c i t T y p e s
222C-----------------------------------------------
223#include "implicit_f.inc"
224C-----------------------------------------------
225C G l o b a l P a r a m e t e r s
226C-----------------------------------------------
227#include "mvsiz_p.inc"
228C-----------------------------------------------
229C C o m m o n B l o c k s
230C-----------------------------------------------
231#include "com04_c.inc"
232#include "com08_c.inc"
233C-----------------------------------------------
234C role of the routine:
235C ===================
236C classifies the elts of bpe and the nodes of bpn into two zones
237C > or < to a boundary here determined and outputs everything
238C in bpe, hpe, and bpn, hpn
239C-----------------------------------------------
240C D u m m y A r g u m e n t s
241C
242C NOM DESCRIPTION E/S
243C
244C BPE ARRAY OF FACETTES TO SORT E/S
245C and the result on the max side
246C PE ARRAY OF FACETTES S
247C RESULTAT COTE MIN
248C BPN SORTED NODES ARRAY E/S
249C and the result on the max side
250C PN NODES ARRAY S
251C RESULTAT COTE MIN
252C ADD(2,*) ARRAY OF ADRESSES E/S
253C 1.......ADRESSES NODES C 2.......ADRESSES ELEMENTS
254C ZYZM(6,*) ARRAY OF XYZMIN E/S
255C 1.......XMIN BOITE
256C 2.......YMIN BOITE
257C 3.......ZMIN BOITE
258C 4.......XMAX BOITE
259C 5.......YMAX BOITE
260C 6.......ZMAX BOITE
261C EMINX(6,*) ARRAY OF COORD ELEM MIN/MAX E
262C X(3,*) COORDONNEES NODALES E
263C NB_NC NUMBER OF CANDIDATE NODES E/S
264C NB_EC NUMBER OF CANDIDATE ELEMENTS E/S
265C I_ADD position in the input/output address table
266C NSV NOS SYSTEMES DES NODES E
267C Xmax larger abcisse existing e
268C XMAX largest order.existing E
269C Xmax larger existing side E
270C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
271C I_STOK storage level of the pairs
272C CANDIDATES impact E/S
273C CAND_N boites resultats nodes C CAND_E adresses des boites resultat elements
274C COUPLES NODES,ELT CANDIDATES
275C MINBOX TAILLE MIN BUCKET
276C
277C-----------------------------------------------
278C D u m m y A r g u m e n t s
279C-----------------------------------------------
280 INTEGER NB_NC,NB_EC,I_ADD,MAXSIZ,I_STOK_GLOB,I_STOK,MX_CAND,
281 . NB_N_B,I_ADD_MAX,CONT ,IXS(NIXS,*),IXS16(8,*),
282 . ADD(2,*),BPE(*),PE(*),BPN(*),PN(*),
283 . NSV(*),CAND_N(*),CAND_E(*),NELEM(*),
284 . PROV_N(*) ,PROV_E(*) ,IXS20(12,*), IXS10(6,*)
285C REAL
286 my_real
287 . X(3,*),V(3,*),A(3,*),XYZM(6,*),EMINX(6,*),
288 . MINBOX,TZINF,DIST
289C-----------------------------------------------
290C L o c a l V a r i a b l e s
291C-----------------------------------------------
292 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,
293 . nn,ne,le,l,ncand_prov,n16,n20,n8,n10
294C REAL
295 my_real
296 . dx,dy,dz,dsup,seuil,xx,yy,zz
297C
298C-----------------------------------------------------------
299C
300C
301C 1- TEST ARRET = BOITE VIDE
302C BOITE TROP PETITE
303C BOITE NE CONTENANT QU'ONE NODE C More Available Memory
304C
305C-------------------test on exceeded memory------------
306C
307 IF(add(2,i_add)+nb_ec>maxsiz) THEN
308C no more space in the stack of elements, boxes too small
309 cont = -1
310ctmp+++
311c WRITE(istdo,*)'MAXSIZ = ',MAXSIZ
312c WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
313c WRITE(istdo,*)'NB_EC = ',NB_EC
314ctmp---
315 RETURN
316 ENDIF
317C
318C--------------------test on empty boxes--------------
319C
320 IF(nb_ec/=0.AND.nb_nc/=0) THEN
321C
322 dx = xyzm(4,i_add) - xyzm(1,i_add)
323 dy = xyzm(5,i_add) - xyzm(2,i_add)
324 dz = xyzm(6,i_add) - xyzm(3,i_add)
325 dsup= max(dx,dy,dz)
326C
327C-------------------test on end of branch ------------
328C 1.1- storage of the candidate node(s) and corresponding elts
329C remove the useless ones
330C
331C NCAND_PROV=NB_EC*NB_NC
332C NCAND_PROV negatif qd NB_EC*NB_NC > 2e31
333C
334 IF(nb_ec+nb_nc<=128) THEN
335 ncand_prov = nb_ec*nb_nc
336 ELSE
337 ncand_prov = 129
338 ENDIF
339C
340 IF(dsup<minbox.OR.nb_nc<=nb_n_b.OR.ncand_prov<=128)THEN
341C necessary qd nb_nc <= nb_n_b or dsup <minbox and nb_ec+nb_nc> 128
342 ncand_prov = nb_ec*nb_nc
343 DO l=1,ncand_prov
344 i = 1+(l-1)/nb_nc
345 j = l-(i-1)*nb_nc
346 le = bpe(i)
347 ne = nelem(le)
348 n8 = ne
349 n10 = n8-numels8
350 n20 = n10-numels10
351 n16 = n20-numels20
352 nn = nsv(bpn(j))
353 xx = x(1,nn)+dt2*(v(1,nn)+dt12*a(1,nn))
354 yy = x(2,nn)+dt2*(v(2,nn)+dt12*a(2,nn))
355 zz = x(3,nn)+dt2*(v(3,nn)+dt12*a(3,nn))
356 dist = 0.
357 dist = max(eminx(1,le)-xx,xx-eminx(4,le),dist)
358 dist = max(eminx(2,le)-yy,yy-eminx(5,le),dist)
359 dist = max(eminx(3,le)-zz,zz-eminx(6,le),dist)
360 IF(dist<tzinf)THEN
361 IF(n8>=1.AND.n8<=numels8)THEN
362 IF(nn/=ixs(2,ne).AND.nn/=ixs(3,ne).AND.
363 & nn/=ixs(4,ne).AND.nn/=ixs(5,ne).AND.
364 & nn/=ixs(6,ne).AND.nn/=ixs(7,ne).AND.
365 & nn/=ixs(8,ne).AND.nn/=ixs(9,ne))THEN
366 i_stok = i_stok + 1
367 prov_n(i_stok) = bpn(j)
368 prov_e(i_stok) = le
369 IF(i_stok==mvsiz-1)CALL i16sto(
370 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
371 2 cont ,mx_cand )
372 IF(cont==-2)RETURN
373 ENDIF
374 ELSEIF(n10>=1.AND.n10<=numels8)THEN
375 IF(nn/=ixs(2,ne).AND.nn/=ixs(4,ne).AND.
376 & nn/=ixs(7,ne).AND.nn/=ixs(6,ne).AND.
377 & nn/=ixs10(1,n10).AND.nn/=ixs10(2,n10).AND.
378 & nn/=ixs10(3,n10).AND.nn/=ixs10(4,n10).AND.
379 & nn/=ixs10(5,n10).AND.nn/=ixs10(6,n10))THEN
380 i_stok = i_stok + 1
381 prov_n(i_stok) = bpn(j)
382 prov_e(i_stok) = le
383 IF(i_stok==mvsiz-1)CALL i16sto(
384 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
385 2 cont ,mx_cand )
386 IF(cont==-2)RETURN
387 ENDIF
388 ELSEIF(n16>=1.AND.n16<=numels16)THEN
389 IF(nn/=ixs(2,ne).AND.nn/=ixs(3,ne).AND.
390 & nn/=ixs(4,ne).AND.nn/=ixs(5,ne).AND.
391 & nn/=ixs(6,ne).AND.nn/=ixs(7,ne).AND.
392 & nn/=ixs(8,ne).AND.nn/=ixs(9,ne).AND.
393 & nn/=ixs16(1,n16).AND.nn/=ixs16(2,n16).AND.
394 & nn/=ixs16(3,n16).AND.nn/=ixs16(4,n16).AND.
395 & nn/=ixs16(5,n16).AND.nn/=ixs16(6,n16).AND.
396 & nn/=ixs16(7,n16).AND.nn/=ixs16(8,n16))THEN
397 i_stok = i_stok + 1
398 prov_n(i_stok) = bpn(j)
399 prov_e(i_stok) = le
400 IF(i_stok==mvsiz-1)CALL i16sto(
401 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
402 2 cont ,mx_cand )
403 IF(cont==-2)RETURN
404 ENDIF
405 ELSEIF(n20>=1.AND.n20<=numels20)THEN
406 IF(nn/=ixs(2,ne).AND.nn/=ixs(3,ne).AND.
407 & nn/=ixs(4,ne).AND.nn/=ixs(5,ne).AND.
408 & nn/=ixs(6,ne).AND.nn/=ixs(7,ne).AND.
409 & nn/=ixs(8,ne).AND.nn/=ixs(9,ne).AND.
410 & nn/=ixs20(1,n20) .AND.nn/=ixs20(2,n20) .AND.
411 & nn/=ixs20(3,n20) .AND.nn/=ixs20(4,n20) .AND.
412 & nn/=ixs20(5,n20) .AND.nn/=ixs20(6,n20) .AND.
413 & nn/=ixs20(7,n20) .AND.nn/=ixs20(8,n20) .AND.
414 & nn/=ixs20(9,n20) .AND.nn/=ixs20(10,n20).AND.
415 & nn/=ixs20(11,n20).AND.nn/=ixs20(12,n20))THEN
416 i_stok = i_stok + 1
417 prov_n(i_stok) = bpn(j)
418 prov_e(i_stok) = le
419 IF(i_stok==mvsiz-1)CALL i16sto(
420 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
421 2 cont ,mx_cand )
422 IF(cont==-2)RETURN
423 ENDIF
424 ENDIF
425 ENDIF
426 ENDDO
427C-----------------------------------------------------------
428 ELSE
429C-----------------------------------------------------------
430C
431C
432C 2- sorting phase on the median according to the largest direction
433C
434C
435C-----------------------------------------------------------
436C
437C 2.1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
438C
439 dir = 1
440 IF(dy==dsup) THEN
441 dir = 2
442 ELSE IF(dz==dsup) THEN
443 dir = 3
444 ENDIF
445 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))*0.5
446C
447C 2.2- DIVISER LES NODES EN TWO ZONES
448C
449 nb_ncn= 0
450 nb_ncn1= 0
451 addnn= add(1,i_add)
452#include "vectorize.inc"
453 DO i=1,nb_nc
454 IF(x(dir,nsv(bpn(i)))<seuil) THEN
455C store in the bottom of the BP stack
456 nb_ncn1 = nb_ncn1 + 1
457 addnn = addnn + 1
458 pn(addnn) = bpn(i)
459 ENDIF
460 ENDDO
461#include "vectorize.inc"
462 DO i=1,nb_nc
463 IF(x(dir,nsv(bpn(i)))>=seuil) THEN
464 nb_ncn = nb_ncn + 1
465 bpn(nb_ncn) = bpn(i)
466C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
467 ENDIF
468 ENDDO
469C
470C 2.3- DIVISER LES ELEMENTS
471C
472 nb_ecn= 0
473 addne= add(2,i_add)
474 IF(nb_ncn1==0) THEN
475C no nodes in the second box
476#include "vectorize.inc"
477 DO i=1,nb_ec
478 le = bpe(i)
479 IF(eminx(dir+3,le)+tzinf>=seuil) THEN
480C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
481 nb_ecn = nb_ecn + 1
482 bpe(nb_ecn) = le
483 ENDIF
484 ENDDO
485 ELSEIF(nb_ncn==0) THEN
486C no nodes in the first box
487#include "vectorize.inc"
488 DO i=1,nb_ec
489 le = bpe(i)
490 IF(eminx(dir,le)-tzinf<seuil) THEN
491C store in the PE stack
492 addne = addne + 1
493 pe(addne) = le
494 ENDIF
495 ENDDO
496 ELSE
497#include "vectorize.inc"
498 DO i=1,nb_ec
499 le = bpe(i)
500 IF(eminx(dir,le)-tzinf<seuil) THEN
501C store in the PE stack
502 addne = addne + 1
503 pe(addne) = le
504 ENDIF
505 IF(eminx(dir+3,le)+tzinf>=seuil) THEN
506C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
507 nb_ecn = nb_ecn + 1
508 bpe(nb_ecn) = le
509 ENDIF
510 ENDDO
511 ENDIF
512C
513C 2.4- REMPLIR LES TABLEAUX D'ADRESSES
514C
515 add(1,i_add+1) = addnn
516 add(2,i_add+1) = addne
517C-----fill the min of the next box and the max of the current one
518 xyzm(1,i_add+1) = xyzm(1,i_add)
519 xyzm(2,i_add+1) = xyzm(2,i_add)
520 xyzm(3,i_add+1) = xyzm(3,i_add)
521 xyzm(4,i_add+1) = xyzm(4,i_add)
522 xyzm(5,i_add+1) = xyzm(5,i_add)
523 xyzm(6,i_add+1) = xyzm(6,i_add)
524 xyzm(dir,i_add+1) = seuil
525 xyzm(dir+3,i_add) = seuil
526C
527 nb_nc = nb_ncn
528 nb_ec = nb_ecn
529C increment the descent level before exiting
530 i_add = i_add + 1
531 IF(i_add+1>=i_add_max) THEN
532 cont = -3
533 RETURN
534 ENDIF
535C=======================================================================
536 cont=1
537ctmp+++
538c WRITE(istdo,*)'CONT = ',CONT
539c WRITE(istdo,*)'I_ADD = ',I_ADD
540c WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
541c WRITE(istdo,*)'NB_EC = ',NB_EC
542c WRITE(istdo,*)'NB_NC = ',NB_NC
543c WRITE(istdo,*)'dir seuil = ',dir, seuil
544c WRITE(istdo,*)'Xmin = ',XYZM(1,I_ADD)
545c WRITE(istdo,*)'Ymin = ',XYZM(2,I_ADD)
546c WRITE(istdo,*)'Zmin = ',XYZM(3,I_ADD)
547c WRITE(istdo,*)'Xmax = ',XYZM(4,I_ADD)
548c WRITE(istdo,*)'Ymax = ',XYZM(5,I_ADD)
549c WRITE(istdo,*)'Zmax = ',XYZM(6,I_ADD)
550ctmp---
551 RETURN
552C=======================================================================
553 ENDIF
554 ENDIF
555C-------------------------------------------------------------------------
556C end of sorting test
557C-------------------------------------------------------------------------
558 IF (i_add==1) THEN
559 cont = 0
560 RETURN
561 ENDIF
562C-----------------------------------------------------------
563C
564C 3- end of branch or empty box
565C
566C-----------------------------------------------------------
567C-------------------------------------------------------------------------
568C we decrement the descent level before starting again
569C-------------------------------------------------------------------------
570 i_add = i_add - 1
571C-------------------------------------------------------------------------
572C the bottoms of the stacks must be copied into the corresponding bas_de_pile
573C before descending into the neighboring branch
574C-------------------------------------------------------------------------
575C 3.1- PILE DES NODES C
576 nb_nc = add(1,i_add+1) - add(1,i_add)
577 DO i=1,nb_nc
578 bpn(i) = pn(add(1,i_add)+i)
579 ENDDO
580C
581C 3.2- PILE DES ELEMENTS
582C
583 nb_ec = add(2,i_add+1) - add(2,i_add)
584 DO i=1,nb_ec
585 bpe(i) = pe(add(2,i_add)+i)
586 ENDDO
587C=======================================================================
588 cont=1
589 RETURN
590C=======================================================================
591 END
592!||====================================================================
593!|| i16sto ../engine/source/interfaces/int16/i16tri.F
594!||--- called by ------------------------------------------------------
595!|| i16cut ../engine/source/interfaces/int16/i16tri.F
596!|| i16tri ../engine/source/interfaces/int16/i16tri.F
597!||====================================================================
598 SUBROUTINE i16sto(
599 1 I_STOK,I_STOK_GLOB,PROV_N,CAND_N,PROV_E,CAND_E,
600 2 CONT ,MX_CAND )
601C-----------------------------------------------
602C I m p l i c i t T y p e s
603C-----------------------------------------------
604#include "implicit_f.inc"
605#include "comlock.inc"
606C-----------------------------------------------
607C D u m m y A r g u m e n t s
608C-----------------------------------------------
609 INTEGER I_STOK,I_STOK_GLOB,CONT ,MX_CAND,
610 . PROV_N(*),CAND_N(*),PROV_E(*),CAND_E(*)
611C-----------------------------------------------
612C L o c a l V a r i a b l e s
613C-----------------------------------------------
614 INTEGER I,J_STOK_GLOB
615C-----------------------------------------------
616#include "lockon.inc"
617 J_STOK_GLOB = i_stok_glob
618 IF(i_stok_glob + i_stok<=mx_cand)THEN
619 i_stok_glob = i_stok_glob + i_stok
620 ELSE
621 cont = -2
622 ENDIF
623#include "lockoff.inc"
624 IF(cont==-2)RETURN
625C
626 DO i=1,i_stok
627 cand_n(i+j_stok_glob)=prov_n(i)
628 cand_e(i+j_stok_glob)=prov_e(i)
629 ENDDO
630C
631 i_stok = 0
632C-----------------------------------------------
633 RETURN
634 END
i16cut
subroutine i16cut(bpe, pe, bpn, pn, add, x, nb_nc, nb_ec, xyzm, i_add, nsv, maxsiz, cand_n, cand_e, minbox, cont, nb_n_b, i_add_max, eminx, nelem, i_stok, ixs, ixs16, ixs20, tzinf, i_stok_glob, prov_n, prov_e, v, a, mx_cand, ixs10)
Definition i16tri.F:219
i16tri
subroutine i16tri(bpe, pe, bpn, pn, nsn, tzinf, ixs, ixs16, ixs20, nelem, nsv, maxsiz, cand_n, cand_e, minbox, cont, nb_n_b, eminx, i_stok_glob, nme, itask, noint, x, v, a, mx_cand, ixs10, esh_t)
Definition i16tri.F:43
i16sto
subroutine i16sto(i_stok, i_stok_glob, prov_n, cand_n, prov_e, cand_e, cont, mx_cand)
Definition i16tri.F:601
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
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
arret
subroutine arret(nn)
Definition arret.F:86