45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
67 USE fill_surf_plane_mod
68 USE file_descriptor_mod
69
70
71
72#include "implicit_f.inc"
73#include "com04_c.inc"
74
75
76
77 TYPE (GROUP_) , INTENT(INOUT):: IGRNOD(*)
78 TYPE (SURF_) , INTENT(INOUT):: IGRSURF(*)
79 TYPE (SURF_) , INTENT(INOUT):: IGRSLIN(*)
80 TYPE (GROUP_) , INTENT(INOUT):: (*)
81 TYPE (GROUP_) , INTENT(INOUT):: IGRBRIC(*)
82 TYPE (GROUP_) , INTENT(INOUT):: IGRQUAD(*)
83 TYPE (GROUP_) , INTENT(INOUT):: IGRSH4N(*)
84 TYPE (GROUP_) , INTENT(INOUT):: IGRSH3N(*)
85 TYPE (GROUP_) , INTENT(INOUT):: (*)
86 TYPE (GROUP_) , INTENT(INOUT):: IGRBEAM(*)
87 TYPE (GROUP_) , INTENT(INOUT):: IGRSPRING(*)
88 TYPE (SET_), DIMENSION(NSETS),INTENT(INOUT) :: SET
89 INTEGER, INTENT(IN) :: LISURF1
91 INTEGER, INTENT(IN) :: ROOTLEN,INFILE_NAME_LEN
92 CHARACTER(LEN=ROOTLEN), INTENT(IN) :: ROOTNAM
93 CHARACTER(LEN=INFILE_NAME_LEN), INTENT(IN) :: INFILE_NAME
94
95
96
97 INTEGER NVAR
98
99
100
101 INTEGER I,J,IGS,GRTYPE,IO_ERR1,IO_ERR2,NB_GRNODE,NB_GRPART
102 LOGICAL IS_USED
103 CHARACTER FILNAM*109, KEYA*80
104 CHARACTER(LEN=NCHARLINE) ::CARTE
105 INTEGER :: LEN_TMP_NAME
106 CHARACTER(len=4096) :: TMP_NAME
107 INTEGER , DIMENSION(:), ALLOCATABLE :: GRNODE,GRPART,GRPART_TMP
108
109
110
111 io_err1 = 0
112 nb_grnode = 0
113 nb_grpart = 0
114 DO i = 1, 10000
115 WRITE(filnam, '(A, A, I4.4, A)') rootnam(1:rootlen), '_', i-1, '.rad'
116 tmp_name = infile_name(1:infile_name_len)//filnam(1:len_trim(filnam))
117 len_tmp_name = infile_name_len + len_trim(filnam)
118 OPEN(unit=tmp_engine, file=tmp_name(1:len_tmp_name),
119 . access='SEQUENTIAL', status='OLD', iostat=io_err1)
120
121 IF (io_err1 == 0) THEN
122
123 io_err2 = 0
124 DO WHILE (io_err2 == 0)
125 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) keya
126 IF (io_err2 == 0) THEN
127
128 IF(keya(1:14) == '/DT/NODA/CST/1' .OR. keya(1:8) == '/DYREL/1''/KEREL/1'
129 . keya(1:14) == '/INIV/AXIS/X/2' .OR. keya(1:14) == '/INIV/AXIS/Y/2' .OR.
130 . keya(1:14) == '/INIV/AXIS/Z/2') THEN
131 nb_grnode = nb_grnode + 1
132 ELSEIF(keya(1:4) == '/H3D' .AND. keya(1:7) /= '/H3D/DT' .AND.
133 . keya(1:10) /= '/H3D/TITLE' .AND. keya(1:13) /= '/H3D/COMPRESS' .AND.
134 . keya(1:12) /= '/H3D/LSENSOR' .AND. keya(1:7) /= '/H3D/RB' ) THEN
135 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
136 IF(carte(1:1) == '/') THEN
137 backspace(tmp_engine)
138 ELSE IF(carte(1:1) /= '#') THEN
139 ALLOCATE(grpart_tmp(
nvar(carte)))
140 READ(carte, fmt=*) grpart_tmp
142 IF(grpart_tmp(j) < 0) nb_grpart = nb_grpart
143 END DO
144 IF(ALLOCATED(grpart_tmp)) DEALLOCATE(grpart_tmp)
145 ENDIF
146 ELSE IF(keya(1:6) == '/BEGIN') THEN
147 io_err2 = 1
148 ENDIF
149 END IF
150 END DO
151
152 CLOSE(tmp_engine)
153 ENDIF
154 END DO
155
156 IF (nb_grnode > 0) ALLOCATE(grnode(nb_grnode))
157 nb_grnode = 0
158
159 IF (nb_grpart > 0) ALLOCATE(grpart(nb_grpart))
160 nb_grpart = 0
161
162 DO i = 1, 10000
163 WRITE(filnam, '(A, A, I4.4, A)') rootnam(1:rootlen), '_', i-1, '.rad'
164 tmp_name = infile_name(1:infile_name_len)//filnam(1:len_trim(filnam))
165 len_tmp_name = infile_name_len + len_trim(filnam)
166 OPEN(unit=tmp_engine, file=tmp_name(1:len_tmp_name),
167 . access='SEQUENTIAL', status='OLD', iostat=io_err1)
168
169 IF (io_err1 == 0) THEN
170
171 io_err2 = 0
172 DO WHILE (io_err2 == 0)
173 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) keya
174 IF (io_err2 == 0) THEN
175
176 IF(keya(1:14) == '/DT/NODA/CST/1') THEN
177 nb_grnode = nb_grnode + 1
178
179 DO WHILE (carte(1:1) == '#' .AND. io_err2 == 0)
180 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
181 END DO
182 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
183 DO WHILE (carte(1:1) == '#' .AND. io_err2 == 0)
184 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
185 END DO
186 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
187 DO WHILE (carte(1:1) == '#' .AND. io_err2 == 0)
188 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
189 END DO
190 READ(carte, fmt=*) grnode(nb_grnode)
191 ELSEIF(keya(1:8) == '/DYREL/1') THEN
192 nb_grnode = nb_grnode + 1
193
194 DO WHILE (carte(1:1) == '#' .AND. io_err2 == 0)
195 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
196 END DO
197 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
198 DO WHILE (carte(1:1) == '#' .AND. io_err2 == 0)
199 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
200 END DO
201 READ(carte, fmt=*) grnode(nb_grnode)
202 ELSEIF(keya(1:8) == '/KEREL/1') THEN
203 nb_grnode = nb_grnode + 1
204
205 DO WHILE (carte(1:1) == '#' .AND. io_err2 == 0)
206 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
207 END DO
208 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
209 DO WHILE (carte(1:1) =='#'
210 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
211 END DO
212 READ(carte, fmt=*) grnode(nb_grnode)
213 ELSEIF(keya(1:14) == '/INIV/AXIS/X/2' .OR. keya(1:14) == '/INIV/AXIS/Y/2' .OR.
214 . keya(1:14) == '/INIV/AXIS/Z/2') THEN
215 nb_grnode = nb_grnode + 1
216
217 DO WHILE (carte(1:1) == '#' .AND. io_err2 == 0)
218 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
219 END DO
220 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
221 DO WHILE (carte(1:1) == '#' .AND. IO_ERR2 == 0)
222 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
223 END DO
224 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
225 DO WHILE (carte(1:1) == '#' .AND. io_err2 == 0)
226 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
227 END DO
228 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
229 DO WHILE (carte(1:1) == '#' .AND. io_err2 == 0)
230 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
231 END DO
232 READ(carte, fmt=*) grnode(nb_grnode)
233 ELSE IF(keya(1:6) == '/BEGIN') THEN
234 io_err2 = 1
235 ELSE IF(keya(1:4) == '/H3D' .AND. keya(1:7) /= '/H3D/DT' .AND.
236 . keya(1:10) /= '/H3D/TITLE' .AND. keya(1:13) /= '/H3D/COMPRESS' .AND.
237 . keya(1:12) /= '/H3D/LSENSOR' .AND. keya(1:7) /= '/H3D/RB' ) THEN
238 READ(unit=tmp_engine, fmt='(A)', iostat=io_err2) carte
239 IF(carte(1:1) == '/') THEN
240 backspace(tmp_engine)
241 ELSE IF(carte(1:1) /= '#') THEN
242 ALLOCATE(grpart_tmp(
nvar(carte)))
243 READ(carte, fmt=*) grpart_tmp
245 IF(grpart_tmp(j) < 0) THEN
246 nb_grpart = nb_grpart + 1
247 grpart(nb_grpart) = grpart_tmp(j)
248 ENDIF
249 END DO
250 IF(ALLOCATED(grpart_tmp)) DEALLOCATE(grpart_tmp)
251 ENDIF
252 ENDIF
253 END IF
254 END DO
255
256 CLOSE(tmp_engine)
257 ENDIF
258 END DO
259
260
261
263
264 IF( set(igs)%SET_ACTIV == 0 ) cycle
265
266
267
269
270 IF(.NOT. is_used .AND. nb_grpart > 0) THEN
271 DO i=1,nb_grpart
272 IF(set(igs)%SET_ID == -grpart(i)) THEN
273 is_used = .true.
274 ENDIF
275 ENDDO
276 ENDIF
277
278 IF(is_used .OR.
doqa == 1)
THEN
279 grtype = 0
280 CALL fill_gr( igrpart ,ngrpart,grtype,
281 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%PART,set(igs)%NB_PART,set(igs)%SET_GRPART_ID)
282 ENDIF
283
285 IF(ALLOCATED (set(igs)%PART )) DEALLOCATE ( set(igs)%PART )
286 set(igs)%NB_PART = 0
287 ENDIF
288
289
291 IF(is_used .OR.
doqa == 1)
THEN
292 grtype = 1
293 CALL fill_gr( igrbric ,ngrbric,grtype,
294 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%SOLID,set(igs)%NB_SOLID,set(igs)%SET_GRSOLID_ID)
295 ENDIF
296
298 IF(ALLOCATED (set(igs)%SOLID )) DEALLOCATE
299 set(igs)%NB_SOLID = 0
300 ENDIF
301
302
304 IF(is_used .OR.
doqa == 1)
THEN
305 grtype = 2
306 CALL fill_gr( igrquad ,ngrquad,grtype,
307 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%QUAD,set(igs)%NB_QUAD,set(igs)%SET_GRQUAD_ID)
308 ENDIF
309
311 IF(ALLOCATED (set(igs)%QUAD )) DEALLOCATE ( set(igs)%QUAD )
312 set(igs)%NB_QUAD = 0
313 ENDIF
314
315
317 IF(is_used .OR.
doqa == 1)
THEN
318 grtype = 3
319 CALL fill_gr( igrsh4n ,ngrshel,grtype,
320 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%SH4N,set(igs)%NB_SH4N
321 ENDIF
322
324 IF(ALLOCATED (set(igs)%SH4N )) DEALLOCATE ( set(igs)%SH4N )
325 set(igs)%NB_SH4N = 0
326 ENDIF
327
328
330 IF(is_used .OR.
doqa == 1)
THEN
331 grtype = 7
332 CALL fill_gr( igrsh3n ,ngrsh3n,grtype,
333 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%SH3N,set(igs)%NB_SH3N,set(igs)%SET_GRSH3N_ID)
334 ENDIF
335
337 IF(ALLOCATED (set(igs)%SH3N )) DEALLOCATE ( set(igs)%SH3N )
338 set(igs)%NB_SH3N = 0
339 ENDIF
340
341
343 IF(is_used .OR.
doqa == 1)
THEN
344 IF (numeltria > 0) THEN
345 grtype = 7
346 CALL fill_gr( igrsh3n ,ngrsh3n,grtype,
347 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%TRIA,set(igs)%NB_TRIA,set(igs)%SET_GRTRIA_ID)
348 ENDIF
349 ENDIF
350
352 IF(ALLOCATED (set(igs)%TRIA )) DEALLOCATE ( set(igs)%TRIA )
353 set(igs)%NB_TRIA = 0
354 ENDIF
355
356
358 IF(is_used .OR.
doqa == 1)
THEN
359 grtype = 4
360 CALL fill_gr( igrtruss ,ngrtrus,grtype,
361 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%TRUSS,set(igs)%NB_TRUSS,set(igs)%SET_GRTRUSS_ID)
362 ENDIF
363
365 IF(ALLOCATED (set(igs)%TRUSS )) DEALLOCATE ( set(igs)%TRUSS )
366 set(igs)%NB_TRUSS = 0
367 ENDIF
368
369
371 IF(is_used .OR.
doqa == 1)
THEN
372 grtype = 5
373 CALL fill_gr( igrbeam ,ngrbeam,grtype,
374 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%BEAM,set(igs)%NB_BEAM,set(igs)%SET_GRBEAM_ID)
375 ENDIF
376
378 IF(ALLOCATED (set(igs)%BEAM )) DEALLOCATE ( set(igs)%BEAM )
379 set(igs)%NB_BEAM = 0
380 ENDIF
381
382
384 IF(is_used .OR.
doqa == 1)
THEN
385 grtype = 6
386 CALL fill_gr( igrspring ,ngrspri,grtype,
387 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%SPRING,set(igs)%NB_SPRING,set(igs)%SET_GRSPRING_ID)
388 ENDIF
389
391 IF(ALLOCATED (set(igs)%SPRING )) DEALLOCATE ( set(igs)%SPRING )
392 set(igs)%NB_SPRING = 0
393 ENDIF
394
395
397
398 IF(.NOT. is_used .AND. nb_grnode > 0) THEN
399 DO i=1,nb_grnode
400 IF(set(igs)%SET_ID == grnode(i)) THEN
401 is_used = .true.
402 ENDIF
403 ENDDO
404 ENDIF
405
406 IF((is_used .OR.
doqa == 1) .AND. set(igs)%NB_ELLIPSE == 0 .AND. set(igs)%NB_PLANE == 0
407 * .AND. set(igs)%NB_NODENS == 0 )THEN
408 grtype = 0
409 CALL fill_gr( igrnod ,ngrnod,grtype,
410 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%NODE,set(igs)%NB_NODE,set(igs)%SET_GRNOD_ID)
411 ENDIF
412
414 IF(ALLOCATED (set(igs)%NODE )) DEALLOCATE ( set(igs)%NODE )
415 set(igs)%NB_NODE = 0
416 ENDIF
417
418
420 IF((is_used .OR.
doqa == 1) .AND. set(igs)%NB_ELLIPSE == 0 .AND. set(igs
421 * .AND. set(igs)%NB_NODENS /= 0 )THEN
422 grtype = 0
423 CALL fill_gr( igrnod ,ngrnod,grtype,
424 * set(igs)%SET_ID,set(igs)%TITLE,set(igs)%NODENS,set(igs)%NB_NODENS,set(igs)%SET_GRNOD_ID)
425 igrnod(set(igs)%SET_GRNOD_ID)%SORTED = 1
426 ENDIF
427
429 IF(ALLOCATED (set(igs)%NODENS )) DEALLOCATE ( set(igs)%NODENS )
430 set(igs)%NB_NODENS = 0
431 ENDIF
432
433
435 IF(is_used .OR.
doqa == 1)
THEN
436 IF (set(igs)%NB_ELLIPSE == 0 .and. set(igs)%NB_PLANE == 0)
CALL fill_surf(set(igs),igrsurf,nsurf)
437 IF (set(igs)%NB_ELLIPSE > 0)
CALL fill_surf_ellipse(set(igs),igrsurf,nsurf,bufsf,lisurf1,nsurf)
438 IF (set(igs)%NB_PLANE > 0) CALL fill_surf_plane(set(igs),igrsurf,nsurf,bufsf,lisurf1,nsurf)
439 ENDIF
440
442 IF(ALLOCATED (set(igs)%SURF_NODES )) DEALLOCATE ( set(igs)%SURF_NODES )
443 IF(ALLOCATED (set(igs)%SURF_ELTYP )) DEALLOCATE ( set(igs)%SURF_ELTYP )
444 IF(ALLOCATED (set(igs)%SURF_ELEM )) DEALLOCATE ( set(igs)%SURF_ELEM )
445 set(igs)%NB_SURF_SEG = 0
446
447 IF(ALLOCATED (set(igs)%ELLIPSE_SKEW )) DEALLOCATE ( set(igs)%ELLIPSE_SKEW )
448 set(igs)%ELLIPSE_A = zero
449 set(igs)%ELLIPSE_B = zero
450 set(igs)%ELLIPSE_C = zero
451 set(igs)%ELLIPSE_XC = zero
452 set(igs)%ELLIPSE_YC = zero
453 set(igs)%ELLIPSE_ZC = zero
454 set(igs)%ELLIPSE_N = zero
455 set(igs)%ELLIPSE_IAD_BUFR = 0
456 set(igs)%ELLIPSE_ID_MADYMO = 0
457
458 set(igs)%PLANE_XM = zero
459 set(igs)%PLANE_YM = zero
460 set(igs)%PLANE_ZM = zero
461 set(igs)%PLANE_XM1 = zero
462 set(igs)%PLANE_YM1 = zero
463 set(igs)%PLANE_ZM1 = zero
464 set(igs)%PLANE_IAD_BUFR = 0
465 ENDIF
466
467
469 IF(is_used .OR.
doqa == 1)
THEN
471 ENDIF
472
474 IF(ALLOCATED (set(igs)%LINE_NODES )) DEALLOCATE ( set(igs)%LINE_NODES )
475 IF(ALLOCATED (set(igs)%LINE_ELTYP )) DEALLOCATE ( set(igs)%LINE_ELTYP )
476 IF(ALLOCATED (set(igs)%LINE_ELEM )) DEALLOCATE ( set(igs)%LINE_ELEM )
477 set(igs)%NB_LINE_SEG = 0
478 ENDIF
479 ENDDO
480
481 IF(ALLOCATED(grnode)) DEALLOCATE(grnode)
482 IF(ALLOCATED(grpart)) DEALLOCATE(grpart)
483
subroutine fill_line(set, igrslin, igrl)
subroutine fill_gr(igrele, ngrelem, ielt, set_id, set_title, getelem, nelem, set_greid)
subroutine fill_surf(set, igrsurf, igrs)
subroutine fill_surf_ellipse(set, igrsurf, igrs, bufsf, lisurf1, nsurf)
subroutine hm_group_is_used(name, sname, id, is_used)
integer function nvar(text)