OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_fvb_aelf.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_aelf ../engine/source/mpi/anim/spmd_fvb_aelf.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!||====================================================================
32 SUBROUTINE spmd_fvb_aelf(FVMASS , FVPRES, FVQX , FVQY , FVQZ ,
33 . FVRHO , FVENER, FVCSON, FVGAMA, FVVISU,
34 . FVEL2FA)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE fvbag_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42 USE spmd_comm_world_mod, ONLY : spmd_comm_world
43#include "implicit_f.inc"
44C-----------------------------------------------------------------
45C M e s s a g e P a s s i n g
46C-----------------------------------------------
47#include "spmd.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "task_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER FVEL2FA(*)
56 my_real
57 . fvmass(*), fvpres(*), fvqx(*), fvqy(*), fvqz(*), fvrho(*),
58 . fvener(*), fvcson(*), fvgama(*), fvvisu(*)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62#ifdef MPI
63 INTEGER ELOFF, I, PMAIN, J, K, KK, N, NN, IDP, ITAG, MSGOFF,
64 . NNTR, LEN, IAD, STAT(MPI_STATUS_SIZE), IERR,MSGOFF2
65 my_real
66 . gama, ssp, fac
67 my_real
68 . , DIMENSION(:), ALLOCATABLE :: rbuf
69 DATA msgoff/7046/
70 DATA msgoff2/7047/
71
72C
73 eloff=0
74 DO i=1,nfvbag
75 pmain=fvspmd(i)%PMAIN
76 IF (ispmd==0) THEN
77 IF (ispmd==pmain-1) THEN
78 DO j=1,fvdata(i)%NPOLH
79 gama=fvdata(i)%GPOLH(j)
80 ssp=sqrt((gama-one)*gama*fvdata(i)%EPOLH(j)/
81 . fvdata(i)%MPOLH(j))
82 DO k=fvdata(i)%IFVPADR(j),fvdata(i)%IFVPADR(j+1)-1
83 kk=fvdata(i)%IFVPOLH(k)
84 DO n=fvdata(i)%IFVTADR(kk),
85 . fvdata(i)%IFVTADR(kk+1)-1
86 nn=fvdata(i)%IFVPOLY(n)
87 fac=one
88 IF (fvdata(i)%IFVTRI(4,nn)/=0) THEN
89 idp=fvdata(i)%IDPOLH(j)
90 fvvisu(fvel2fa(eloff+nn))=idp-(idp/8)*8+1
91 ELSE
92 fvvisu(fvel2fa(eloff+nn))=-1
93 fac=half
94 ENDIF
95 nn=fvel2fa(eloff+nn)
96 fvmass(nn)=fvmass(nn)+fac*fvdata(i)%MPOLH(j)
97 fvpres(nn)=fvpres(nn)+fac*fvdata(i)%PPOLH(j)
98 IF (fvdata(i)%MPOLH(j)>zero) THEN
99 fvqx(nn)=fvqx(nn)+fac*fvdata(i)%QPOLH(1,j)/
100 . fvdata(i)%MPOLH(j)
101 fvqy(nn)=fvqy(nn)+fac*fvdata(i)%QPOLH(2,j)/
102 . fvdata(i)%MPOLH(j)
103 fvqz(nn)=fvqz(nn)+fac*fvdata(i)%QPOLH(3,j)/
104 . fvdata(i)%MPOLH(j)
105 fvener(nn)=fvener(nn)+fac*fvdata(i)%EPOLH(j)/
106 . fvdata(i)%MPOLH(j)
107 ENDIF
108 fvrho(nn)=fvrho(nn)+fac*fvdata(i)%RPOLH(j)
109 fvcson(nn)=fvcson(nn)+fac*ssp
110 fvgama(nn)=fvgama(nn)+fac*gama
111 ENDDO
112 ENDDO
113 ENDDO
114 eloff=eloff+fvdata(i)%NNTR
115 ELSE
116 itag=msgoff
117 CALL mpi_recv(nntr, 1, mpi_integer, it_spmd(pmain),
118 . itag, spmd_comm_world, stat, ierr)
119C
120 len=10*nntr
121 ALLOCATE(rbuf(len))
122 itag=msgoff2
123 CALL mpi_recv(rbuf, len, real, it_spmd(pmain),
124 . itag, spmd_comm_world, stat, ierr)
125C
126 DO j=1,nntr
127 nn=fvel2fa(eloff+j)
128 fvmass(nn)=rbuf(j)
129 fvpres(nn)=rbuf(nntr+j)
130 fvqx(nn)=rbuf(2*nntr+j)
131 fvqy(nn)=rbuf(3*nntr+j)
132 fvqz(nn)=rbuf(4*nntr+j)
133 fvener(nn)=rbuf(5*nntr+j)
134 fvrho(nn)=rbuf(6*nntr+j)
135 fvcson(nn)=rbuf(7*nntr+j)
136 fvgama(nn)=rbuf(8*nntr+j)
137 fvvisu(nn)=rbuf(9*nntr+j)
138 ENDDO
139 eloff=eloff+nntr
140 DEALLOCATE(rbuf)
141 ENDIF
142 ELSE
143 IF (ispmd==pmain-1) THEN
144 nntr=fvdata(i)%NNTR
145 itag=msgoff
146 CALL mpi_send(nntr, 1, mpi_integer, it_spmd(1),
147 . itag, spmd_comm_world, ierr)
148C
149 len=10*nntr
150 ALLOCATE(rbuf(len))
151 DO j=1,len
152 rbuf(j)=zero
153 ENDDO
154 DO j=1,fvdata(i)%NPOLH
155 gama=fvdata(i)%GPOLH(j)
156 ssp=sqrt((gama-one)*gama*fvdata(i)%EPOLH(j)/
157 . fvdata(i)%MPOLH(j))
158 DO k=fvdata(i)%IFVPADR(j),fvdata(i)%IFVPADR(j+1)-1
159 kk=fvdata(i)%IFVPOLH(k)
160 DO n=fvdata(i)%IFVTADR(kk),
161 . fvdata(i)%IFVTADR(kk+1)-1
162 nn=fvdata(i)%IFVPOLY(n)
163 fac=one
164 IF (fvdata(i)%IFVTRI(4,nn)/=0) THEN
165 idp=fvdata(i)%IDPOLH(j)
166 rbuf(9*nntr+nn)=idp-(idp/8)*8+1
167 ELSE
168 rbuf(9*nntr+nn)=-1
169 fac=half
170 ENDIF
171 rbuf(nn)=rbuf(nn)+fac*fvdata(i)%MPOLH(j)
172 rbuf(nntr+nn)=rbuf(nntr+nn)
173 . +fac*fvdata(i)%PPOLH(j)
174 IF (fvdata(i)%MPOLH(j)>zero) THEN
175 rbuf(2*nntr+nn)=rbuf(2*nntr+nn)
176 . +fac*fvdata(i)%QPOLH(1,j)/
177 . fvdata(i)%MPOLH(j)
178 rbuf(3*nntr+nn)=rbuf(3*nntr+nn)
179 . +fac*fvdata(i)%QPOLH(2,j)/
180 . fvdata(i)%MPOLH(j)
181 rbuf(4*nntr+nn)=rbuf(4*nntr+nn)
182 . +fac*fvdata(i)%QPOLH(3,j)/
183 . fvdata(i)%MPOLH(j)
184 rbuf(5*nntr+nn)=rbuf(5*nntr+nn)
185 . +fac*fvdata(i)%EPOLH(j)/
186 . fvdata(i)%MPOLH(j)
187 ENDIF
188 rbuf(6*nntr+nn)=rbuf(6*nntr+nn)
189 . +fac*fvdata(i)%RPOLH(j)
190 rbuf(7*nntr+nn)=rbuf(7*nntr+nn)+fac*ssp
191 rbuf(8*nntr+nn)=rbuf(8*nntr+nn)+fac*gama
192 ENDDO
193 ENDDO
194 ENDDO
195 itag=msgoff2
196 CALL mpi_send(rbuf, len, real, it_spmd(1),
197 . itag, spmd_comm_world, ierr)
198C
199 DEALLOCATE(rbuf)
200 ENDIF
201 ENDIF
202 ENDDO
203C
204#endif
205 RETURN
206 END
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
spmd_fvb_aelf
subroutine spmd_fvb_aelf(fvmass, fvpres, fvqx, fvqy, fvqz, fvrho, fvener, fvcson, fvgama, fvvisu, fvel2fa)
Definition spmd_fvb_aelf.F:35