OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_fxb_for_pon.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#ifdef MPI
24!||====================================================================
25!|| spmd_fxb_for_pon ../engine/source/mpi/kinematic_conditions/spmd_fxb_for_pon.f
26!||--- called by ------------------------------------------------------
27!|| fxbyfor ../engine/source/constraints/fxbody/fxbyfor.F
28!||--- uses -----------------------------------------------------
29!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
30!||====================================================================
31 SUBROUTINE spmd_fxb_for_pon(FXBIPM, MFEXTP, FSKYFXB, DSKY, IADN)
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35 USE spmd_comm_world_mod, ONLY : spmd_comm_world
36#include "implicit_f.inc"
37C-----------------------------------------------------------------
38C M e s s a g e P a s s i n g
39C-----------------------------------------------
40#include "spmd.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com01_c.inc"
45#include "com04_c.inc"
46#include "fxbcom.inc"
47#include "task_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER FXBIPM(NBIPM,*), DSKY, IADN(*)
52 my_real
53 . mfextp(*), fskyfxb(dsky,*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57#ifdef MPI
58 INTEGER NFX, NMOD, NME, NSN, NVAR, PMAIN, IAD, NSNT, I, J, JJ,
59 . ITAG, MSGOFF, NSNP(NSPMD-1), NSNPMAX, LEN, K, KK, AVAR,
60 . IERR, REQ(NSPMD-1), STAT(MPI_STATUS_SIZE,NSPMD-1),
61 . II
62 my_real
63 . , DIMENSION(:,:), ALLOCATABLE :: fskyl, fskyp
64C
65 DATA msgoff /197/
66C
67 DO nfx=1,nfxbody
68 nmod=fxbipm(4,nfx)
69 nme=fxbipm(17,nfx)
70 nsn=fxbipm(18,nfx)
71 avar=fxbipm(13,nfx)
72 pmain=fxbipm(39,nfx)
73 iad=iadn(nfx)
74 IF (ispmd==pmain) THEN
75 nsnt=fxbipm(40,nfx)
76 ALLOCATE(fskyl(nsnt,nme+nmod))
77 DO i=1,nme+nmod
78 DO j=1,nsn
79 jj=nint(fskyfxb(iad+j,1))
80 fskyl(jj,i)=fskyfxb(iad+j,1+i)
81 ENDDO
82 ENDDO
83C
84 ii=0
85 DO i=1,nspmd
86 IF (ispmd==i-1) cycle
87 ii=ii+1
88 itag=msgoff
89 CALL mpi_irecv(nsnp(ii), 1, mpi_integer, it_spmd(i),
90 . itag, spmd_comm_world, req(ii), ierr)
91 ENDDO
92 CALL mpi_waitall(nspmd-1, req, stat, ierr)
93C
94 nsnpmax=0
95 DO i=1,nspmd-1
96 nsnpmax=max(nsnpmax,nsnp(i))
97 ENDDO
98 ALLOCATE(fskyp(nsnpmax*(1+nme+nmod),nspmd-1))
99 ii=0
100 DO i=1,nspmd
101 IF (ispmd==i-1) cycle
102 ii=ii+1
103 itag=msgoff
104 len=nsnp(ii)*(1+nme+nmod)
105 CALL mpi_irecv(fskyp(1,ii), len, real, it_spmd(i),
106 . itag, spmd_comm_world, req(ii), ierr)
107 ENDDO
108 CALL mpi_waitall(nspmd-1, req, stat, ierr)
109C
110 DO i=1,nspmd-1
111 DO j=1,nme+nmod
112 jj=j*nsnp(i)
113 DO k=1,nsnp(i)
114 kk=nint(fskyp(k,i))
115 fskyl(kk,j)=fskyp(jj+k,i)
116 ENDDO
117 ENDDO
118 ENDDO
119 DEALLOCATE(fskyp)
120C
121 DO i=1,nme+nmod
122 mfextp(avar+i-1)=zero
123 DO j=1,nsnt
124 mfextp(avar+i-1)=mfextp(avar+i-1)+fskyl(j,i)
125 ENDDO
126 ENDDO
127 DEALLOCATE(fskyl)
128 ELSE
129 itag=msgoff
130 CALL mpi_isend(nsn, 1, mpi_integer, it_spmd(pmain+1),
131 . itag, spmd_comm_world, req(1), ierr)
132 CALL mpi_wait(req, stat, ierr)
133C
134 ALLOCATE(fskyl(nsn,1+nme+nmod))
135 DO i=1,1+nme+nmod
136 DO j=1,nsn
137 fskyl(j,i)=fskyfxb(iad+j,i)
138 ENDDO
139 ENDDO
140 len=nsn*(1+nme+nmod)
141 itag=msgoff
142 CALL mpi_isend(fskyl, len, real, it_spmd(pmain+1),
143 . itag, spmd_comm_world, req(1), ierr)
144 CALL mpi_wait(req, stat, ierr)
145C
146 DEALLOCATE(fskyl)
147 ENDIF
148 ENDDO
149C
150#endif
151 RETURN
152 END
153
154
155
156#elif 1
157
158
159C version simplifiee pour mono non SPMD
160!||====================================================================
161!|| spmd_fxb_for_pon ../engine/source/mpi/kinematic_conditions/spmd_fxb_for_pon.F
162!||--- called by ------------------------------------------------------
163!|| fxbyfor ../engine/source/constraints/fxbody/fxbyfor.F
164!||--- uses -----------------------------------------------------
165!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
166!||====================================================================
167 SUBROUTINE spmd_fxb_for_pon(FXBIPM, MFEXTP, FSKYFXB, DSKY, IADN)
168C-----------------------------------------------
169C I m p l i c i t T y p e s
170C-----------------------------------------------
171 USE spmd_comm_world_mod, ONLY : spmd_comm_world
172#include "implicit_f.inc"
173C-----------------------------------------------
174C C o m m o n B l o c k s
175C-----------------------------------------------
176#include "com04_c.inc"
177#include "fxbcom.inc"
178C-----------------------------------------------
179C D u m m y A r g u m e n t s
180C-----------------------------------------------
181 INTEGER FXBIPM(NBIPM,*), DSKY, IADN(*)
182 my_real
183 . mfextp(*), fskyfxb(dsky,*)
184C-----------------------------------------------
185C L o c a l V a r i a b l e s
186C-----------------------------------------------
187 INTEGER NFX, NMOD, NME, NSN, NVAR, IAD, I, J, JJ,
188 . ITAG, AVAR
189 my_real
190 . , DIMENSION(:,:), ALLOCATABLE :: fskyl
191C
192 DO nfx=1,nfxbody
193 nmod=fxbipm(4,nfx)
194 nme=fxbipm(17,nfx)
195 nsn=fxbipm(18,nfx)
196 avar=fxbipm(13,nfx)
197 iad=iadn(nfx)
198 ALLOCATE(fskyl(nsn,nme+nmod))
199 DO i=1,nme+nmod
200 DO j=1,nsn
201 jj=nint(fskyfxb(iad+j,1))
202 fskyl(jj,i)=fskyfxb(iad+j,1+i)
203 ENDDO
204 ENDDO
205C
206 DO i=1,nme+nmod
207 mfextp(avar+i-1)=zero
208 DO j=1,nsn
209 mfextp(avar+i-1)=mfextp(avar+i-1)+fskyl(j,i)
210 ENDDO
211 ENDDO
212 DEALLOCATE(fskyl)
213 ENDDO
214 RETURN
215 END
216
217
218C
219
220#endif
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
mpi_waitall
subroutine mpi_waitall(cnt, array_of_requests, status, ierr)
Definition mpi.f:536
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
spmd_fxb_for_pon
subroutine spmd_fxb_for_pon(fxbipm, mfextp, fskyfxb, dsky, iadn)
Definition spmd_fxb_for_pon.F:168