hm_bigbox2.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_bigbox2 (x, flag, nel, skew, igs, iskn, itabm1, ibox, id, nadmesh, nix, ix, nix1, numel, iparte, ipart, klevtree, eltree, keltree, buftmp, key, titr, mes, igrelem, ngrele, nn, iadb, iboxmax, ibufbox, idb)

Function/Subroutine Documentation

hm_bigbox2()

subroutine hm_bigbox2	(		x,
		integer	flag,
		integer	nel,
			skew,
		integer	igs,
		integer, dimension(liskn,*)	iskn,
		integer, dimension(*)	itabm1,
		type (box_), dimension(nbbox)	ibox,
		integer	id,
		integer	nadmesh,
		integer	nix,
		integer, dimension(nix,*)	ix,
		integer	nix1,
		integer	numel,
		integer, dimension(*)	iparte,
		integer, dimension(lipart1,*)	ipart,
		integer	klevtree,
		integer, dimension(keltree,*)	eltree,
		integer	keltree,
		integer, dimension(numel*5)	buftmp,
		character	key,
		character(len=nchartitle)	titr,
		character	mes,
		type (group_), dimension(ngrele)	igrelem,
		integer	ngrele,
		integer	nn,
		integer	iadb,
		integer	iboxmax,
		integer, dimension(*)	ibufbox,
		integer, intent(in)	idb )

Definition at line 34 of file hm_bigbox2.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_mod
      USE optiondef_mod
      USE names_and_titles_mod , ONLY : nchartitle
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "scr17_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JREC,FLAG,NEL,IGS,
     .        ISKN(LISKN,*),ITABM1(*),ID,NADMESH,
     .        NIX,IX(NIX,*),NIX1,NUMEL,IPARTE(*),IPART(LIPART1,*),
     .        KLEVTREE,KELTREE,ELTREE(KELTREE,*),
     .        BUFTMP(NUMEL*5),NGRELE,NN,IBOXMAX,IADB,IBUFBOX(*)
      INTEGER,INTENT(IN) :: IDB     
      my_real x(3,*),skew(lskew,*)
      CHARACTER KEY*4,MES*40
      CHARACTER(LEN=NCHARTITLE) :: TITR
C-----------------------------------------------
      TYPE (GROUP_), DIMENSION(NGRELE) :: IGRELEM
      TYPE (BOX_)  , DIMENSION(NBBOX)  :: IBOX
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,ISU,ISK,TAGN(NUMEL),BOXTYPE,
     . NEGBOX,TAGNEG(NUMEL),TAGPOS(NUMEL),
     . NBOX,BOXELE,ICOUNT,ITER,FLAGG,IADISU
      my_real xp1,yp1,zp1,xp2,yp2,zp2,diam,nodinb(3)
      CHARACTER BOX*3
      LOGICAL BOOL
C-----------------------------------------------
       DO i=1,nbbox
         ibox(i)%NBLEVELS = 0
         ibox(i)%LEVEL = 1
         ibox(i)%ACTIBOX = 0
         IF(ibox(i)%NBOXBOX > 0)THEN
           ibox(i)%NBLEVELS = -1
           ibox(i)%LEVEL =  0
         END IF
C
         ibox(i)%BOXIAD = 0
       END DO
C-------
      IF(key(1:4) == 'BOX2')THEN
        boxtype = 2
      ELSE IF(key(1:3) == 'BOX')THEN
        boxtype = 1
      END IF
C-------
C get box de box ID'S dans grshel:
C-------
      isu = 0
      DO i=1,nbbox
        IF(idb == ibox(i)%ID)THEN
         isu=i
         EXIT
       ENDIF
      END DO
C---
      IF(isu > 0)THEN
       nbox   = ibox(isu)%NBOXBOX
C super box activated:
       ibox(isu)%ACTIBOX = 1
      ELSE
       IF(flag == 0)THEN
        CALL ancmsg(msgid=798,
     .              msgtype=msgerror,
     .              anmode=aninfo,
     .              i1=id,
     .              c1=titr,
     .              i2=idb)
       END IF
      END IF
C---
C   simple box dans grshel:
C---
      bool =.false.
      IF(isu>0)THEN
        IF(ibox(isu)%NBLEVELS == 0 .AND. ibox(isu)%LEVEL == 1) THEN
          IF (nbox == 0) THEN ! simple box (no sub box)
            CALL boxtage(x      ,skew   ,ibox   ,
     .                   isu    ,boxtype,ix     ,nix   ,
     .                   nix1   ,iparte ,ipart  ,klevtree,eltree,
     .                   keltree,numel  ,nadmesh,flag  ,iboxmax,
     .                   iadb   ,ibufbox)
            bool=.true.
          END IF
        END IF
      ENDIF
C---
C READ LEVELS OF BOXES ==> "SUBLEVEL DONE"
C---
      IF(.NOT.bool)THEN
        icount = 1
        iter   = 0
        DO WHILE (icount == 1)
          iter  = iter  + 1
          flagg = 0
C---      count next level
          CALL boxbox2(ibox    ,skew  ,
     .                 flagg   ,icount,iter    ,boxtype,
     .                 x       ,ix    ,flag    ,iboxmax,
     .                 nix     ,nix1  ,iparte  ,ipart  ,
     .                 klevtree,eltree,keltree ,numel  ,
     .                 nadmesh ,id     ,titr   ,mes    ,
     .                 iadb    ,ibufbox)
C---      fill next level
          flagg = 1
          CALL boxbox2(ibox    ,skew   ,
     .                 flagg   ,icount ,iter    ,boxtype,
     .                 x       ,ix     ,flag    ,iboxmax,
     .                 nix     ,nix1   ,iparte  ,ipart  ,
     .                 klevtree,eltree ,keltree ,numel  ,
     .                 nadmesh ,id     ,titr    ,mes    ,
     .                 iadb    ,ibufbox)
C---
        ENDDO
      ENDIF
C---
C tag group elements in main-box:
C---
      IF(isu > 0)THEN
        IF(flag == 0)THEN
          boxele = ibox(isu)%NENTITY  ! elements of main box
          nel = boxele
        ELSE IF(flag == 1)THEN
          boxele = ibox(isu)%NENTITY  ! elements of main box
          iadisu = ibox(isu)%BOXIAD  ! addresses of elements in main box
          nel = boxele
          DO i=1,boxele
            j=ibufbox(iadisu+i-1)
            nn = nn + 1
            igrelem(igs)%ENTITY(nn) = j
          END DO
        END IF
      END IF
C----------
      RETURN