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