OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i17tri.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i17tri (tzinf, ixs, ixs16, ixs20, nelem, neles, maxsiz, cand_n, cand_e, minbox, cont, nb_n_b, eminx, i_stok_glob, nme, itask, noint, x, v, a, mx_cand, eminxs, esh_t, maxsizs, i_add_max, xyzm, nmes, nmesr, nin)
subroutine i17cut (bpe, pe, bpn, pn, add, x, nb_nc, nb_ec, xyzm, i_add, neles, 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, eminxs, maxsizs, nmes, nin)
subroutine i17sto (i_stok, i_stok_glob, prov_n, cand_n, prov_e, cand_e, cont, mx_cand)

Function/Subroutine Documentation

◆ i17cut()

subroutine i17cut ( integer, dimension(*) bpe,
integer, dimension(*) pe,
integer, dimension(*) bpn,
integer, dimension(*) pn,
integer, dimension(2,*) add,
x,
integer nb_nc,
integer nb_ec,
xyzm,
integer i_add,
integer, dimension(*) neles,
integer maxsiz,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
minbox,
integer cont,
integer nb_n_b,
integer i_add_max,
eminx,
integer, dimension(*) nelem,
integer i_stok,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
tzinf,
integer i_stok_glob,
integer, dimension(*) prov_n,
integer, dimension(*) prov_e,
v,
a,
integer mx_cand,
eminxs,
integer maxsizs,
integer nmes,
integer nin )

Definition at line 186 of file i17tri.F.

