i10buce.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "units_c.inc"
#include "warn_c.inc"
#include "com01_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i10buce (x, irect, nsv, nmn, nrtm, nsn, ncont, cand_e, cand_n, gap, noint, ii_stok, tzinf, maxbox, minbox, nb_n_b, eshift, bminma, mwag, ild, ncontact, nsnrold, stfn, nin, igap, gap_s, nsnr, renum, stf, gap_m, gapmin, gapmax, i_mem, intheat, idt_therm, nodadt_therm)

Function/Subroutine Documentation

i10buce()

subroutine i10buce	(		x,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	nsv,
		integer	nmn,
		integer	nrtm,
		integer	nsn,
		integer	ncont,
		integer, dimension(*)	cand_e,
		integer, dimension(*)	cand_n,
			gap,
		integer	noint,
		integer	ii_stok,
			tzinf,
			maxbox,
			minbox,
		integer	nb_n_b,
		integer	eshift,
			bminma,
		integer, dimension(*)	mwag,
		integer	ild,
		integer	ncontact,
		integer	nsnrold,
			stfn,
		integer	nin,
		integer	igap,
			gap_s,
		integer	nsnr,
		integer, dimension(*)	renum,
			stf,
			gap_m,
			gapmin,
			gapmax,
		integer	i_mem,
		integer, intent(in)	intheat,
		integer, intent(in)	idt_therm,
		integer, intent(in)	nodadt_therm )

Definition at line 34 of file i10buce.F.

C============================================================================
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
#include      "warn_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NMN, NRTM, NSN, NOINT, NIN, IGAP, NSNR, NSNROLD
      INTEGER IRECT(4,*),NSV(*),MWAG(*)
      INTEGER CAND_E(*),CAND_N(*),RENUM(*)
      INTEGER ILD,NB_N_B,ESHIFT,NCONTACT,NCONT,I_MEM,II_STOK 
      INTEGER ,INTENT(IN) :: INTHEAT
      INTEGER, INTENT(IN) :: IDT_THERM
      INTEGER, INTENT(IN) :: NODADT_THERM
C     REAL
      my_real
     .   gap,tzinf,maxbox,minbox,gapmin, gapmax, bminma(6)
      my_real
     .   x(3,*),stfn(*), gap_s(*), stf(*), gap_m(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I_ADD_MAX
      parameter(i_add_max = 1001)
      INTEGER I, J,I_ADD, IP0, IP1, MAXSIZ,
     .        ADD(2,I_ADD_MAX), LOC_PROC, N,
     .        NSNFIOLD(NSPMD)
C     REAL
      my_real
     .        xyzm(6,i_add_max-1),marge
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
C----- TRI PAR BOITES DES ELEMENTS ET DES NOEUDS
C
C-----------------------------------------------
C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
C
C     POINTEUR  NOM                            TAILLE
C     P0........CAND_A:Adresse de N ds CAND_N  NSN + 3[+ NSNROLD dans le cas SPMD]
C     P1........Elt Bas Pile                   NRTM
C     P2........Elt PILE                       2*NRTM
C     P21.......BPN                            NSN
C     P22.......PN                             NSN
C     P31.......ADDI                           2*I_ADD_MAX
      maxsiz = 3*(nrtm+100)
      ip0 = 1
      ip1 = ip0 + nsn + nsnrold + 3
C
C
C-----INITIALISATION DES ADRESSES ET X,Y,Z
C
C     ADDE     ADDN     X      Y      Z
C     1        1        XMIN   YMIN   ZMIN
C     1        1        XMAX   YMAX   ZMAX
C
      add(1,1) = 0
      add(2,1) = 0
      add(1,2) = 0
      add(2,2) = 0
      i_add = 1
      xyzm(1,i_add) = bminma(4)
      xyzm(2,i_add) = bminma(5)
      xyzm(3,i_add) = bminma(6)
      xyzm(4,i_add) = bminma(1)
      xyzm(5,i_add) = bminma(2)
      xyzm(6,i_add) = bminma(3)
      i_mem = 0
C
C
C-----DEBUT DE LA PHASE DE TRI 
C 
C       SEPARER B ET N EN TWO
      marge = tzinf-gap  ! il s agit bien de la marge
      CALL i10tri(
     1   add     ,nsn     ,renum    ,nsnr     ,nrtm     ,    
     2   irect   ,x       ,xyzm     ,igap     ,gap      ,
     3   i_add   ,nsv     ,maxsiz   ,ii_stok  ,cand_n   ,  
     4   cand_e  ,ncontact,noint    ,tzinf    ,maxbox   ,
     5   minbox  ,i_mem   ,nb_n_b   ,i_add_max,mwag(ip0),
     6   eshift  ,nsnrold ,stf      ,stfn     ,gap_s    ,
     7   gap_m   ,gapmin  ,gapmax   ,marge    ,nin      ,
     8   intheat, idt_therm, nodadt_therm)
C---------------------------------
C     I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
C     I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
C     I_MEM = 3 ==> TROP NIVEAUX PILE 
      IF (i_mem == 2) RETURN
      IF(i_mem==1)THEN
        nb_n_b = nb_n_b + 1
        IF ( nb_n_b > ncont) THEN
          CALL ancmsg(msgid=85,anmode=aninfo,
     .                i1=noint)
          CALL arret(2)
        ENDIF
        ild = 1
      ELSEIF(i_mem==2) THEN
        IF(debug(1)>=1) THEN
          iwarn = iwarn+1
#include "lockon.inc"
          WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
          WRITE(iout,*)' **WARNING INTERFACE NB:',noint
          WRITE(iout,*)'       TOO MANY POSSIBLE IMPACTS'
          WRITE(iout,*)'       SIZE OF INFLUENCE ZONE IS'
          WRITE(iout,*)'       MULTIPLIED BY 0.75'
#include "lockoff.inc"
        ENDIF
        tzinf = three_over_4*tzinf
C ne pas dimunuer la taille des boite
C        MINBOX= THREE_OVER_4*MINBOX
C        MAXBOX= THREE_OVER_4*MAXBOX
        IF( tzinf<=gap ) THEN
          CALL ancmsg(msgid=85,anmode=aninfo,
     .                i1=noint)
          CALL arret(2)
        ENDIF
        ild = 1
      ELSEIF(i_mem==3)THEN
        nb_n_b = nb_n_b + 1
        IF ( nb_n_b > ncont) THEN
          CALL ancmsg(msgid=90,anmode=aninfo,
     .                i1=noint)
          CALL arret(2)
        ENDIF
        ild = 1
      ENDIF
C
      RETURN