ale_box_coloration.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/.
!||====================================================================
!||    ale_box_coloration   ../starter/source/initial_conditions/inivol/ale_box_coloration.F
!||--- called by ------------------------------------------------------
!||    init_inivol          ../starter/source/initial_conditions/inivol/init_inivol.F90
!||--- calls      -----------------------------------------------------
!||--- uses       -----------------------------------------------------
!||    inivol_def_mod       ../starter/share/modules1/inivol_mod.F
!||====================================================================
        SUBROUTINE ale_box_coloration(NSURF,NUMNOD,
     .                                NB_CELL_X,NB_CELL_Y,NB_CELL_Z,SURFACE_NUMBER,
     .                                MIN_MAX_POSITION,CELL,X,IGRSURF,INIVOL,CELL_POSITION,
     .                                ALE_NODE_NUMBER,LIST_ALE_NODE)
!$COMMENT
!       ALE_BOX_COLORATION description
!       ALE_BOX_COLORATION colors the grid created by ALE_BOX_CREATION routine
!       with the node of the surface
!       
!       ALE_BOX_COLORATION organization :
!       - loop over the surface
!           - loop over the node of the surface
!               - compute the node's position (ix,iy,iz) in the cell
!               - color the cell (ix,iy,iz) & all the cells crossed by a segment of the surface
!       - the position of ALE nodes in the grid are computed 
!$ENDCOMMENT
        USE array_mod
        USE inivol_def_mod , only : inivol_struct_
        USE groupdef_mod , only : surf_
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER,INTENT(IN) :: NSURF,NUMNOD
        INTEGER, INTENT(IN) :: NB_CELL_X,NB_CELL_Y,NB_CELL_Z ! number of cell in x/y/z direction
        INTEGER, INTENT(IN) :: SURFACE_NUMBER ! number of surface
        TYPE(array_type), DIMENSION(SURFACE_NUMBER), INTENT(INOUT) :: CELL ! voxcell
        my_real, DIMENSION(6), INTENT(IN) :: min_max_position ! min/max position
        my_real, DIMENSION(3,NUMNOD), INTENT(IN) :: x ! position
        INTEGER, DIMENSION(3,NUMNOD), INTENT(INOUT) :: CELL_POSITION ! position of node/cell
        TYPE (SURF_), DIMENSION(NSURF), INTENT(IN) :: IGRSURF ! surface data
        TYPE (INIVOL_STRUCT_), INTENT(IN) :: INIVOL ! inivol data
        INTEGER, INTENT(IN) :: ALE_NODE_NUMBER ! number of ale node
        INTEGER, DIMENSION(ALE_NODE_NUMBER), INTENT(IN) :: LIST_ALE_NODE ! list of ale node
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER :: I,J,K
        INTEGER :: II,JJ,KK
        INTEGER, DIMENSION(5) :: IX,IY,IZ
        INTEGER :: SURFACE_ID,SURFACE_NODE_NUMBER,SURFACE_TYPE
        INTEGER, DIMENSION(4) :: NODE_ID
        INTEGER :: LOW_X,UP_X
        INTEGER :: LOW_Y,UP_Y
        INTEGER :: LOW_Z,UP_Z
        my_real :: xmin,ymin,zmin
        my_real :: xmax,ymax,zmax
