fill_clause_rbody_box.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    fill_clause_rbody_box   ../starter/source/model/sets/fill_clause_rbody_box.F
!||--- called by ------------------------------------------------------
!||    create_rbody_box        ../starter/source/model/sets/create_rbody_box.F
!||--- calls      -----------------------------------------------------
!||    rbody_box               ../starter/source/model/sets/fill_clause_rbody_box.F
!||    set_merge_simple        ../starter/source/model/sets/set_merge_simple.F
!||--- uses       -----------------------------------------------------
!||    message_mod             ../starter/share/message_module/message_mod.F
!||    set_mod                 ../starter/share/modules1/set_mod.F
!||====================================================================
      SUBROUTINE fill_clause_rbody_box( IBOX   ,X  ,SKEW  ,SET_TITLE ,KEYSET,
     *                                 BOXLIST, BOXLIST_SIZE,
     *                                 BOXNDS, SZ_BOXNDS     ,RBY_MSN)
 
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
      END
 
 
!||====================================================================
!||    rbody_box               ../starter/source/model/sets/fill_clause_rbody_box.F
!||--- called by ------------------------------------------------------
!||    fill_clause_rbody_box   ../starter/source/model/sets/fill_clause_rbody_box.F
!||--- calls      -----------------------------------------------------
!||    set_merge_simple        ../starter/source/model/sets/set_merge_simple.F
!||    simple_rbody_box        ../starter/source/model/sets/simple_rbody_box.F
!||--- uses       -----------------------------------------------------
!||    message_mod             ../starter/share/message_module/message_mod.F
!||    set_mod                 ../starter/share/modules1/set_mod.F
!||====================================================================
      RECURSIVE SUBROUTINE rbody_box( IB  ,
     *                     IBOX ,X  ,SKEW  ,SET_TITLE ,KEYSET,
     *                     BOXNDS, SZ_BOXNDS,RBY_MSN)
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
      END