OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_dynain.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!|| read_dynain ../engine/source/output/dynain/read_dynain.f
25!||--- called by ------------------------------------------------------
26!|| lectur ../engine/source/input/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| my_orders ../common_source/tools/sort/my_orders.c
31!|| spmd_gather_int ../engine/source/mpi/generic/spmd_gather_int.F
32!|| spmd_gatherv_int ../engine/source/mpi/generic/spmd_gatherv_int.F
33!||--- uses -----------------------------------------------------
34!|| element_mod ../common_source/modules/elements/element_mod.f90
35!|| message_mod ../engine/share/message_module/message_mod.f
36!|| state_mod ../common_source/modules/state_mod.f
37!||====================================================================
38 SUBROUTINE read_dynain(IPART,DYNAIN_DATA,IPARTC,IPARTTG,IXC,IXTG)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE state_mod
44 use element_mod , only : nixc,nixtg
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com04_c.inc"
53#include "units_c.inc"
54#include "scr16_c.inc"
55#include "scr17_c.inc"
56#include "task_c.inc"
57#include "com01_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER IPART(LIPART1,*), IXC(NIXC,*), IXTG(NIXTG,*),IPARTC(*), IPARTTG(*)
62 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,IDPRT,K_STAT,J,IP
67 INTEGER N ,NELC , NELTG , NELCG , NELTGG ,
68 . FLG_CHK , IS_CHECK , JWARN, NELMIN , NELMAX,
69 . MY_SIZEC ,MY_SIZETG ,IERR ,
70 . SIZEC_P0(NSPMD), SIZETG_P0(NSPMD) ,ADRC(NSPMD) ,
71 . ADRTG(NSPMD)
72C
73 INTEGER WORK(70000)
74 INTEGER , DIMENSION(:),ALLOCATABLE :: NELIDC ,NELIDTG,
75 . CLEFC ,CLEFTG ,INDXC ,INDXTG ,IDWARN ,NELIDCG ,
76 . NELIDTGG
77 my_real
78 . t0,dt0
79C-----------------------------------------------
80 ALLOCATE( dynain_data%IPART_DYNAIN(npart))
81 dynain_data%IPART_DYNAIN(1:npart) = 0
82 IF (dynain_data%NDYNAINPRT /= 0) THEN
83 DO i=1,dynain_data%NDYNAINPRT
84 READ(iin,'(I10)') idprt
85 ip=0
86 DO j=1,npart
87 IF(ipart(4,j)==idprt)ip=j
88 END DO
89 IF(ip==0)THEN
90 CALL ancmsg(msgid=290,anmode=aninfo,i1=idprt)
91 CALL arret(2)
92 END IF
93 dynain_data%IPART_DYNAIN(ip)=1
94 END DO
95 ELSEIF(dynain_data%NDYNAINALL /= 0) THEN
96 DO j=1,npart
97 dynain_data%IPART_DYNAIN(j) = 1
98 END DO
99 ENDIF
100
101C-------------------------------------------------------------------------------
102C CHECK FOR DYNAIN FILE OUTPUT : 3node shell and 4node shell have same ID
103C-------------------------------------------------------------------------------
104
105 IF(dynain_data%DYNAIN_CHECK == 0.AND.(dynain_data%NDYNAINPRT /=0 .OR.dynain_data%NDYNAINALL /= 0) ) THEN
106
107 nelc = 0
108 neltg = 0
109 nelcg = 0
110 neltgg = 0
111
112 IF(numelc/=0) ALLOCATE(nelidc(numelc),stat=ierr)
113 IF(numeltg/=0) ALLOCATE(nelidtg(numeltg),stat=ierr)
114
115 IF(dynain_data%NDYNAINALL /= 0) THEN
116
117 IF(numelc/=0)THEN
118 DO i=1,numelc
119 nelidc(i) = ixc(nixc,i)
120 ENDDO
121 nelc = numelc
122 ENDIF
123 IF(numeltg/=0)THEN
124 DO i=1,numeltg
125 nelidtg(neltg) = ixtg(nixtg,i)
126 ENDDO
127 neltg = numeltg
128 ENDIF
129
130 ELSE
131 nelc = 0
132 DO i=1,numelc
133 ip = ipartc(i)
134 IF(dynain_data%IPART_DYNAIN(ip)==1) THEN
135 nelc = nelc + 1
136 nelidc(nelc) = ixc(nixc,i)
137 ENDIF
138 ENDDO
139 neltg = 0
140 DO i=1,numeltg
141 ip = iparttg(i)
142 IF(dynain_data%IPART_DYNAIN(ip)==1) THEN
143 neltg = neltg + 1
144 nelidtg(neltg) = ixtg(nixtg,i)
145 ENDIF
146 ENDDO
147
148 ENDIF
149
150
151 IF (nspmd > 1) THEN
152
153
154 sizec_p0(1:nspmd) = 0
155 adrc(1:nspmd) = 0
156
157 ! send the local size of index to PROC0
158 my_sizec = nelc
159
160 CALL spmd_gather_int(my_sizec,sizec_p0,0,1,nspmd)
161
162 sizetg_p0(1:nspmd) = 0
163 adrtg(1:nspmd) = 0
164
165 my_sizetg = neltg
166
167 CALL spmd_gather_int(my_sizetg,sizetg_p0,0,1,nspmd)
168
169 nelcg = 0
170 IF(ispmd==0) THEN
171 adrc(1) = 0
172 DO i=1,nspmd-1
173 adrc(i+1) = adrc(i) + sizec_p0(i)
174 nelcg = nelcg + sizec_p0(i)
175 ENDDO
176 nelcg = nelcg + sizec_p0(nspmd)
177 ENDIF
178
179 neltgg = 0
180 IF(ispmd==0) THEN
181 adrtg(1) = 0
182 DO i=1,nspmd-1
183 adrtg(i+1) = adrtg(i) + sizetg_p0(i)
184 neltgg = neltgg + sizetg_p0(i)
185 ENDDO
186 neltgg = neltgg + sizetg_p0(nspmd)
187 ENDIF
188
189 ALLOCATE(nelidcg(nelcg),stat=ierr)
190 ALLOCATE(nelidtgg(neltgg),stat=ierr)
191
192 ! send the local NUMELC to PROC0
193
194 CALL spmd_gatherv_int(nelidc,nelidcg,0,my_sizec,nelcg,
195 . sizec_p0,adrc)
196 ! send the local NUMELTG to PROC0
197 CALL spmd_gatherv_int(nelidtg,nelidtgg,0,my_sizetg,neltgg,
198 . sizetg_p0,adrtg)
199
200 ELSE
201 nelcg = nelc
202 neltgg = neltg
203 IF(nelcg/=0) THEN
204 ALLOCATE(nelidcg(nelcg),stat=ierr)
205 nelidcg(1:nelcg) = nelidc(1:nelc)
206 ENDIF
207 IF(neltgg/=0) THEN
208 ALLOCATE(nelidtgg(neltgg),stat=ierr)
209 nelidtgg(1:neltgg) = nelidtg(1:neltg)
210 ENDIF
211
212 ENDIF
213
214
215 IF(ispmd == 0) THEN
216
217 flg_chk = 0
218
219 IF(nelcg/=0.AND.neltgg/=0) flg_chk = 1
220
221 IF(flg_chk > 0 ) THEN ! IF checK is needed
222
223 is_check = 0
224
225 ALLOCATE(clefc(nelcg),stat=ierr)
226 ALLOCATE(indxc(2*nelcg),stat=ierr)
227
228 DO n=1,nelcg
229 indxc(n)=n
230 clefc(n)= nelidcg(n)
231 END DO
232 CALL my_orders(0,work,clefc,indxc,nelcg,1)
233
234 ALLOCATE(cleftg(neltgg),stat=ierr)
235 ALLOCATE(indxtg(2*neltgg),stat=ierr)
236
237 DO n=1,neltgg
238 indxtg(n)=n
239 cleftg(n)= nelidtgg(n)
240 END DO
241
242 CALL my_orders(0,work,cleftg,indxtg,neltgg,1)
243
244 IF(nelidtgg(indxtg(1))>=nelidcg(indxc(1)).AND.nelidtgg(indxtg(1))<=nelidcg(indxc(nelcg)))THEN
245 is_check = 1
246 ENDIF
247
248 IF(nelidtgg(indxtg(neltgg))>=nelidcg(indxc(1)).AND.nelidtgg(indxtg(neltgg))<=nelidcg(indxc(nelcg)))THEN
249 is_check = 1
250 ENDIF
251
252 IF(nelidcg(indxc(1))>=nelidtgg(indxtg(1)).AND.nelidcg(indxc(1))<=nelidtgg(indxtg(neltgg)))THEN
253 is_check = 1
254 ENDIF
255
256 IF(nelidcg(indxc(nelcg))>=nelidtgg(indxtg(1)).AND.nelidcg(indxc(nelcg))<=nelidtgg(indxtg(neltgg)))THEN
257 is_check = 1
258 ENDIF
259
260 IF(is_check == 1) THEN
261 nelmin = max(nelidcg(indxc(1)),nelidtgg(indxtg(1)))
262 nelmax = min(nelidcg(indxc(nelcg)),nelidtgg(indxtg(neltgg)))
263
264 ALLOCATE(idwarn(min(nelcg,neltgg)),stat=ierr)
265
266 jwarn = 0
267 DO i=1,nelcg
268 IF(nelidcg(indxc(i))>=nelmin.AND.nelidcg(indxc(i))<=nelmax) THEN
269 DO j=1,neltgg
270 IF(nelidtgg(indxtg(j))>=nelmin.AND.nelidtgg(indxtg(j))<=nelmax) THEN
271 IF(nelidcg(indxc(i))==nelidtgg(indxtg(j))) THEN
272 jwarn = jwarn + 1
273 idwarn(jwarn) = nelidcg(indxc(i))
274 ENDIF
275 ENDIF
276 ENDDO
277 ENDIF
278 ENDDO
279
280 IF(jwarn/=0)THEN
281 WRITE(iout,'(A,A)')
282 . ' ** ERROR : DYNAIN FILE CAN NOT BE WRITTEN',
283 . ' THESE 4 NODE SHELLS AND 3 NODE SHELLS HAVE SAME USER ID'
284 WRITE(iout,*) idwarn(1:jwarn)
285
286 WRITE(istdo,'(A,A,I10,A)')
287 . ' ** ERROR : DYNAIN FILE CAN NOT BE WRITTEN',
288 . ' 4 NODE SHELLS AND 3 NODE SHELLS MUST TO HAVE DIFFERENT USER ID',
289 . jwarn,'ERROR(S)'
290 CALL arret(0)
291 ENDIF
292
293 DEALLOCATE(idwarn)
294
295 ENDIF
296C
297 DEALLOCATE(clefc,cleftg,indxc,indxtg)
298C
299 ENDIF
300 ENDIF
301
302 IF(numelc/=0) DEALLOCATE(nelidc,stat=ierr)
303 IF(numeltg/=0) DEALLOCATE(nelidtg,stat=ierr)
304 DEALLOCATE(nelidcg,nelidtgg)
305
306 ENDIF
307
308
309 RETURN
310 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
message_mod
Definition message_mod.F:1257
state_mod
Definition state_mod.F:54
read_dynain
subroutine read_dynain(ipart, dynain_data, ipartc, iparttg, ixc, ixtg)
Definition read_dynain.F:39
spmd_gather_int
subroutine spmd_gather_int(sendbuf, recvbuf, proc, send_size, rcv_size)
Definition spmd_gather_int.F:34
spmd_gatherv_int
subroutine spmd_gatherv_int(sendbuf, recvbuf, proc, send_size, total_rcv_size, rcv_size, dipls)
Definition spmd_gatherv_int.F:33
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86