OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inter_deallocate_wait.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| inter_deallocate_wait ../engine/source/interfaces/generic/inter_deallocate_wait.F
25!||--- called by ------------------------------------------------------
26!|| inttri ../engine/source/interfaces/intsort/inttri.F
27!||--- calls -----------------------------------------------------
28!|| my_barrier ../engine/source/system/machine.F
29!||--- uses -----------------------------------------------------
30!|| h3d_mod ../engine/share/modules/h3d_mod.F
31!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
32!|| inter_sorting_mod ../engine/share/modules/inter_sorting_mod.F
33!|| inter_struct_mod ../engine/share/modules/inter_struct_mod.F
34!|| metric_mod ../common_source/modules/interfaces/metric_mod.F
35!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
36!|| sensor_mod ../common_source/modules/sensor_mod.F90
37!||====================================================================
38 SUBROUTINE inter_deallocate_wait( ITASK,NB_INTER_SORTED,LIST_INTER_SORTED,IPARI,
39 1 NSENSOR,IRECVFROM,SENSOR_TAB,INTER_STRUCT,SORT_COMM )
40!$COMMENT
41! INTER_DEALLOCATE_WAIT description
42! wait the message "send the secondary nodes" & deallocation of array
43! inter_deallocate_wait organization :
44!$ENDCOMMENT
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE multi_fvm_mod
49 USE h3d_mod
50 USE metric_mod
51 USE intbufdef_mod
52 USE inter_struct_mod
53 USE inter_sorting_mod
54 USE sensor_mod
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "com08_c.inc"
65#include "param_c.inc"
66#include "task_c.inc"
67#include "spmd.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER, INTENT(in) :: ITASK ! omp thread ID
72 INTEGER, INTENT(in) :: NB_INTER_SORTED ! number of interfaces that need to be sorted
73 INTEGER, INTENT(in) :: NSENSOR
74 INTEGER, DIMENSION(NB_INTER_SORTED), INTENT(in) :: LIST_INTER_SORTED ! list of interfaces that need to be sorted
75 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI ! interface data
76 INTEGER, DIMENSION(NINTER+1,NSPMD+1), INTENT(in) :: IRECVFROM
77 TYPE(inter_struct_type), DIMENSION(NINTER), INTENT(inout) :: INTER_STRUCT ! structure for interface
78 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
79 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER :: KK,N,P
84 INTEGER :: NTY,INACTI,ISENS
85 INTEGER :: NSN,NMN
86 LOGICAL :: TYPE18
87#ifdef MPI
88 INTEGER :: IERROR,STATUS(MPI_STATUS_SIZE)
89#endif
90 my_real :: ts
91! ----------------------------------------
92 IF(itask==0.AND.nb_inter_sorted>0) THEN
93 DO kk=1,nb_inter_sorted
94 n = list_inter_sorted(kk)
95
96 nty = ipari(7,n)
97 inacti = ipari(22,n)
98 type18=.false.
99 IF(nty==7.AND.inacti==7)type18=.true.
100
101 isens = 0
102 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
103 IF (isens > 0) THEN ! IF INTERFACE IS ACTIVATED BY SENSOR
104 ts = sensor_tab(isens)%TSTART
105 ELSE
106 ts = tt
107 ENDIF
108
109 nsn = ipari(5,n)
110 nmn = ipari(6,n)
111 ! -----------------------------------------------------
112 ! type 7
113 IF((nty==7.AND.tt>=ts).AND.(.NOT.type18))THEN
114 ! wait the message only for proc with only secondary nodes
115 IF(nsn>0.AND.nmn==0) THEN ! local nsn>0 && local nmn == 0
116 DO p = 1, nspmd
117 IF(irecvfrom(n,p)/=0) THEN ! nmn >0
118 IF(p/=ispmd+1) THEN
119 IF(sort_comm(n)%NB(p)/=0) THEN
120#ifdef MPI
121 CALL mpi_wait(sort_comm(n)%REQ_SD2(p),status,ierror)
122 DEALLOCATE(sort_comm(n)%DATA_PROC(p)%RBUF)
123 CALL mpi_wait(sort_comm(n)%REQ_SD3(p),status,ierror)
124 DEALLOCATE(sort_comm(n)%DATA_PROC(p)%IBUF)
125 sort_comm(n)%NB(p) = 0
126#endif
127 END IF
128 ENDIF
129 ENDIF
130 ENDDO
131 ENDIF
132 ENDIF
133 ! -----------------------------------------------------
134 ! deallocation
135 IF(ALLOCATED(sort_comm(n)%COARSE_GRID) )DEALLOCATE( sort_comm(n)%COARSE_GRID )
136 IF(ALLOCATED(sort_comm(n)%MAIN_COARSE_GRID) )DEALLOCATE( sort_comm(n)%MAIN_COARSE_GRID )
137 IF(ALLOCATED(sort_comm(n)%GLOBAL_COARSE_CELL) )DEALLOCATE( sort_comm(n)%GLOBAL_COARSE_CELL )
138
139 IF(ALLOCATED(sort_comm(n)%SEND_SIZE_COARSE_CELL) ) DEALLOCATE( sort_comm(n)%SEND_SIZE_COARSE_CELL )
140 IF(ALLOCATED(sort_comm(n)%RCV_SIZE_COARSE_CELL) ) DEALLOCATE( sort_comm(n)%RCV_SIZE_COARSE_CELL )
141 IF(ALLOCATED(sort_comm(n)%SEND_DISPLS_COARSE_CELL) ) DEALLOCATE( sort_comm(n)%SEND_DISPLS_COARSE_CELL )
142 IF(ALLOCATED(sort_comm(n)%RCV_DISPLS_COARSE_CELL) ) DEALLOCATE( sort_comm(n)%RCV_DISPLS_COARSE_CELL )
143
144
145 IF(ALLOCATED(sort_comm(n)%KEEP_PROC) )DEALLOCATE( sort_comm(n)%KEEP_PROC )
146 IF(ALLOCATED(sort_comm(n)%CELL_LIST) )DEALLOCATE( sort_comm(n)%CELL_LIST )
147 IF(ALLOCATED(sort_comm(n)%NB_CELL_PROC) )DEALLOCATE( sort_comm(n)%NB_CELL_PROC )
148 IF(ALLOCATED(sort_comm(n)%CELL) )DEALLOCATE( sort_comm(n)%CELL )
149
150 IF(ALLOCATED(sort_comm(n)%SEND_NB_CELL) ) DEALLOCATE( sort_comm(n)%SEND_NB_CELL )
151 IF(ALLOCATED(sort_comm(n)%RCV_NB_CELL) ) DEALLOCATE( sort_comm(n)%RCV_NB_CELL )
152 IF(ALLOCATED(sort_comm(n)%SEND_DISPLS_NB_CELL) ) DEALLOCATE( sort_comm(n)%SEND_DISPLS_NB_CELL )
153 IF(ALLOCATED(sort_comm(n)%RCV_DISPLS_NB_CELL) ) DEALLOCATE( sort_comm(n)%RCV_DISPLS_NB_CELL )
154
155 IF(ALLOCATED(sort_comm(n)%SEND_SIZE_CELL) ) DEALLOCATE( sort_comm(n)%SEND_SIZE_CELL )
156 IF(ALLOCATED(sort_comm(n)%RCV_SIZE_CELL) ) DEALLOCATE( sort_comm(n)%RCV_SIZE_CELL )
157 IF(ALLOCATED(sort_comm(n)%SEND_DISPLS_CELL) ) DEALLOCATE( sort_comm(n)%SEND_DISPLS_CELL )
158 IF(ALLOCATED(sort_comm(n)%RCV_DISPLS_CELL) ) DEALLOCATE( sort_comm(n)%RCV_DISPLS_CELL )
159
160 IF(ALLOCATED(sort_comm(n)%REQUEST_NB_S) ) DEALLOCATE( sort_comm(n)%REQUEST_NB_S )
161 IF(ALLOCATED(sort_comm(n)%REQUEST_NB_R) ) DEALLOCATE( sort_comm(n)%REQUEST_NB_R )
162 IF(ALLOCATED(sort_comm(n)%NB) ) DEALLOCATE( sort_comm(n)%NB )
163 IF(ALLOCATED(sort_comm(n)%INDEX_RCV) ) DEALLOCATE( sort_comm(n)%INDEX_RCV )
164
165 IF(ALLOCATED(sort_comm(n)%SEND_NB) ) DEALLOCATE( sort_comm(n)%SEND_NB )
166 IF(ALLOCATED(sort_comm(n)%RECV_NB) ) DEALLOCATE( sort_comm(n)%RECV_NB )
167
168 IF(ALLOCATED(sort_comm(n)%REQUEST_CELL_SEND) ) DEALLOCATE( sort_comm(n)%REQUEST_CELL_SEND )
169 IF(ALLOCATED(sort_comm(n)%REQUEST_CELL_RCV) ) DEALLOCATE( sort_comm(n)%REQUEST_CELL_RCV )
170
171 IF(ALLOCATED(sort_comm(n)%IIX) )DEALLOCATE( sort_comm(n)%IIX )
172 IF(ALLOCATED(sort_comm(n)%IIY) )DEALLOCATE( sort_comm(n)%IIY )
173 IF(ALLOCATED(sort_comm(n)%IIZ) )DEALLOCATE( sort_comm(n)%IIZ )
174 IF(ALLOCATED(sort_comm(n)%LAST_NOD) )DEALLOCATE( sort_comm(n)%LAST_NOD )
175 IF(ALLOCATED(sort_comm(n)%NEXT_NOD) )DEALLOCATE( sort_comm(n)%NEXT_NOD )
176 IF(ALLOCATED(sort_comm(n)%VOXEL) )DEALLOCATE( sort_comm(n)%VOXEL )
177
178 IF(ALLOCATED(inter_struct(n)%CURV_MAX)) DEALLOCATE(inter_struct(n)%CURV_MAX)
179 ! -----------------------------------------------------
180 ENDDO
181 IF(ALLOCATED(nb_local_cell) )DEALLOCATE( nb_local_cell )
182 IF(ALLOCATED(cell_bool) )DEALLOCATE( cell_bool )
183 ENDIF
184 CALL my_barrier()
185
186 RETURN
187 END SUBROUTINE inter_deallocate_wait
my_real
#define my_real
Definition cppsort.cpp:32
inter_deallocate_wait
subroutine inter_deallocate_wait(itask, nb_inter_sorted, list_inter_sorted, ipari, nsensor, irecvfrom, sensor_tab, inter_struct, sort_comm)
Definition inter_deallocate_wait.F:40
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
h3d_mod
Definition h3d_mod.F:308
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_sorting_mod::nb_local_cell
integer, dimension(:), allocatable nb_local_cell
Definition inter_sorting_mod.F:77
inter_sorting_mod::cell_bool
logical, dimension(:,:,:), allocatable cell_bool
Definition inter_sorting_mod.F:78
inter_struct_mod
Definition inter_struct_mod.F:49
metric_mod
Definition metric_mod.F:42
my_barrier
subroutine my_barrier
Definition machine.F:31
inter_sorting_mod::sorting_comm_type
Definition inter_sorting_mod.F:91
inter_struct_mod::inter_struct_type
Definition inter_struct_mod.F:64