OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_fvb_avec.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!|| spmd_fvb_avec ../engine/source/mpi/anim/spmd_fvb_avec.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.f
27!||--- calls -----------------------------------------------------
28!|| write_r_c ../common_source/tools/input_output/write_routines.c
29!||--- uses -----------------------------------------------------
30!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
31!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
32!||====================================================================
33 SUBROUTINE spmd_fvb_avec()
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE fvbag_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41 USE spmd_comm_world_mod, ONLY : spmd_comm_world
42#include "implicit_f.inc"
43C-----------------------------------------------------------------
44C M e s s a g e P a s s i n g
45C-----------------------------------------------
46#include "spmd.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "task_c.inc"
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54#ifdef MPI
55 INTEGER I, PMAIN, NNS_ANIM, NNTR, J, K, KK, L, LL, N1, N2, N3,
56 . ITAG, LEN, MSGOFF, STAT(MPI_STATUS_SIZE), IERR,MSGOFF2
58 . vvt(3)
59 REAL R4
60C
61 INTEGER, DIMENSION(:), ALLOCATABLE :: NPTR, NPN
63 . , DIMENSION(:,:), ALLOCATABLE :: vtr, vv
64C
65 DATA msgoff/7048/
66 DATA msgoff2/7049/
67C
68 DO i=1,nfvbag
69 pmain=fvspmd(i)%PMAIN
70 IF (ispmd==0) THEN
71 IF (ispmd==pmain-1) THEN
72 nns_anim=fvdata(i)%NNS_ANIM
73 nntr=fvdata(i)%NNTR
74 ALLOCATE(vtr(3,nntr), vv(3,nns_anim), nptr(nntr),
75 . npn(nns_anim))
76C
77 DO j=1,nntr
78 nptr(j)=0
79 vtr(1,j)=zero
80 vtr(2,j)=zero
81 vtr(3,j)=zero
82 ENDDO
83 DO j=1,nns_anim
84 npn(j)=0
85 vv(1,j)=zero
86 vv(2,j)=zero
87 vv(3,j)=zero
88 ENDDO
89 DO j=1,fvdata(i)%NPOLH
90 IF (fvdata(i)%MPOLH(j)==zero) cycle
91 DO k=fvdata(i)%IFVPADR(j),fvdata(i)%IFVPADR(j+1)-1
92 kk=fvdata(i)%IFVPOLH(k)
93 DO l=fvdata(i)%IFVTADR(kk),
94 . fvdata(i)%IFVTADR(kk+1)-1
95 ll=fvdata(i)%IFVPOLY(l)
96 nptr(ll)=nptr(ll)+1
97 vtr(1,ll)=vtr(1,ll)+fvdata(i)%QPOLH(1,j)/
98 . fvdata(i)%MPOLH(j)
99 vtr(2,ll)=vtr(2,ll)+fvdata(i)%QPOLH(2,j)/
100 . fvdata(i)%MPOLH(j)
101 vtr(3,ll)=vtr(3,ll)+fvdata(i)%QPOLH(3,j)/
102 . fvdata(i)%MPOLH(j)
103 ENDDO
104 ENDDO
105 ENDDO
106 DO j=1,nntr
107 n1=fvdata(i)%IFVTRI_ANIM(1,j)
108 n2=fvdata(i)%IFVTRI_ANIM(2,j)
109 n3=fvdata(i)%IFVTRI_ANIM(3,j)
110 npn(n1)=npn(n1)+1
111 npn(n2)=npn(n2)+1
112 npn(n3)=npn(n3)+1
113 IF (nptr(j)/=0) THEN
114 vvt(1)=vtr(1,j)/nptr(j)
115 vvt(2)=vtr(2,j)/nptr(j)
116 vvt(3)=vtr(3,j)/nptr(j)
117 ELSE
118 vvt(1)=zero
119 vvt(2)=zero
120 vvt(3)=zero
121 ENDIF
122 vv(1,n1)=vv(1,n1)+vvt(1)
123 vv(2,n1)=vv(2,n1)+vvt(2)
124 vv(3,n1)=vv(3,n1)+vvt(3)
125 vv(1,n2)=vv(1,n2)+vvt(1)
126 vv(2,n2)=vv(2,n2)+vvt(2)
127 vv(3,n2)=vv(3,n2)+vvt(3)
128 vv(1,n3)=vv(1,n3)+vvt(1)
129 vv(2,n3)=vv(2,n3)+vvt(2)
130 vv(3,n3)=vv(3,n3)+vvt(3)
131 ENDDO
132C
133 DO j=1,nns_anim
134 r4 = vv(1,j)/npn(j)
135 CALL write_r_c(r4,1)
136 r4 = vv(2,j)/npn(j)
137 CALL write_r_c(r4,1)
138 r4 = vv(3,j)/npn(j)
139 CALL write_r_c(r4,1)
140 ENDDO
141C
142 DEALLOCATE(vtr, vv, nptr, npn)
143 ELSE
144 itag=msgoff
145 CALL mpi_recv(nns_anim, 1, mpi_integer, it_spmd(pmain),
146 . itag, spmd_comm_world, stat, ierr)
147C
148 ALLOCATE(vv(3,nns_anim))
149 itag=msgoff2
150 len=3*nns_anim
151 CALL mpi_recv(vv, len, real, it_spmd(pmain),
152 . itag, spmd_comm_world, stat, ierr)
153C
154 DO j=1,nns_anim
155 r4 = vv(1,j)
156 CALL write_r_c(r4,1)
157 r4 = vv(2,j)
158 CALL write_r_c(r4,1)
159 r4 = vv(3,j)
160 CALL write_r_c(r4,1)
161 ENDDO
162C
163 DEALLOCATE(vv)
164 ENDIF
165 ELSE
166 IF (ispmd==pmain-1) THEN
167 nns_anim=fvdata(i)%NNS_ANIM
168 itag=msgoff
169 CALL mpi_send(nns_anim, 1, mpi_integer, it_spmd(1),
170 . itag, spmd_comm_world, ierr)
171C
172 nntr=fvdata(i)%NNTR
173 ALLOCATE(vtr(3,nntr), vv(3,nns_anim), nptr(nntr),
174 . npn(nns_anim))
175C
176 DO j=1,nntr
177 nptr(j)=0
178 vtr(1,j)=zero
179 vtr(2,j)=zero
180 vtr(3,j)=zero
181 ENDDO
182 DO j=1,nns_anim
183 npn(j)=0
184 vv(1,j)=zero
185 vv(2,j)=zero
186 vv(3,j)=zero
187 ENDDO
188 DO j=1,fvdata(i)%NPOLH
189 IF (fvdata(i)%MPOLH(j)==zero) cycle
190 DO k=fvdata(i)%IFVPADR(j),fvdata(i)%IFVPADR(j+1)-1
191 kk=fvdata(i)%IFVPOLH(k)
192 DO l=fvdata(i)%IFVTADR(kk),
193 . fvdata(i)%IFVTADR(kk+1)-1
194 ll=fvdata(i)%IFVPOLY(l)
195 nptr(ll)=nptr(ll)+1
196 vtr(1,ll)=vtr(1,ll)+fvdata(i)%QPOLH(1,j)/
197 . fvdata(i)%MPOLH(j)
198 vtr(2,ll)=vtr(2,ll)+fvdata(i)%QPOLH(2,j)/
199 . fvdata(i)%MPOLH(j)
200 vtr(3,ll)=vtr(3,ll)+fvdata(i)%QPOLH(3,j)/
201 . fvdata(i)%MPOLH(j)
202 ENDDO
203 ENDDO
204 ENDDO
205 DO j=1,nntr
206 n1=fvdata(i)%IFVTRI_ANIM(1,j)
207 n2=fvdata(i)%IFVTRI_ANIM(2,j)
208 n3=fvdata(i)%IFVTRI_ANIM(3,j)
209 npn(n1)=npn(n1)+1
210 npn(n2)=npn(n2)+1
211 npn(n3)=npn(n3)+1
212 IF (nptr(j)/=0) THEN
213 vvt(1)=vtr(1,j)/nptr(j)
214 vvt(2)=vtr(2,j)/nptr(j)
215 vvt(3)=vtr(3,j)/nptr(j)
216 ELSE
217 vvt(1)=zero
218 vvt(2)=zero
219 vvt(3)=zero
220 ENDIF
221 vv(1,n1)=vv(1,n1)+vvt(1)
222 vv(2,n1)=vv(2,n1)+vvt(2)
223 vv(3,n1)=vv(3,n1)+vvt(3)
224 vv(1,n2)=vv(1,n2)+vvt(1)
225 vv(2,n2)=vv(2,n2)+vvt(2)
226 vv(3,n2)=vv(3,n2)+vvt(3)
227 vv(1,n3)=vv(1,n3)+vvt(1)
228 vv(2,n3)=vv(2,n3)+vvt(2)
229 vv(3,n3)=vv(3,n3)+vvt(3)
230 ENDDO
231C
232 DO j=1,nns_anim
233 vv(1,j)=vv(1,j)/npn(j)
234 vv(2,j)=vv(2,j)/npn(j)
235 vv(3,j)=vv(3,j)/npn(j)
236 ENDDO
237 itag=msgoff2
238 len=3*nns_anim
239 CALL mpi_send(vv, len, real, it_spmd(1),
240 . itag, spmd_comm_world, ierr)
241C
242 DEALLOCATE(vtr, vv, nptr, npn)
243 ENDIF
244 ENDIF
245 ENDDO
246C
247 IF (ispmd==0) THEN
248 r4=zero
249 DO i=1,3
250 CALL write_r_c(r4,1)
251 CALL write_r_c(r4,1)
252 CALL write_r_c(r4,1)
253 ENDDO
254 ENDIF
255C
256#endif
257 RETURN
258 END
#define my_real
Definition cppsort.cpp:32
subroutine genani(x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, swaft, smas, sxnorm, siad, iparg, pm, geo, ms, sinvert, cont, smater, icut, skew, xcut, fint, itab, sel2fa, fext, fopt, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, mat_param, dd_iad, weight, eani, ipart, cluster, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, rby, swa4, tors, nom_opt, igrsurf, bufsf, idata, rdata, siadg, bufmat, bufgeo, kxx, ixx, ipartx, suix, sxusr, snfacptx, sixedge, sixfacet, sixsolid, snumx1, snumx2, snumx3, soffx1, soffx2, soffx3, smass1, smass2, smass3, sfunc1, sfunc2, sfunc3, kxsp, ixsp, nod2sp, ipartsp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, iflow, rflow, fncont, ftcont, temp, thke, err_thk_sh4, err_thk_sh3, diag_sms, ipari, fncont2, dr, ale_connectivity, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, dxancg, nod_pxfem, iel_pxfem, zi_ply, vgaz, fcontg, fncontg, ftcontg, fanreac, inod_crk, iel_crk, elcutc, iadc_crk, pdama2, res_sms, weight_md, nodglobxfe, nodedge, fcluster, mcluster, xfem_tab, w, nv46, ipartig3d, kxig3d, ixig3d, sig3dsolid, knot, wige, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, igrnod, h3d_data, subset, multi_fvm, knotlocpc, knotlocel, fcont_max, fncontp2, ftcontp2, glob_therm, drape_sh4n, drape_sh3n, drapeg, output)
Definition genani.F:240
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
type(fvbag_spmd), dimension(:), allocatable fvspmd
Definition fvbag_mod.F:129
type(fvbag_data), dimension(:), allocatable fvdata
Definition fvbag_mod.F:128
integer nfvbag
Definition fvbag_mod.F:127
subroutine spmd_fvb_avec()
void write_r_c(float *w, int *len)