C-----------------------------------------------
 
        !   ------------------
        xmax = min_max_position(4)
        xmin = min_max_position(1)
        ymax = min_max_position(5)
        ymin = min_max_position(2)
        zmax = min_max_position(6)
        zmin = min_max_position(3)
        !   ------------------
 
        !   ------------------
        ! loop over the surface
        DO i=1,surface_number
            ! ------------------
            ! allocation of CELL array
            cell(i)%SIZE_INT_ARRAY_3D(1) = nb_cell_x
            cell(i)%SIZE_INT_ARRAY_3D(2) = nb_cell_y
            cell(i)%SIZE_INT_ARRAY_3D(3) = nb_cell_z
            CALL alloc_3d_array(cell(i))
            cell(i)%INT_ARRAY_3D(1:nb_cell_x,1:nb_cell_y,1:nb_cell_z) = 0
            ! ------------------
 
            ! ------------------
            surface_id = inivol%CONTAINER(i)%SURF_ID ! surface id
            surface_node_number = igrsurf(surface_id)%NSEG ! number of segment of the surface
            surface_type = igrsurf(surface_id)%TYPE ! type of surface
            IF(surface_type/=200.AND.surface_type/=101) THEN
                DO k=1,surface_node_number
                    ! ------------------
                    ! load the positions of the 4 nodes of the surface K
                    DO j=1,4
                        node_id(j) = igrsurf(surface_id)%NODES(k,j) ! node id
                        ix(j)=max(1,1+int(nb_cell_x*(x(1,node_id(j))-xmin)/(xmax-xmin)))
                        iy(j)=max(1,1+int(nb_cell_y*(x(2,node_id(j))-ymin)/(ymax-ymin)))
                        iz(j)=max(1,1+int(nb_cell_z*(x(3,node_id(j))-zmin)/(zmax-zmin)))
                    ENDDO
                    ix(5) = ix(1)
                    iy(5) = iy(1)
                    iz(5) = iz(1)
                    ! ------------------
                    ! tag the cells crossed by the segments of the surface K
                    !       1       2       3
                    !   * ----- * ----- * ----- *
                    !   | o_____|__o    |       |
                    ! a |  \    |  |    |       |           a1,b1,c1,a2,b2 are coloured
                    !   * --\-- * -o--- * ----- *
                    !   |    \  | /     |       |
                    ! b |     \ |/      |       |
                    !   * -----o* ----- * ----- *
                    !   |       |       |       |
                    ! c |       |       |       |
                    !   * ----- * ----- * ----- *
                
                    low_x = nb_cell_x + 1
                    up_x = -1
                    low_y = nb_cell_y + 1
                    up_y = -1
                    low_z = nb_cell_z + 1
                    up_z = -1
                    DO j=1,4
                      low_z = min(low_z,iz(j))
                      up_z = max(up_z,iz(j+1))
                      low_y = min(low_y,iy(j))
                      up_y = max(up_y,iy(j+1))
                      low_x = min(low_x,ix(j))
                      up_x = max(up_x,ix(j+1))
                    ENDDO
                    low_z = max(1,low_z)
                    up_z = min(nb_cell_z,up_z)
                    low_y = max(1,low_y)
                    up_y = min(nb_cell_y,up_y)
                    low_x = max(1,low_x)
                    up_x = min(nb_cell_x,up_x)
                    ! ------------------
                    DO kk=low_z,up_z
                      DO jj=low_y,up_y
                        DO ii=low_x,up_x
                          ! ------------------
                          ! the cell (ii,jj,kk) contains a node of a surface or is crossed by the segment
                          IF(cell(i)%INT_ARRAY_3D(ii,jj,kk)/=2) THEN
                            cell(i)%INT_ARRAY_3D(ii,jj,kk) = 2
                          ENDIF
                          ! ------------------
                        ENDDO
                      ENDDO
                    ENDDO
                    ! ------------------
                ENDDO
                ! ------------------
            ENDIF
        ENDDO
        !   ------------------
 
        !   ------------------
        ! compute the position of ALE nodes in grid
        DO j=1,ale_node_number
            i = list_ale_node(j)
            cell_position(1,i) =max(1,1+int(nb_cell_x*(x(1,i)-xmin)/(xmax-xmin)))
            cell_position(2,i) =max(1,1+int(nb_cell_y*(x(2,i)-ymin)/(ymax-ymin)))
            cell_position(3,i) =max(1,1+int(nb_cell_z*(x(3,i)-zmin)/(zmax-zmin)))
 
            ! ensure that cell_position does not exceed the number of
            ! cell(single precision issue)
            cell_position(1,i) =min(cell_position(1,i),nb_cell_x)
            cell_position(2,i) =min(cell_position(2,i),nb_cell_y)
            cell_position(3,i) =min(cell_position(3,i),nb_cell_z)
        ENDDO   
        !   ------------------
 
        RETURN
        END SUBROUTINE ale_box_coloration