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 of box IDs in 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 in /LINE:
C---
      BOOL=.FALSE.
      IF(ISU>0)THEN
.AND.        IF(IBOX(ISU)%NBLEVELS == 0  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---
.NOT.      IF(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       )
.OR.          IF (IADB>SBUFBOX  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 (or 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