OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_i20normf.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_i20normf ../engine/source/mpi/interfaces/spmd_i20normf.F
25!||--- called by ------------------------------------------------------
26!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../engine/share/message_module/message_mod.F
32!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
33!|| tri7box ../engine/share/modules/tri7box.F
34!||====================================================================
35 SUBROUTINE spmd_i20normf(
36 1 SOLIDN_NORMAL,SOLIDN_NORMAL_F,SOLIDN_NORMAL_FE,NIN ,IRLEN20 ,
37 2 ISLEN20 ,IRLEN20T ,ISLEN20T ,IRLEN20E,ISLEN20E,
38 3 NSV ,NLG ,ISLINS )
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE tri7box
43 USE message_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47 USE spmd_comm_world_mod, ONLY : spmd_comm_world
48#include "implicit_f.inc"
49C-----------------------------------------------
50C M e s s a g e P a s s i n g
51C-----------------------------------------------
52#include "spmd.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com01_c.inc"
57#include "task_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,
62 . IRLEN20E,ISLEN20E,NIN,
63 . NSV(*), NLG(*), ISLINS(2,*)
64 integer
65 . solidn_normal(3,*),
66 . solidn_normal_f(3,*), solidn_normal_fe(3,*)
67
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71#ifdef MPI
72 INTEGER P, L, ADD, NB, SIZ, LOC_PROC, I, NOD, IL, IL1, IL2,
73 . IDEB, N, MSGTYP, IERROR, MSGOFF,
74 . N1, N2, IALLOCS, IALLOCR, LEN20, LEN20E,
75 . debut, debute,
76 . status(mpi_status_size),
77 . adds(nspmd+1), addr(nspmd+1),
78 . req_si(nspmd),req_ri(nspmd),istocom
79 INTEGER ,DIMENSION(:), ALLOCATABLE :: BBUFS, BBUFR
80 DATA MSGOFF/164/
81C-----------------------------------------------
82C S o u r c e L i n e s
83C-----------------------------------------------
84 loc_proc = ispmd + 1
85 len20 = 3
86 len20e = 6
87 istocom=0
88C
89 iallocs = len20*islen20 + len20*islen20t + len20e*islen20e
90 ierror=0
91 IF(iallocs>0)
92 + ALLOCATE(bbufs(iallocs),stat=ierror)
93 IF(ierror/=0) THEN
94 CALL ancmsg(msgid=20,anmode=aninfo)
95 CALL arret(2)
96 END IF
97C
98 iallocr = len20*irlen20 + len20*irlen20t + len20e*irlen20e
99 ierror=0
100 IF(iallocr>0)
101 + ALLOCATE(bbufr(iallocr),stat=ierror)
102 IF(ierror/=0) THEN
103 CALL ancmsg(msgid=20,anmode=aninfo)
104 CALL arret(2)
105 END IF
106C
107C Receive
108C
109 l = 0
110 DO p = 1, nspmd
111 add = l+1
112 addr(p) = add
113 siz = 0
114 IF(p/=loc_proc)THEN
115 nb = nsnfi(nin)%P(p)
116 l = l + nb*len20
117C ajout partie edge pour type 20
118 nb = nsnfie(nin)%P(p)
119 l = l + nb*len20e
120 siz = l+1-add
121 IF(siz>0)THEN
122 msgtyp = msgoff
123 CALL mpi_irecv(
124 . bbufr(add),siz,mpi_integer,it_spmd(p),msgtyp,
125 . spmd_comm_world,req_ri(p),ierror )
126 ENDIF
127 ENDIF
128 ENDDO
129 addr(nspmd+1) = addr(nspmd)+siz
130 IF(l>0) THEN
131 istocom = 1
132 ENDIF
133C
134C Send
135C
136 debut=0
137 debute=0
138 l = 0
139 DO p = 1, nspmd
140 add = l+1
141 adds(p) = add
142 siz = 0
143 IF(p/=loc_proc)THEN
144 ideb = debut
145 nb = nsnsi(nin)%P(p)
146 DO i = 1, nb
147 n = nsvsi(nin)%P(ideb+i)
148 il = nsv(n)
149 nod = nlg(il)
150 bbufs(l+1) = solidn_normal(1,nod)
151 bbufs(l+2) = solidn_normal(2,nod)
152 bbufs(l+3) = solidn_normal(3,nod)
153 l = l + len20
154 ENDDO
155 debut=debut+nb
156C Extra Code for Type20 Edge
157C
158 nb = nsnsie(nin)%P(p)
159 ideb = debute
160 DO i = 1, nb
161 n = nsvsie(nin)%P(ideb+i)
162 il1 = islins(1,n)
163 nod = nlg(il1)
164 bbufs(l+1) = solidn_normal(1,nod)
165 bbufs(l+2) = solidn_normal(2,nod)
166 bbufs(l+3) = solidn_normal(3,nod)
167 il2 = islins(2,n)
168 nod = nlg(il2)
169 bbufs(l+4) = solidn_normal(1,nod)
170 bbufs(l+5) = solidn_normal(2,nod)
171 bbufs(l+6) = solidn_normal(3,nod)
172 l = l + len20e
173 ENDDO
174 debute=debute+nb
175C end i20 edge
176 siz = l+1-add
177 IF(siz>0)THEN
178 msgtyp = msgoff
179C BUFR : reception partie force et envoi partie vitesse
180 CALL mpi_isend(
181 . bbufs(add),siz,mpi_integer,it_spmd(p),msgtyp,
182 . spmd_comm_world,req_si(p),ierror )
183 ENDIF
184 ENDIF
185 ENDDO
186 adds(nspmd+1)=adds(nspmd)+siz
187C
188C Attente reception buffer et decompactage
189C
190 IF(istocom==1)THEN
191C
192 debut = 0
193 debute= 0
194C
195C Attente IRECV
196C
197 DO p = 1, nspmd
198 IF(addr(p+1)-addr(p)>0) THEN
199 CALL mpi_wait(req_ri(p),status,ierror)
200 l = addr(p)-1
201 nb = nsnfi(nin)%P(p)
202 IF(nb>0)THEN
203 ideb = debut
204 DO i = 1, nb
205 solidn_normal_f(1,i+ideb) = bbufr(l+1)
206 solidn_normal_f(2,i+ideb) = bbufr(l+2)
207 solidn_normal_f(3,i+ideb) = bbufr(l+3)
208 l = l + len20
209 ENDDO
210 debut = debut + nb
211 ENDIF
212C
213C Extra Code for Type20 Edge
214C
215 nb = nsnfie(nin)%P(p)
216 IF(nb>0)THEN
217 ideb = debute
218 DO i = 1, nb
219 n1 = 2*(i+ideb-1)+1
220 n2 = 2*(i+ideb)
221 solidn_normal_fe(1,n1) = bbufr(l+1)
222 solidn_normal_fe(2,n1) = bbufr(l+2)
223 solidn_normal_fe(3,n1) = bbufr(l+3)
224 solidn_normal_fe(1,n2) = bbufr(l+4)
225 solidn_normal_fe(2,n2) = bbufr(l+5)
226 solidn_normal_fe(3,n2) = bbufr(l+6)
227 l = l + len20e
228 ENDDO
229 debute = debute + nb
230 ENDIF
231C end extra for i20 edge
232 END IF
233 END DO
234 END IF
235C
236 IF(iallocr>0)THEN
237 DEALLOCATE(bbufr)
238 iallocr=0
239 END IF
240C
241C Attente ISEND
242C
243 DO p = 1, nspmd
244 IF(adds(p+1)-adds(p)>0) THEN
245 CALL mpi_wait(req_si(p),status,ierror)
246 ENDIF
247 ENDDO
248C
249 IF(iallocs>0)THEN
250 DEALLOCATE(bbufs)
251 iallocs=0
252 END IF
253C
254#endif
255 RETURN
256 END
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_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
message_mod
Definition message_mod.F:1249
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::nsnfie
type(int_pointer), dimension(:), allocatable nsnfie
Definition tri7box.F:440
tri7box::nsnsie
type(int_pointer), dimension(:), allocatable nsnsie
Definition tri7box.F:491
tri7box::nsvsie
type(int_pointer), dimension(:), allocatable nsvsie
Definition tri7box.F:485
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
spmd_i20normf
subroutine spmd_i20normf(solidn_normal, solidn_normal_f, solidn_normal_fe, nin, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, nsv, nlg, islins)
Definition spmd_i20normf.F:39
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87