i25buce.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i25buce (x, v, irect, nsv, stfn, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, mulnsn, bminma, marge, curv_max, pmax_gap, vmaxdt, eshift, nin, stf, gap_s, nsnr, ncont, gap_m, itask, bgapsmx, i_mem, pene_old, itab, nbinflg, mbinflg, ilev, msegtyp, flagremnode, kremnod, remnod, igap, gap_s_l, gap_m_l, icodt, iskew, drad, dgapload)

Function/Subroutine Documentation

i25buce()

subroutine i25buce	(		x,
			v,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	nsv,
			stfn,
		integer	nmn,
		integer	nrtm,
		integer	nsn,
		integer, dimension(*)	cand_e,
		integer, dimension(*)	cand_n,
			gap,
		integer	noint,
		integer	ii_stok,
		integer	mulnsn,
			bminma,
			marge,
			curv_max,
			pmax_gap,
			vmaxdt,
		integer	eshift,
		integer	nin,
			stf,
			gap_s,
		integer	nsnr,
		integer	ncont,
			gap_m,
		integer	itask,
			bgapsmx,
		integer	i_mem,
			pene_old,
		integer, dimension(*)	itab,
		integer, dimension(*)	nbinflg,
		integer, dimension(*)	mbinflg,
		integer	ilev,
		integer, dimension(*)	msegtyp,
		integer	flagremnode,
		integer, dimension(*)	kremnod,
		integer, dimension(*)	remnod,
		integer	igap,
			gap_s_l,
			gap_m_l,
		integer, dimension(*)	icodt,
		integer, dimension(*)	iskew,
		intent(in)	drad,
		intent(in)	dgapload )

Definition at line 33 of file i25buce.F.

C============================================================================
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      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      "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,IDT,NIN, NSNR
      INTEGER IRECT(4,*),NSV(*),ITASK,ILEV, IGAP
      INTEGER CAND_E(*),CAND_N(*),MSEGTYP(*)
      INTEGER MULNSN,ESHIFT,NCONT,I_MEM,
     .        II_STOK,ITAB(*),NBINFLG(*),MBINFLG(*),
     .        FLAGREMNODE,KREMNOD(*),REMNOD(*),ICODT(*),ISKEW(*)
C     REAL
      my_real , INTENT(IN) :: dgapload ,drad
      my_real
     .   gap,pmax_gap,vmaxdt,
     .   bminma(6),curv_max(nrtm),bgapsmx, marge
      my_real
     .   x(3,*), v(3,*), stfn(*),pene_old(5,nsn),
     .   stf(*), gap_s(*), gap_m(*), gap_s_l(*), gap_m_l(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, IP0, IP1, MAXSIZ,
     .        LOC_PROC, N, ISZNSNR,
     .        NSNFIOLD(NSPMD)
C     REAL
      my_real
     .        xyzm(6), aaa
      INTEGER NBX,NBY,NBZ
      INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8   
      INTEGER :: INIVOXEL_L
 
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
C----- TRI DES ELEMENTS ET DES NOEUDS
C
C-----------------------------------------------
C
C----- BORNES DU DOMAINE DEJA CALCULEES
C
      xyzm(1) = bminma(4)
      xyzm(2) = bminma(5)
      xyzm(3) = bminma(6)
      xyzm(4) = bminma(1)
      xyzm(5) = bminma(2)
      xyzm(6) = bminma(3)
      i_mem = 0
C
      isznsnr = nsnr
C=============================================================================
c
c     Si MARGE - DELTA_PMAX_GAP - SOMME(Vrel*dt) < ZERO => RETRI
c        DELTA_PMAX_GAP = MAX((PENEmax(i)-GAP)-(PENEmax_Tri(i)-GAP)
c
C=============================================================================
 
 
      IF( nmn /= 0) THEN
       aaa = sqrt(nmn /
     .           ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
     .           +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
     .           +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
      ELSE
        aaa = 0
      ENDIF
 
      aaa = 0.75*aaa
 
      nbx = nint(aaa*(bminma(1)-bminma(4)))
      nby = nint(aaa*(bminma(2)-bminma(5)))
      nbz = nint(aaa*(bminma(3)-bminma(6)))
      nbx = max(nbx,1)
      nby = max(nby,1)
      nbz = max(nbz,1)
 
      nbx8=nbx
      nby8=nby
      nbz8=nbz
      res8=(nbx8+2)*(nby8+2)*(nbz8+2)
      lvoxel8 = lvoxel      
 
      IF(res8 > lvoxel8) THEN
        aaa = lvoxel
        aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
        aaa = aaa**(third)
        nbx = int((nbx+2)*aaa)-2
        nby = int((nby+2)*aaa)-2
        nbz = int((nbz+2)*aaa)-2
        nbx = max(nbx,1)
        nby = max(nby,1)
        nbz = max(nbz,1)
      ENDIF
      
      nbx8=nbx
      nby8=nby
      nbz8=nbz
      res8=(nbx8+2)*(nby8+2)*(nbz8+2)
      
      IF(res8 > lvoxel8) THEN
        nbx = min(100,max(nbx8,1))
        nby = min(100,max(nby8,1))
        nbz = min(100,max(nbz8,1))
      ENDIF
 
!$OMP SINGLE
      DO i=1,(nbx+2)*(nby+2)*(nbz+2)
        voxel1(i)=0
      ENDDO
      inivoxel = max(inivoxel,(nbx+2)*(nby+2)*(nbz+2)+1)
      ! wait not necessary, because there is a barrier at the start of I25TRIVOX
!$OMP END SINGLE NOWAIT
 
      CALL i25trivox(
     1   nsn     ,nsnr     ,isznsnr  ,i_mem   ,vmaxdt   ,
     2   irect   ,x        ,stf      ,stfn    ,xyzm     ,
     3   nsv     ,ii_stok  ,cand_n   ,eshift  ,cand_e   ,
     4   mulnsn  ,noint    ,v        ,bgapsmx  ,
     5   voxel1  ,nbx      ,nby      ,nbz     ,pmax_gap ,
     6   nrtm    ,gap_s    ,gap_m    ,marge   ,curv_max ,
     7   nin     ,itask    ,pene_old,itab     ,nbinflg  ,
     8   mbinflg ,ilev     ,msegtyp  ,
     9   flagremnode,kremnod,remnod  ,
     a   igap    ,gap_s_l  ,gap_m_l  ,icodt   ,iskew    ,
     b   drad    ,dgapload )
C
C     I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
C
      RETURN