hm_bigsbox.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_bigsbox (numel, ix, nix, nix1, nix2, ieltyp, x, nseg, flag, skew, iskn, isurf0, itabm1, ibox, id, ibufbox, isurflin, iadb, key, sbufbox, titr, mess, tagshellbox, nn, lsubmodel)

Function/Subroutine Documentation

hm_bigsbox()

subroutine hm_bigsbox	(	integer	numel,
		integer, dimension(nix,*)	ix,
		integer	nix,
		integer	nix1,
		integer	nix2,
		integer	ieltyp,
			x,
		integer	nseg,
		integer	flag,
			skew,
		integer, dimension(liskn,*)	iskn,
		integer	isurf0,
		integer, dimension(*)	itabm1,
		type (box_), dimension(nbbox)	ibox,
		integer	id,
		integer, dimension(*)	ibufbox,
		type (surf_)	isurflin,
		integer	iadb,
		character	key,
		integer	sbufbox,
		character(len=nchartitle)	titr,
		character	mess,
		integer, dimension(*)	tagshellbox,
		integer	nn,
		type(submodel_data), dimension(nsubmod)	lsubmodel )

Definition at line 38 of file hm_bigsbox.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_mod
      USE optiondef_mod
      USE hm_option_read_mod
      USE submodel_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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NIX,IX(NIX,*),NIX1,NIX2,NUMEL,IELTYP,
     .        NSEG,FLAG,ISKN(LISKN,*),ISURF0,
     .        ITABM1(*),IBUFBOX(*),
     .        IADB,SBUFBOX,TAGSHELLBOX(*),NN
      my_real
     .        x(3,*),skew(lskew,*)
      CHARACTER KEY*4,MESS*40
      CHARACTER(LEN=NCHARTITLE) :: TITR
C-----------------------------------------------
      TYPE (SURF_) :: ISURFLIN
      TYPE (box_)  , DIMENSION(NBBOX)  :: ibox
      TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,JJ,K,K1,J,JREC,ISK,BOXTYPE,ISU,TAGN(NUMEL),
     .    ITYPE,IADBOX,IDB,NBOX,ID,IDBX,BOXSEG,IADISU,
     .    ICOUNT,ITER,FLAGG,NIXEL
      my_real
     .    diam,xp1,yp1,zp1,xp2,yp2,zp2,nodinb(3)
      CHARACTER BOX*3
      LOGICAL BOOL,IS_AVAILABLE, IS_ENCRYPTED
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
         ibox(i)%BOXIAD = 0
       END DO
C-------
      CALL hm_get_int_array_index('ids',idb,1,is_available,lsubmodel)
      IF(key == 'BOX')THEN
        boxtype = 1
      ELSE IF(key == 'BOX2')THEN
        boxtype = 2
      END IF
C-------
C get box de box ID'S dans LINE :
C-------
      isu = 0
      DO i=1,nbbox
        IF(idb == ibox(i)%ID) isu=i
      END DO
C---
      IF(isu > 0)THEN
       nbox   = ibox(isu)%NBOXBOX
       !super box enabled:
       ibox(isu)%ACTIBOX = 1
      ELSE
       IF(flag == 0)THEN
        IF(isurf0 == 0)THEN
          CALL ancmsg(msgid=799, msgtype=msgerror, anmode=aninfo,i1=id, c1=titr,i2=idb)
        ELSE IF(isurf0 == 1)THEN
          CALL ancmsg(msgid=800,msgtype=msgerror,anmode=aninfo,i1=id,c1=titr,i2=idb)
        END IF
       END IF
      END IF
C---
C   simple box dans /LINE :
C---
      bool=.false.
      IF(isu>0)THEN
        IF(ibox(isu)%NBLEVELS == 0 .AND. ibox(isu)%LEVEL == 1) THEN
          IF(nbox == 0)THEN
            CALL box_surf_sh(x          ,ibufbox,skew  ,iadb   ,boxtype,
     .                       ibox       ,isu    ,numel ,nix    ,ix     ,
     .                       nix1       ,nix2   ,isurf0,ieltyp ,flag   ,
     .                       tagshellbox,0      )
            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 boxboxs(ibox       ,skew    ,flagg  ,icount ,iter   ,
     .                 boxtype    ,ibufbox ,x      ,iadb   ,ix     ,
     .                 nix        ,nix1    ,nix2   ,numel  ,isurf0 ,
     .                 ieltyp     ,id      ,titr   ,mess   ,flag   ,
     .                 tagshellbox,0       )
          IF (iadb>sbufbox .OR. iadb<0) 
     .      CALL ancmsg(msgid=1007, msgtype=msgerror,anmode=anstop)
C---      fill next level
          flagg = 1
          CALL boxboxs(ibox       ,skew    ,flagg  ,icount ,iter   ,
     .                 boxtype    ,ibufbox ,x      ,iadb   ,ix     ,
     .                 nix        ,nix1    ,nix2   ,numel  ,isurf0 ,
     .                 ieltyp     ,id      ,titr   ,mess   ,flag   ,
     .                 tagshellbox,0       )
C---
        ENDDO
      ENDIF
C---
C tag lines (ou surfaces) in main-box:
C---
C---count lines within BOX
      IF(isu > 0)THEN
C
        IF(flag == 0)THEN
          boxseg = ibox(isu)%NENTITY  ! segments of main box
          nseg = nseg + boxseg
        ELSE IF(flag == 1)THEN
          boxseg = ibox(isu)%NENTITY  ! segments of main box
          iadisu = ibox(isu)%BOXIAD  ! addresses of segments in main box
          nseg = nseg + boxseg
          DO i=1,boxseg
           nn = nn + 1
           IF(isurf0 == 1)THEN ! surfaces
             DO k=nix1,nix2
               j=ibufbox(iadisu+k-2)
                isurflin%NODES(nn,k-1) = j
             ENDDO
             iadisu = iadisu + nix2 - 1
           ELSE ! lines
C--------------------
             j=ibufbox(iadisu)
             isurflin%NODES(nn,1) = j
             iadisu = iadisu + 1
C--------------------
            j=ibufbox(iadisu)
            isurflin%NODES(nn,2) = j
            iadisu = iadisu + 1
           END IF
C--------------------
           IF(ieltyp == 7)THEN
               j=ibufbox(iadisu)
               isurflin%NODES(nn,4) = 
     .                         isurflin%NODES(nn,3)
               iadisu = iadisu + 1
           END IF
C--------------------
               j=ibufbox(iadisu)
               isurflin%ELTYP(nn)= j
               iadisu = iadisu + 1
C--------------------
               j=ibufbox(iadisu)
               isurflin%ELEM(nn) = j
               iadisu = iadisu + 1
C--------------------
          END DO
        END IF ! IF(FLAG == 0)
      END IF ! IF(ISU > 0)
C-----------
      RETURN