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