OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inter_color_coarse_voxel.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine inter_color_coarse_voxel (itask, nb_inter_sorted, list_inter_sorted, ipari, intbuf_tab, x, sort_comm)

Function/Subroutine Documentation

◆ inter_color_coarse_voxel()

subroutine inter_color_coarse_voxel ( integer, intent(in) itask,
integer, intent(in) nb_inter_sorted,
integer, dimension(nb_inter_sorted), intent(in) list_inter_sorted,
integer, dimension(npari,ninter), intent(in) ipari,
type(intbuf_struct_), dimension(ninter), intent(in) intbuf_tab,
target x,
type(sorting_comm_type), dimension(ninter), intent(inout) sort_comm )

Definition at line 33 of file inter_color_coarse_voxel.F.

35!$COMMENT
36! INTER_COLOR_COARSE_VOXEL description :
37! color the coarse grid with the secondary nodes only for large interfaces (= with more than NSPMD/2 processors)
38!
39! INTER_COLOR_COARSE_VOXEL organization :
40! loop over the secondary nodes (omp //)
41! compute the index of the coarse grid with the node position
42! color the cell of the coarse grid
43!$ENDCOMMENT
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE intbufdef_mod
48 USE inter_sorting_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53#include "comlock.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "param_c.inc"
60#include "task_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER, INTENT(in) :: ITASK ! thread ID
65 INTEGER, INTENT(in) :: NB_INTER_SORTED ! number of interfaces that need to be sorted
66 INTEGER, DIMENSION(NB_INTER_SORTED), INTENT(in) :: LIST_INTER_SORTED ! list of interfaces that need to be sorted
67 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI ! interface data
68 my_real, DIMENSION(3,NUMNOD), INTENT(in), TARGET :: x ! position
69 TYPE(INTBUF_STRUCT_),DIMENSION(NINTER), INTENT(in) :: INTBUF_TAB ! interface data
70 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER :: KK,I,J
75 INTEGER :: NIN,NEXT
76 INTEGER :: IX,IY,IZ
77 INTEGER :: NSN
78 INTEGER :: FIRST,LAST
79 my_real :: VALUE
80 my_real :: xminb,yminb,zminb
81 my_real :: xmaxb,ymaxb,zmaxb
82! ----------------------------------------
83 ! ------------------
84 ! allocation of global omp array
85 IF(itask==0) THEN
86 ALLOCATE(cell_bool(nb_box_coarse_grid,nb_box_coarse_grid,nb_box_coarse_grid))
87 cell_bool(1:nb_box_coarse_grid,1:nb_box_coarse_grid,1:nb_box_coarse_grid) = .false.
88 ENDIF
89 CALL my_barrier()
90 ! ------------------
91 ! loop over the interface
92 DO kk=1,nb_inter_sorted
93 nin = list_inter_sorted(kk)
94 nsn = ipari(5,nin)
95 ! ------------------
96 ! coarse grid is generated only for large interface (nb of processor > nspm/2)
97 IF(sort_comm(nin)%PROC_NUMBER>nspmd/2) THEN
98 first = 1 + itask*nsn/nthread
99 last = (itask+1)*nsn/nthread
100 xmaxb = box_limit(1)
101 ymaxb = box_limit(2)
102 zmaxb = box_limit(3)
103 xminb = box_limit(4)
104 yminb = box_limit(5)
105 zminb = box_limit(6)
106 IF(itask==0) cell_bool(1:nb_box_coarse_grid,1:nb_box_coarse_grid,1:nb_box_coarse_grid) = .false.
107 CALL my_barrier()
108 ! ------------------
109 ! loop over the secondary node to color the coarse grid
110 DO i=first,last
111 j=intbuf_tab(nin)%NSV(i)
112 VALUE = nb_box_coarse_grid*(x(1,j)-xminb)/(xmaxb-xminb)
113 ix = min(int(VALUE),nb_box_coarse_grid)
114 ix = max(ix,1)
115 VALUE = nb_box_coarse_grid*(x(2,j)-yminb)/(ymaxb-yminb)
116 iy = min(int(VALUE),nb_box_coarse_grid)
117 iy = max(iy,1)
118 VALUE = nb_box_coarse_grid*(x(3,j)-zminb)/(zmaxb-zminb)
119 iz = min(int(VALUE),nb_box_coarse_grid)
120 iz = max(iz,1)
121 cell_bool(ix,iy,iz) = .true.
122 ENDDO
123 CALL my_barrier()
124 ! ------------------
125 ! omp reduction
126 IF(itask==0) THEN
127 IF(.NOT.ALLOCATED(sort_comm(nin)%COARSE_GRID)) THEN
128 ALLOCATE(sort_comm(nin)%COARSE_GRID(nb_box_coarse_grid**3 + 1))
129 ENDIF
130 sort_comm(nin)%COARSE_GRID(1:nb_box_coarse_grid**3 + 1) = 0
131 next = 0
132 DO iz=1,nb_box_coarse_grid
133 DO iy=1,nb_box_coarse_grid
134 DO ix=1,nb_box_coarse_grid
135 IF(cell_bool(ix,iy,iz)) THEN
136 next = next + 1
137 sort_comm(nin)%COARSE_GRID(next) =
138 . ix+(iy-1)*nb_box_coarse_grid+(iz-1)*nb_box_coarse_grid**2
139 ENDIF
140 ENDDO
141 ENDDO
142 ENDDO
143 sort_comm(nin)%COARSE_GRID(nb_box_coarse_grid**3 + 1) = next
144 ENDIF
145 CALL my_barrier()
146 ! ------------------
147 ENDIF
148 ! ------------------
149 ENDDO
150 ! ------------------
151
152 CALL my_barrier()
153 IF(itask==0) THEN
154 DEALLOCATE(cell_bool)
155 ENDIF
156 ! ------------------
157 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_sorting_mod::cell_bool
logical, dimension(:,:,:), allocatable cell_bool
Definition inter_sorting_mod.F:78
inter_sorting_mod::nb_box_coarse_grid
integer, parameter nb_box_coarse_grid
Definition inter_sorting_mod.F:70
my_barrier
subroutine my_barrier
Definition machine.F:31