OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_gatheritab.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_gatheritab ../engine/source/mpi/anim/spmd_gatheritab.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.f
27!||--- calls -----------------------------------------------------
28!|| write_i_c ../common_source/tools/input_output/write_routines.c
29!||--- uses -----------------------------------------------------
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!||====================================================================
32 SUBROUTINE spmd_gatheritab(V,WEIGHT,NODGLOB,NUM)
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36 USE spmd_comm_world_mod, ONLY : spmd_comm_world
37#include "implicit_f.inc"
38#include "spmd.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "com01_c.inc"
43#include "com04_c.inc"
44#include "task_c.inc"
45#include "spmd_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 integer
50 . v(*)
51 INTEGER WEIGHT(*),NODGLOB(*),NUM
52C-----------------------------------------------
53C L O C A L V A R I A B L E S
54C-----------------------------------------------
55#ifdef MPI
56 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
57 INTEGER SIZ,MSGTYP,I,K,NG,NREC,MSGOFF2
58
59 INTEGER, DIMENSION(:,:) , ALLOCATABLE :: BUFSR
60 INTEGER, DIMENSION(:) , ALLOCATABLE :: XGLOB
61C-----------------------------------------------
62 DATA msgoff/7018/
63 DATA msgoff2/7019/
64
65
66C-----------------------------------------------
67 ALLOCATE(bufsr(2,numnodm))
68 ALLOCATE(xglob(num))
69C-----------------------------------------------
70 IF (ispmd/=0) THEN
71
72 siz = 0
73 DO i=1,numnod
74 IF (weight(i)==1) THEN
75 siz = siz + 1
76 bufsr(1,siz) = nodglob(i)
77 bufsr(2,siz) = v(i)
78 END IF
79 END DO
80
81
82 msgtyp = msgoff
83 CALL mpi_send(bufsr,2*siz,mpi_integer,it_spmd(1),msgtyp,
84 . spmd_comm_world,ierror)
85
86 ELSE
87 DO i=1,numnod
88 IF (weight(i)==1) THEN
89 ng = nodglob(i)
90 xglob(ng) = v(i)
91 ENDIF
92 ENDDO
93
94 DO i=2,nspmd
95
96C reception of the entire buffer of NODGLOB addresses
97 msgtyp = msgoff
98
99 CALL mpi_probe(it_spmd(i),msgtyp,
100 . spmd_comm_world,status,ierror)
101 CALL mpi_get_count(status,mpi_integer,siz,ierror)
102
103 CALL mpi_recv(bufsr,siz,mpi_integer,it_spmd(i),msgtyp,
104 . spmd_comm_world,status,ierror)
105
106 nrec = siz/2
107
108 DO k = 1, nrec
109 ng = bufsr(1,k)
110 xglob(ng) = bufsr(2,k)
111 ENDDO
112 ENDDO
113 CALL write_i_c(xglob,numnodg)
114
115 ENDIF
116 DEALLOCATE(bufsr)
117 DEALLOCATE(xglob)
118
119#endif
120 RETURN
121 END
subroutine genani(x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, swaft, smas, sxnorm, siad, iparg, pm, geo, ms, sinvert, cont, smater, icut, skew, xcut, fint, itab, sel2fa, fext, fopt, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, mat_param, dd_iad, weight, eani, ipart, cluster, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, rby, swa4, tors, nom_opt, igrsurf, bufsf, idata, rdata, siadg, bufmat, bufgeo, kxx, ixx, ipartx, suix, sxusr, snfacptx, sixedge, sixfacet, sixsolid, snumx1, snumx2, snumx3, soffx1, soffx2, soffx3, smass1, smass2, smass3, sfunc1, sfunc2, sfunc3, kxsp, ixsp, nod2sp, ipartsp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, iflow, rflow, fncont, ftcont, temp, thke, err_thk_sh4, err_thk_sh3, diag_sms, ipari, fncont2, dr, ale_connectivity, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, dxancg, nod_pxfem, iel_pxfem, zi_ply, vgaz, fcontg, fncontg, ftcontg, fanreac, inod_crk, iel_crk, elcutc, iadc_crk, pdama2, res_sms, weight_md, nodglobxfe, nodedge, fcluster, mcluster, xfem_tab, w, nv46, ipartig3d, kxig3d, ixig3d, sig3dsolid, knot, wige, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, igrnod, h3d_data, subset, multi_fvm, knotlocpc, knotlocel, fcont_max, fncontp2, ftcontp2, glob_therm, drape_sh4n, drape_sh3n, drapeg, output)
Definition genani.F:240
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
subroutine mpi_get_count(status, datatype, cnt, ierr)
Definition mpi.f:296
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
subroutine mpi_probe(source, tag, comm, status, ierr)
Definition mpi.f:449
subroutine spmd_gatheritab(v, weight, nodglob, num)
void write_i_c(int *w, int *len)