inter_color_coarse_voxel.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/.
!||====================================================================
!||    inter_color_coarse_voxel   ../engine/source/interfaces/generic/inter_color_coarse_voxel.F
!||--- called by ------------------------------------------------------
!||    inter_prepare_sort         ../engine/source/interfaces/generic/inter_prepare_sort.F
!||--- calls      -----------------------------------------------------
!||    my_barrier                 ../engine/source/system/machine.F
!||--- uses       -----------------------------------------------------
!||    intbufdef_mod              ../common_source/modules/interfaces/intbufdef_mod.F90
!||    inter_sorting_mod          ../engine/share/modules/inter_sorting_mod.F
!||====================================================================
        SUBROUTINE inter_color_coarse_voxel(ITASK,NB_INTER_SORTED,LIST_INTER_SORTED,IPARI,INTBUF_TAB,
     .                                      X,SORT_COMM)
!$COMMENT
!       INTER_COLOR_COARSE_VOXEL description :
!       color the coarse grid with the secondary nodes only for large interfaces (= with more than NSPMD/2 processors)
!
!       INTER_COLOR_COARSE_VOXEL organization :
!           loop over the secondary nodes (omp //)
!           compute the index of the coarse grid with the node position
!           color the cell of the coarse grid
!$ENDCOMMENT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE intbufdef_mod
        USE inter_sorting_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(in) :: ITASK ! thread ID
        INTEGER, INTENT(in) :: NB_INTER_SORTED        !   number of interfaces that need to be sorted
        INTEGER, DIMENSION(NB_INTER_SORTED), INTENT(in) :: LIST_INTER_SORTED   !   list of interfaces that need to be sorted
        INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI    !   interface data
        my_real, DIMENSION(3,NUMNOD), INTENT(in), TARGET :: x            !   position
        TYPE(intbuf_struct_),DIMENSION(NINTER), INTENT(in) :: INTBUF_TAB    ! interface data
        TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM   ! structure for interface sorting comm
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER :: KK,I,J
        INTEGER :: NIN,NEXT
        INTEGER :: IX,IY,IZ
        INTEGER :: NSN
        INTEGER :: FIRST,LAST
        my_real :: VALUE
        my_real :: xminb,yminb,zminb
        my_real :: xmaxb,ymaxb,zmaxb
!   ----------------------------------------
        ! ------------------
        ! allocation of global omp array 
        IF(itask==0) THEN
            ALLOCATE(cell_bool(nb_box_coarse_grid,nb_box_coarse_grid,nb_box_coarse_grid))
            cell_bool(1:nb_box_coarse_grid,1:nb_box_coarse_grid,1:nb_box_coarse_grid) = .false.
        ENDIF
        CALL my_barrier()
        ! ------------------
        ! loop over the interface
        DO kk=1,nb_inter_sorted
            nin = list_inter_sorted(kk)
            nsn = ipari(5,nin)
            ! ------------------
            ! coarse grid is generated only for large interface (nb of processor > nspm/2)
            IF(sort_comm(nin)%PROC_NUMBER>nspmd/2) THEN
                first = 1 + itask*nsn/nthread
                last = (itask+1)*nsn/nthread
                xmaxb = box_limit(1)
                ymaxb = box_limit(2)
                zmaxb = box_limit(3)
                xminb = box_limit(4)
                yminb = box_limit(5)
                zminb = box_limit(6)
                IF(itask==0) cell_bool(1:nb_box_coarse_grid,1:nb_box_coarse_grid,1:nb_box_coarse_grid) = .false.
                CALL my_barrier()
                ! ------------------
                !   loop over the secondary node to color the coarse grid
                DO i=first,last
                    j=intbuf_tab(nin)%NSV(i)
                    VALUE = nb_box_coarse_grid*(x(1,j)-xminb)/(xmaxb-xminb)
                    ix = min(int(VALUE),nb_box_coarse_grid)
                    ix = max(ix,1)
                    VALUE = nb_box_coarse_grid*(x(2,j)-yminb)/(ymaxb-yminb)
                    iy = min(int(VALUE),nb_box_coarse_grid)
                    iy = max(iy,1)
                    VALUE = nb_box_coarse_grid*(x(3,j)-zminb)/(zmaxb-zminb)
                    iz = min(int(VALUE),nb_box_coarse_grid)
                    iz = max(iz,1)
                    cell_bool(ix,iy,iz) = .true.                
                ENDDO
                CALL my_barrier()
                ! ------------------
                ! omp reduction
                IF(itask==0) THEN
                    IF(.NOT.ALLOCATED(sort_comm(nin)%COARSE_GRID)) THEN
                        ALLOCATE(sort_comm(nin)%COARSE_GRID(nb_box_coarse_grid**3 + 1))
                    ENDIF
                    sort_comm(nin)%COARSE_GRID(1:nb_box_coarse_grid**3 + 1) = 0
                    next = 0
                    DO iz=1,nb_box_coarse_grid
                        DO iy=1,nb_box_coarse_grid
                            DO ix=1,nb_box_coarse_grid
                                IF(cell_bool(ix,iy,iz)) THEN
                                    next = next + 1
                                    sort_comm(nin)%COARSE_GRID(next) = 
     .                ix+(iy-1)*nb_box_coarse_grid+(iz-1)*nb_box_coarse_grid**2
                                ENDIF
                            ENDDO
                        ENDDO
                    ENDDO
                    sort_comm(nin)%COARSE_GRID(nb_box_coarse_grid**3 + 1) = next
                ENDIF  
                CALL my_barrier()
                ! ------------------  
            ENDIF
            ! ------------------
        ENDDO 
        ! ------------------
 
        CALL my_barrier()
        IF(itask==0) THEN
            DEALLOCATE(cell_bool)
        ENDIF
        !   ------------------
        RETURN
        END SUBROUTINE inter_color_coarse_voxel