OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
check_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!|| check_dynain ../starter/source/starter/check_dynain.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.f
31!||====================================================================
32 SUBROUTINE check_dynain(IPART,IPARTC,IPARTTG,IXC,IXTG,DYNAIN_CHECK)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE message_mod
37 USE inoutfile_mod
38 USE names_and_titles_mod , ONLY : ncharline
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com04_c.inc"
47#include "scr17_c.inc"
48#include "scr15_c.inc"
49#include "units_c.inc"
50#include "scr03_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER IPART(LIPART1,*), IXC(NIXC,*), IXTG(NIXTG,*),
55 . IPARTC(*), IPARTTG(*)
56 INTEGER , INTENT(INOUT) :: DYNAIN_CHECK
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I, J, K, N ,NELC , NELTG , IO_ERR1 , IP , NPRT ,
61 . FLG_CHK , IS_CHECK , JWARN, NELMIN , NELMAX , IPRT ,
62 . NELTGG , NELCG , IPRTALL , IERR2 ,IS_READ,
63 . DYNPART(NPART), IPART_DYNAIN(NPART)
64C
65 INTEGER WORK(70000)
66 INTEGER , DIMENSION(:),ALLOCATABLE :: NELIDC ,NELIDTG,
67 . CLEFC ,CLEFTG ,INDXC ,INDXTG ,IDWARN ,NELIDCG ,NELIDTGG
68 my_real t0,dt0
69 CHARACTER FILNAM*109, KEYA*80, KEYA2*80
70 CHARACTER(LEN=NCHARLINE) ::CARTE
71 INTEGER :: LEN_TMP_NAME
72 CHARACTER(len=4096) :: TMP_NAME
73C-------------------------------------------------------------------------------
74C CHECK FOR DYNAIN FILE OUTPUT : 3node shell and 4node shell have same ID
75C-------------------------------------------------------------------------------
76
77C-----------------------------------------------
78C READING ENGINE FILE
79C-----------------------------------------------
80 filnam=rootnam(1:rootlen)//'_0001.rad'
81 tmp_name=infile_name(1:infile_name_len)//filnam(1:len_trim(filnam))
82 len_tmp_name = infile_name_len+len_trim(filnam)
83 OPEN(unit=71,file=tmp_name(1:len_tmp_name),
84 . access='SEQUENTIAL',status='OLD',iostat=io_err1)
85C
86 IF (io_err1/=0) THEN
87 filnam=rootnam(1:rootlen)//'D01'
88 tmp_name=infile_name(1:infile_name_len)//filnam(1:len_trim(filnam))
89 len_tmp_name = infile_name_len+len_trim(filnam)
90 OPEN(unit=71,file=tmp_name(1:len_tmp_name),
91 . access='SEQUENTIAL',status='OLD',iostat=io_err1)
92 ENDIF
93C
94 nelc = 0
95 neltg = 0
96 nprt = 0
97 iprtall = 0
98 is_read = 0
99 dynpart(1:npart) = 0
100 ipart_dynain(1:npart) = 0
101 IF (io_err1==0) THEN
102C
10310 READ(71,'(A)',END=20) keya
104
105 IF(keya(1:1)=='#')GOTO 10
106 IF(keya(1:1)=='$')GOTO 10
107C
108C-- Check dynain file is requested --
109 dynain_check = 1
110
111 IF(keya(1:14)=='/DYNAIN/DT/ALL') THEN
112 IF(numelc/=0)THEN
113 ALLOCATE(nelidc(numelc),stat=ierr2)
114 DO i=1,numelc
115 nelidc(i) = ixc(nixc,i)
116 ENDDO
117 nelc = numelc
118 ENDIF
119 IF(numeltg/=0)THEN
120 ALLOCATE(nelidtg(numeltg),stat=ierr2)
121 DO i=1,numeltg
122 nelidtg(neltg) = ixtg(nixtg,i)
123 ENDDO
124 neltg = numeltg
125 ENDIF
126 nprt = npart
127 iprtall = 1
128
129 DO j=1,npart
130 ipart_dynain(j) = 1
131 END DO
132
133 is_read = 1
134
135 ELSEIF(keya(1:10)=='/DYNAIN/DT') THEN
136 READ(71,*,END=20) T0,dt0
137
138 READ(71,'(A)',END=20) carte
139 j=1
140 nprt = 0
141C
142C-- Counting and storing parts id --
143 IF(carte(1:1)/='#'.OR.carte(1:1)/='$') THEN
144 DO WHILE(carte(1:1) /= '/'.AND.len_trim(carte)/=0)
145 DO WHILE (j<=len_trim(carte))
146 IF(carte(j:j)/=' ') THEN
147 k=j
148 DO WHILE(carte(k:k)/=' '.AND.carte(k:k)/=char(13).AND.k<=len_trim(carte))
149 k=k+1
150 ENDDO
151 nprt = nprt + 1
152 READ(carte(j:k-1),'(I10)') iprt
153 dynpart(nprt) = iprt
154 j = k
155 ENDIF
156 j = j +1
157 ENDDO
158 READ(71,'(A)',END=20) carte
159 ENDDO
160 ENDIF
161 is_read = 1
162 ENDIF
163
164 GOTO 10
165C
166 20 CONTINUE
167 CLOSE(71)
168
169 IF(is_read > 0 ) THEN
170 IF(nprt == 0)THEN
171 CALL ancmsg(msgid=1909,
172 . msgtype=msgerror,
173 . anmode=aninfo_blind_1)
174
175 ELSEIF(iprtall ==0) THEN
176C
177C-- parts id to local part --
178
179 DO i=1,nprt
180 ip=0
181 iprt = dynpart(i)
182 DO j=1,npart
183 IF(ipart(4,j)==iprt)ip=j
184 END DO
185 IF(ip==0)THEN
186 CALL ancmsg(msgid=1908,
187 . msgtype=msgerror,
188 . anmode=aninfo_blind_1,
189 . i1=iprt)
190 END IF
191 ipart_dynain(ip)=1
192 ENDDO
193 IF(numelc/=0) ALLOCATE(nelidc(numelc),stat=ierr2)
194 IF(numeltg/=0) ALLOCATE(nelidtg(numeltg),stat=ierr2)
195
196 ENDIF
197C
198C-- Counting concerned elements --
199
200 nelc = 0
201 DO i=1,numelc
202 ip = ipartc(i)
203 IF(ipart_dynain(ip)==1) THEN
204 nelc = nelc + 1
205 nelidc(nelc) = ixc(nixc,i)
206 ENDIF
207 ENDDO
208 neltg = 0
209 DO i=1,numeltg
210 ip = iparttg(i)
211 IF(ipart_dynain(ip)==1) THEN
212 neltg = neltg + 1
213 nelidtg(neltg) = ixtg(nixtg,i)
214 ENDIF
215 ENDDO
216
217 ENDIF
218C
219C
220 ENDIF
221
222 flg_chk = 0
223
224 IF(nelc/=0.AND.neltg/=0) flg_chk = 1
225
226 IF(flg_chk == 1 ) THEN ! IF check is needed
227 is_check = 0
228
229 ALLOCATE(clefc(nelc),stat=ierr2)
230 ALLOCATE(indxc(2*nelc),stat=ierr2)
231
232 DO n=1,nelc
233 indxc(n)=n
234 clefc(n)= nelidc(n)
235 END DO
236 CALL my_orders(0,work,clefc,indxc,nelc,1)
237
238 ALLOCATE(cleftg(neltg),stat=ierr2)
239 ALLOCATE(indxtg(2*neltg),stat=ierr2)
240
241 DO n=1,neltg
242 indxtg(n)=n
243 cleftg(n)= nelidtg(n)
244 END DO
245 CALL my_orders(0,work,cleftg,indxtg,neltg,1)
246
247 IF(nelidtg(indxtg(1))>=nelidc(indxc(1)).AND.nelidtg(indxtg(1))<=nelidc(indxc(nelc)))THEN
248 is_check = 1
249 ENDIF
250
251 IF(nelidtg(indxtg(neltg))>=nelidc(indxc(1)).AND.nelidtg(indxtg(neltg))<=nelidc(indxc(nelc)))THEN
252 is_check = 1
253 ENDIF
254
255 IF(nelidc(indxc(1))>=nelidtg(indxtg(1)).AND.nelidc(indxc(1))<=nelidtg(indxtg(neltg)))THEN
256 is_check = 1
257 ENDIF
258
259 IF(nelidc(indxc(nelc))>=nelidtg(indxtg(1)).AND.nelidc(indxc(nelc))<=nelidtg(indxtg(neltg)))THEN
260 is_check = 1
261 ENDIF
262
263 IF(is_check == 1) THEN
264 nelmin = max(nelidc(indxc(1)),nelidtg(indxtg(1)))
265 nelmax = min(nelidc(indxc(nelc)),nelidtg(indxtg(neltg)))
266
267 ALLOCATE(idwarn(min(nelc,neltg)),stat=ierr2)
268 jwarn = 0
269 DO i=1,nelc
270 IF(nelidc(indxc(i))>=nelmin.AND.nelidc(indxc(i))<=nelmax) THEN
271 DO j=1,neltg
272 IF(nelidtg(indxtg(j))>=nelmin.AND.nelidtg(indxtg(j))<=nelmax) THEN
273 IF(nelidc(indxc(i))==nelidtg(indxtg(j))) THEN
274 jwarn = jwarn + 1
275 idwarn(jwarn) = nelidc(indxc(i))
276 ENDIF
277 ENDIF
278 ENDDO
279 ENDIF
280 ENDDO
281 IF(jwarn/=0)THEN
282 IF(ipri>=6)THEN
283
284 WRITE(iout,'(A,A)')
285 . ' ** ERROR : DYNAIN FILE CAN NOT BE WRITTEN',
286 . ' THESE 4 NODE SHELLS AND 3 NODE SHELLS HAVE SAME USER ID'
287 WRITE(iout,*) idwarn(1:jwarn)
288
289 CALL ancmsg(msgid=1910,
290 . msgtype=msgerror,
291 . anmode=aninfo_blind_1,
292 . i1=jwarn)
293
294 ELSE
295
296 CALL ancmsg(msgid=1910,
297 . msgtype=msgerror,
298 . anmode=aninfo_blind_1,
299 . i1=jwarn)
300
301 ENDIF
302 ENDIF
303 DEALLOCATE(idwarn)
304 ENDIF
305
306 DEALLOCATE(clefc,cleftg,indxc,indxtg)
307
308 ENDIF
309
310 IF(is_read > 0 ) THEN
311 IF(numelc/=0) DEALLOCATE(nelidc,stat=ierr2)
312 IF(numeltg/=0) DEALLOCATE(nelidtg,stat=ierr2)
313 ENDIF
314
315 RETURN
316 END
check_dynain
subroutine check_dynain(ipart, ipartc, iparttg, ixc, ixtg, dynain_check)
Definition check_dynain.F:33
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
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::infile_name_len
integer infile_name_len
Definition inoutfile_mod.F:114
inoutfile_mod::infile_name
character(len=infile_char_len) infile_name
Definition inoutfile_mod.F:116
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
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
starter
program starter
Definition starter.F:39