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

Go to the source code of this file.

Functions/Subroutines

subroutine inter_deallocate_wait (itask, nb_inter_sorted, list_inter_sorted, ipari, nsensor, irecvfrom, sensor_tab, inter_struct, sort_comm)

Function/Subroutine Documentation

◆ inter_deallocate_wait()

subroutine inter_deallocate_wait ( 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,
integer, intent(in) nsensor,
integer, dimension(ninter+1,nspmd+1), intent(in) irecvfrom,
type (sensor_str_), dimension(nsensor) sensor_tab,
type(inter_struct_type), dimension(ninter), intent(inout) inter_struct,
type(sorting_comm_type), dimension(ninter), intent(inout) sort_comm )

Definition at line 38 of file inter_deallocate_wait.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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