OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_fvb_avec.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_fvb_avec ()

Function/Subroutine Documentation

◆ spmd_fvb_avec()

subroutine spmd_fvb_avec

Definition at line 33 of file spmd_fvb_avec.F.

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
57 my_real
58 . vvt(3)
59 REAL R4
60C
61 INTEGER, DIMENSION(:), ALLOCATABLE :: NPTR, NPN
62 my_real
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
my_real
#define my_real
Definition cppsort.cpp:32
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvspmd
type(fvbag_spmd), dimension(:), allocatable fvspmd
Definition fvbag_mod.F:129
fvbag_mod::fvdata
type(fvbag_data), dimension(:), allocatable fvdata
Definition fvbag_mod.F:128
fvbag_mod::nfvbag
integer nfvbag
Definition fvbag_mod.F:127
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519