194C============================================================================
195C M o d u l e s
196C-----------------------------------------------
197 USE tri7box
198 use element_mod , only : nixs
199C-----------------------------------------------
200C I m p l i c i t T y p e s
201C-----------------------------------------------
202#include "implicit_f.inc"
203C-----------------------------------------------
204C G l o b a l P a r a m e t e r s
205C-----------------------------------------------
206#include "mvsiz_p.inc"
207C-----------------------------------------------
208C C o m m o n B l o c k s
209C-----------------------------------------------
210#include "com01_c.inc"
211C-----------------------------------------------
212C Routine Role:
213C ===================
214C classifies the bpe elts and bpn nodes into two zones
215C > or < to a boundary determined here and outputs everything
216C in bpe, hpe, and bpn, hpn
217C-----------------------------------------------
218C D u m m y A r g u m e n t s
219C
220C NOM DESCRIPTION E/S
221C
222C BPE ARRAY OF FACETTES TO SORT E/S
223C and of the result on the max side
224C PE ARRAY OF FACETTES S
225C RESULTAT COTE MIN
226C BPN SORTED NODES ARRAY E/S
227C and of the result on the max side
228C PN NODES ARRAY S
229C RESULTAT COTE MIN
230C ADD(2,*) ARRAY OF ADRESSES E/S
231C 1.......ADRESSES NODES C 2.......ADRESSES ELEMENTS
232C ZYZM(6,*) ARRAY OF XYZMIN E/S
233C 1.......XMIN BOITE
234C 2.......YMIN BOITE
235C 3.......ZMIN BOITE
236C 4.......XMAX BOITE
237C 5.......YMAX BOITE
238C 6.......ZMAX BOITE
239C EMINX(6,*) ARRAY OF COORD ELEM MIN/MAX E
240C X(3,*) COORDONNEES NODALES E
241C NB_NC NUMBER OF CANDIDATE NODES E/S
242C NB_EC NUMBER OF CANDIDATE ELEMENTS E/S
243C i_add position in the i/o address table
244C NSV NOS SYSTEMES DES NODES E
245C Xmax larger abcisse existing e
246C XMAX largest order.existing E
247C Xmax larger existing side E
248C MAXSIZ TAILLE MEMOIRE MAX POSSIBLE E
249C i_stok storage level of pairs
250C CANDIDATES impact E/S
251C CAND_N boites resultats nodes C CAND_E adresses des boites resultat elements
252C COUPLES NODES,ELT CANDIDATES
253C MINBOX TAILLE MIN BUCKET
254C
255C-----------------------------------------------
256C D u m m y A r g u m e n t s
257C-----------------------------------------------
258 INTEGER NB_NC,NB_EC,I_ADD,MAXSIZ,I_STOK_GLOB,I_STOK,MX_CAND,NIN,
259 . NB_N_B,I_ADD_MAX,CONT ,IXS(NIXS,*),IXS16(8,*),
260 . ADD(2,*),BPE(*),PE(*),BPN(*),PN(*),
261 . CAND_N(*),CAND_E(*),NELEM(*),NELES(*),
262 . PROV_N(*) ,PROV_E(*) ,IXS20(12,*),MAXSIZS, NMES
263C REAL
264 my_real
265 . x(3,*),v(3,*),a(3,*),xyzm(6,*),eminx(6,*),eminxs(6,*),
266 . minbox,tzinf
267C-----------------------------------------------
268C L o c a l V a r i a b l e s
269C-----------------------------------------------
270 INTEGER NB_NCN,NB_NCN1,NB_ECN,ADDNN,ADDNE,I,J,DIR,
271 . NES,NE,LE,LES,L,NCAND_PROV,LESL
272C REAL
273 my_real
274 . dx,dy,dz,dsup,seuil
275C
276C-----------------------------------------------------------
277C
278C
279C 1- TEST ARRET = BOITE VIDE
280C BOITE TROP PETITE
281C BOITE NE CONTENANT QU'ONE NODE C No More Available Memory
282C
283Cmemory exceeded test
284C
285 IF(add(2,i_add)+nb_ec>maxsiz) THEN
286C no more space in the main elements stack, boxes too small
287 cont = -1
288ctmp+++
289c WRITE(istdo,*)'MAXSIZ = ',MAXSIZ
290c WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
291c WRITE(istdo,*)'NB_EC = ',NB_EC
292ctmp---
293 RETURN
294 ENDIF
295 IF(add(1,i_add)+nb_nc>maxsizs) THEN
296C no more space in the secondary elements stack, boxes too small
297 cont = -1
298 RETURN
299 ENDIF
300C
301Cempty box test
302C
303 IF(nb_ec/=0.AND.nb_nc/=0) THEN
304C
305 dx = xyzm(4,i_add) - xyzm(1,i_add)
306 dy = xyzm(5,i_add) - xyzm(2,i_add)
307 dz = xyzm(6,i_add) - xyzm(3,i_add)
308 dsup= max(dx,dy,dz)
309C
310Cend of branch test
311C 1.1- storage of candidate node(s) and corresponding elts
312C remove the useless ones
313C
314C NCAND_PROV=NB_EC*NB_NC
315C NCAND_PROV negatif qd NB_EC*NB_NC > 2e31
316C
317 IF(nb_ec+nb_nc<=128) THEN
318 ncand_prov = nb_ec*nb_nc
319 ELSE
320 ncand_prov = 129
321 ENDIF
322C
323 IF(dsup<minbox.OR.nb_nc<=nb_n_b.OR.ncand_prov<=128)THEN
324C necessary qd nb_nc <= nb_n_b or dsup <minbox and nb_ec+nb_nc> 128
325 ncand_prov = nb_ec*nb_nc
326 DO l=1,ncand_prov
327 i = 1+(l-1)/nb_nc
328 j = l-(i-1)*nb_nc
329 le = bpe(i)
330 les = bpn(j)
331 ne = nelem(le)
332 IF(les<=nmes)THEN ! candidat local
333 nes = neles(les)
334 IF(ne/=nes.AND.
335 . eminxs(4,les)>eminx(1,le)-tzinf.AND.
336 . eminxs(5,les)>eminx(2,le)-tzinf.AND.
337 . eminxs(6,les)>eminx(3,le)-tzinf.AND.
338 . eminxs(1,les)<eminx(4,le)+tzinf.AND.
339 . eminxs(2,les)<eminx(5,le)+tzinf.AND.
340 . eminxs(3,les)<eminx(6,le)+tzinf)THEN
341 i_stok = i_stok + 1
342 prov_n(i_stok) = les
343 prov_e(i_stok) = le
344 IF(i_stok==mvsiz-1)CALL i17sto(
345 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
346 2 cont ,mx_cand )
347 IF(cont==-2)RETURN
348 ENDIF
349 ELSE ! SPMD complementary part
350 lesl = les-nmes
351 IF(xrem(4,lesl)>eminx(1,le)-tzinf.AND.
352 . xrem(5,lesl)>eminx(2,le)-tzinf.AND.
353 . xrem(6,lesl)>eminx(3,le)-tzinf.AND.
354 . xrem(1,lesl)<eminx(4,le)+tzinf.AND.
355 . xrem(2,lesl)<eminx(5,le)+tzinf.AND.
356 . xrem(3,lesl)<eminx(6,le)+tzinf)THEN
357 i_stok = i_stok + 1
358 prov_n(i_stok) = les
359 prov_e(i_stok) = le
360 IF(i_stok==mvsiz-1)CALL i17sto(
361 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
362 2 cont ,mx_cand )
363 IF(cont==-2)RETURN
364 ENDIF
365 END IF
366 ENDDO
367C-----------------------------------------------------------
368 ELSE
369C-----------------------------------------------------------
370C
371C
372C 2- sorting phase on the median according to the largest direction
373C
374C
375C-----------------------------------------------------------
376C
377C 2.1- DETERMINER LA DIRECTION A DIVISER X,Y OU Z
378C
379 dir = 1
380 IF(dy==dsup) THEN
381 dir = 2
382 ELSE IF(dz==dsup) THEN
383 dir = 3
384 ENDIF
385 seuil =(xyzm(dir+3,i_add)+xyzm(dir,i_add))*half
386C
387C 2.2- DIVISER LES ELEMENTS SECONDS EN TWO ZONES
388C
389 nb_ncn= 0
390 nb_ncn1= 0
391 addnn= add(1,i_add)
392 nb_ecn= 0
393 addne= add(2,i_add)
394#include "vectorize.inc"
395 DO i=1,nb_nc
396 les = bpn(i)
397 IF(les<=nmes)THEN
398 IF(eminxs(dir,les)<seuil) THEN
399C stored in the pn stack
400 nb_ncn1 = nb_ncn1 + 1
401 addnn = addnn + 1
402 pn(addnn) = les
403 ENDIF
404 END IF
405 ENDDO
406 IF(nspmd>1)THEN ! SPMD complementary part
407#include "vectorize.inc"
408 DO i=1,nb_nc
409 les = bpn(i)
410 IF(les>nmes)THEN
411 lesl = les-nmes
412 IF(xrem(dir,lesl)<seuil) THEN
413C stored in the pn stack
414 nb_ncn1 = nb_ncn1 + 1
415 addnn = addnn + 1
416 pn(addnn) = les
417 END IF
418 END IF
419 END DO
420 END IF
421C
422#include "vectorize.inc"
423 DO i=1,nb_nc
424 les = bpn(i)
425 IF(les<=nmes)THEN
426 IF(eminxs(dir+3,les)>=seuil) THEN
427C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
428 nb_ncn = nb_ncn + 1
429 bpn(nb_ncn) = les
430 ENDIF
431 ENDIF
432 ENDDO
433 IF(nspmd>1)THEN ! SPMD complementary part
434#include "vectorize.inc"
435 DO i=1,nb_nc
436 les = bpn(i)
437 IF(les>nmes)THEN
438 lesl = les-nmes
439 IF(xrem(dir+3,lesl)>=seuil) THEN
440C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPN
441 nb_ncn = nb_ncn + 1
442 bpn(nb_ncn) = les
443 ENDIF
444 ENDIF
445 ENDDO
446 END IF
447C
448C 2.3- DIVISER LES ELEMENTS MAINS
449C
450 nb_ecn= 0
451 addne= add(2,i_add)
452 IF(nb_ncn1==0) THEN
453C no secondary elements in the second box
454#include "vectorize.inc"
455 DO i=1,nb_ec
456 le = bpe(i)
457 IF(eminx(dir+3,le)+tzinf>=seuil) THEN
458C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
459 nb_ecn = nb_ecn + 1
460 bpe(nb_ecn) = le
461 ENDIF
462 ENDDO
463 ELSEIF(nb_ncn==0) THEN
464C no secondary elements in the first box
465#include "vectorize.inc"
466 DO i=1,nb_ec
467 le = bpe(i)
468 IF(eminx(dir,le)-tzinf<seuil) THEN
469C stored in the pe stack
470 addne = addne + 1
471 pe(addne) = le
472 ENDIF
473 ENDDO
474 ELSE
475#include "vectorize.inc"
476 DO i=1,nb_ec
477 le = bpe(i)
478 IF(eminx(dir,le)-tzinf<seuil) THEN
479C stored in the pe stack
480 addne = addne + 1
481 pe(addne) = le
482 ENDIF
483 IF(eminx(dir+3,le)+tzinf>=seuil) THEN
484C ON STOCKE EN ECRASANT PROGRESSIVEMENT BPE
485 nb_ecn = nb_ecn + 1
486 bpe(nb_ecn) = le
487 ENDIF
488 ENDDO
489 ENDIF
490C
491C 2.4- REMPLIR LES TABLEAUX D'ADRESSES
492C
493 add(1,i_add+1) = addnn
494 add(2,i_add+1) = addne
495Cfill the min of the next box and the max of the current one
496 xyzm(1,i_add+1) = xyzm(1,i_add)
497 xyzm(2,i_add+1) = xyzm(2,i_add)
498 xyzm(3,i_add+1) = xyzm(3,i_add)
499 xyzm(4,i_add+1) = xyzm(4,i_add)
500 xyzm(5,i_add+1) = xyzm(5,i_add)
501 xyzm(6,i_add+1) = xyzm(6,i_add)
502 xyzm(dir,i_add+1) = seuil
503 xyzm(dir+3,i_add) = seuil
504C
505 nb_nc = nb_ncn
506 nb_ec = nb_ecn
507C increment the descent level before exiting
508 i_add = i_add + 1
509 IF(i_add+1>=i_add_max) THEN
510 cont = -3
511 RETURN
512 ENDIF
513C=======================================================================
514 cont=1
515ctmp+++
516c WRITE(istdo,*)'CONT = ',CONT
517c WRITE(istdo,*)'I_ADD = ',I_ADD
518c WRITE(istdo,*)'ADD(2,I_ADD) = ',ADD(2,I_ADD)
519c WRITE(istdo,*)'NB_EC = ',NB_EC
520c WRITE(istdo,*)'NB_NC = ',NB_NC
521c WRITE(istdo,*)'dir seuil = ',dir, seuil
522c WRITE(istdo,*)'Xmin = ',XYZM(1,I_ADD)
523c WRITE(istdo,*)'Ymin = ',XYZM(2,I_ADD)
524c WRITE(istdo,*)'Zmin = ',XYZM(3,I_ADD)
525c WRITE(istdo,*)'Xmax = ',XYZM(4,I_ADD)
526c WRITE(istdo,*)'Ymax = ',XYZM(5,I_ADD)
527c WRITE(istdo,*)'Zmax = ',XYZM(6,I_ADD)
528ctmp---
529 RETURN
530C=======================================================================
531 ENDIF
532 ENDIF
533C-------------------------------------------------------------------------
534C end of sorting test
535C-------------------------------------------------------------------------
536 IF (i_add==1) THEN
537 cont = 0
538 RETURN
539 ENDIF
540C-----------------------------------------------------------
541C
542C 3- end of branch or empty box
543C
544C-----------------------------------------------------------
545C-------------------------------------------------------------------------
546C decrement the descent level before restarting
547C-------------------------------------------------------------------------
548 i_add = i_add - 1
549C-------------------------------------------------------------------------
550C need to copy the bottom of the stacks into the corresponding bottom_of_stack
551C before descending into the neighboring branch
552C-------------------------------------------------------------------------
553C 3.1- PILE DES NODES C
554 nb_nc = add(1,i_add+1) - add(1,i_add)
555 DO i=1,nb_nc
556 bpn(i) = pn(add(1,i_add)+i)
557 ENDDO
558C
559C 3.2- PILE DES ELEMENTS
560C
561 nb_ec = add(2,i_add+1) - add(2,i_add)
562 DO i=1,nb_ec
563 bpe(i) = pe(add(2,i_add)+i)
564 ENDDO
565C=======================================================================
566 cont=1
567 RETURN
568C=======================================================================
my_real
#define my_real
Definition cppsort.cpp:32
i17sto
subroutine i17sto(i_stok, i_stok_glob, prov_n, cand_n, prov_e, cand_e, cont, mx_cand)
Definition i17tri.F:581
max
#define max(a, b)
Definition macros.h:21

