OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_collect_multi_fvm.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_collect_multi_fvm ../engine/source/mpi/output/spmd_collect_multi_fvm.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| double_array_checksum ../engine/source/mpi/output/node_checksum.F
29!|| my_orders ../common_source/tools/sort/my_orders.c
30!||--- uses -----------------------------------------------------
31!|| checksum_mod ../engine/source/mpi/output/node_checksum.F
32!|| debug_mod ../engine/share/modules/debug_mod.F
33!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
34!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.f90
35!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
36!||====================================================================
37 SUBROUTINE spmd_collect_multi_fvm(IXS,MULTI_FVM,FLAG)
38!$COMMENT
39! SPMD_COLLECT_MULTI_FVM description
40! creation of a file with hexa values of MULTI_FVM%VEL
41!
42! SPMD_COLLECT_MULTI_FVM organization :
43! * gather of MULTI_FVM values on the main processor
44! * sorting of the value according the global user ID of the
45! element
46! * creation of the *.adb file
47!
48!$ENDCOMMENT
49 USE checksum_mod, ONLY : double_array_checksum
50 USE inoutfile_mod
51 USE debug_mod
52 USE multi_fvm_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56 USE spmd_comm_world_mod, ONLY : spmd_comm_world
57#include "implicit_f.inc"
58C-----------------------------------------------------------------
59C M e s s a g e P a s s i n g
60C-----------------------------------------------
61#include "spmd.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "task_c.inc"
68#include "spmd_c.inc"
69#include "chara_c.inc"
70#include "units_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER, DIMENSION(NIXS,*), INTENT(in) :: IXS
75 TYPE(multi_fvm_struct), INTENT(INOUT) :: MULTI_FVM
76 INTEGER,INTENT(in) :: FLAG ! 1: write the file ; 2 compute the checksum
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER MSGOFF,MSGOFF0,MSGTYP,INFO,I,K,NG,N,
81 . EMPL,FILEN
82 CHARACTER FILNAM*100,CYCLENUM*7
83 INTEGER :: LEN_TMP_NAME,SHIFT
84 CHARACTER(len=2148) :: TMP_NAME
85 INTEGER, DIMENSION(NSPMD) :: SIZE_NUMELS
86 INTEGER, DIMENSION(:), ALLOCATABLE :: SDNODG
87 DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: AGLOB,RECGLOB
88 DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: RECGLOB_ORDERED
89 ! array for sorting
90 INTEGER, DIMENSION(:), ALLOCATABLE :: ITRI,WORK,INDEX_TRI
91 INTEGER ::CHECKSUM
92
93
94#ifdef MPI
95 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
96
97 DATA msgoff0/176/
98 DATA msgoff/177/
99#endif
100C-----------------------------------------------
101C S o u r c e L i n e s
102C-----------------------------------------------
103 IF(ispmd==0) THEN
104 ALLOCATE( sdnodg(numelsg) )
105 ALLOCATE( recglob(4,numelsg) )
106 ELSE
107 ALLOCATE( sdnodg(numels) )
108 ALLOCATE( recglob(0,0) )
109 ALLOCATE( aglob(4,numels) )
110 ENDIF
111
112 size_numels(1:nspmd) = 0
113#ifdef MPI
114 IF (ispmd/=0) THEN
115
116 DO i = 1,numels
117! SDNODG(I) = IXS(NIXS,I)
118 aglob(1,i) = ixs(nixs,i)
119 aglob(2,i) = multi_fvm%VEL(1,i)
120 aglob(3,i) = multi_fvm%VEL(2,i)
121 aglob(4,i) = multi_fvm%VEL(3,i)
122 ENDDO
123
124 msgtyp=msgoff0
125 CALL mpi_send(numels,1,mpi_integer,
126 . it_spmd(1),msgtyp,
127 . spmd_comm_world,ierror)
128
129 msgtyp=msgoff
130 CALL mpi_send(aglob,4*numels,mpi_double_precision,
131 . it_spmd(1),msgtyp,
132 . spmd_comm_world,ierror)
133 ELSE
134 size_numels(1) = numels
135 DO k=2,nspmd
136 msgtyp=msgoff0
137 CALL mpi_recv(size_numels(k),1,mpi_integer,
138 . it_spmd(k),msgtyp,
139 . spmd_comm_world,status,ierror)
140
141 ALLOCATE( aglob(4,size_numels(k)) )
142
143 msgtyp=msgoff
144 CALL mpi_recv(aglob,4*size_numels(k),mpi_double_precision,
145 . it_spmd(k),msgtyp,
146 . spmd_comm_world,status,ierror)
147
148 shift = 0
149 DO i=1,k-1
150 shift = shift + size_numels(i)
151 ENDDO
152 DO i=1,size_numels(k)
153 recglob(1,i+shift) = aglob(1,i)
154 recglob(2,i+shift) = aglob(2,i)
155 recglob(3,i+shift) = aglob(3,i)
156 recglob(4,i+shift) = aglob(4,i)
157 ENDDO
158 DEALLOCATE( aglob )
159 END DO
160 ENDIF
161#endif
162C
163
164 IF(ispmd==0) THEN
165
166 DO i=1,numels
167 n = ixs(nixs,i)
168 recglob(1,i) = ixs(nixs,i)
169 recglob(2,i) = multi_fvm%VEL(1,i)
170 recglob(3,i) = multi_fvm%VEL(2,i)
171 recglob(4,i) = multi_fvm%VEL(3,i)
172 ENDDO
173
174 ALLOCATE( itri(numelsg) )
175 ALLOCATE( index_tri(2*numelsg) )
176 ALLOCATE( work(70000) )
177 DO i=1,numelsg
178 index_tri(i) = i
179 itri(i) = nint(recglob(1,i))
180 ENDDO
181
182 CALL my_orders(0,work,itri,index_tri,numelsg,1)
183
184 IF(flag == 2) THEN
185 ALLOCATE(recglob_ordered(4,numelsg))
186 DO i = 1, numelsg
187 n = index_tri(i)
188 recglob_ordered(1,i) = recglob(1,n)
189 recglob_ordered(2,i) = recglob(2,n)
190 recglob_ordered(3,i) = recglob(3,n)
191 recglob_ordered(4,i) = recglob(4,n)
192 END DO
193 checksum = double_array_checksum(recglob_ordered,numelsg,4)
194 WRITE(iout,*) ncycle, "MULTI_FVM CHECKSUM:",checksum
195 DEALLOCATE( recglob_ordered)
196 ELSE IF(flag == 1) THEN
197 WRITE(cyclenum,'(I7.7)')ncycle
198 filnam=rootnam(1:rootlen)//'_FVM_'//chrun//'_'//cyclenum//'.adb'
199
200 len_tmp_name = outfile_name_len + len_trim(filnam)
201 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
202
203 OPEN(unit=idbg5,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',
204 . form='FORMATTED',status='UNKNOWN')
205
206 filen = rootlen+17
207
208 DO i = 1, numelsg
209 n = index_tri(i)
210 WRITE(idbg5,'(A,I10,I10,Z20,Z20,Z20)' ) '>',ncycle,nint(recglob(1,n)),recglob(2,n),recglob(3,n),recglob(4,n)
211 END DO
212 WRITE (iout,1300) filnam(1:filen)
213 WRITE (istdo,1300) filnam(1:filen)
214 CLOSE(unit=idbg5)
215 ENDIF
216
217 DEALLOCATE( itri )
218 DEALLOCATE( index_tri )
219 DEALLOCATE( work )
220
221 END IF
222
223 IF(ALLOCATED(sdnodg)) DEALLOCATE( sdnodg )
224 IF(ALLOCATED(recglob)) DEALLOCATE( recglob )
225 IF(ALLOCATED(aglob)) DEALLOCATE( aglob )
226C
227 1300 FORMAT (4x,' debug analysis fvm file :',1X,A,' written')
228 RETURN
229 END SUBROUTINE SPMD_COLLECT_MULTI_FVM
230
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
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
checksum_mod
Definition node_checksum.F:30
checksum_mod::double_array_checksum
integer function double_array_checksum(a, siz1, siz2)
Definition node_checksum.F:53
debug_mod
Definition debug_mod.F:45
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::outfile_name
character(len=outfile_char_len) outfile_name
Definition inoutfile_mod.F:111
inoutfile_mod::outfile_name_len
integer outfile_name_len
Definition inoutfile_mod.F:109
spmd_collect_multi_fvm
subroutine spmd_collect_multi_fvm(ixs, multi_fvm, flag)
Definition spmd_collect_multi_fvm.F:38