OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_state_inimap1d_exch_data.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_state_inimap1d_exch_data ../engine/source/output/sta/spmd_state_inimap1d_exch_data.F
25!||--- called by ------------------------------------------------------
26!|| stat_inimap1d_file_spmd ../engine/source/output/sta/stat_inimap1d_file_spmd.F
27!|| stat_inimap1d_spmd ../engine/source/output/sta/stat_inimap1d_spmd.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!|| state_inimap_mod ../engine/share/modules/state_inimap_mod.F
32!||====================================================================
33 SUBROUTINE spmd_state_inimap1d_exch_data()
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE state_inimap_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"
43#include "spmd.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com01_c.inc"
48#include "task_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52C
53C-----------------------------------------------
54C L O C A L V A R I A B L E S
55C-----------------------------------------------
56#ifdef MPI
57 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
58 INTEGER SIZ,MSGTYP,I,J,K,L
59 INTEGER NCELL, NPTS, NBMAT
60
61 DATA msgoff/10002/
62
63 my_real, ALLOCATABLE,DIMENSION(:,:) :: buff_r
64C-----------------------------------------------
65C S o u r c e L i n e s
66C-----------------------------------------------
67
68 !------------------------!
69 !---EXCHANGE DATA CELL
70 !------------------------!
71 IF (ispmd/=0) THEN
72 ncell = state_inimap_buf(1)%NUM_CENTROIDS
73 nbmat = state_inimap_buf(1)%NSUBMAT
74 ALLOCATE (buff_r(ncell, 1 + 4*nbmat))
75 !1:abscissa ; 2,3,4 vfrac_i, rho_i, E_i ; ...Etc
76 DO i=1,ncell
77 buff_r(i,1) = state_inimap_buf(1)%POS_CENTROIDS(i)
78 k=1
79 DO j=1,nbmat
80 k=k+1
81 buff_r(i,k) = state_inimap_buf(1)%SUBMAT(j)%VFRAC(i)
82 k=k+1
83 buff_r(i,k) = state_inimap_buf(1)%SUBMAT(j)%RHO(i)
84 k=k+1
85 buff_r(i,k) = state_inimap_buf(1)%SUBMAT(j)%E(i)
86 k=k+1
87 buff_r(i,k) = state_inimap_buf(1)%SUBMAT(j)%PRES(i)
88 ENDDO
89 ENDDO
90 msgtyp = msgoff
91 siz = ncell*(1+4*nbmat)
92 CALL mpi_send(buff_r, siz, real,it_spmd(1),msgtyp,spmd_comm_world,ierror)
93 IF(ALLOCATED(buff_r))DEALLOCATE(buff_r)
94 ELSE
95 ncell = state_inimap_buf(1)%NUM_CENTROIDS
96 DO i=2,nspmd
97 ! reception of the double-precision floating buffer of data_i addresses
98 msgtyp = msgoff
99 ncell = state_inimap_buf(i)%NUM_CENTROIDS
100 nbmat = state_inimap_buf(i)%NSUBMAT
101 siz = ncell*(1+4*nbmat)
102 ALLOCATE (buff_r(ncell, 1 + 4*nbmat ))
103 CALL mpi_recv(buff_r,siz,real,it_spmd(i),msgtyp,spmd_comm_world,status,ierror)
104 ALLOCATE(state_inimap_buf(i)%POS_CENTROIDS(ncell))
105 ALLOCATE(state_inimap_buf(i)%SUBMAT(nbmat))
106 DO j=1,nbmat
107 ALLOCATE(state_inimap_buf(i)%SUBMAT(j)%VFRAC(ncell))
108 ALLOCATE(state_inimap_buf(i)%SUBMAT(j)%RHO(ncell))
109 ALLOCATE(state_inimap_buf(i)%SUBMAT(j)%E(ncell))
110 ALLOCATE(state_inimap_buf(i)%SUBMAT(j)%PRES(ncell))
111 ENDDO
112 DO l=1,ncell
113 state_inimap_buf(i)%POS_CENTROIDS(l) = buff_r(l,1)
114 k=1
115 DO j=1,nbmat
116 k=k+1
117 state_inimap_buf(i)%SUBMAT(j)%VFRAC(l) = buff_r(l,k)
118 k=k+1
119 state_inimap_buf(i)%SUBMAT(j)%RHO(l) = buff_r(l,k)
120 k=k+1
121 state_inimap_buf(i)%SUBMAT(j)%E(l) = buff_r(l,k)
122 k=k+1
123 state_inimap_buf(i)%SUBMAT(j)%PRES(l) = buff_r(l,k)
124 ENDDO
125 ENDDO
126 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
127 ENDDO !next I=2,NSPMD
128 ENDIF
129
130 !------------------------!
131 !---EXCHANGE VEL
132 !------------------------!
133 IF (ispmd /= 0) THEN
134 npts = state_inimap_buf(1)%NUM_POINTS
135 ALLOCATE (buff_r(npts,2))
136 DO i=1,npts
137 buff_r(i,1) = state_inimap_buf(1)%POS_NODES(i)
138 buff_r(i,2) = state_inimap_buf(1)%VEL_NODES(i)
139 ENDDO
140 msgtyp = msgoff
141 siz = 2*npts
142 CALL mpi_send(buff_r, siz, real,it_spmd(1),msgtyp,spmd_comm_world,ierror)
143 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
144 !deallocate useless data once sent
145 nbmat=state_inimap_buf(1)%NSUBMAT
146 DO j=1,nbmat
147 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(j)%VFRAC))DEALLOCATE(state_inimap_buf(1)%SUBMAT(j)%VFRAC)
148 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(j)%RHO ))DEALLOCATE(state_inimap_buf(1)%SUBMAT(j)%RHO)
149 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(j)%E ))DEALLOCATE(state_inimap_buf(1)%SUBMAT(j)%E)
150 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(j)%PRES))DEALLOCATE(state_inimap_buf(1)%SUBMAT(j)%PRES)
151 ENDDO
152 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT ))DEALLOCATE(state_inimap_buf(1)%SUBMAT)
153 IF(ALLOCATED(state_inimap_buf(1)%POS_NODES ))DEALLOCATE(state_inimap_buf(1)%POS_NODES)
154 IF(ALLOCATED(state_inimap_buf(1)%VEL_NODES ))DEALLOCATE(state_inimap_buf(1)%VEL_NODES)
155 IF(ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS))DEALLOCATE(state_inimap_buf(1)%POS_CENTROIDS)
156 ELSE
157 npts = state_inimap_buf(1)%NUM_POINTS
158 DO i=1,npts
159 state_inimap_buf(1)%POS_NODES(i)=state_inimap_buf(1)%POS_NODES(i)
160 ENDDO
161 DO i=2,nspmd
162 ! reception of the double-precision floating buffer of data_i addresses
163 msgtyp = msgoff
164 npts = state_inimap_buf(i)%NUM_POINTS
165 siz = 2*npts
166 ALLOCATE (buff_r(npts, 2 ))
167 CALL mpi_recv(buff_r,siz,real,it_spmd(i),msgtyp,spmd_comm_world,status,ierror)
168 ALLOCATE(state_inimap_buf(i)%POS_NODES(npts))
169 ALLOCATE(state_inimap_buf(i)%VEL_NODES(npts))
170 DO l=1,npts
171 state_inimap_buf(i)%POS_NODES(l) = buff_r(l,1)
172 state_inimap_buf(i)%VEL_NODES(l) = buff_r(l,2)
173 ENDDO
174 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
175 ENDDO !next i=2,nspmd
176 ENDIF
177
178C-----------------------------------------------
179#endif
180 RETURN
181 END SUBROUTINE spmd_state_inimap1d_exch_data
my_real
#define my_real
Definition cppsort.cpp:32
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
state_inimap_mod
Definition state_inimap_mod.F:38
state_inimap_mod::state_inimap_buf
type(map_struct), dimension(:), allocatable state_inimap_buf
Definition state_inimap_mod.F:84
spmd_state_inimap1d_exch_data
subroutine spmd_state_inimap1d_exch_data()
Definition spmd_state_inimap1d_exch_data.F:34