◆ i17sto()

subroutine i17sto ( integer i_stok,
integer i_stok_glob,
integer, dimension(*) prov_n,
integer, dimension(*) cand_n,
integer, dimension(*) prov_e,
integer, dimension(*) cand_e,
integer cont,
integer mx_cand )

Definition at line 578 of file i17tri.F.

581C-----------------------------------------------
582C M o d u l e s
583C-----------------------------------------------
584 USE icontact_mod
585C-----------------------------------------------
586C I m p l i c i t T y p e s
587C-----------------------------------------------
588#include "implicit_f.inc"
589#include "comlock.inc"
590C-----------------------------------------------
591C D u m m y A r g u m e n t s
592C-----------------------------------------------
593 INTEGER I_STOK,I_STOK_GLOB,CONT ,MX_CAND,
594 . PROV_N(*),CAND_N(*),PROV_E(*),CAND_E(*)
595C-----------------------------------------------
596C L o c a l V a r i a b l e s
597C-----------------------------------------------
598 INTEGER I,J_STOK_GLOB
599 INTEGER LE,LES,NEXT,IC,J
600C-----------------------------------------------
601C duplicate search
602 j=0
603
604#include "lockon.inc"
605
606 DO i=1,i_stok
607 les = prov_n(i)
608 le = prov_e(i)
609 next = adchaine(les)
610 IF(next == 0)THEN
611 j=j+1
612 prov_n(j) = les
613 prov_e(j) = le
614 mx_ad = mx_ad + 1
615 IF(mx_ad > mx_cand)THEN
616 cont = -2
617#include "lockoff.inc"
618 RETURN
619 ENDIF
620 adchaine(les) = mx_ad
621 chaine(1,mx_ad) = le
622 chaine(2,mx_ad) = 0
623 goto 200
624 ENDIF
625 100 continue
626 ic = next
627 IF(le == chaine(1,ic))goto 200
628 next = chaine(2,ic)
629 IF(next /= 0)goto 100
630 j=j+1
631 prov_n(j) = les
632 prov_e(j) = le
633 mx_ad = mx_ad + 1
634 IF(mx_ad > mx_cand)THEN
635 cont = -2
636#include "lockoff.inc"
637 RETURN
638 ENDIF
639 chaine(2,ic) = mx_ad
640 chaine(1,mx_ad) = le
641 chaine(2,mx_ad) = 0
642 200 continue
643 ENDDO
644 i_stok = j
645
646 j_stok_glob = i_stok_glob
647 IF(i_stok_glob + i_stok<=mx_cand)THEN
648 i_stok_glob = i_stok_glob + i_stok
649 ELSE
650 cont = -2
651 ENDIF
652#include "lockoff.inc"
653 IF(cont==-2)RETURN
654C
655 DO i=1,i_stok
656 cand_n(i+j_stok_glob)=prov_n(i)
657 cand_e(i+j_stok_glob)=prov_e(i)
658 ENDDO
659C
660 i_stok = 0
661C-----------------------------------------------
662 RETURN
icontact_mod
Definition icontact_mod.F:34
icontact_mod::mx_ad
integer mx_ad
Definition icontact_mod.F:42
icontact_mod::chaine
integer, dimension(:,:), allocatable chaine
Definition icontact_mod.F:41
icontact_mod::adchaine
integer, dimension(:), allocatable adchaine
Definition icontact_mod.F:40

