OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_gatheritab_crk.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_crk ../engine/source/mpi/anim/spmd_gatheritab_crk.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_routtines.c
29!||--- uses -----------------------------------------------------
30!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
31!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
32!||====================================================================
33 SUBROUTINE spmd_gatheritab_crk(ICRK,NUM,IDMAXNOD,NODGLOBXFE)
34C-----------------------------------------------
35 USE crackxfem_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39 USE spmd_comm_world_mod, ONLY : spmd_comm_world
40#include "implicit_f.inc"
41#include "spmd.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "task_c.inc"
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER ICRK,NUM,IDMAXNOD,NODGLOBXFE(*)
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,STEP
58
59C Tableau utilise par proc 0
60 INTEGER, DIMENSION(:,:),ALLOCATABLE :: IBUF
61 INTEGER, DIMENSION(:),ALLOCATABLE :: XGLOB
62C-----------------------------------------------
63 DATA msgoff/7068/
64C-----------------------------------------------
65 ALLOCATE(ibuf(2,ncrknodg))
66 ALLOCATE(xglob(num))
67
68 IF(ispmd /= 0)THEN
69 siz = 0
70 step = 0
71 DO i=1,crknod(icrk)%CRKNUMNODS
72 siz = siz + 1
73 step = crknod(icrk)%CRKNUMNODS*(icrk-1)
74 ibuf(1,siz) = nodglobxfe(i+step)
75 ibuf(2,siz) = crknod(icrk)%XFECRKNODID(i)+idmaxnod
76 END DO
77C
78 msgtyp = msgoff
79 CALL mpi_send(ibuf,2*siz,mpi_integer,it_spmd(1),msgtyp,
80 . spmd_comm_world,ierror)
81 ELSE
82C proc 0
83 step = 0
84 DO i=1,crknod(icrk)%CRKNUMNODS
85 step = crknod(icrk)%CRKNUMNODS*(icrk-1)
86 ng = nodglobxfe(i+step)
87 xglob(ng) = crknod(icrk)%XFECRKNODID(i)+idmaxnod
88cc CALL WRITE_I_C(XGLOB(NG),1)
89 ENDDO
90C all the rest procs
91 DO i=2,nspmd
92C Reception du buffer entier des adresses NODGLOB
93 msgtyp = msgoff
94 CALL mpi_probe(it_spmd(i),msgtyp,
95 . spmd_comm_world,status,ierror)
96 CALL mpi_get_count(status,mpi_integer,siz,ierror)
97 CALL mpi_recv(ibuf,siz,mpi_integer,it_spmd(i),msgtyp,
98 . spmd_comm_world,status,ierror)
99C
100 nrec = siz/2
101 DO k = 1, nrec
102 ng = ibuf(1,k)
103 xglob(ng) = ibuf(2,k)
104cc CALL WRITE_I_C(XGLOB(NG),1)
105 ENDDO
106 ENDDO ! DO I=2,NSPMD
107cc CALL WRITE_I_C(XGLOB,NUM)
108C
109 DO i=1,ncrknodg
110 k=i+ncrknodg*(icrk-1)
111 CALL write_i_c(xglob(k),1)
112 ENDDO
113C
114 ENDIF
115C
116 DEALLOCATE(ibuf)
117 DEALLOCATE(xglob)
118#endif
119 RETURN
120 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, anin, 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:239
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
type(xfem_nodes_), dimension(:), allocatable crknod
subroutine spmd_gatheritab_crk(icrk, num, idmaxnod, nodglobxfe)
void write_i_c(int *w, int *len)