read_box_box.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	read_box_box (ibox, iad, nbox, lsubmodel)

Function/Subroutine Documentation

read_box_box()

subroutine read_box_box	(	type (box_), dimension(nbbox)	ibox,
		integer	iad,
		integer	nbox,
		type(submodel_data), dimension(*), intent(in)	lsubmodel )

Definition at line 38 of file read_box_box.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE my_alloc_mod
      USE submodel_mod
      USE message_mod
      USE optiondef_mod
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharkey
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER :: IAD,NBOX
      TYPE (BOX_)  ,DIMENSION(NBBOX)  :: IBOX
      TYPE(SUBMODEL_DATA),DIMENSION(*) ,INTENT(IN) :: LSUBMODEL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,II,J,KK,BOXID,SUB_ID,IDNEG,NLIST,NBOX_POS,NBOX_NEG
      CHARACTER(LEN=NCHARKEY)    :: KEY
      CHARACTER(LEN=NCHARTITLE)  :: TITR
      LOGICAL :: IS_AVAILABLE
C-----------------------------------------------
C     IBOX(I)%ID       : BOX IDENTIFIER
C     IBOX(I)%TITLE    : BOX title
C     IBOX(I)%NBOXBOX  : NUMBER OF SUB BOXES (BOXES OF BOXES)
C     IBOX(I)%ISKBOX   : BOX SKEW_ID (RECTA)
C     IBOX(I)%NOD1     : FIRST NODE for box limit definition  - N1 -
C     IBOX(I)%NOD2     : SECOND NODE for box limit definition - N2 -
C     IBOX(I)%TYPE     : BOX SHAPE (1='RECTA',2='CYLIN' ,3='SPHER')
C     IBOX(I)%NBLEVELS : TEMPORARY LEVEL NB OF BOXES
C     IBOX(I)%LEVEL    : FLAG "SUBLEVEL DONE" FOR BOX OF BOXES
C     IBOX(I)%ACTIBOX  : FLAG FOR ACTIVATED BOX FOR (GRNOD,GRSHEL,LINE,SURF...)
C     IBOX(I)%NENTITY  : NUMBER OF BOX ENTITIES (NODES,ELEMS,LINES,SURF)
C                        WITHIN ACTIVATED BOX
C     IBOX(I)%SURFIAD  : temporary address for solid external surface (in box)
C     IBOX(I)%BOXIAD   : temporary address
C     IBOX(I)%DIAM     : BOX diameter (CYLIN + SPHER)
C     IBOX(I)%X1       : coord.X for N1
C     IBOX(I)%Y1       : coord.Y for N1
C     IBOX(I)%Z1       : coord.Z for N1
C     IBOX(I)%X2       : coord.X for N2
C     IBOX(I)%Y2       : coord.Y for N2
C     IBOX(I)%Z2       : coord.Z for N2
C     IBOX(I)%IBOXBOX(NBOXBOX)  : LIST OF BOXES (in /box/box)
C     IBOX(I)%ENTITY(NENTITY)   : LIST OF ENTITIES (NODES,ELEMS,LINES,SURF)
C=======================================================================
c
      CALL hm_option_start('/BOX/BOX')
c
c--------------------------------------------------
      kk = 0
      DO i = 1,nbox
c
        CALL hm_option_read_key(lsubmodel,  option_id   = boxid ,
     .                                      submodel_id = sub_id,
     .                                      option_titr = titr  ,
     .                                      keyword2    = key   )
c-----------------------
        CALL hm_get_intv  ('Nbox'     ,nbox_pos ,is_available, lsubmodel)        
        CALL hm_get_intv  ('Nboxneg'  ,nbox_neg ,is_available, lsubmodel)
c
        nlist = nbox_pos + nbox_neg   
c
        iad = iad + 1
        ibox(iad)%NBOXBOX = nlist
        CALL my_alloc(ibox(iad)%IBOXBOX  ,nlist)
c
        ii = 0
        IF (nbox_pos > 0) THEN
          DO j=1,nbox_pos
            ii = ii + 1
            CALL hm_get_int_array_index('box_ID',ibox(iad)%IBOXBOX(ii),j,is_available,lsubmodel)
          END DO
        END IF
c
        IF (nbox_neg > 0) THEN
          DO j=1,nbox_neg    
            ii = ii + 1
            CALL hm_get_int_array_index('box_IDneg',idneg,j,is_available,lsubmodel)
            ibox(iad)%IBOXBOX(ii) = -idneg
          END DO
        END IF
c
        IF (nlist == 0) THEN
          CALL ancmsg(msgid=801, msgtype= msgerror,
     .                           anmode = aninfo  ,
     .                           i1     = boxid   ,
     .                           c1     = titr    )
        END IF
c
        ibox(iad)%TITLE   = trim(titr)
        ibox(iad)%ID      = boxid
        ibox(iad)%ISKBOX  = 0
        ibox(iad)%NBLEVELS=-1
        ibox(iad)%LEVEL   = 0
        ibox(iad)%TYPE    = 0
        ibox(iad)%ACTIBOX = 0
        ibox(iad)%NOD1    = 0
        ibox(iad)%NOD2    = 0
        ibox(iad)%DIAM    = zero
        ibox(iad)%X1      = zero
        ibox(iad)%Y1      = zero
        ibox(iad)%Z1      = zero
        ibox(iad)%X2      = zero
        ibox(iad)%Y2      = zero
        ibox(iad)%Z2      = zero
        ibox(iad)%SURFIAD = 0
        ibox(iad)%NENTITY = 0
        ibox(iad)%BOXIAD  = 0
c
      ENDDO
c-----------
      RETURN