OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_fvb_apar.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_apar ../engine/source/mpi/anim/spmd_fvb_apar.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_apar(NELCUT, NBF , NESCT, NERWL, NESRG,
33 . NESMD1, FVPBUF)
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 D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NELCUT, NBF, NESCT, NERWL, NESRG, NESMD1, FVPBUF(*)
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58#ifdef MPI
59 INTEGER FVIAD, I, PMAIN, J, K, KK, N, NN, ITAG, MSGOFF,MSGOFF2,
60 . npolh_anim, ierr, stat(mpi_status_size), iad, iadp
61C-----------------------------------------------
62 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGT, IBUF
63C-----------------------------------------------
64 DATA msgoff/7043/
65 DATA msgoff2/7044/
66C
67 iadp=0
68 fviad=nelcut+nbf+nesct+nerwl+nesrg+nesmd1
69 DO i=1,nfvbag
70 pmain=fvspmd(i)%PMAIN
71 IF (ispmd==0) THEN
72 IF (ispmd==pmain-1) THEN
73 ALLOCATE(itagt(fvdata(i)%NNTR))
74 DO j=1,fvdata(i)%NNTR
75 itagt(j)=0
76 ENDDO
77C
78 DO j=1,fvdata(i)%NPOLH_ANIM
79 DO k=fvdata(i)%IFVPADR_ANIM(j),
80 . fvdata(i)%IFVPADR_ANIM(j+1)-1
81 kk=fvdata(i)%IFVPOLH_ANIM(k)
82 DO n=fvdata(i)%IFVTADR_ANIM(kk),
83 . fvdata(i)%IFVTADR_ANIM(kk+1)-1
84 nn=fvdata(i)%IFVPOLY_ANIM(n)
85 IF (itagt(nn)==0) THEN
86 fviad=fviad+1
87 itagt(nn)=1
88 ENDIF
89 ENDDO
90 ENDDO
91 fvpbuf(iadp+j)=fviad
92 ENDDO
93 iadp=iadp+fvdata(i)%NPOLH_ANIM
94C
95 DEALLOCATE(itagt)
96 ELSE
97 itag=msgoff
98 CALL mpi_recv(npolh_anim, 1, mpi_integer,
99 . it_spmd(pmain), itag, spmd_comm_world,
100 . stat, ierr)
101C
102 ALLOCATE(ibuf(npolh_anim))
103 itag=msgoff2
104 CALL mpi_recv(ibuf, npolh_anim, mpi_integer,
105 . it_spmd(pmain), itag, spmd_comm_world,
106 . stat, ierr)
107C
108 DO j=1,npolh_anim
109 fvpbuf(iadp+j)=fviad+ibuf(j)
110 ENDDO
111 fviad=fviad+ibuf(npolh_anim)
112 iadp=iadp+npolh_anim
113 DEALLOCATE(ibuf)
114 ENDIF
115 ELSE
116 IF (ispmd==pmain-1) THEN
117 itag=msgoff
118 CALL mpi_send(fvdata(i)%NPOLH_ANIM, 1, mpi_integer,
119 . it_spmd(1), itag, spmd_comm_world,
120 . ierr)
121C
122 ALLOCATE(ibuf(fvdata(i)%NPOLH_ANIM),
123 . itagt(fvdata(i)%NNTR))
124 iad=0
125C
126 DO j=1,fvdata(i)%NNTR
127 itagt(j)=0
128 ENDDO
129C
130 DO j=1,fvdata(i)%NPOLH_ANIM
131 DO k=fvdata(i)%IFVPADR_ANIM(j),
132 . fvdata(i)%IFVPADR_ANIM(j+1)-1
133 kk=fvdata(i)%IFVPOLH_ANIM(k)
134 DO n=fvdata(i)%IFVTADR_ANIM(kk),
135 . fvdata(i)%IFVTADR_ANIM(kk+1)-1
136 nn=fvdata(i)%IFVPOLY_ANIM(n)
137 IF (itagt(nn)==0) THEN
138 iad=iad+1
139 itagt(nn)=1
140 ENDIF
141 ENDDO
142 ENDDO
143 ibuf(j)=iad
144 ENDDO
145 itag=msgoff2
146 CALL mpi_send(ibuf, fvdata(i)%NPOLH_ANIM, mpi_integer,
147 . it_spmd(1), itag, spmd_comm_world,
148 . ierr)
149C
150 DEALLOCATE(ibuf, itagt)
151 ENDIF
152 ENDIF
153 ENDDO
154C
155#endif
156 RETURN
157 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_apar
subroutine spmd_fvb_apar(nelcut, nbf, nesct, nerwl, nesrg, nesmd1, fvpbuf)
Definition spmd_fvb_apar.F:34