OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_state_inimap1d_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_inimap1d_exch_data ()

Function/Subroutine Documentation

◆ spmd_state_inimap1d_exch_data()

subroutine spmd_state_inimap1d_exch_data

Definition at line 33 of file spmd_state_inimap1d_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, 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 du buffer flottant double des adresses DATA_I
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 du buffer flottant double des adresses DATA_I
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
#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