OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_drape.F File Reference
#include "implicit_f.inc"
#include "drape_c.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr03_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prelecdrape (idrapeid, lsubmodel)
subroutine hm_read_drape (drape_wrk, iwork_t, iworksh, igrsh3n, igrsh4n, ixc, ixtg, igeo, igeo_stack, lsubmodel, unitab, indxsh)

Function/Subroutine Documentation

◆ hm_read_drape()

subroutine hm_read_drape ( type (drape_), dimension(numelc + numeltg), target drape_wrk,
type(drape_work_), dimension(numelc+numeltg), target iwork_t,
integer, dimension(3,*) iworksh,
type (group_), dimension(ngrsh3n) igrsh3n,
type (group_), dimension(ngrshel) igrsh4n,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropgi,*) igeo_stack,
type(submodel_data), dimension(*) lsubmodel,
type (unit_type_), intent(in) unitab,
integer, dimension(numelc+numeltg) indxsh )

Definition at line 107 of file hm_read_drape.F.

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

◆ hm_read_prelecdrape()

subroutine hm_read_prelecdrape ( integer, dimension(*) idrapeid,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 36 of file hm_read_drape.F.

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 or 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
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:573