hm_bigbox.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_bigbox (x, flag, nnod, skew, igs, iskn, itabm1, ibox, id, ibufbox, iadb, titr, key, nn, iboxmax, igrnod, idb)

Function/Subroutine Documentation

hm_bigbox()

subroutine hm_bigbox	(		x,
		integer	flag,
		integer	nnod,
			skew,
		integer	igs,
		integer, dimension(liskn,*)	iskn,
		integer, dimension(*)	itabm1,
		type (box_), dimension(nbbox)	ibox,
		integer	id,
		integer, dimension(*)	ibufbox,
		integer	iadb,
		character(len=nchartitle)	titr,
		character(len=ncharfield)	key,
		integer	nn,
		integer	iboxmax,
		type (group_), dimension(ngrnod)	igrnod,
		integer, intent(in)	idb )

Definition at line 34 of file hm_bigbox.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE groupdef_mod
      USE optiondef_mod
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharfield
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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER FLAG,NNOD,
     .        IGS,ISKN(LISKN,*),ITABM1(*),
     .        ID,IBUFBOX(*),IADB,NN,IBOXMAX
      INTEGER,INTENT(IN) :: IDB
      my_real
     .        x(3,*),skew(lskew,*)
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER(LEN=NCHARFIELD) :: KEY
      TYPE (GROUP_)  , DIMENSION(NGRNOD) :: IGRNOD
      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,K,N,ISU,JREC,NBOX,BOXTYPE,IADBOX,
     .        ICOUNT,ITER,FLAGG,INBOX,BOXNODS,IADISU
      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-------
C get box de box ID'S dans grnod:
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=794,
     .              msgtype=msgerror,
     .              anmode=aninfo,
     .              i1=id,
     .              c1=titr,
     .              i2=idb)
       END IF
      END IF
C---
C   simple box dans grnod:
C---
      bool = .false.
      IF(isu>0)THEN
        IF(ibox(isu)%NBLEVELS == 0 .AND. ibox(isu)%LEVEL == 1) THEN
          IF(nbox == 0)THEN
            CALL boxtagn(x   ,ibufbox,skew,iadb,ibox,isu ,flag,iboxmax)
            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 boxbox(ibox  ,skew   ,
     .                flagg  ,icount,iter  ,ibufbox,
     .                x      ,iadb  ,id    ,titr   ,
     .                key    ,flag  ,iboxmax)
C---      fill next level
          flagg = 1
          CALL boxbox(ibox  ,skew   ,
     .                flagg  ,icount,iter  ,ibufbox,
     .                x      ,iadb  ,id    ,titr   ,
     .                key    ,flag  ,iboxmax)
C---
        ENDDO
      ENDIF
C---
C tag group nodes in main-box:
C---
      IF(isu > 0)THEN
        IF(flag == 0)THEN
          boxnods = ibox(isu)%NENTITY  ! nodes of main box
          nnod = boxnods
        ELSE IF(flag == 1)THEN
          boxnods = ibox(isu)%NENTITY  ! nodes of main box
          iadisu  = ibox(isu)%BOXIAD  ! addresses of nodes in main box
          nnod = boxnods
          DO i=1,boxnods
            n=ibufbox(iadisu+i-1)
            nn = nn + 1
            igrnod(igs)%ENTITY(nn) = n
          END DO
        END IF
      END IF
C--------------
      RETURN