OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
chktyp2.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!|| chktyp2 ../starter/source/interfaces/interf1/chktyp2.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE chktyp2(IPARI ,ITAB,
34 . NOM_OPT ,INTBUF_TAB, NATIV_SMS)
35 USE message_mod
36 USE intbufdef_mod
37 USE names_and_titles_mod , ONLY : nchartitle
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C A n a l y s e M o d u l e
44C-----------------------------------------------
45#include "param_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER IPARI(NPARI,*), ITAB(*)
50 INTEGER NOM_OPT(LNOPT1,*),NATIV_SMS(*)
51 TYPE(intbuf_struct_) INTBUF_TAB(*)
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com04_c.inc"
56#include "scr17_c.inc"
57#include "sms_c.inc"
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER N, NTY
62 INTEGER K10,K11,K12,K13,K14,ILEV,II,J,NMN,NSN,NRTS,NRTM,
63 . nlins,nlinm,iwout
64 INTEGER, DIMENSION(:),ALLOCATABLE :: TAGHIER
65 INTEGER ID
66 CHARACTER(LEN=NCHARTITLE) :: TITR
67C-----------------------------------------------
68 ALLOCATE(taghier(numnod))
69 taghier(1:numnod) = 0
70 DO n=1,ninter
71 nty =i pari(7,n)
72 IF (nty == 2) THEN
73 nrts =ipari(3,n)
74 nrtm =ipari(4,n)
75 nsn =ipari(5,n)
76 nmn =ipari(6,n)
77 ilev =ipari(20,n)
78C
79 DO ii=1,nsn
80 j = intbuf_tab(n)%NSV(ii)
81 IF (ilev /=25 .and. ilev/=26 .and. ilev/=27 .and. ilev/=28) taghier(j) = 1
82 ENDDO
83 ENDIF
84 ENDDO
85 DO n=1,ninter
86 nty = ipari(7,n)
87 id = nom_opt(1,n)
88 CALL fretitl2(titr, nom_opt(lnopt1-ltitr+1,n),ltitr)
89 IF (nty == 2) THEN
90 ilev = ipari(20,n)
91 IF (ilev == 0 .OR. ilev == 1 .OR. ilev == 27 .OR. ilev == 28) THEN
92 nmn = ipari(6,n)
93 DO ii=1,nmn
94 j=intbuf_tab(n)%MSR(ii)
95 IF (taghier(j) == 1) THEN
96 CALL ancmsg(msgid=556,
97 . msgtype=msgerror,
98 . anmode=aninfo_blind_1,
99 . i1=id,
100 . c1=titr,
101 . i2=itab(j))
102 ENDIF
103 ENDDO
104 ENDIF
105 ENDIF
106 ENDDO
107C
108C-----
109C-- Check of secnd nodes of type2 + AMS + contact
110C
111 IF (isms /=0 ) THEN
112C
113 taghier(1:numnod) = 0
114 DO n=1,ninter
115 nty = ipari(7,n)
116 ilev = ipari(20,n)
117 IF (nty == 2 .AND. ilev/=25 .and. ilev /= 26) THEN
118 nsn =ipari(5,n)
119 DO ii=1,nsn
120 j = intbuf_tab(n)%NSV(ii)
121C-- Only secnds nodes with AMS are checked
122 IF (nativ_sms(j)/=0) taghier(j) = 1
123 ENDDO
124 ENDIF
125 ENDDO
126C
127 DO n=1,ninter
128 nty=ipari(7,n)
129 nsn =ipari(5,n)
130 nrts =ipari(3,n)
131 nrtm =ipari(4,n)
132
133 id=nom_opt(1,n)
134 CALL fretitl2(titr,
135 . nom_opt(lnopt1-ltitr+1,n),ltitr)
136 iwout=0
137 IF(nty == 7 .OR. nty == 10 .OR. nty == 20 .OR. nty == 22)THEN
138 DO ii=1,nsn
139 j=intbuf_tab(n)%NSV(ii)
140 IF(taghier(j) == one) THEN
141 IF(iwout==0)THEN
142 CALL ancmsg(msgid=852,
143 . msgtype=msgwarning,
144 . anmode=aninfo_blind_1,
145 . i1=id,
146 . c1=titr)
147 iwout=1
148 END IF
149 CALL ancmsg(msgid=849,
150 . msgtype=msgwarning,
151 . anmode=aninfo_blind_2,
152 . i1=id,
153 . c1=titr,
154 . i2=itab(j))
155 END IF
156 END DO
157 DO ii=1,nrtm
158 j=intbuf_tab(n)%IRECTM(1+4*(ii-1))
159 IF(taghier(j) == one)THEN
160 IF(iwout==0)THEN
161 CALL ancmsg(msgid=852,
162 . msgtype=msgwarning,
163 . anmode=aninfo_blind_1,
164 . i1=id,
165 . c1=titr)
166 iwout=1
167 END IF
168 CALL ancmsg(msgid=850,
169 . msgtype=msgwarning,
170 . anmode=aninfo_blind_2,
171 . i1=id,
172 . c1=titr,
173 . i2=itab(j))
174 END IF
175 j=intbuf_tab(n)%IRECTM(4*(ii-1)+2)
176 IF(taghier(j) == one)THEN
177 IF(iwout==0)THEN
178 CALL ancmsg(msgid=852,
179 . msgtype=msgwarning,
180 . anmode=aninfo_blind_1,
181 . i1=id,
182 . c1=titr)
183 iwout=1
184 END IF
185 CALL ancmsg(msgid=850,
186 . msgtype=msgwarning,
187 . anmode=aninfo_blind_2,
188 . i1=id,
189 . c1=titr,
190 . i2=itab(j))
191 END IF
192 j=intbuf_tab(n)%IRECTM(4*(ii-1)+3)
193 IF(taghier(j) == one)THEN
194 IF(iwout==0)THEN
195 CALL ancmsg(msgid=852,
196 . msgtype=msgwarning,
197 . anmode=aninfo_blind_1,
198 . i1=id,
199 . c1=titr)
200 iwout=1
201 END IF
202 CALL ancmsg(msgid=850,
203 . msgtype=msgwarning,
204 . anmode=aninfo_blind_2,
205 . i1=id,
206 . c1=titr,
207 . i2=itab(j))
208 END IF
209 j=intbuf_tab(n)%IRECTM(4*(ii-1)+4)
210 IF(taghier(j) == one)THEN
211 IF(iwout==0)THEN
212 CALL ancmsg(msgid=852,
213 . msgtype=msgwarning,
214 . anmode=aninfo_blind_1,
215 . i1=id,
216 . c1=titr)
217 iwout=1
218 END IF
219 CALL ancmsg(msgid=850,
220 . msgtype=msgwarning,
221 . anmode=aninfo_blind_2,
222 . i1=id,
223 . c1=titr,
224 . i2=itab(j))
225 END IF
226 END DO
227 IF(nty == 20)THEN
228 nlins =ipari(51,n)
229 nlinm =ipari(52,n)
230 IF(nlins+nlinm /= 0)THEN
231 DO ii=1,nlins
232 j=intbuf_tab(n)%IXLINS(2*(ii-1)+1)
233 IF(taghier(j) == one)THEN
234 IF(iwout==0)THEN
235 CALL ancmsg(msgid=852,
236 . msgtype=msgwarning,
237 . anmode=aninfo_blind_1,
238 . i1=id,
239 . c1=titr)
240 iwout=1
241 END IF
242 CALL ancmsg(msgid=851,
243 . msgtype=msgwarning,
244 . anmode=aninfo_blind_2,
245 . i1=id,
246 . c1=titr,
247 . i2=itab(j))
248 END IF
249 j=intbuf_tab(n)%IXLINS(2*(ii-1)+2)
250 IF(taghier(j) == one)THEN
251 IF(iwout==0)THEN
252 CALL ancmsg(msgid=852,
253 . msgtype=msgwarning,
254 . anmode=aninfo_blind_1,
255 . i1=id,
256 . c1=titr)
257 iwout=1
258 END IF
259 CALL ancmsg(msgid=851,
260 . msgtype=msgwarning,
261 . anmode=aninfo_blind_2,
262 . i1=id,
263 . c1=titr,
264 . i2=itab(j))
265 END IF
266 END DO
267 DO ii=1,nlinm
268 j=intbuf_tab(n)%IXLINM(2*(ii-1)+1)
269 IF(taghier(j) == one)THEN
270 IF(iwout==0)THEN
271 CALL ancmsg(msgid=852,
272 . msgtype=msgwarning,
273 . anmode=aninfo_blind_1,
274 . i1=id,
275 . c1=titr)
276 iwout=1
277 END IF
278 CALL ancmsg(msgid=851,
279 . msgtype=msgwarning,
280 . anmode=aninfo_blind_2,
281 . i1=id,
282 . c1=titr,
283 . i2=itab(j))
284 END IF
285 j=intbuf_tab(n)%IXLINM(2*(ii-1)+2)
286 IF(taghier(j) == one)THEN
287 IF(iwout==0)THEN
288 CALL ancmsg(msgid=852,
289 . msgtype=msgwarning,
290 . anmode=aninfo_blind_1,
291 . i1=id,
292 . c1=titr)
293 iwout=1
294 END IF
295 CALL ancmsg(msgid=851,
296 . msgtype=msgwarning,
297 . anmode=aninfo_blind_2,
298 . i1=id,
299 . c1=titr,
300 . i2=itab(j))
301 END IF
302 END DO
303 END IF
304 END IF
305 ELSEIF(nty == 11)THEN
306 DO ii=1,nrts
307 j=intbuf_tab(n)%IRECTS(2*(ii-1)+1)
308 IF(taghier(j) == one)THEN
309 IF(iwout==0)THEN
310 CALL ancmsg(msgid=852,
311 . msgtype=msgwarning,
312 . anmode=aninfo_blind_1,
313 . i1=id,
314 . c1=titr)
315 iwout=1
316 END IF
317 CALL ancmsg(msgid=851,
318 . msgtype=msgwarning,
319 . anmode=aninfo_blind_2,
320 . i1=id,
321 . c1=titr,
322 . i2=itab(j))
323 END IF
324 j=intbuf_tab(n)%IRECTS(2*(ii-1)+2)
325 IF(taghier(j) == one)THEN
326 IF(iwout==0)THEN
327 CALL ancmsg(msgid=852,
328 . msgtype=msgwarning,
329 . anmode=aninfo_blind_1,
330 . i1=id,
331 . c1=titr)
332 iwout=1
333 END IF
334 CALL ancmsg(msgid=851,
335 . msgtype=msgwarning,
336 . anmode=aninfo_blind_2,
337 . i1=id,
338 . c1=titr,
339 . i2=itab(j))
340 END IF
341 END DO
342 DO ii=1,nrtm
343 j=intbuf_tab(n)%IRECTM(2*(ii-1)+1)
344 IF(taghier(j) == one)THEN
345 IF(iwout==0)THEN
346 CALL ancmsg(msgid=852,
347 . msgtype=msgwarning,
348 . anmode=aninfo_blind_1,
349 . i1=id,
350 . c1=titr)
351 iwout=1
352 END IF
353 CALL ancmsg(msgid=851,
354 . msgtype=msgwarning,
355 . anmode=aninfo_blind_2,
356 . i1=id,
357 . c1=titr,
358 . i2=itab(j))
359 END IF
360 j=intbuf_tab(n)%IRECTM(2*(ii-1)+2)
361 IF(taghier(j) == one)THEN
362 IF(iwout==0)THEN
363 CALL ancmsg(msgid=852,
364 . msgtype=msgwarning,
365 . anmode=aninfo_blind_1,
366 . i1=id,
367 . c1=titr)
368 iwout=1
369 END IF
370 CALL ancmsg(msgid=851,
371 . msgtype=msgwarning,
372 . anmode=aninfo_blind_2,
373 . i1=id,
374 . c1=titr,
375 . i2=itab(j))
376 END IF
377 END DO
378 ELSEIF(nty == 21)THEN
379 DO ii=1,nsn
380 j=intbuf_tab(n)%NSV(ii)
381 IF(taghier(j) == one) THEN
382 IF(iwout==0)THEN
383 CALL ancmsg(msgid=852,
384 . msgtype=msgwarning,
385 . anmode=aninfo_blind_1,
386 . i1=id,
387 . c1=titr)
388 iwout=1
389 END IF
390 CALL ancmsg(msgid=849,
391 . msgtype=msgwarning,
392 . anmode=aninfo_blind_2,
393 . i1=id,
394 . c1=titr,
395 . i2=itab(j))
396 END IF
397 END DO
398 END IF
399 END DO
400 END IF
401 DEALLOCATE(taghier)
402C
403 RETURN
404 END
chktyp2
subroutine chktyp2(ipari, itab, nom_opt, intbuf_tab, nativ_sms)
Definition chktyp2.F:35
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804