OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_drape.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!|| hm_read_prelecdrape ../starter/source/properties/composite_options/drape/hm_read_drape.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
29!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
30!|| udouble ../starter/source/system/sysfus.F
31!||--- uses -----------------------------------------------------
32!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!||====================================================================
36 SUBROUTINE hm_read_prelecdrape(IDRAPEID,LSUBMODEL)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE message_mod
41 USE submodel_mod
42 USE hm_option_read_mod
43 USE names_and_titles_mod , ONLY : nchartitle
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "drape_c.inc"
52C-----------------------------------------------
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER IDRAPEID(*)
57 TYPE(submodel_data) LSUBMODEL(*)
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I,ID
62 CHARACTER(LEN=NCHARTITLE) :: TITR
63 CHARACTER MESS*40
64 DATA mess/'DRAPE DEFINITION '/
65c REAL ou REAL*8
66 my_real
67 . bid
68C======================================================================|
69 ! PREREAD OF DRAPE
70 CALL hm_option_start('/DRAPE')
71 ! Loop over DRAPE
72 DO i=1,ndrape
73 titr = ''
74 CALL hm_option_read_key(lsubmodel,
75 . option_id = id,
76 . option_titr = titr)
77 idrapeid(i) = id
78 ENDDO ! DO I=1,NDRAPE
79 ! Looking for double IDs
80 CALL udouble(idrapeid,1,ndrape,mess,0,bid)
81C-------------------------------------
82 RETURN
83 END
84C
85!||====================================================================
86!|| hm_read_drape ../starter/source/properties/composite_options/drape/hm_read_drape.F
87!||--- called by ------------------------------------------------------
88!|| lectur ../starter/source/starter/lectur.F
89!||--- calls -----------------------------------------------------
90!|| ancmsg ../starter/source/output/message/message.f
91!|| hm_get_float_array_2indexes ../starter/source/devtools/hm_reader/hm_get_float_array_2indexes.F
92!|| hm_get_int_array_2indexes ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
93!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
94!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
95!|| hm_get_string_index ../starter/source/devtools/hm_reader/hm_get_string_index.F
96!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
97!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
98!|| udouble ../starter/source/system/sysfus.F
99!|| udouble3 ../starter/source/system/sysfus.F
100!||--- uses -----------------------------------------------------
101!|| drape_mod ../starter/share/modules1/drape_mod.F
102!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
103!|| message_mod ../starter/share/message_module/message_mod.F
104!|| stack_mod ../starter/share/modules1/stack_mod.f
105!|| submodel_mod ../starter/share/modules1/submodel_mod.F
106!||====================================================================
107 SUBROUTINE hm_read_drape(DRAPE_WRK ,IWORK_T ,IWORKSH,IGRSH3N ,IGRSH4N,
108 . IXC ,IXTG ,IGEO ,IGEO_STACK ,LSUBMODEL ,
109 . UNITAB, INDXSH )
110C-----------------------------------------------
111C M o d u l e s
112C-----------------------------------------------
113 USE message_mod
114 USE stack_mod
115 USE groupdef_mod
116 USE drape_mod
117 USE submodel_mod
118 USE hm_option_read_mod
119 USE unitab_mod
120 USE names_and_titles_mod , ONLY : nchartitle
121C-----------------------------------------------
122C I m p l i c i t T y p e s
123C-----------------------------------------------
124#include "implicit_f.inc"
125C-----------------------------------------------
126C C o m m o n B l o c k s
127C-----------------------------------------------
128#include "units_c.inc"
129#include "drape_c.inc"
130C-----------------------------------------------
131#include "com04_c.inc"
132#include "param_c.inc"
133#include "scr03_c.inc"
134C-----------------------------------------------
135C D u m m y A r g u m e n t s
136C-----------------------------------------------
137 INTEGER :: IWORKSH(3,*),IXC(NIXC,*),
138 . IXTG(NIXTG,*),IGEO(NPROPGI,*),
139 . igeo_stack(npropgi,*),indxsh(numelc+numeltg)
140C-----------------------------------------------
141 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
142 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
143 TYPE (DRAPE_) , DIMENSION(NUMELC + NUMELTG) ,TARGET :: DRAPE_WRK
144 TYPE(submodel_data) LSUBMODEL(*)
145 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
146 TYPE(drape_work_) , DIMENSION(NUMELC+NUMELTG), TARGET :: IWORK_T
147C-----------------------------------------------
148C L o c a l V a r i a b l e s
149C-----------------------------------------------
150 INTEGER ::I, II,J,JJ,IX,ID,SHELL_ID,SH3N_ID,GRSHEL_ID,GRSH3N_ID,OFFC,
151 . IT1,IT2,IT3,IT4,NEL,IAD,ITY,IDSHEL,IDSH3N,PID,
152 . jpid,igtyp,ie,ip,idrp,jdrp,ish,igr,jgr,is,listmax,slicelistmax,
153 . nis,no_ish,no_isheused_drape,nums,npt,ippid,isl,npt_drp,nslice,
154 . slicelist,npt_slice,mat_id,no_used_drape
155 INTEGER , DIMENSION(NDRAPE) :: DRP_SHEL, DRP_SH3N,DRAPE_ID
156 my_real
157 . thinning,theta_drape,bid
158 CHARACTER(LEN=NCHARTITLE) :: TITR,DRAPE_ENTITY
159 CHARACTER MESS*40,MESS1*40,MESS2*40, MESS3*40,MESS4*40,MESS5*40
160 DATA mess/'DRAPE DEFINITION '/
161 DATA mess1/'SHELL '/
162 DATA mess2/'GRSHEL '/
163 DATA mess3/'SH3N '/
164 DATA mess4/'GRSH3N '/
165 DATA mess5/'/DRAPE '/
166 INTEGER, DIMENSION (:) ,ALLOCATABLE :: TAGSH,INDX_TMP
167 INTEGER, DIMENSION (:,:),ALLOCATABLE :: ISH3N_DRP,IGRSH4N_DRP,ISH4N_DRP,IGRSH3N_DRP,
168 . itmp_sh4n,itmp_grsh4n,itmp_sh3n,itmp_grsh3n
169 INTEGER, DIMENSION(:,:,:),ALLOCATABLE :: ISH4N,ISH3N,ISH4N_GR,ISH3N_GR
170 my_real, DIMENSION(:,:,:),ALLOCATABLE :: RSH4N,RSH3N,RSH4N_GR,RSH3N_GR
171 LOGICAL :: IS_AVAILABLE
172C======================================================================|
173 is_available = .false.
174 drape_id = 0
175 drp_shel = 0
176 drp_sh3n = 0
177 numelc_drape = 0
178 numeltg_drape = 0
179C
180 ALLOCATE(tagsh(numelc+numeltg), indx_tmp(numelc + numeltg))
181 indx_tmp = 0
182C
183 !====================================================================================
184 ! Start reading /DRAPE
185 !====================================================================================
186 CALL hm_option_start('/DRAPE')
187 ! Loop over DRAPE
188 DO i=1,ndrape
189 it1 = 0
190 it2 = 0
191 it3 = 0
192 it4 = 0
193 tagsh(1:numelc+numeltg) = 0
194 !---------------------------------
195 ! Read TITLE and ID
196 !---------------------------------
197 titr = ''
198 CALL hm_option_read_key(lsubmodel,
199 . option_id = id,
200 . option_titr = titr)
201 drape_id(i) = id
202 IF (ipri == 5) THEN
203 WRITE (iout,1001)
204 ELSE
205 WRITE (iout,1002)
206 ENDIF
207 ! Count number of entities
208 CALL hm_get_intv('drapelistmax',listmax,is_available,lsubmodel)
209 slicelistmax = 0
210 DO ii = 1,listmax
211 ! N of slice entities
212 CALL hm_get_int_array_index('slicelistmax',slicelist,ii,is_available,lsubmodel)
213 slicelistmax= max(slicelistmax,slicelist)
214 ENDDO
215 !!
216 ALLOCATE(ish4n(listmax,slicelistmax,2) ,ish4n_gr(listmax,slicelistmax,2),
217 . ish3n(listmax,slicelistmax,2) ,ish3n_gr(listmax,slicelistmax,2),
218 . ish4n_drp(listmax,3),igrsh4n_drp(listmax,3),ish3n_drp(listmax,3),igrsh3n_drp(listmax,3),
219 . itmp_sh4n(2,listmax),itmp_sh3n(2,listmax),itmp_grsh4n(2,listmax),itmp_grsh3n(2,listmax))
220 ish4n = 0
221 ish3n = 0
222 ish4n_gr = 0
223 ish3n_gr = 0
224 ish4n_drp = 0
225 ish3n_drp = 0
226 igrsh4n_drp = 0
227 igrsh3n_drp = 0
228 itmp_sh4n =0
229 itmp_sh3n =0
230 itmp_grsh4n = 0
231 itmp_grsh3n = 0
232 ALLOCATE(rsh4n(listmax,slicelistmax,2),rsh3n(listmax,slicelistmax,2),rsh4n_gr(listmax,slicelistmax,2),
233 . rsh3n_gr(listmax, slicelistmax,2))
234 rsh4n = zero
235 rsh3n = zero
236 rsh4n_gr = zero
237 rsh3n_gr = zero
238
239 !--------------------------------------------------------------------------
240 ! Loop over entities
241 !--------------------------------------------------------------------------
242 DO ii = 1,listmax
243 ! N of slice entities
244 CALL hm_get_int_array_index('slicelistmax',slicelist,ii,is_available,lsubmodel)
245
246 !! tag of DRAPE elements
247 ! Reading the Drape entity type
248 CALL hm_get_string_index('entity_type',drape_entity,ii,10,is_available)
249 drape_entity(len_trim(drape_entity)+1:10)=' '
250 !------------------------------------------------------------------------
251 ! 1 - If entity is a SHELL
252 !------------------------------------------------------------------------
253 IF (drape_entity(1:5) == 'SHELL') THEN
254 ! Id of the SHELL
255 CALL hm_get_int_array_index('elem_sh_n4',shell_id,ii,is_available,lsubmodel)
256 it1 = it1 + 1
257 ish4n_drp(it1,1) = shell_id
258 ish4n_drp(it1,2) = id
259 ish4n_drp(it1,3) = slicelist
260 itmp_sh4n(1,it1) = shell_id
261 itmp_sh4n(2,it1) = id
262 DO jj = 1, slicelist
263 ! drape slice Thinning
264 CALL hm_get_float_array_2indexes('thinning',thinning,ii,jj,is_available,lsubmodel,unitab)
265 ! drape slice Angle
266 CALL hm_get_float_array_2indexes('theta_slice',theta_drape,ii,jj,is_available,lsubmodel,unitab)
267 ! Id of the Mat
268 CALL hm_get_int_array_2indexes('mat_ID',mat_id,ii,jj,is_available,lsubmodel)
269 ! npt of slice
270 CALL hm_get_int_array_2indexes('npt_slice',npt_slice,ii,jj,is_available,lsubmodel)
271 ! Checking shell ID
272 IF (shell_id == 0) THEN
273 CALL ancmsg(msgid=1163,
274 . msgtype=msgerror,
275 . anmode=aninfo,
276 . c1=mess5,
277 . i1=id,
278 . c2=mess1,
279 . i2=shell_id)
280 ENDIF
281 IF (ipri == 5)
282 . WRITE(iout,'(10X,I10,14X,A6,7X,I10,7X,I10,2(15X,1PG20.13))')
283 . id,drape_entity(1:5),shell_id,jj,thinning,theta_drape
284 ! Converting angle from deg to rad
285 theta_drape=theta_drape*pi/hundred80
286 ! Default thinning value
287 IF (thinning == zero) thinning = one
288 ! Tag shell element
289 ish4n(it1,jj,1) = mat_id
290 ish4n(it1,jj,2) = npt_slice
291 rsh4n(it1,jj,1) = thinning
292 rsh4n(it1,jj,2) = theta_drape
293 ENDDO ! SLICELIST
294 !----------------- -------------------------------------------------------
295 ! 2 - If entity is a SH3N
296 !------------------------------------------------------------------------
297 ELSEIF (drape_entity(1:4) == 'SH3N') THEN
298 ! Id of the SH3N
299 CALL hm_get_int_array_index('elem_sh_n3',sh3n_id,ii,is_available,lsubmodel)
300 !!
301 it2 = it2 + 1
302 ish3n_drp(it2,1) = sh3n_id
303 ish3n_drp(it2,2) = id
304 ish3n_drp(it2,3) = slicelist
305 itmp_sh3n(1,it2) = sh3n_id
306 itmp_sh3n(2,it2) = id
307 DO jj = 1, slicelist
308 ! drape slice Thinning
309 CALL hm_get_float_array_2indexes('thinning',thinning,ii,jj,is_available,lsubmodel,unitab)
310 ! drape slice Angle
311 CALL hm_get_float_array_2indexes('theta_slice',theta_drape,ii,jj,is_available,lsubmodel,unitab)
312 ! Id of the Mat
313 CALL hm_get_int_array_2indexes('mat_ID',mat_id,ii,jj,is_available,lsubmodel)
314 ! npt of slice
315 CALL hm_get_int_array_2indexes('npt_slice',npt_slice,ii,jj,is_available,lsubmodel)
316 ! Checking sh3n ID
317 IF (sh3n_id == 0) THEN
318 CALL ancmsg(msgid=1163,
319 . msgtype=msgerror,
320 . anmode=aninfo,
321 . c1=mess5,
322 . i1=id,
323 . c2=mess3,
324 . i2=sh3n_id)
325 ENDIF
326 IF (ipri == 5)
327 . WRITE(iout,'(10X,I10,14X,A6,7X,I10,7X,I10,2(15X,1PG20.13))')
328 . id,drape_entity(1:4),sh3n_id,jj,thinning,theta_drape
329 ! Converting angle from deg to rad
330 theta_drape=theta_drape*pi/hundred80
331 ! Default thinning value
332 IF (thinning == zero) thinning = one
333 ! Tag sh3n element
334 ish3n(it2,jj,1) = mat_id
335 ish3n(it2,jj,2) = npt_slice
336 rsh3n(it2,jj,1) = thinning
337 rsh3n(it2,jj,2) = theta_drape
338 ENDDO ! SLICELIST
339 !------------------------------------------------------------------------
340 ! 3 - If entity is a Groupe of SHELL
341 !------------------------------------------------------------------------
342 ELSEIF (drape_entity(1:6) == 'GRSHEL') THEN
343 ! Id of the GRSHEL
344 CALL hm_get_int_array_index('grshel_id',grshel_id,ii,is_available,lsubmodel)
345 ! drape slice Thinning
346 !!
347 it3 = it3 + 1
348 igrsh4n_drp(it3,1) = grshel_id
349 igrsh4n_drp(it3,2) = id
350 igrsh4n_drp(it3,3) = slicelist
351 itmp_grsh4n(1,it3) = grshel_id
352 itmp_grsh4n(2,it3) = id
353 DO jj = 1, slicelist
354 CALL hm_get_float_array_2indexes('thinning',thinning,ii,jj,is_available,lsubmodel,unitab)
355 ! drape slice Angle
356 CALL hm_get_float_array_2indexes('theta_slice',theta_drape,ii,jj,is_available,lsubmodel,unitab)
357 ! Id of the Mat
358 CALL hm_get_int_array_2indexes('mat_ID',mat_id,ii,jj,is_available,lsubmodel)
359 ! npt of slice
360 CALL hm_get_int_array_2indexes('npt_slice',npt_slice,ii,jj,is_available,lsubmodel)
361 ! Checking grshell ID
362 IF (grshel_id == 0) THEN
363 CALL ancmsg(msgid=1163,
364 . msgtype=msgerror,
365 . anmode=aninfo,
366 . c1=mess5,
367 . i1=id,
368 . c2=mess2,
369 . i2=grshel_id)
370 ENDIF
371 IF (ipri == 5)
372 . WRITE(iout,'(10X,I10,14X,A6,7X,I10,7X,I10,2(15X,1PG20.13))')
373 . id,drape_entity(1:6),grshel_id,jj,thinning,theta_drape
374 ! Converting angle from deg to rad
375 theta_drape=theta_drape*pi/hundred80
376 ! Default thinning value
377 IF (thinning == zero) thinning = one
378 ! Tag grshell
379 ish4n_gr(it3,jj,1) = mat_id
380 ish4n_gr(it3,jj,2) = npt_slice
381 rsh4n_gr(it3,jj,1) = thinning
382 rsh4n_gr(it3,jj,2) = theta_drape
383 ENDDO
384 !------------------------------------------------------------------------
385 ! 4 - If entity is a Groupe of SH3N
386 !------------------------------------------------------------------------
387 ELSEIF (drape_entity(1:6) == 'GRSH3N') THEN
388 ! Id of the GRSH3N
389 CALL hm_get_int_array_index('grtria_id',grsh3n_id,ii,is_available,lsubmodel)
390 !!
391 it4 = it4 + 1
392 igrsh3n_drp(it4,1) = grsh3n_id
393 igrsh3n_drp(it4,2) = id
394 igrsh3n_drp(it4,3) = slicelist
395 itmp_grsh4n(1,it4) = grsh3n_id
396 itmp_grsh4n(2,it4) = id
397 DO jj = 1, slicelist
398 ! drape slice Thinning
399 CALL hm_get_float_array_2indexes('thinning',thinning,ii,jj,is_available,lsubmodel,unitab)
400 ! drape slice Angle
401 CALL hm_get_float_array_2indexes('theta_slice',theta_drape,ii,jj,is_available,lsubmodel,unitab)
402 ! Id of the Mat
403 CALL hm_get_int_array_2indexes('mat_ID',mat_id,ii,jj,is_available,lsubmodel)
404 ! npt of slice
405 CALL hm_get_int_array_2indexes('npt_slice',npt_slice,ii,jj,is_available,lsubmodel)
406 ! Checking grsh3n ID
407 IF (grsh3n_id == 0) THEN
408 CALL ancmsg(msgid=1163,
409 . msgtype=msgerror,
410 . anmode=aninfo,
411 . c1=mess5,
412 . i1=id,
413 . c2=mess4,
414 . i2=grsh3n_id)
415 ENDIF
416 IF (ipri == 5)
417 . WRITE(iout,'(10X,I10,14X,A6,7X,I10,7X,I10,2(15X,1PG20.13))')
418 . id,drape_entity(1:6),grsh3n_id,jj,thinning,theta_drape
419 ! Converting angle from deg to rad
420 theta_drape = theta_drape*pi/hundred80
421 ! Default thinning value
422 IF (thinning == zero) thinning = one
423 ! Tag grsh3n
424
425 ish3n_gr(it4,jj,1) = mat_id
426 ish3n_gr(it4,jj,2) = npt_slice
427 rsh3n_gr(it4,jj,1) = thinning
428 rsh3n_gr(it4,jj,2) = theta_drape
429 ENDDO ! SLICELIST
430 ENDIF
431 ENDDO ! LISTMAX
432 !------------------------------------------------------------
433 ! CHECK FOR UNUSED DRAPE
434 !------------------------------------------------------------
435 no_used_drape = 0
436 ippid = 2
437 DO ie=1,numelc
438 ix = ixc(nixc,ie)
439 pid = ixc(6,ie)
440 igtyp = igeo(11,pid)
441 npt = iworksh(1,ie)
442 IF (igtyp == 17 .OR. igtyp == 51) THEN
443 DO ip=1,npt
444 jpid = iwork_t(ie)%PLYID(ip)! ply pid number
445c IGEO(1, JPID) ! ply pid ID
446 IF (jpid > 0) THEN
447 jdrp = igeo(48,jpid)
448 IF (id == jdrp)THEN
449 no_used_drape = no_used_drape + 1
450 ENDIF
451 ENDIF
452 ENDDO
453 ELSEIF (igtyp == 52) THEN
454 DO ip=1,npt
455 jpid = iwork_t(ie)%PLYID(ip) ! ply pid number
456c IGEO(1, JPID) ! ply pid ID
457 IF (jpid > 0) THEN
458 jdrp = igeo_stack(48,jpid)
459 IF (id == jdrp)THEN
460 no_used_drape = no_used_drape + 1
461 ENDIF
462 ENDIF
463 ENDDO ! DO IP=1,N1
464 ENDIF ! IF (IGTYP == 17 .OR. IGTYP == 51)
465 ENDDO ! DO IE=1,NUMELC
466C
467 DO ie=1,numeltg
468 ix = ixtg(nixtg,ie)
469 pid = ixtg(5,ie)
470 igtyp = igeo(11,pid)
471 npt = iworksh(1,numelc + ie)
472 IF (igtyp == 17 .OR. igtyp == 51) THEN
473 DO ip=1,npt
474 jpid = iwork_t(numelc + ie)%PLYID(ip) ! ply pid number
475c IGEO(1, JPID) ! ply pid ID
476 IF (jpid > 0) THEN
477 jdrp = igeo(48,jpid)
478 IF (id == jdrp)THEN
479 no_used_drape = no_used_drape + 1
480 ENDIF
481 ENDIF
482 ENDDO
483 ELSEIF (igtyp == 52) THEN
484 DO ip=1,npt
485 jpid = iwork_t(numelc + ie)%PLYID(ip) ! ply pid number
486c IGEO(1, JPID) ! ply pid ID
487 IF (jpid > 0) THEN
488 jdrp = igeo_stack(48,jpid)
489 IF (id == jdrp)THEN
490 no_used_drape = no_used_drape + 1
491 ENDIF
492 ENDIF
493 ENDDO ! DO IP=1,N1
494 ENDIF ! IF (IGTYP == 17 .OR. IGTYP == 51)
495 ENDDO ! DO IE=1,NUMELTG
496 ! Drape ID non-associated to any ply
497 IF (no_used_drape == 0) THEN
498 CALL ancmsg(msgid=1169,
499 . msgtype=msgwarning,
500 . anmode=aninfo,
501 . c1=mess5,
502 . i1=id)
503 ENDIF
504 !-------------------------------------------------------------------------
505 ! Looking for ID doubles (shell, sh3n, grshel, grsh3n) in the same /DRAPE
506 !-------------------------------------------------------------------------
507 ! Double shell -
508 CALL udouble3(itmp_sh4n,2,it1,mess5,mess1,0,bid)
509 ! Double grshel -
510 CALL udouble3(itmp_grsh4n,2,it3,mess5,mess2,0,bid)
511 ! To be checked for sh3n, grsh3n
512 ! - double she3n -
513 CALL udouble3(itmp_sh3n,2,it2,mess5,mess3,0,bid)
514 ! - double grshel -
515 CALL udouble3(itmp_grsh3n,2,it4,mess5,mess4,0,bid)
516 !-------------------------------------------------------------------------
517 ! Filling DRAPE data structure
518 !-------------------------------------------------------------------------
519
520 IF (it1 > 0) THEN
521 DO j=1,it1
522 ish = ish4n_drp(j,1)
523 idrp = ish4n_drp(j,2)
524 nslice = ish4n_drp(j,3)
525 no_ish = 0
526 DO ie=1,numelc
527 ix = ixc(nixc,ie)
528 pid = ixc(6,ie)
529 igtyp = igeo(11,pid)
530 npt = iworksh(1,ie)
531 npt_drp = 0
532 IF (ish == ix) THEN
533 no_ish = no_ish + 1
534c tag of sh4n to check doubles within the DRAPE
535 IF (tagsh(ie) == 0) THEN
536 tagsh(ie) = ish
537 nis = 0
538 IF (.NOT.ALLOCATED(drape_wrk(ie)%DRAPE_PLY)) THEN
539 ALLOCATE(drape_wrk(ie)%DRAPE_PLY(npt))
540 numelc_drape = numelc_drape + 1
541 indx_tmp(ie) = numelc_drape
542 drape_wrk(ie)%NPLY_DRAPE = 0
543 ENDIF
544 no_ish = no_ish + 1
545C count DRAPE entities for printing out
546 drp_shel(i) = drp_shel(i) + 1
547C
548 IF (igtyp == 17 .OR. igtyp == 51) THEN
549 ippid = 2
550 IF (.NOT.ALLOCATED(drape_wrk(ie)%INDX_PLY)) THEN
551 ALLOCATE(drape_wrk(ie)%INDX_PLY(npt) )
552 drape_wrk(ie)%INDX_PLY = 0
553 ENDIF
554 npt_drp = drape_wrk(ie)%NPLY_DRAPE
555 DO ip=1,npt
556 jpid = iwork_t(ie)%PLYID(ip) ! ply pid number
557c IGEO(1, JPID) ! ply pid ID
558 IF (jpid > 0) THEN
559 jdrp = igeo(48,jpid)
560 IF (idrp == jdrp)THEN
561 ALLOCATE(drape_wrk(ie)%DRAPE_PLY(ip)%RDRAPE(nslice,2))
562 ALLOCATE(drape_wrk(ie)%DRAPE_PLY(ip)%IDRAPE(nslice,2))
563 drape_wrk(ie)%DRAPE_PLY(ip)%RDRAPE = zero
564 drape_wrk(ie)%DRAPE_PLY(ip)%IDRAPE = 0
565 drape_wrk(ie)%DRAPE_PLY(ip)%NSLICE = nslice
566 npt_drp = npt_drp + 1
567 drape_wrk(ie)%NPLY_DRAPE = npt_drp
568 drape_wrk(ie)%INDX_PLY(npt_drp) = ip
569 drape_wrk(ie)%DRAPE_PLY(ip)%IPID = idrp
570 DO isl = 1,nslice
571 drape_wrk(ie)%DRAPE_PLY(ip)%RDRAPE(isl,1) = rsh4n(j,isl,1)
572 drape_wrk(ie)%DRAPE_PLY(ip)%RDRAPE(isl,2) = rsh4n(j,isl,2)
573 drape_wrk(ie)%DRAPE_PLY(ip)%IDRAPE(isl,1) = ish4n(j,isl,1) !! Mat_id
574 drape_wrk(ie)%DRAPE_PLY(ip)%IDRAPE(isl,2) = ish4n(j,isl,2) !! NPT_SLICE
575 ENDDO ! nbre of slice
576check if SH4N of the DRAPE is inside any plys
577 nis = nis + 1
578 ENDIF
579 ENDIF
580 ENDDO ! DO IP=1,NPT
581 ELSEIF (igtyp == 52) THEN
582 ippid = 2
583 IF (.NOT.ALLOCATED(drape_wrk(ie)%INDX_PLY)) THEN
584 ALLOCATE(drape_wrk(ie)%INDX_PLY(npt) )
585 drape_wrk(ie)%INDX_PLY = 0
586 ENDIF
587 npt_drp = drape_wrk(ie)%NPLY_DRAPE
588 DO ip=1,npt
589 jpid = iwork_t(ie)%PLYID(ip) ! ply pid number
590c IGEO(1, JPID) ! ply pid ID
591 IF (jpid > 0) THEN
592 jdrp = igeo_stack(48,jpid)
593 IF (idrp==jdrp)THEN
594 ALLOCATE(drape_wrk(ie)%DRAPE_PLY(ip)%RDRAPE(nslice,2) )
595 ALLOCATE(drape_wrk(ie)%DRAPE_PLY(ip)%IDRAPE(nslice,2) )
596 drape_wrk(ie)%DRAPE_PLY(ip)%RDRAPE = zero
597 drape_wrk(ie)%DRAPE_PLY(ip)%IDRAPE = 0
598 drape_wrk(ie)%DRAPE_PLY(ip)%NSLICE = nslice
599 npt_drp = npt_drp + 1
600 drape_wrk(ie)%NPLY_DRAPE = npt_drp
601 drape_wrk(ie)%INDX_PLY(npt_drp) = ip
602 drape_wrk(ie)%DRAPE_PLY(ip)%IPID = idrp
603 DO isl = 1,nslice
604 drape_wrk(ie)%DRAPE_PLY(ip)%RDRAPE(isl,1) = rsh4n(j,isl,1)
605 drape_wrk(ie)%DRAPE_PLY(ip)%RDRAPE(isl,2) = rsh4n(j,isl,2)
606 drape_wrk(ie)%DRAPE_PLY(ip)%IDRAPE(isl,1) = ish4n(j,isl,1) !! Mat_id
607 drape_wrk(ie)%DRAPE_PLY(ip)%IDRAPE(isl,2) = ish4n(j,isl,2) !! NPT_SLICE
608 ENDDO ! nbre of slice
609C count DRAPE entities for printing out
610c DRP_SHEL(I) = DRP_SHEL(I) + 1
611check if SH4N of the DRAPE is inside any plys
612 nis = nis + 1
613 ENDIF
614 ENDIF
615 ENDDO ! DO IP=1,NPT
616 ENDIF ! F (IGTYP == 17 .OR. IGTYP == 51)
617C---
618 IF (nis == 0 .AND.
619 . (igtyp == 17. or. igtyp == 51 .OR. igtyp == 52)) THEN
620C
621C error message to be add
622C
623C --- SH4N --- from /DRAPE not associated to a PID = 17, 51, 52 plys
624C
625 CALL ancmsg(msgid=1172,
626 . msgtype=msgerror,
627 . anmode=aninfo,
628 . c1=mess5,
629 . i1=id,
630 . c2=mess1,
631 . i2=ish)
632 ELSEIF (nis == 0 .AND.
633 . igtyp /= 17. and. igtyp /= 51 .AND. igtyp /= 52) THEN
634C --- SH4N --- from /DRAPE belong to a not allowed PID
635 CALL ancmsg(msgid=1171,
636 . msgtype=msgerror,
637 . anmode=aninfo,
638 . c1=mess5,
639 . i1=id,
640 . c2=mess1,
641 . i2=ish)
642 ENDIF ! IF (NIS == 0
643 ENDIF ! IF (TAGSH(IE) == 0)
644 ENDIF ! IF (ISH == IX)
645 ENDDO ! DO IE=1,NUMELC
646C---
647 IF (no_ish == 0) THEN
648C --- SH4N --- from /DRAPE is not existing
649 CALL ancmsg(msgid=1174,
650 . msgtype=msgerror,
651 . anmode=aninfo,
652 . c1=mess5,
653 . i1=id,
654 . c2=mess1,
655 . i2=ish)
656 ENDIF
657 ENDDO ! DO J=1,IT1
658 ENDIF ! IF (IT1 > 0)
659C---
660C---
661 IF (it3 > 0) THEN
662 DO j=1,it3
663 igr = igrsh4n_drp(j,1)
664 idrp = igrsh4n_drp(j,2)
665 nslice = igrsh4n_drp(j,3)
666 DO jj=1,ngrshel
667 offc = ngrnod + ngrbric + ngrquad + jj
668 jgr = igrsh4n(jj)%ID
669 nel = igrsh4n(jj)%NENTITY
670C element type Q4
671 ity = igrsh4n(jj)%GRTYPE
672 IF (igr == jgr) THEN
673 IF (ity == 3) THEN
674 DO ii = 1,nel
675 idshel = igrsh4n(jj)%ENTITY(ii)
676 pid = ixc(6,idshel)
677 igtyp = igeo(11,pid)
678 npt =iworksh(1,idshel)
679 IF (tagsh(idshel) == 0) THEN
680 tagsh(idshel) = idshel
681 nis = 0
682 IF (.NOT.ALLOCATED(drape_wrk(idshel)%DRAPE_PLY)) THEN
683 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(npt))
684 numelc_drape = numelc_drape + 1
685 indx_tmp(idshel) = numelc_drape
686 drape_wrk(idshel)%NPLY_DRAPE = 0
687 ENDIF
688C
689C count DRAPE entities for printing out
690 drp_shel(i) = drp_shel(i) + 1
691 ippid = 2
692 IF (igtyp == 17 .OR. igtyp == 51) THEN
693 IF (.NOT.ALLOCATED(drape_wrk(idshel)%INDX_PLY)) THEN
694 ALLOCATE(drape_wrk(idshel)%INDX_PLY(npt) )
695 drape_wrk(idshel)%INDX_PLY = 0
696 ENDIF
697 npt_drp = drape_wrk(idshel)%NPLY_DRAPE
698 DO ip=1,npt
699 jpid = iwork_t(idshel)%PLYID(ip) ! ply pid number
700c IGEO(1, JPID) ! ply pid ID
701 IF (jpid > 0) THEN
702 jdrp = igeo(48,jpid)
703 IF (idrp==jdrp)THEN
704 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(nslice,2) )
705 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(nslice,2) )
706 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE = 0
707 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE = zero
708 drape_wrk(idshel)%DRAPE_PLY(ip)%NSLICE = nslice
709 npt_drp = npt_drp + 1
710 drape_wrk(idshel)%NPLY_DRAPE = npt_drp
711 drape_wrk(idshel)%INDX_PLY(npt_drp) = ip
712 drape_wrk(idshel)%DRAPE_PLY(ip)%IPID = idrp
713 DO isl = 1,nslice
714 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,1) = rsh4n_gr(j,isl,1)
715 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,2) = rsh4n_gr(j,isl,2)
716 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,1) = ish4n_gr(j,isl,1) !! Mat_id
717 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,2) = ish4n_gr(j,isl,2) !! NPT_SLICE
718 ENDDO ! nbre of slice
719C
720C count DRAPE entities for printing out
721c DRP_SHEL(I) = DRP_SHEL(I) + 1
722C
723check if SH4N of grshel of the DRAPE is inside any plys
724 nis = nis + 1
725 ENDIF
726 ENDIF
727 ENDDO
728 ELSEIF (igtyp == 52) THEN
729 IF (.NOT.ALLOCATED(drape_wrk(idshel)%INDX_PLY)) THEN
730 ALLOCATE(drape_wrk(idshel)%INDX_PLY(npt) )
731 drape_wrk(idshel)%INDX_PLY = 0
732 drape_wrk(idshel)%NPLY_DRAPE = 0
733 ENDIF
734 npt_drp = drape_wrk(idshel)%NPLY_DRAPE
735 DO ip=1,npt
736 jpid = iwork_t(idshel)%PLYID(ip)
737 IF (jpid > 0) THEN
738 jdrp = igeo_stack(48,jpid)
739 IF (idrp==jdrp)THEN
740 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(nslice,2) )
741 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(nslice,2) )
742 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE = zero
743 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE = 0
744 drape_wrk(idshel)%DRAPE_PLY(ip)%NSLICE = nslice
745 npt_drp = npt_drp + 1
746 drape_wrk(idshel)%NPLY_DRAPE = npt_drp
747 drape_wrk(idshel)%INDX_PLY(npt_drp) = ip
748 drape_wrk(idshel)%DRAPE_PLY(ip)%IPID = idrp
749 DO isl = 1,nslice
750 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,1) = rsh4n_gr(j,isl,1)
751 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,2) = rsh4n_gr(j,isl,2)
752 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,1) = ish4n_gr(j,isl,1) !! Mat_id
753 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,2) = ish4n_gr(j,isl,2) !! NPT_SLICE
754 ENDDO ! nbre of slice
755C count DRAPE entities for printing out
756c DRP_SHEL(I) = DRP_SHEL(I) + 1
757C
758check if SH4N of grshel of the DRAPE is inside any plys
759 nis = nis + 1
760 ENDIF
761 ENDIF
762 ENDDO
763 ENDIF ! IF (IGTYP == 17 .OR. IGTYP == 51)
764C---
765 IF (nis == 0 .AND.
766 . (igtyp == 17. or. igtyp == 51 .OR. igtyp == 52)) THEN
767C --- SH4N --- from /DRAPE not associated to a PID = 17, 51, 52 plys
768 CALL ancmsg(msgid=1173,
769 . msgtype=msgerror,
770 . anmode=aninfo,
771 . c1=mess5,
772 . i1=id,
773 . c2=mess2,
774 . i2=igr,
775 . c3=mess1,
776 . i3=ixc(nixc,idshel))
777 ELSEIF (nis == 0 .AND.
778 . igtyp /= 17. and. igtyp /= 51 .AND. igtyp /= 52) THEN
779C --- SH4N --- from /DRAPE belong to a not allowed PID
780 CALL ancmsg(msgid=1170,
781 . msgtype=msgerror,
782 . anmode=aninfo,
783 . c1=mess5,
784 . i1=id,
785 . c2=mess2,
786 . i2=igr,
787 . c3=mess1,
788 . i3=ixc(nixc,idshel))
789 ENDIF
790 ELSEIF (tagsh(idshel) == ixc(nixc,idshel)) THEN
791 CALL ancmsg(msgid=1155,
792 . msgtype=msgerror,
793 . anmode=aninfo,
794 . c1=mess,
795 . i1=idrp,
796 . c2=mess2,
797 . i2=igr,
798 . c3=mess1,
799 . i3=ixc(nixc,idshel))
800 ENDIF ! IF (TAGSH(IE) == 0)
801 ENDDO ! DO II = 1,NEL
802 ENDIF ! IF (ITY == 3)
803 ENDIF ! IF (IGR == JGR)
804 ENDDO ! DO JJ=1,NGRSHEL
805 ENDDO ! DO J=1,IT3
806 ENDIF ! IF (IT3 > 0)
807 IF (it2 > 0) THEN
808 DO j=1,it2
809 ish = ish3n_drp(j,1)
810 idrp = ish3n_drp(j,2)
811 nslice = ish3n_drp(j,3)
812 no_ish = 0
813 DO ie=1,numeltg
814 ix = ixtg(nixtg,ie)
815 pid = ixtg(5,ie)
816 igtyp = igeo(11,pid)
817 npt_drp = 0
818 IF (ish == ix) THEN
819 no_ish = no_ish + 1
820c tag of SH3N to check doubles within grshel of the DRAPE
821 npt = iworksh(1,numelc +ie) ! nb max de plys belong to the element
822 IF (tagsh(ie+numelc) == 0) THEN
823 tagsh(ie+numelc) = ish
824 nis = 0
825 IF (.NOT.ALLOCATED(drape_wrk(numelc + ie)%DRAPE_PLY)) THEN
826 ALLOCATE(drape_wrk(numelc + ie)%DRAPE_PLY(npt))
827 numeltg_drape = numeltg_drape + 1
828 indx_tmp(numelc + ie) = numeltg_drape
829 drape_wrk(ie + numelc)%NPLY_DRAPE = 0
830 ENDIF
831C count DRAPE entities for printing out
832 drp_sh3n(i) = drp_sh3n(i) + 1
833 ippid = 2
834 IF (igtyp == 17 .OR. igtyp == 51) THEN
835 IF (.NOT.ALLOCATED(drape_wrk(numelc + ie)%INDX_PLY)) THEN
836 ALLOCATE(drape_wrk(numelc + ie)%INDX_PLY(npt) )
837 drape_wrk(numelc + ie)%INDX_PLY = 0
838 ENDIF
839 npt_drp = drape_wrk(numelc + ie)%NPLY_DRAPE
840 DO ip=1,npt
841 jpid = iwork_t(numelc + ie)%PLYID(ip) ! ply pid
842c IGEO(1, JPID) ! ply pid ID
843 IF (jpid > 0) THEN
844 jdrp = igeo(48,jpid)
845 IF (idrp==jdrp)THEN
846 ALLOCATE(drape_wrk(ie+numelc)%DRAPE_PLY(ip)%RDRAPE(nslice,2) )
847 ALLOCATE(drape_wrk(ie+numelc)%DRAPE_PLY(ip)%IDRAPE(nslice,2) )
848 drape_wrk(ie+numelc)%DRAPE_PLY(ip)%RDRAPE = zero
849 drape_wrk(ie+numelc)%DRAPE_PLY(ip)%IDRAPE = 0
850 drape_wrk(ie+numelc)%DRAPE_PLY(ip)%NSLICE = nslice
851 npt_drp = npt_drp + 1
852 drape_wrk(ie+numelc)%NPLY_DRAPE = npt_drp
853 drape_wrk(ie+numelc)%INDX_PLY(npt_drp) = ip
854 drape_wrk(ie+numelc)%DRAPE_PLY(ip)%IPID = idrp
855 DO isl = 1,nslice
856 drape_wrk(ie+numelc)%DRAPE_PLY(ip)%RDRAPE(isl,1) = rsh3n(j,isl,1)
857 drape_wrk(ie+numelc)%DRAPE_PLY(ip)%RDRAPE(isl,2) = rsh3n(j,isl,2)
858 drape_wrk(ie+numelc)%DRAPE_PLY(ip)%IDRAPE(isl,1) = ish3n(j,isl,1) !! Mat_id
859 drape_wrk(ie+numelc)%DRAPE_PLY(ip)%IDRAPE(isl,2) = ish3n(j,isl,2) !! NPT_SLICE
860 ENDDO ! nbre of slice
861C
862C count DRAPE entities for printing out
863c DRP_SH3N(I) = DRP_SH3N(I) + 1
864C
865check if SH3N of grshel of the DRAPE is inside any plys
866 nis = nis + 1
867 ENDIF
868 ENDIF
869 ENDDO ! DO IP=1,NPT
870 ELSEIF (igtyp == 52) THEN
871 IF (.NOT.ALLOCATED(drape_wrk(numelc + ie)%INDX_PLY)) THEN
872 ALLOCATE(drape_wrk(numelc + ie)%INDX_PLY(npt) )
873 drape_wrk(numelc + ie)%INDX_PLY = 0
874 ENDIF
875 npt_drp = drape_wrk(numelc + ie)%NPLY_DRAPE
876 DO ip=1,npt
877 jpid = iwork_t(numelc + ie)%PLYID(ip) ! ply pid
878c IGEO(1, JPID) ! ply pid ID
879 IF (jpid > 0) THEN
880 jdrp = igeo_stack(48,jpid)
881 IF (idrp==jdrp)THEN
882 ALLOCATE(drape_wrk(numelc + ie)%DRAPE_PLY(ip)%RDRAPE(nslice,2) )
883 ALLOCATE(drape_wrk(numelc + ie)%DRAPE_PLY(ip)%IDRAPE(nslice,2) )
884 drape_wrk(numelc + ie)%DRAPE_PLY(ip)%NSLICE = nslice
885 npt_drp = npt_drp + 1
886 drape_wrk(numelc + ie)%NPLY_DRAPE = npt_drp
887 drape_wrk(numelc + ie)%INDX_PLY(npt_drp) = ip
888 drape_wrk(numelc + ie)%DRAPE_PLY(ip)%IPID = idrp
889 DO isl = 1,nslice
890 drape_wrk(numelc + ie)%DRAPE_PLY(ip)%RDRAPE(isl,1) = rsh3n(j,isl,1)
891 drape_wrk(numelc + ie)%DRAPE_PLY(ip)%RDRAPE(isl,2) = rsh3n(j,isl,2)
892 drape_wrk(numelc + ie)%DRAPE_PLY(ip)%IDRAPE(isl,1) = ish3n(j,isl,1) !! Mat_id
893 drape_wrk(numelc + ie)%DRAPE_PLY(ip)%IDRAPE(isl,2) = ish3n(j,isl,2) !! NPT_SLICE
894 ENDDO ! nbre of slice
895C
896C count DRAPE entities for printing out
897c DRP_SH3N(I) = DRP_SH3N(I) + 1
898C
899check if SH3N of grshel of the DRAPE is inside any plys
900 nis = nis + 1
901 ENDIF
902 ENDIF
903 ENDDO ! DO IP=1,NPT
904 ENDIF ! IF (IGTYP == 17 .OR. IGTYP == 51)
905C---
906 IF (nis == 0 .AND.
907 . (igtyp == 17. or. igtyp == 51 .OR. igtyp == 52)) THEN
908C --- SH3N --- from /DRAPE not associated to a PID = 17, 51, 52 plys
909 CALL ancmsg(msgid=1172,
910 . msgtype=msgerror,
911 . anmode=aninfo,
912 . c1=mess5,
913 . i1=id,
914 . c2=mess3,
915 . i2=ish)
916 ELSEIF (nis == 0 .AND.
917 . igtyp /= 17. and. igtyp /= 51 .AND. igtyp /= 52) THEN
918C --- SH3N --- from /DRAPE belong to a not allowed PID
919 CALL ancmsg(msgid=1171,
920 . msgtype=msgerror,
921 . anmode=aninfo,
922 . c1=mess5,
923 . i1=id,
924 . c2=mess3,
925 . i2=ish)
926 ENDIF ! IF (NIS == 0
927 ENDIF ! IF (TAGSH(IE+NUMELC) == 0)
928 ENDIF ! IF (ISH == IX)
929 ENDDO ! DO IE=1,NUMELTG
930C---
931 IF (no_ish == 0) THEN
932C --- SH3N --- from /DRAPE is not existing
933 CALL ancmsg(msgid=1174,
934 . msgtype=msgerror,
935 . anmode=aninfo,
936 . c1=mess5,
937 . i1=id,
938 . c2=mess3,
939 . i2=ish)
940 ENDIF
941 ENDDO ! DO J=1,IT2
942 ENDIF ! IF (IT2 > 0)
943C---
944 IF (it4 > 0) THEN
945 DO j=1,it4
946 igr = igrsh3n_drp(j,1)
947 idrp = igrsh3n_drp(j,2)
948 nslice = igrsh3n_drp(j,3)
949 DO jj=1, ngrsh3n
950 offc = ngrnod + ngrbric + ngrquad + ngrshel + ngrtrus +
951 . ngrbeam + ngrspri + jj
952 jgr = igrsh3n(jj)%ID
953 nel = igrsh3n(jj)%NENTITY
954C element type T3
955 ity = igrsh3n(jj)%GRTYPE
956 IF (igr == jgr) THEN
957 IF (ity == 7) THEN !!! obsolete
958 DO ii = 1,nel
959 idsh3n = igrsh3n(jj)%ENTITY(ii)
960 idshel = idsh3n + numelc
961 pid = ixtg(5,idsh3n)
962 igtyp = igeo(11,pid)
963 npt = iworksh(1,idshel)
964 npt_drp = 0
965 IF (tagsh(idshel) == 0) THEN
966 tagsh(idshel) = ixtg(nixtg,idsh3n)
967 nis = 0
968 IF (.NOT.ALLOCATED(drape_wrk(idshel)%DRAPE_PLY)) THEN
969 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(npt))
970 numeltg_drape = numeltg_drape + 1
971 indx_tmp(idshel) = numeltg_drape
972 drape_wrk(idshel)%NPLY_DRAPE = 0
973 ENDIF
974C
975C count DRAPE entities for printing out
976 drp_sh3n(i) = drp_sh3n(i) + 1
977 ippid = 2
978 IF (igtyp == 17 .OR. igtyp == 51) THEN
979 IF (.NOT.ALLOCATED(drape_wrk(idshel)%INDX_PLY)) THEN
980 ALLOCATE(drape_wrk(idshel)%INDX_PLY(npt) )
981 drape_wrk(idshel)%INDX_PLY = 0
982 ENDIF
983 npt_drp = drape_wrk(idshel)%NPLY_DRAPE
984 DO ip=1,npt
985 jpid = iwork_t(idshel)%PLYID(ip) ! ply pid number
986c IGEO(1, JPID) ! ply pid ID
987 IF (jpid > 0) THEN
988 jdrp = igeo(48,jpid)
989 IF (idrp==jdrp)THEN
990 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(nslice,2))
991 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(nslice,2))
992 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE = zero
993 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE = 0
994 drape_wrk(idshel)%DRAPE_PLY(ip)%NSLICE = nslice
995 npt_drp = npt_drp + 1
996 drape_wrk(idshel)%NPLY_DRAPE = npt_drp
997 drape_wrk(idshel)%INDX_PLY(npt_drp)= ip
998 drape_wrk(idshel)%DRAPE_PLY(ip)%IPID = idrp
999 DO isl = 1,nslice
1000 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,1) = rsh3n_gr(j,isl,1)
1001 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,2) = rsh3n_gr(j,isl,2)
1002 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,1) = ish3n_gr(j,isl,1) !! Mat_id
1003 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,2) = ish3n_gr(j,isl,2) !! NPT_SLICE
1004 ENDDO ! nbre of slice
1005C count DRAPE entities for printing out
1006c DRP_SH3N(I) = DRP_SH3N(I) + 1
1007check if SH3N of grshel of the DRAPE is inside any plys
1008 nis = nis + 1
1009 ENDIF
1010 ENDIF
1011 ENDDO ! DO IP=1,N1
1012 ELSEIF (igtyp == 52) THEN
1013 IF (.NOT.ALLOCATED(drape_wrk(idshel)%INDX_PLY)) THEN
1014 ALLOCATE(drape_wrk(idshel)%INDX_PLY(npt) )
1015 drape_wrk(idshel)%INDX_PLY = 0
1016 ENDIF
1017 npt_drp = drape_wrk(idshel)%NPLY_DRAPE
1018 DO ip=1,npt
1019 jpid = iwork_t(idshel)%PLYID(ip)
1020c IGEO(1, JPID) ! ply pid ID
1021 IF (jpid > 0) THEN
1022 jdrp = igeo_stack(48,jpid)
1023 IF (idrp==jdrp)THEN
1024 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(nslice,2) )
1025 ALLOCATE(drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(nslice,2) )
1026 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE = zero
1027 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE = 0
1028 drape_wrk(idshel)%DRAPE_PLY(ip)%NSLICE = nslice
1029 npt_drp = npt_drp + 1
1030 drape_wrk(idshel)%NPLY_DRAPE = npt_drp
1031 drape_wrk(idshel)%INDX_PLY(npt_drp)= ip
1032 drape_wrk(idshel)%DRAPE_PLY(ip)%IPID = idrp
1033 DO isl = 1,nslice
1034 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,1) = rsh3n_gr(j,isl,1)
1035 drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,2) = rsh3n_gr(j,isl,2)
1036 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,1) = ish3n_gr(j,isl,1) !! Mat_id
1037 drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,2) = ish3n_gr(j,isl,2) !! NPT_SLICE
1038 ENDDO ! nbre of slice
1039C count DRAPE entities for printing out
1040c DRP_SH3N(I) = DRP_SH3N(I) + 1
1041C
1042check if SH3N of grshel of the DRAPE is inside any plys
1043 nis = nis + 1
1044 ENDIF
1045 ENDIF
1046 ENDDO
1047 ENDIF ! IF (IGTYP == 17 .OR. IGTYP == 51)
1048C---
1049 IF (nis == 0 .AND.
1050 . (igtyp == 17. or. igtyp == 51 .OR. igtyp == 52)) THEN
1051C --- SH3N --- from /DRAPE not associated to a PID = 17, 51, 52 plys
1052 CALL ancmsg(msgid=1173,
1053 . msgtype=msgerror,
1054 . anmode=aninfo,
1055 . c1=mess5,
1056 . i1=id,
1057 . c2=mess4,
1058 . i2=igr,
1059 . c3=mess3,
1060 . i3=ixtg(nixtg,idsh3n))
1061 ELSEIF (nis == 0 .AND.
1062 . igtyp /= 17. and. igtyp /= 51 .AND. igtyp /= 52) THEN
1063C --- SH3N --- from /DRAPE belong to a not allowed PID
1064 CALL ancmsg(msgid=1170,
1065 . msgtype=msgerror,
1066 . anmode=aninfo,
1067 . c1=mess5,
1068 . i1=id,
1069 . c2=mess4,
1070 . i2=igr,
1071 . c3=mess3,
1072 . i3=ixtg(nixtg,idsh3n))
1073 ENDIF
1074 ELSEIF (tagsh(idshel) == ixtg(nixtg,idsh3n)) THEN
1075 CALL ancmsg(msgid=1155,
1076 . msgtype=msgerror,
1077 . anmode=aninfo,
1078 . c1=mess,
1079 . i1=idrp,
1080 . c2=mess4,
1081 . i2=igr,
1082 . c3=mess3,
1083 . i3=ixtg(nixtg,idsh3n))
1084 ENDIF ! IF (TAGSH(IDSHEL) == 0)
1085 ENDDO ! DO II = 1,NEL
1086 ENDIF ! IF (ITY == 7)
1087 ENDIF ! IF (IGR == JGR)
1088 ENDDO ! DO JJ=1,NGRSHEL
1089 ENDDO ! DO J=1,IT4
1090 ENDIF ! IF (IT4 > 0)
1091C---
1092 IF (ipri < 5) WRITE(iout,'(10X,I10,2(15X,I10))')
1093 . id,drp_shel(i),drp_sh3n(i)
1094C---
1095 DEALLOCATE(ish4n,ish4n_gr,ish3n ,ish3n_gr,
1096 . ish4n_drp,igrsh4n_drp,ish3n_drp,igrsh3n_drp,
1097 . itmp_sh4n,itmp_sh3n, itmp_grsh4n, itmp_grsh3n)
1098 DEALLOCATE(rsh4n,rsh3n,rsh4n_gr, rsh3n_gr)
1099 ENDDO ! DO I=1,NDRAPE
1100!
1101 IF(numelc_drape > 0) THEN
1102 DO i=1,numelc
1103 ii = indx_tmp(i)
1104 IF(ii > 0)indxsh(ii) = i
1105 ENDDO
1106 ENDIF
1107
1108 IF(numeltg_drape > 0) THEN
1109 DO i=1,numeltg
1110 ii = indx_tmp(i + numelc)
1111 IF(ii > 0) indxsh(numelc_drape + ii) = i+ numelc
1112 ENDDO
1113 ENDIF
1114 DEALLOCATE(indx_tmp)
1115 !====================================================================================
1116 ! End reading /DRAPE
1117 !====================================================================================
1118C-------------------------------------
1119C Recherche des ID doubles (parmis les options /DRAPE)
1120C-------------------------------------
1121 CALL udouble(drape_id,1,ndrape,mess,0,bid)
1122C---
1123C-----------------------------
1124 1001 FORMAT(//
1125 .' DRAPE OPTION '/
1126 .' ------------- '/
1127 .' DRAPE NUMBER ENTITY TYPE ENTITY ID SLICE NUMBER',
1128 .' PLY THINNING FACTOR PLY ORIENTATION ANGLE CHANGE')
1129 1002 FORMAT(//
1130 .' DRAPE OPTION '/
1131 .' ------------- '/
1132 .' DRAPE NUMBER NB. OF SHELL ELEMENTS NB. OF SH3N ELEMENTS')
1133C-----------------------------
1134 RETURN
1135 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_2indexes
subroutine hm_get_float_array_2indexes(name, rval, index1, index2, is_available, lsubmodel, unitab)
Definition hm_get_float_array_2indexes.F:36
hm_get_int_array_2indexes
subroutine hm_get_int_array_2indexes(name, ival, index1, index2, is_available, lsubmodel)
Definition hm_get_int_array_2indexes.F:57
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_prelecdrape
subroutine hm_read_prelecdrape(idrapeid, lsubmodel)
Definition hm_read_drape.F:37
hm_read_drape
subroutine hm_read_drape(drape_wrk, iwork_t, iworksh, igrsh3n, igrsh4n, ixc, ixtg, igeo, igeo_stack, lsubmodel, unitab, indxsh)
Definition hm_read_drape.F:110
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
drape_mod::numeltg_drape
integer numeltg_drape
Definition drape_mod.F:92
drape_mod::numelc_drape
integer numelc_drape
Definition drape_mod.F:92
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
stack_mod
Definition stack_mod.F:72
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589
udouble3
subroutine udouble3(list, ilist, nlist, mess, mess2, ir, rlist)
Definition sysfus.F:1100
starter
program starter
Definition starter.F:39
drape_mod::drape_work_
Definition drape_mod.F:85
submodel_mod::submodel_data
Definition submodel_mod.F:723