◆ i17tri()

subroutine i17tri ( tzinf,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) nelem,
integer, dimension(*) neles,
integer maxsiz,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
minbox,
integer cont,
integer nb_n_b,
eminx,
integer i_stok_glob,
integer nme,
integer itask,
integer noint,
x,
v,
a,
integer mx_cand,
eminxs,
integer esh_t,
integer maxsizs,
integer i_add_max,
xyzm,
integer nmes,
integer nmesr,
integer nin )

Definition at line 37 of file i17tri.F.

44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE message_mod
48 use element_mod , only : nixs
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53#include "comlock.inc"
54C-----------------------------------------------
55C G l o b a l P a r a m e t e r s
56C-----------------------------------------------
57#include "mvsiz_p.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61ctmp+1
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65C Parameter (i_add_max = 1001) declare in i17buce
66 INTEGER I_ADD_MAX, NMESR, NIN,
67 . MAXSIZ,NB_N_B,I_STOK_GLOB,NME,NMES ,ITASK,NOINT ,MX_CAND,
68 . IXS(NIXS,*),IXS16(8,*),
69 . NELES(*),CAND_N(*),CAND_E(*),NELEM(*),IXS20(12,*),ESH_T,
70 . MAXSIZS
71C REAL
72 my_real
73 . x(3,*),v(3,*),a(3,*),eminx(6,*),eminxs(6,*),
74 . minbox,tzinf,
75 . xyzm(6,i_add_max-1)
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER I,I_ADD,I_STOK,L,NB_NC,NB_EC,CONT
80 INTEGER ADD(2,I_ADD_MAX) ,PROV_N(MVSIZ),PROV_E(MVSIZ),
81 . BPE(MAXSIZ/3), PE(MAXSIZ), BPN(MAXSIZS/3), PN(MAXSIZS)
82C in all rigor maxsiz = nme and maxsizs = nmes+nmesr
83 my_real
84 . xmin,ymin,zmin,xmax,ymax,zmax
85C------------------------------------
86C---------------------------------
87C init of main boxes
88C---------------------------------
89C
90 nb_ec = nme
91 DO l=1,nb_ec
92 i = l + esh_t
93 bpe(l) = i
94 ENDDO
95C
96Cinitialization of addresses and x, y, z
97C
98C ADDE ADDN X Y Z
99C 1 1 XMIN YMIN ZMIN
100C 1 1 XMAX YMAX ZMAX
101 i_stok = 0
102 add(1,1) = 0
103 add(2,1) = 0
104 add(1,2) = 0
105 add(2,2) = 0
106 i_add = 1
107 xmin = xyzm(1,i_add)
108 ymin = xyzm(2,i_add)
109 zmin = xyzm(3,i_add)
110 xmax = xyzm(4,i_add)
111 ymax = xyzm(5,i_add)
112 zmax = xyzm(6,i_add)
113 nb_nc = 0
114 DO i=1,nmes
115C
116 IF(eminxs(4,i)>xmin.AND.
117 . eminxs(5,i)>ymin.AND.
118 . eminxs(6,i)>zmin.AND.
119 . eminxs(1,i)<xmax.AND.
120 . eminxs(2,i)<ymax.AND.
121 . eminxs(3,i)<zmax)THEN
122 nb_nc=nb_nc+1
123 bpn(nb_nc) = i
124 ENDIF
125 ENDDO
126C
127C Non -local candidate account in SPMD
128C
129 DO i = nmes+1, nmes+nmesr
130 nb_nc = nb_nc + 1
131 bpn(nb_nc) = i
132 ENDDO
133C
134C-----------------------------------------------
135C loop over boxes
136C-----------------------------------------------
137 DO WHILE (cont==1)
138C-----------------------------------------------
139C Decouption of space by 2 following x y or z
140C-----------------------------------------------
141 CALL i17cut(
142 1 bpe ,pe ,bpn ,pn ,add ,
143 2 x ,nb_nc ,nb_ec ,xyzm ,i_add ,
144 3 neles ,maxsiz ,cand_n ,cand_e ,minbox ,
145 4 cont ,nb_n_b ,i_add_max,eminx ,nelem ,
146 5 i_stok ,ixs ,ixs16 ,ixs20 ,tzinf ,
147 6 i_stok_glob,prov_n ,prov_e ,v ,a ,
148 7 mx_cand ,eminxs ,maxsizs ,nmes ,nin )
149 ENDDO
150C-----------------------------------------------
151C end or error test
152C-----------------------------------------------
153C CONT = 0 ==> FIN
154C CONT = -1 ==> PAS ASSEZ DE MEMOIRE PILE
155C CONT = -2 ==> PAS ASSEZ DE MEMOIRE CANDIDATES
156C CONT = -3 ==> TROP NIVEAUX PILE
157 IF(cont==0)THEN
158 IF(i_stok/=0)CALL i17sto(
159 1 i_stok,i_stok_glob,prov_n,cand_n,prov_e,cand_e,
160 2 cont ,mx_cand )
161 ENDIF
162 IF(cont==-1) THEN
163 CALL ancmsg(msgid=86,anmode=aninfo,i1=noint)
164 CALL arret(2)
165 ELSEIF(cont==-2) THEN
166 CALL ancmsg(msgid=86,anmode=aninfo,i1=noint)
167 CALL arret(2)
168 ELSEIF(cont==-3)THEN
169 CALL ancmsg(msgid=90,anmode=aninfo,i1=noint)
170 CALL arret(2)
171 ENDIF
172C
173C
174 RETURN
i17cut
subroutine i17cut(bpe, pe, bpn, pn, add, x, nb_nc, nb_ec, xyzm, i_add, neles, 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, eminxs, maxsizs, nmes, nin)
Definition i17tri.F:194
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
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