fill_clause_rbody_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_rbody_box (ibox, x, skew, set_title, keyset, boxlist, boxlist_size, boxnds, sz_boxnds, rby_msn)
recursive subroutine	rbody_box (ib, ibox, x, skew, set_title, keyset, boxnds, sz_boxnds, rby_msn)

Function/Subroutine Documentation

fill_clause_rbody_box()

subroutine fill_clause_rbody_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,
		integer, dimension(2,nrbody), intent(in)	rby_msn )

Definition at line 34 of file fill_clause_rbody_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
      INTEGER, INTENT(IN), DIMENSION(2,NRBODY) :: RBY_MSN
 
      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(nrbody))
      ALLOCATE(result(nrbody))
 
!
      ! Tag nodes from boxes
      ! ---------------------
      clause_operator = set_add 
      sz_boxnds = 0
      DO i=1,boxlist_size
        ib = boxlist(i)
        b_nds_size = 0
        
        CALL rbody_box( ib  ,
     *                  ibox ,x  ,skew  ,set_title ,keyset,
     *                  b_nds, b_nds_size,rby_msn)
        
 
        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

rbody_box()

recursive subroutine rbody_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,
		integer, dimension(2,nrbody), intent(in)	rby_msn )

Definition at line 117 of file fill_clause_rbody_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, INTENT(IN), DIMENSION(2,NRBODY) :: RBY_MSN
 
      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_rbody_box(ibox, x, skew, ib,
     *                         boxnds, sz_boxnds,rby_msn)
 
      ELSE
          ALLOCATE(b_nds(nrbody))
          ALLOCATE(result(nrbody))
 
 
          DO i=1,nb_box_of_box
 
            j    = ibox(ib)%IBOXBOX(i)  !  could be negative
            new_box = abs(j)
 
            b_nds_size=0
 
            CALL rbody_box ( new_box ,
     *                       ibox ,x  ,skew  ,set_title ,keyset,
     *                       b_nds, b_nds_size ,rby_msn)
            
            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