OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_state_inimap2d_exch_data.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_state_inimap2d_exch_data ()

Function/Subroutine Documentation

◆ spmd_state_inimap2d_exch_data()

subroutine spmd_state_inimap2d_exch_data

Definition at line 33 of file spmd_state_inimap2d_exch_data.F.

34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
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,NG,NREC,MSGOFF2,IDOM,IPOS
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, 3 + 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 buff_r(i,2) = state_inimap_buf(1)%POS2_CENTROIDS(i)
79 buff_r(i,3) = state_inimap_buf(1)%CELL_IDS(i)
80 k=3
81 DO j=1,nbmat
82 k=k+1
83 buff_r(i,k) = state_inimap_buf(1)%SUBMAT(j)%VFRAC(i)
84 k=k+1
85 buff_r(i,k) = state_inimap_buf(1)%SUBMAT(j)%RHO(i)
86 k=k+1
87 buff_r(i,k) = state_inimap_buf(1)%SUBMAT(j)%E(i)
88 k=k+1
89 buff_r(i,k) = state_inimap_buf(1)%SUBMAT(j)%PRES(i)
90 ENDDO
91 ENDDO
92 msgtyp = msgoff
93 siz = ncell*(3+4*nbmat)
94 CALL mpi_send(buff_r, siz, real,it_spmd(1),msgtyp,spmd_comm_world,ierror)
95 IF(ALLOCATED(buff_r))DEALLOCATE(buff_r)
96 ELSE
97 DO i=2,nspmd
98 ! Reception du buffer flottant double des adresses DATA_I
99 msgtyp = msgoff
100 ncell = state_inimap_buf(i)%NUM_CENTROIDS
101 nbmat = state_inimap_buf(i)%NSUBMAT
102 siz = ncell*(3+4*nbmat)
103 !IF(SIZ == 0)CYCLE
104 ALLOCATE (buff_r(ncell, 3+4*nbmat ))
105 CALL mpi_recv(buff_r,siz,real,it_spmd(i),msgtyp,spmd_comm_world,status,ierror)
106 ALLOCATE(state_inimap_buf(i)%CELL_IDS(ncell))
107 ALLOCATE(state_inimap_buf(i)%POS_CENTROIDS(ncell))
108 ALLOCATE(state_inimap_buf(i)%POS2_CENTROIDS(ncell))
109 ALLOCATE(state_inimap_buf(i)%SUBMAT(nbmat))
110 DO j=1,nbmat
111 ALLOCATE(state_inimap_buf(i)%SUBMAT(j)%VFRAC(ncell))
112 ALLOCATE(state_inimap_buf(i)%SUBMAT(j)%RHO(ncell))
113 ALLOCATE(state_inimap_buf(i)%SUBMAT(j)%E(ncell))
114 ALLOCATE(state_inimap_buf(i)%SUBMAT(j)%PRES(ncell))
115 ENDDO
116 DO l=1,ncell
117 state_inimap_buf(i)%POS_CENTROIDS(l) = buff_r(l,1)
118 state_inimap_buf(i)%POS2_CENTROIDS(l) = buff_r(l,2)
119 state_inimap_buf(i)%CELL_IDS(l) = buff_r(l,3)
120 k=3
121 DO j=1,nbmat
122 k=k+1
123 state_inimap_buf(i)%SUBMAT(j)%VFRAC(l) = buff_r(l,k)
124 k=k+1
125 state_inimap_buf(i)%SUBMAT(j)%RHO(l) = buff_r(l,k)
126 k=k+1
127 state_inimap_buf(i)%SUBMAT(j)%E(l) = buff_r(l,k)
128 k=k+1
129 state_inimap_buf(i)%SUBMAT(j)%PRES(l) = buff_r(l,k)
130 ENDDO
131 ENDDO
132 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
133 ENDDO !next I=2,NSPMD
134 ENDIF
135
136 !------------------------!
137 !---EXCHANGE VEL
138 !------------------------!
139 IF (ispmd /= 0) THEN
140 npts = state_inimap_buf(1)%NUM_POINTS
141 ALLOCATE (buff_r(npts,5))
142 DO i=1,npts
143 buff_r(i,1) = state_inimap_buf(1)%POS_NODES(i)
144 buff_r(i,2) = state_inimap_buf(1)%POS2_NODES(i)
145 buff_r(i,3) = state_inimap_buf(1)%VEL_NODES(i)
146 buff_r(i,4) = state_inimap_buf(1)%VEL2_NODES(i)
147 buff_r(i,5) = state_inimap_buf(1)%NODE_IDS(i)
148 ENDDO
149 msgtyp = msgoff
150 siz = 5*npts
151 CALL mpi_send(buff_r, siz, real,it_spmd(1),msgtyp,spmd_comm_world,ierror)
152 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
153 !deallocate useless data once sent
154 nbmat=state_inimap_buf(1)%NSUBMAT
155 DO j=1,nbmat
156 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(j)%VFRAC))DEALLOCATE(state_inimap_buf(1)%SUBMAT(j)%VFRAC)
157 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(j)%RHO ))DEALLOCATE(state_inimap_buf(1)%SUBMAT(j)%RHO)
158 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(j)%E ))DEALLOCATE(state_inimap_buf(1)%SUBMAT(j)%E)
159 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(j)%PRES))DEALLOCATE(state_inimap_buf(1)%SUBMAT(j)%PRES)
160 ENDDO
161 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT ))DEALLOCATE(state_inimap_buf(1)%SUBMAT)
162 IF(ALLOCATED(state_inimap_buf(1)%POS_NODES ))DEALLOCATE(state_inimap_buf(1)%POS_NODES)
163 IF(ALLOCATED(state_inimap_buf(1)%POS2_NODES ))DEALLOCATE(state_inimap_buf(1)%POS2_NODES)
164 IF(ALLOCATED(state_inimap_buf(1)%VEL_NODES ))DEALLOCATE(state_inimap_buf(1)%VEL_NODES)
165 IF(ALLOCATED(state_inimap_buf(1)%VEL2_NODES ))DEALLOCATE(state_inimap_buf(1)%VEL2_NODES)
166 IF(ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS ))DEALLOCATE(state_inimap_buf(1)%POS_CENTROIDS)
167 IF(ALLOCATED(state_inimap_buf(1)%POS2_CENTROIDS))DEALLOCATE(state_inimap_buf(1)%POS2_CENTROIDS)
168 IF(ALLOCATED(state_inimap_buf(1)%NODE_IDS ))DEALLOCATE(state_inimap_buf(1)%NODE_IDS)
169 ELSE
170 npts = state_inimap_buf(1)%NUM_POINTS
171 DO i=2,nspmd
172 ! Reception du buffer flottant double des adresses DATA_I
173 msgtyp = msgoff
174 npts = state_inimap_buf(i)%NUM_POINTS
175 siz = 5*npts
176 ALLOCATE (buff_r(npts, 5 ))
177 CALL mpi_recv(buff_r,siz,real,it_spmd(i),msgtyp,spmd_comm_world,status,ierror)
178 ALLOCATE(state_inimap_buf(i)%POS_NODES(npts))
179 ALLOCATE(state_inimap_buf(i)%POS2_NODES(npts))
180 ALLOCATE(state_inimap_buf(i)%VEL_NODES(npts))
181 ALLOCATE(state_inimap_buf(i)%VEL2_NODES(npts))
182 ALLOCATE(state_inimap_buf(i)%NODE_IDS(npts))
183 DO l=1,npts
184 state_inimap_buf(i)%POS_NODES(l) = buff_r(l,1)
185 state_inimap_buf(i)%POS2_NODES(l) = buff_r(l,2)
186 state_inimap_buf(i)%VEL_NODES(l) = buff_r(l,3)
187 state_inimap_buf(i)%VEL2_NODES(l) = buff_r(l,4)
188 state_inimap_buf(i)%NODE_IDS(l) = buff_r(l,5)
189 ENDDO
190 IF(ALLOCATED(buff_r))DEALLOCATE (buff_r)
191 ENDDO !next I=2,NSPMD
192 ENDIF
193
194C-----------------------------------------------
195#endif
196 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
type(map_struct), dimension(:), allocatable state_inimap_buf