inigrav_part_list.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/.
!||====================================================================
!||    inigrav_part_list   ../starter/source/initial_conditions/inigrav/inigrav_part_list.F
!||--- called by ------------------------------------------------------
!||    inigrav_load        ../starter/source/initial_conditions/inigrav/inigrav_load.F
!||--- uses       -----------------------------------------------------
!||    inigrav             ../starter/share/modules1/inigrav_mod.F
!||    message_mod         ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE inigrav_part_list(IPART, IGRPART, EBCS_TAB)
C-----------------------------------------------
C   Description
C-----------------------------------------------
C we need to enumerate all PARTS related to INIGRAV and record gravity vectors 
C this will be used to apply pressure gradient due to hydrostatic pressure with /EBCS/NRF
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE inigrav
      USE message_mod
      USE groupdef_mod
      USE ebcs_mod      
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      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN),TARGET          :: IPART(LIPART1,*)    
      TYPE (GROUP_)  , DIMENSION(NGRPART) :: IGRPART
      TYPE(t_ebcs_tab), INTENT(INOUT)     :: EBCS_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      LOGICAL :: lFOUND_EBCS_NRF
      INTEGER :: KK,JJ,ID_PART,TYP,NSEG,NP
      INTEGER :: IGRP
      my_real :: grav0,ngx,ngy,ngz
C---------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
 
      !-- pre-condition to run this subroutine (this also avoid to access array with 0 as index)
      IF(.NOT. ebcs_tab%is_created)RETURN
      IF(npart == 0)RETURN
 
      !-- checking if user defined /EBCS/NRF
      lfound_ebcs_nrf = .false.
      DO kk=1,ebcs_tab%nebcs
        typ  = ebcs_tab%tab(kk)%poly%type
        nseg = ebcs_tab%tab(kk)%poly%nb_elem
        IF(typ == 10 .AND. nseg > 0) THEN
          lfound_ebcs_nrf = .true.
          EXIT
        ENDIF
      ENDDO
      IF(.NOT.lfound_ebcs_nrf)RETURN
 
      !-- allocations
      inigrav_parts%IS_ALLOCATED = .false.
      ALLOCATE(inigrav_parts%TAGPART(npart))
      ALLOCATE(inigrav_parts%GRAV0(npart))
      ALLOCATE(inigrav_parts%NG(3,npart))      
      inigrav_parts%IS_ALLOCATED = .true.
                  
      !-- list of PARTs
      inigrav_parts%TAGPART(1:npart) = 0
      inigrav_parts%GRAV0(1:npart) = zero      
      DO kk=1,ninigrav 
        igrp    = inigrv(1,kk)           
        grav0   = linigrav(07,kk)  
        ngx     = linigrav(08,kk)
        ngy     = linigrav(09,kk)
        ngz     = linigrav(10,kk) 
        IF(igrp == 0)cycle
        np      = igrpart(igrp)%NENTITY
        DO jj=1,np
          id_part = igrpart(igrp)%ENTITY(jj)   !  UID : IPART(4,IGRPART(IGRP)%ENTITY(JJ))
          inigrav_parts%TAGPART(id_part) = 1
          inigrav_parts%GRAV0(id_part) = grav0       
          inigrav_parts%NG(1,id_part) = ngx
          inigrav_parts%NG(2,id_part) = ngy
          inigrav_parts%NG(3,id_part) = ngz
        ENDDO
      ENDDO    !next K
 
      !DEALLOCATE INIGRAV_PARTS WHEN NO LONGER USED BY /EBCS/NRF   (WHEN HYDROSTATIC PRESSURE WAS INITIALIZED)
      
      RETURN
      END