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