OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sensor_spmd.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!|| sensor_spmd ../engine/source/tools/sensor/sensor_spmd.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| spmd_glob_dsum9 ../engine/source/mpi/interfaces/spmd_th.F
29!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
30!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
31!|| spmd_rbcast ../engine/source/mpi/generic/spmd_rbcast.F
32!|| spmd_sd_acc ../engine/source/mpi/output/spmd_sd_acc.F
33!|| spmd_sd_sens ../engine/source/mpi/output/spmd_sd_sens.F
34!||--- uses -----------------------------------------------------
35!|| groupdef_mod ../common_source/modules/groupdef_mod.F
36!|| sensor_mod ../common_source/modules/sensor_mod.F90
37!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
38!||====================================================================
39 SUBROUTINE sensor_spmd(SENSOR_TAB,IPARI ,NPRW ,ISENSP ,NSENSP ,
40 . XSENS ,X ,ACCELM ,IACCP ,NACCP ,
41 . GAUGE ,IGAUP ,NGAUP ,PARTSAV2,NSENSOR,
42 . COMM_SENS14,SENSOR_STRUCT )
43C-----------------------------------------------
44C SPMD sensor update routine
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE sensor_mod
49 USE groupdef_mod
50 USE spmd_mod
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "param_c.inc"
59#include "com04_c.inc"
60#include "com08_c.inc"
61#include "task_c.inc"
62#include "parit_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER ,INTENT(IN) :: NSENSOR
67 INTEGER IPARI(NPARI,NINTER),
68 . NPRW(*), ISENSP(2,*), NSENSP(*), IACCP(*), NACCP(*),
69 . igaup(*), ngaup(*)
70 my_real xsens(12,*), x(3,*),
71 . accelm(llaccelm,*), gauge(llgauge,*),partsav2(2,*)
72 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
73 type(sensor_comm),INTENT(INOUT) :: COMM_SENS14
74 type(sensor_type),DIMENSION(NSENSOR),INTENT(INOUT) :: SENSOR_STRUCT(*)
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER K, TYP, LEN, IN, N5, ISENSUSR, I, LEN1,LOC_PROC,
79 . ISENST1, ISENST2, KK, N1, N2,M,
80 . IBUF(NSENSOR), ISENST10,ISENST13,J
81 my_real rbuf(nsensor*lsenbuf), rxbuf(5,2*nsensor)
82
83 INTEGER :: MY_SIZE
84 CHARACTER(len=4) :: MY_OPERATION
85 REAL(kind=8), DIMENSION(:), ALLOCATABLE :: SBUF_DOUBLE,RBUF_DOUBLE
86 INTEGER :: I2,I3,I4,IDX
87
88C=======================================================================
89C
90 isenst1 = 0
91 isenst2 = 0
92 isenst10= 0
93 isenst13= 0
94 loc_proc = ispmd+1
95 kk = 0
96 len = 0
97 isensusr = 0
98 DO k=1,nsensor
99 typ = sensor_tab(k)%TYPE
100 IF (typ == 1) THEN
101 isenst1 = 1
102 ELSEIF (typ == 2) THEN
103 isenst2 = 1
104 IF(isensp(1,k) == loc_proc)THEN
105 n1 = sensor_tab(k)%IPARAM(1)
106 IF(loc_proc /= 1)THEN
107 kk = kk+1
108 rxbuf(1,kk) = k
109 rxbuf(2,kk) = 1
110 rxbuf(3,kk) = x(1,n1)
111 rxbuf(4,kk) = x(2,n1)
112 rxbuf(5,kk) = x(3,n1)
113 ELSE
114C stockage directe sur p0
115 xsens(1,k) = x(1,n1)
116 xsens(2,k) = x(2,n1)
117 xsens(3,k) = x(3,n1)
118 END IF
119 END IF
120 IF(isensp(2,k) == loc_proc)THEN
121 n2 = sensor_tab(k)%IPARAM(2)
122 IF(loc_proc /= 1)THEN
123 kk = kk+1
124 rxbuf(1,kk) = k
125 rxbuf(2,kk) = 2
126 rxbuf(3,kk) = x(1,n2)
127 rxbuf(4,kk) = x(2,n2)
128 rxbuf(5,kk) = x(3,n2)
129 ELSE
130C stockage directe sur p0
131 xsens(4,k) = x(1,n2)
132 xsens(5,k) = x(2,n2)
133 xsens(6,k) = x(3,n2)
134 END IF
135 END IF
136 ELSEIF(typ == 6)THEN
137 len = len + 1
138 in = sensor_tab(k)%IPARAM(1)
139 IF (in > ninter) in = sensor_tab(k)%IPARAM(2)
140 ibuf(len) = ipari(29,in)
141 ELSEIF(typ == 7)THEN
142 len = len + 1
143 in = sensor_tab(k)%IPARAM(1)
144 n5 = in + 4*nrwall
145 ibuf(len) = nprw(n5)
146 ELSEIF(typ == 10)THEN
147 isenst10 = 1
148c-------------------------------
149 ELSEIF (typ == 13) THEN ! sensor WORK
150c-------------------------------
151 isenst13 = 1
152 IF (isensp(1,k) == loc_proc) THEN
153 n1 = sensor_tab(k)%IPARAM(1)
154 IF (loc_proc /= 1) THEN
155 kk = kk+1
156 rxbuf(1,kk) = k
157 rxbuf(2,kk) = 1
158 rxbuf(3,kk) = x(1,n1)
159 rxbuf(4,kk) = x(2,n1)
160 rxbuf(5,kk) = x(3,n1)
161 ELSE ! stockage directe sur p0
162 xsens(1,k) = x(1,n1)
163 xsens(2,k) = x(2,n1)
164 xsens(3,k) = x(3,n1)
165 END IF
166 END IF
167 IF (isensp(2,k) == loc_proc) THEN
168 n2 = sensor_tab(k)%IPARAM(2)
169 IF (n2 > 0 ) THEN
170 IF (loc_proc /= 1) THEN
171 kk = kk+1
172 rxbuf(1,kk) = k
173 rxbuf(2,kk) = 2
174 rxbuf(3,kk) = x(1,n2)
175 rxbuf(4,kk) = x(2,n2)
176 rxbuf(5,kk) = x(3,n2)
177 ELSE ! stockage directe sur p0
178 xsens(4,k) = x(1,n2)
179 xsens(5,k) = x(2,n2)
180 xsens(6,k) = x(3,n2)
181 END IF
182 ELSE
183 IF (loc_proc /= 1) THEN
184 kk = kk+1
185 rxbuf(1,kk) = k
186 rxbuf(2,kk) = 2
187 rxbuf(3,kk) = zero
188 rxbuf(4,kk) = zero
189 rxbuf(5,kk) = zero
190 ELSE ! stockage directe sur p0
191 xsens(4,k) = zero
192 xsens(5,k) = zero
193 xsens(6,k) = zero
194 END IF
195 END IF
196 END IF
197c-------------
198 ELSEIF(typ==16)THEN
199 ! -------------------
200 ! sensor HIC : need to communicate ACC
201 isenst1 = 1
202 ! -------------------
203 ELSEIF(typ == 29.OR.typ == 30.OR.typ == 31)THEN
204c-------------
205 isensusr = 1
206 IF(naccelm>0) isenst1 = 1
207 ENDIF
208 ENDDO
209c-----------------------------------------------------------------------
210 IF (isenst1 == 1) THEN
211c Extra communication pour sensor type 1 (accelerometre associe)
212C
213 CALL spmd_sd_acc(accelm,iaccp,naccp)
214 CALL spmd_rbcast(accelm,accelm,llaccelm,naccelm,0,2)
215 END IF
216C
217 IF (isenst10 == 1) THEN
218c Extra communication pour sensor type 1 (gauge associee)
219C
220 CALL spmd_sd_acc(gauge,igaup,ngaup)
221 CALL spmd_rbcast(gauge,gauge,llgauge,nbgauge,0,2)
222 END IF
223C
224 IF (isenst2 == 1) THEN
225c Extra communication pour sensor type 2
226C
227 CALL spmd_sd_sens(xsens,rxbuf,nsensp)
228 CALL spmd_rbcast(xsens,xsens,12,nsensor,0,2)
229 END IF
230c
231 IF (isenst13 == 1) THEN
232c Extra communication pour sensor type 13
233C
234 CALL spmd_sd_sens(xsens,rxbuf,nsensp)
235 CALL spmd_rbcast(xsens,xsens,12,nsensor,0,2)
236 IF (tt == zero) THEN
237 DO k=1,nsensor
238 typ = sensor_tab(k)%TYPE
239 IF (typ == 13) THEN
240 xsens(7,k) = xsens(1,k)
241 xsens(8,k) = xsens(2,k)
242 xsens(9,k) = xsens(3,k)
243 n2 = sensor_tab(k)%IPARAM(2)
244 IF (n2 > 0) THEN
245 xsens(10,k) = xsens(4,k)
246 xsens(11,k) = xsens(5,k)
247 xsens(12,k) = xsens(6,k)
248 ENDIF
249 ENDIF
250 ENDDO
251 ENDIF
252 END IF
253 ! -------------------------------
254 ! mpi communication for energy sensor (type 14)
255 IF(comm_sens14%BOOL) THEN
256 IF(iparit>0) THEN
257 my_size = comm_sens14%NUM_SENS*2*6*nthread
258 ALLOCATE( sbuf_double(my_size) )
259 ALLOCATE( rbuf_double(my_size) )
260 DO k=1,comm_sens14%NUM_SENS
261 j = comm_sens14%ID_SENS(k)
262 DO i2=1,2
263 DO i3=1,6
264 DO i4=1,nthread
265 idx = ((k-1)*2*6*nthread) + ((i2-1)*6*nthread) + ((i3-1)*nthread) + i4
266 sbuf_double(idx) = sensor_struct(j)%FBSAV6_SENS(i2,i3,i4)
267 END DO
268 END DO
269 END DO
270 ENDDO
271
272 CALL spmd_allreduce(sbuf_double,rbuf_double,my_size,spmd_sum)
273
274 DO k=1,comm_sens14%NUM_SENS
275 j = comm_sens14%ID_SENS(k)
276 DO i2=1,2
277 DO i3=1,6
278 DO i4=1,nthread
279 idx = ((k-1)*2*6*nthread) + ((i2-1)*6*nthread) + ((i3-1)*nthread) + i4
280 sensor_struct(j)%FBSAV6_SENS(i2,i3,i4) = rbuf_double(idx)
281 END DO
282 END DO
283 END DO
284 ENDDO
285 DEALLOCATE( sbuf_double )
286 DEALLOCATE( rbuf_double )
287 ELSE
288 CALL spmd_glob_dsum9(partsav2,2*npart)
289 CALL spmd_rbcast(partsav2,partsav2,2,npart,0,2)
290 ENDIF
291 ENDIF
292 ! -------------------------------
293c-----------------------------------------------------------------------
294 IF (len > 0) THEN
295C
296 CALL spmd_glob_isum9(ibuf,len)
297 CALL spmd_ibcast(ibuf,ibuf,len,1,0,2)
298C
299C il faut corrige la reduction et l'affecter au ipari/nprw
300 len = 0
301 DO k=1,nsensor
302 typ = sensor_tab(k)%TYPE
303 IF (typ == 6)THEN
304 len = len + 1
305 in = sensor_tab(k)%IPARAM(1)
306 IF (in > ninter) in = sensor_tab(k)%IPARAM(2)
307 ipari(29,in)=min(ibuf(len),1)
308 ELSEIF (typ == 7)THEN
309 len = len + 1
310 in = sensor_tab(k)%IPARAM(1)
311 n5 = in + 4*nrwall
312 nprw(n5) = min(ibuf(len),1)
313 ENDIF
314 ENDDO
315
316 ENDIF
317C------------
318 RETURN
319 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
groupdef_mod
Definition groupdef_mod.F:662
sensor_spmd
subroutine sensor_spmd(sensor_tab, ipari, nprw, isensp, nsensp, xsens, x, accelm, iaccp, naccp, gauge, igaup, ngaup, partsav2, nsensor, comm_sens14, sensor_struct)
Definition sensor_spmd.F:43
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_rbcast
subroutine spmd_rbcast(tabi, tabr, n1, n2, from, add)
Definition spmd_rbcast.F:62
spmd_sd_acc
subroutine spmd_sd_acc(accelm, iaccp, naccp)
Definition spmd_sd_acc.F:34
spmd_sd_sens
subroutine spmd_sd_sens(xsens, rxbuf, nsensp)
Definition spmd_sd_sens.F:33
spmd_glob_dsum9
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:380
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:523