fill_clause_node_box.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	fill_clause_node_box (ibox, x, skew, set_title, keyset, boxlist, boxlist_size, boxnds, sz_boxnds)
recursive subroutine	node_box (ib, ibox, x, skew, set_title, keyset, boxnds, sz_boxnds)

Function/Subroutine Documentation

fill_clause_node_box()

subroutine fill_clause_node_box	(	type (box_), dimension(nbbox)	ibox,
			x,
			skew,
		character(len=nchartitle)	set_title,
		character(len=ncharfield)	keyset,
		integer, dimension(*)	boxlist,
		integer	boxlist_size,
		integer, dimension(*)	boxnds,
		integer	sz_boxnds )

Definition at line 34 of file fill_clause_node_box.F.

 
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE optiondef_mod
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharfield
      USE set_mod , ONLY : set_add
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-----------------------------------------------
      TYPE (BOX_), DIMENSION(NBBOX) :: IBOX
 
      INTEGER  BOXNDS(*),BOXLIST(*)
      INTEGER  SZ_BOXNDS, BOXLIST_SIZE
 
      my_real x(3,*),skew(lskew,*)
 
      CHARACTER(LEN=NCHARFIELD) :: KEYSET
      CHARACTER(LEN=NCHARTITLE) :: SET_TITLE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,B_NDS_SIZE,NB_RESULT,
     .        ID,IB,NB_BOX_OF_BOX,J,CLAUSE_OPERATOR 
      LOGICAL BOOL
      INTEGER, DIMENSION(:) , ALLOCATABLE :: B_NDS,RESULT      
C-----------------------------------------------
      ALLOCATE(b_nds(numnod))
      ALLOCATE(result(numnod))
 
!
      ! Tag nodes from boxes
      ! ---------------------
      clause_operator = set_add 
      sz_boxnds = 0
      DO i=1,boxlist_size
        ib = boxlist(i)
        b_nds_size = 0
        
        CALL node_box( ib  ,
     *                     ibox ,x  ,skew  ,set_title ,keyset,
     *                     b_nds, b_nds_size)
        
 
        CALL set_merge_simple( boxnds,  sz_boxnds  ,
     *                          b_nds,   b_nds_size ,
     *                          result,  nb_result  ,
     *                          clause_operator)
 
         boxnds(1:nb_result) = result(1:nb_result)
         sz_boxnds = nb_result        
      ENDDO ! DO I=1,BOXLIST_SIZE
 
C-------
      RETURN

node_box()

recursive subroutine node_box	(	integer	ib,
		type (box_), dimension(nbbox)	ibox,
			x,
			skew,
		character(len=nchartitle)	set_title,
		character(len=ncharfield)	keyset,
		integer, dimension(*)	boxnds,
		integer	sz_boxnds )

Definition at line 116 of file fill_clause_node_box.F.

C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   Recursive routine - Go through tree and fill the Node Box array
C
C------------------------------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C
C     NAME           DESCRIPTION                         
C
C     IB             Recursive indice / Current Box to treat
C     IBOX           IBOX Structure
C     SKEW           Skew Structure
C     SET_TITLE      Title for Error message
C     KEYSET         KEYSET for  Error message
C     BOXNDS         merged node array
C     SZ_BOXNDS      number of stacked nodes in BOXNDS
C============================================================================
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE optiondef_mod
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharfield
      USE set_mod , ONLY : set_add,set_delete
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-----------------------------------------------
      TYPE (BOX_)    , DIMENSION(NBBOX)  :: IBOX
 
      INTEGER  BOXNDS(*)
      INTEGER  IB,SZ_BOXNDS 
 
      my_real
     .        x(3,*),skew(lskew,*)
 
      CHARACTER(LEN=NCHARFIELD) :: KEYSET
      CHARACTER(LEN=NCHARTITLE)::SET_TITLE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,B_NDS_SIZE,NB_RESULT,
     .        NB_BOX_OF_BOX,J,NEW_BOX,CLAUSE_OPERATOR
      LOGICAL BOOL
      INTEGER, DIMENSION(:) , ALLOCATABLE :: B_NDS,RESULT
      
C-----------------------------------------------
        
 
      nb_box_of_box   = ibox(ib)%NBOXBOX
 
      IF ( nb_box_of_box == 0 ) THEN
 
          ! Fill SIMPLE Boxes
          ! ---------------------
          sz_boxnds = 0
          CALL simple_node_box(ibox, x, skew, ib,
     *                         boxnds, sz_boxnds)
 
      ELSE
          ALLOCATE(b_nds(numnod))
          ALLOCATE(result(numnod))
 
 
          DO i=1,nb_box_of_box
 
            j    = ibox(ib)%IBOXBOX(i)  !  could be negative
            new_box = abs(j)
 
            b_nds_size=0
 
            CALL node_box (  new_box ,
     *                       ibox ,x  ,skew  ,set_title ,keyset,
     *                       b_nds, b_nds_size )
            
            IF (j < 0)THEN
                clause_operator = set_delete
            ELSE
                clause_operator = set_add 
            ENDIF
 
            CALL set_merge_simple( boxnds,  sz_boxnds  ,
     *                             b_nds,   b_nds_size ,
     *                             result,  nb_result  ,
     *                             clause_operator)
 
            boxnds(1:nb_result) = result(1:nb_result)
            sz_boxnds = nb_result
          ENDDO
 
       ENDIF
 
C-------
      RETURN