62
63
64
75 USE reader_old_mod , ONLY : kinter, kcur, line, nslash
76
77
78
79#include "implicit_f.inc"
80
81
82
83#include "com04_c.inc"
84#include "units_c.inc"
85#include "scr17_c.inc"
86#include "param_c.inc"
87#include "r2r_c.inc"
88#include "lagmult.inc"
89#include "sphcom.inc"
90#include "sms_c.inc"
91
92
93
94 INTEGER ,INTENT(IN) :: NSENSOR
95 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
96 INTEGER IPARTS(*),IPARTC(*),IPARTG(*),IPARTT(*),IPARTP(*),
97 . IPARTR(*),COMPT_T2,MODIF,PASSE,INOM_OPT(*),IPARTSP(*),NSPCONDN,
98 . NSPHION,IPART_L(LIPART1,*),MEMTR(*),IWORKSH(*),NEW_NSLASH_INT,NEW_HM_NINTER,NEW_NINTSUB,
99 . NEW_NINIVOL,IXS10(*), IXS16(*), IXS20(*)
100 INTEGER ,INTENT(IN) :: NB_SEATBELT_SHELLS
101 INTEGER ,INTENT(IN) :: SEATBELT_SHELL_TO_SPRING(NUMELC,2)
103 . pm_stack(*)
104
105 TYPE (GROUP_) , DIMENSION(NGRNOD)
106TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
107 TYPE (SURF_) , DIMENSION(NSLIN) :: IGRSLIN
108 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
109 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
110 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
111 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
112 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
113 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
114 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
115 TYPE(DETONATORS_STRUCT_),TARGET,INTENT(IN) :: DETONATORS
116
117
118
119 INTEGER USR2SYS
120
121
122
123 INTEGER I,J,L,NI,GRM,GRS,IGU,MAIN,NUL,NOD,ISK,NRB
124 INTEGER GR_ID,COMPT,TAG,IAD,CUR_ID,NB_RBY
125 INTEGER NB_KIN,NB_LAG,N1,N2,ID_RBY,DOMA,ISTER
126 INTEGER ID_CYL,CCPL,DIFF,D1,D2,G1,G2,GX,IP,JOE,JIE
127 INTEGER COMPT_M,COMPT_S,CUR_TYP,SUM,CONT,K,TYPE2
128 INTEGER NB_INT,ID_INTER,LNM,LNS,L1,L2,ISENS,VAL,WARN
129 INTEGER ,NUL50(50),ID_RBE3,ID_RBE2,ID_JOIN
130 INTEGER NU(4),NS(4),JREC,ID_MPC,ISUR,ISURS,ID_MON,FLG
131 INTEGER COMPT2,IGR9_TEMP,IGR8_TEMP,IGR2_TEMP,ID,ID_PART,IDS
132 INTEGER SPTFL,BID(LNOPT1),IUD,IGRPP_R2R(2,NGRNOD),FLAG_T24T25
133 INTEGER SUB_ID,IDTITL,IDINT,GR_BRIC,NUMC
134 INTEGER NTRANS,NNODE_TRANSFORM,NODE_TRANSFORM(6)
135 INTEGER GRNOD_T24T25
137 CHARACTER MESS*40,TSENS*40
138 CHARACTER(LEN=NCHARTITLE) :: TITR
139 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
140 CHARACTER(LEN=NCHARFIELD) :: STRING
141 INTEGER, DIMENSION(:), ALLOCATABLE :: BUF_TEMP
142 DATA mess/'MULTIDOMAIN PREREADING OF OPTIONS'/
143 LOGICAL :: IS_AVAILABLE
144
145
146
147
148
149
151 . ipartc,ipartg,igrpp_r2r ,pm_stack , iworksh,
152 . igrnod,igrsurf,igrslin,igrbric,ixs10,
153 . ixs20,ixs16)
154
155
156
157
158
159 IF (passe==0) THEN
160
161
162
163 IF (ndamp>0) THEN
165 . msgtype=msgwarning,
166 . anmode=aninfo_blind_1,
167 . c1="/DAMP")
168 ndamp = 0
169 ENDIF
170
171
172
173 IF (nfxbody>0) THEN
175 . msgtype=msgwarning,
176 . anmode=aninfo,
177 . c1="/FXBODY")
178 nfxbody = 0
179 ENDIF
180
181
182 IF (isms>0) THEN
184 . msgtype=msgerror,
185 . anmode=aninfo,
186 . c1="/AMS")
187 ENDIF
188
189
190
191
192
195 2 igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss,
196 3 igrbeam ,igrspring ,igrnod, lsubmodel , seatbelt_shell_to_spring,
197 4 nb_seatbelt_shells)
198
199
200
201
203 DO i = 1, naccelm
205 CALL hm_get_intv(
'nodeid', nod, is_available, lsubmodel)
206 CALL hm_get_intv(
'skewid', isk, is_available, lsubmodel)
210 ENDDO
211
212
213
214 ntrans = 0
217 DO i=1,ntrans
220 . option_titr = titr,
221 . keyword2 = key)
222
223 IF (key(1:3)/='MAT') THEN
224 CALL hm_get_intv(
'node1',n1,is_available,lsubmodel)
225 CALL hm_get_intv(
'node2',n2,is_available,lsubmodel)
226 IF (n1/=0) THEN
229 ENDIF
230 IF (n2/=0) THEN
233 ENDIF
234 ENDIF
235
236 ENDDO
237
238
239
240
242 DO i=1,nsensor
244 . option_id = isens, keyword2 = key )
245 IF (key(1:4) == 'DIST'.OR. key(1:5) == 'TYPE2') THEN
246 CALL hm_get_intv (
'Sensor1' ,n1 ,is_available,lsubmodel)
247 CALL hm_get_intv (
'Sensor2' ,n2 ,is_available,lsubmodel)
252 ELSEIF (key(1:5) == 'INTER'.OR.key(1:5) == 'TYPE6') THEN
253 CALL ancmsg(msgid=835, msgtype=msgerror, anmode=aninfo,
254 . c1="/SENSOR/INTER")
255 ELSEIF (key(1:4) == 'RWAL'.OR.key(1:5) == 'TYPE7') THEN
256 CALL ancmsg(msgid=835, msgtype=msgerror, anmode=aninfo,
257 . c1="/SENSOR/RWALL")
258 ELSEIF (key(1:3) == 'VEL' .OR. key(1:5) == 'TYPE9') THEN
259
260
261
262 ELSEIF (key(1:4) /='SENS'.AND.key(1:5)/='TYPE3'
263 . .AND.key(1:3)/='AND'.AND.key(1:5)/='TYPE4'
264 . .AND.key(1:2)/='OR'.AND.key(1:5)/='TYPE5'
265 . .AND.key(1:3)/='NOT'.AND.key(1:5)/='TYPE8'
266 . .AND.key(1:4)/='TIME'.AND.key(1:5)/='TYPE0'
267 . .AND.key(1:4)/='ACCE'.AND.key(1:5)/='TYPE1') THEN
268 tsens = '/SENSOR/'//key(1:5)
269 CALL ancmsg(msgid=835, msgtype=msgerror, anmode=aninfo,
270 . c1=tsens)
271 ENDIF
272 END DO
273
274
275
276
277
279
282
283 DO i=1,nbgauge
284 key=''
287 . keyword2 = key )
288
289 flg = 0
290 IF (key(1:3) == 'SPH') cycle
291
293
294 CALL hm_get_intv (
'NODE1' ,nod ,is_available,lsubmodel)
295 CALL hm_get_intv (
'shell_ID' ,ids ,is_available,lsubmodel)
296 IF ((nod== 0).AND.(ids /= 0)) THEN
297 flg = 1
298
299 DO j=1,numelc
300 IF(
ixc(nixc*j)==ids)
THEN
301 ids = j
302 EXIT
303 ENDIF
304 ENDDO
305 IF (
tag_elc(ids+npart) < 1)
THEN
307 ENDIF
308 ELSEIF ((nod/=0).AND.(ids==0)) THEN
309
312 ENDIF
313 END DO
314
315
317 DO i=1,nbgauge
318 key=''
321 . keyword2 = key )
322
323 flg = 0
324 IF (key(1:3) == 'SPH') THEN
325
327
328 CALL hm_get_intv (
'NODE1' ,nod ,is_available,lsubmodel)
329 CALL hm_get_intv (
'shell_ID' ,ids ,is_available,lsubmodel)
330 IF ((nod== 0).AND.(ids /= 0)) THEN
331 flg = 1
332
333 DO j=1,numelc
334 IF(
ixc(nixc*j)==ids)
THEN
335 ids = j
336 EXIT
337 ENDIF
338 ENDDO
339 IF (
tag_elc(ids+npart) < 1)
THEN
341 ENDIF
342 ELSEIF ((nod/=0).AND.(ids==0)) THEN
343
346 ENDIF
347 ENDIF
348 END DO
349
350
351
352
353 ni=0
354 ALLOCATE(
tagmon(nmonvol + nvolu))
356
357
358
359
360
362 compt = 0
363
364 DO i=1,nmonvol
365
367 . option_id = id_mon,
368 . keyword2 = key)
369
370 IF (key(1:7) == 'AIRBAG1') THEN
371 CALL hm_get_intv(
'surf', isur, is_available, lsubmodel)
372 ELSEIF ((key(1:4) == 'PRES').OR.(key(1:6) == 'AIRBAG')) THEN
373 CALL hm_get_intv(
'entityiddisplayed', isur, is_available, lsubmodel)
374 ENDIF
375
376 isurs = 0
377 DO j=1,nsurf
378 IF(isur==igrsurf(j)%ID) isurs=j
379 ENDDO
380
381 IF (isurs==0) GOTO 139
382
383 IF (igrsurf(isurs)%NSEG>0) THEN
384 IF (
isurf_r2r(3,isurs)==igrsurf(isurs)%NSEG)
THEN
385
386 GOTO 139
388
390 . msgtype=msgerror,
391 . anmode=aninfo,
392 . i1=id_mon)
393 ENDIF
394 ENDIF
395
396 GOTO 140
398 compt = compt+1
399140 CONTINUE
400
401 END DO
402
403 new_hm_nvolu = compt
404 new_nvolu = 0
405
406 ENDIF
407
408
409
410
411
413 IF (PASSE==0) ALLOCATE(TAGCYL(NJOINT))
414 TAGCYL(:)=0
415 COMPT = 0
416
417 DO I=1,NJOINT
418 CALL HM_OPTION_READ_KEY(LSUBMODEL,
419 . OPTION_ID = ID_CYL)
420 CALL HM_GET_INTV('independentnode',N1,IS_AVAILABLE,LSUBMODEL)
421 CALL HM_GET_INTV('dependentnodes',N2,IS_AVAILABLE,LSUBMODEL)
422 CALL HM_GET_INTV('dependentnodeset',IGU,IS_AVAILABLE,LSUBMODEL)
423
424 GR_ID = 0
425 DO J=1,NGRNOD
426 IF (IGRNOD(J)%ID==IGU) GR_ID = J
427 END DO
428 N1=USR2SYS(N1,ITABM1,MESS,ID_CYL)
429 N2=USR2SYS(N2,ITABM1,MESS,ID_CYL)
430
431 IF (GR_ID==0) THEN
432 IGR2_TEMP = 0
433 IGR8_TEMP = 0
434 IGR9_TEMP = 0
435 ELSE
436 IGR2_TEMP = IGRNOD(GR_ID)%NENTITY
437 IGR8_TEMP = IGRNOD(GR_ID)%R2R_ALL
438 IGR9_TEMP = IGRNOD(GR_ID)%R2R_SHARE
439 ENDIF
440
441 IF (TAGNO(N1+NPART)>1) IGR9_TEMP=IGR9_TEMP+1
442 IF (TAGNO(N2+NPART)>1) IGR9_TEMP=IGR9_TEMP+1
443 IF (TAGNO(N1+NPART)>0) IGR8_TEMP=IGR8_TEMP+1
444 IF (TAGNO(N2+NPART)>0) IGR8_TEMP=IGR8_TEMP+1
445 IF (TAGNO(N1+NPART)/=0) IGR2_TEMP=IGR2_TEMP+1
446 IF (TAGNO(N2+NPART)/=0) IGR2_TEMP=IGR2_TEMP+1
447
448 IF (IGR8_TEMP>0) THEN
449 DIFF = IGR2_TEMP-IGR8_TEMP
450.OR. IF ((IGR9_TEMP>0)(DIFF/=0)) THEN
451
452 IF (GR_ID>0) THEN
453 DO J=1,IGRNOD(GR_ID)%NENTITY
454 CUR_ID = IGRNOD(GR_ID)%ENTITY(J)
455 IF (TAGNO(CUR_ID+NPART)<3) THEN
456 CALL MODIF_TAG(TAGNO(NPART+CUR_ID),5,MODIF)
457 ENDIF
458 END DO
459 ENDIF
460 IF (TAGNO(N1+NPART)<3) THEN
461 CALL MODIF_TAG(TAGNO(NPART+N1),5,MODIF)
462 ENDIF
463 IF (TAGNO(N2+NPART)<3) THEN
464 CALL MODIF_TAG(TAGNO(NPART+N2),5,MODIF)
465 ENDIF
466 ENDIF
467 COMPT = COMPT + 1
468
469 TAGCYL(I)=ID_CYL
470 ENDIF
471
472350 CONTINUE
473 END DO
474
475 NEW_NJOINT = COMPT
476
477
478
479
480
481 CALL HM_OPTION_START('/mpc')
482 IF (PASSE==0) ALLOCATE(TAGMPC(NUMMPC))
483 TAGMPC(:)=0
484 COMPT = 0
485
486 DO I=1,NUMMPC
487 COMPT_M = 0
488 COMPT_S = 0
489 CALL HM_OPTION_READ_KEY(LSUBMODEL,
490 . OPTION_ID = ID_MPC,
491 . OPTION_TITR = TITR)
492 CALL HM_GET_INTV('number_of_nodes',NUMC,IS_AVAILABLE,LSUBMODEL)
493 DO J=1,NUMC
494 CALL HM_GET_INT_ARRAY_INDEX('node_id',N1,J,IS_AVAILABLE,LSUBMODEL)
495 N2 = USR2SYS(N1,ITABM1,MESS,ID_MPC)
496 IF (TAGNO(N2+NPART)>=0) COMPT_M=COMPT_M+1
497 IF (TAGNO(N2+NPART)>1) COMPT_S=COMPT_S+1
498 IF (TAGNO(N2+NPART)<=0) COMPT_S=COMPT_S+1
499 END DO
500
501 IF (COMPT_M>0) THEN
502 IF (COMPT_S==0) THEN
503
504 TAGMPC(I) = ID_MPC
505 COMPT = COMPT + 1
506 ELSE
507
508 CALL ANCMSG(MSGID=896,
509 . MSGTYPE=MSGERROR,
510 . ANMODE=ANINFO,
511 . C1="/MPC",
512 . I1=ID_MPC)
513 ENDIF
514 ENDIF
515 END DO
516
517 NEW_NUMMPC = COMPT
518
519
520
521
522
523 CALL HM_OPTION_START('/gjoint')
524 IF (PASSE==0) ALLOCATE(TAGJOIN(NGJOINT))
525 TAGJOIN(:)=0
526 COMPT = 0
527
528 DO I=1,NGJOINT
529 COMPT_M = 0
530 COMPT_S = 0
531
532 CALL HM_OPTION_READ_KEY(LSUBMODEL,
533 . OPTION_ID = ID_JOIN,
534 . OPTION_TITR = TITR,
535 . KEYWORD2 = KEY2)
536
537 CALL HM_GET_INTV('node_id0',NU(1),IS_AVAILABLE,LSUBMODEL)
538 CALL HM_GET_INTV('node_id1',NU(2),IS_AVAILABLE,LSUBMODEL)
539 CALL HM_GET_INTV('node_id2',NU(3),IS_AVAILABLE,LSUBMODEL)
540 CALL HM_GET_INTV('node_id3',NU(4),IS_AVAILABLE,LSUBMODEL)
541
542 VAL = 3
543 IF(KEY2(1:4)=='diff') VAL = 4
544
545 DO J=1,VAL
546 NS(J) = USR2SYS(NU(J),ITABM1,MESS,ID_JOIN)
547 IF (TAGNO(NS(J)+NPART)>=0) COMPT_M=COMPT_M+1
548 IF (TAGNO(NS(J)+NPART)>1) COMPT_S=COMPT_S+1
549 IF (TAGNO(NS(J)+NPART)<=0) COMPT_S=COMPT_S+1
550 END DO
551
552
553 IF (COMPT_M>0) THEN
554 IF (COMPT_S==0) THEN
555
556 TAGJOIN(I) = ID_JOIN
557 COMPT = COMPT + 1
558 ELSE
559
560 CALL ANCMSG(MSGID=896,
561 . MSGTYPE=MSGERROR,
562 . ANMODE=ANINFO,
563 . C1="/GJOINT",
564 . I1=ID_JOIN)
565 ENDIF
566 ENDIF
567 END DO
568
569 NEW_NGJOINT = COMPT
570
571
572
573
574
575 IF (PASSE==0) ALLOCATE(TAGRB2(NRBE2))
576 TAGRB2(:)=0
577 COMPT = 0
578
579 CALL HM_OPTION_START('/rbe2')
580 DO I=1,NRBE2
581
582 CALL HM_OPTION_READ_KEY(LSUBMODEL,
583 . OPTION_ID = ID_RBE2,
584 . OPTION_TITR = TITR)
585
586 CALL HM_GET_INTV('independentnode',N1,IS_AVAILABLE,LSUBMODEL)
587 CALL HM_GET_INTV('dependentnodeset',IGU,IS_AVAILABLE,LSUBMODEL)
588
589 N2 = USR2SYS(N1,ITABM1,MESS,ID_RBE2)
590 GR_ID=0
591 DO J=1,NGRNOD
592 IF (IGRNOD(J)%ID==IGU) GR_ID = J
593 END DO
594
595 IF (GR_ID==0) THEN
596 COMPT = COMPT + 1
597 TAGRB2(I)=ID_RBE2
598 GOTO 360
599 ENDIF
600
601 COMPT_M = IGRNOD(GR_ID)%R2R_ALL
602 COMPT_S = IGRNOD(GR_ID)%R2R_SHARE
603 IF (TAGNO(N2+NPART)>=0) COMPT_M=COMPT_M+1
604 IF (TAGNO(N2+NPART)>1) COMPT_S=COMPT_S+1
605 IF (TAGNO(N2+NPART)<=0) COMPT_S=COMPT_S+1
606
607 IF (COMPT_M>0) THEN
608 IF (COMPT_S==0) THEN
609
610 TAGRB2(I) = ID_RBE2
611 COMPT = COMPT + 1
612 ELSE
613
614 CALL ANCMSG(MSGID=896,
615 . MSGTYPE=MSGERROR,
616 . ANMODE=ANINFO,
617 . C1="/RBE2",
618 . I1=ID_RBE2)
619 ENDIF
620 ENDIF
621360 CONTINUE
622 END DO
623
624 NEW_NRBE2 = COMPT
625
626
627
628
629
630 IF (PASSE==0) ALLOCATE(TAGRB3(NRBE3))
631 TAGRB3(:)=0
632 COMPT = 0
633 CALL HM_OPTION_START('/rbe3')
634
635 DO I=1,NRBE3
636 COMPT_S = 0
637 COMPT_M = 0
638 CALL HM_OPTION_READ_KEY(LSUBMODEL,
639 . OPTION_ID = ID_RBE3,
640 . OPTION_TITR = TITR)
641 CALL HM_GET_INTV('dependentnode',N1,IS_AVAILABLE,LSUBMODEL)
642 CALL HM_GET_INTV('nset',VAL,IS_AVAILABLE,LSUBMODEL)
643
644 ALLOCATE(BUF_TEMP(VAL))
645 N2 = USR2SYS(N1,ITABM1,MESS,ID_RBE3)
646
647 DO L=1,VAL
648 CALL HM_GET_FLOAT_ARRAY_INDEX('independentnodesetcoeffs',F,L,IS_AVAILABLE,LSUBMODEL,UNITAB)
649 CALL HM_GET_INT_ARRAY_INDEX('independentnodesets',IGU,L,IS_AVAILABLE,LSUBMODEL)
650 DO J=1,NGRNOD
651 IF (IGRNOD(J)%ID==IGU) GR_ID = J
652 END DO
653 BUF_TEMP(L)=GR_ID
654 COMPT_M = COMPT_M + IGRNOD(GR_ID)%R2R_ALL
655 COMPT_S = COMPT_S + IGRNOD(GR_ID)%R2R_SHARE
656 END DO
657
658 IF (TAGNO(N2+NPART)>=0) COMPT_M=COMPT_M+1
659 IF (TAGNO(N2+NPART)>1) COMPT_S=COMPT_S+1
660 IF (TAGNO(N2+NPART)<=0) COMPT_S=COMPT_S+1
661
662
663 IF (COMPT_M>0) THEN
664 IF (COMPT_S==0) THEN
665
666 TAGRB3(I) = ID_RBE3
667 COMPT = COMPT + 1
668 ELSE
669
670 IF (TAGNO(NPART+N2)/=-1) THEN
671
672 TAGRB3(I) = ID_RBE3
673 COMPT = COMPT +1
674 ENDIF
675 DO L=1,VAL
676 GR_ID = BUF_TEMP(L)
677 DO J=1,IGRNOD(GR_ID)%NENTITY
678 CUR_ID = IGRNOD(GR_ID)%ENTITY(J)
679 IF (TAGNO(CUR_ID+NPART)<3) THEN
680 CALL MODIF_TAG(TAGNO(NPART+CUR_ID),4,MODIF)
681 ENDIF
682 END DO
683 END DO
684 ENDIF
685 ENDIF
686 DEALLOCATE(BUF_TEMP)
687 END DO
688
689 NEW_NRBE3 = COMPT
690
691
692
693
694
695 IF (PASSE==0) ALLOCATE(TAGLNK(NLINK))
696 TAGLNK(:)=0
697 COMPT = 0
698 CALL HM_OPTION_START('/rlink')
699
700 DO I=1,NLINK
701 CALL HM_OPTION_READ_KEY(LSUBMODEL,
702 . OPTION_ID = ID_RLINK,
703 . OPTION_TITR = TITR)
704 CALL HM_GET_INTV('dependentnodeset' ,IGU ,IS_AVAILABLE,LSUBMODEL)
705
706 GR_ID = 0
707 DO J=1,NGRNOD
708 IF (IGRNOD(J)%ID==IGU) GR_ID = J
709 END DO
710
711 TAG = 0
712 NOD=IGRNOD(GR_ID)%R2R_ALL
713 IF (IGRNOD(GR_ID)%R2R_SHARE==0) TAG = 1
714
715 IF (NOD>0) THEN
716 COMPT = COMPT+1
717 TAGLNK(I)=ID_RLINK
718 IF(TAG/=1) THEN
719
720 DO J=1,IGRNOD(GR_ID)%NENTITY
721 CUR_ID = IGRNOD(GR_ID)%ENTITY(J)
722 IF (TAGNO(CUR_ID+NPART)<3) THEN
723 CALL MODIF_TAG(TAGNO(NPART+CUR_ID),5,MODIF)
724 ENDIF
725 END DO
726 ENDIF
727 ENDIF
728 END DO
729
730 NEW_NLINK = COMPT
731
732
733
734
735
736
737 COMPT_T2 = 0
738 NB_INT = 0
739 KCUR = KINTER
740
741
742 IF (PASSE==0) ALLOCATE(TAGINT(HM_NINTER+NSLASH(KCUR)),TAGINT_WARN(NINTER+1))
743
744
745
746
747 TAGINT(:)=0
748 TAGINT_WARN(:)=0
749 FLG_TIED(:) = 0
750
751
752
753
754
755 CALL HM_OPTION_START('/inter')
756 NI = 0
757 COMPT = 0
758
759 DO I=1,HM_NINTER
760
761 TAG = 0
762 VAL = IDDOM
763 TYPE2 = 0
764
765 CALL HM_OPTION_READ_KEY(LSUBMODEL,
766 . OPTION_ID = ID_INTER,
767 . UNIT_ID = NUL,
768 . SUBMODEL_ID = SUB_ID,
769 . OPTION_TITR = TITR,
770 . KEYWORD2 = KEY,
771 . KEYWORD3 = KEY2)
772
773 TAG = 0
774 VAL = IDDOM
775 TYPE2 = 0
776
777 FLG = 0
778 IF (KEY(6:6)=='/') FLG = 1
779 IF ((LEN_TRIM(KEY))==5) FLG = 1
780
781 GRNOD_T24T25 = 0
782 FLAG_T24T25 = 0
783 IF ((KEY(1:6)=='type24.OR.')(KEY(1:6)=='type25')) THEN
784 FLAG_T24T25 = 1
785 CALL HM_GET_INTV('secondaryentityids',GRS,IS_AVAILABLE,LSUBMODEL)
786 CALL HM_GET_INTV('grnod_id',GRNOD_T24T25,IS_AVAILABLE,LSUBMODEL)
787
788.AND. IF ((GRS > 0)(GRNOD_T24T25 > 0)) GRNOD_T24T25 = 0
789 ENDIF
790
791
792 IF (((KEY(1:5)=='type2.AND..OR.')(FLG==1))
793 . (KEY(1:5)=='type7.OR.')(KEY(1:5)=='type5.OR.')(KEY(1:5)=='type8').OR.
794 . (key(1:6)=='TYPE10').OR.(key(1:6)=='TYPE14').OR.
795 . ((key(1:6)=='TYPE24').AND.(grnod_t24t25 > 0)).OR.
796 . ((key(1:6)=='TYPE25').AND.(grnod_t24t25 > 0))) THEN
797 cont = 1
798 CALL hm_get_intv(
'secondaryentityids',grs,is_available,lsubmodel)
799 CALL hm_get_intv(
'mainentityids',grm,is_available,lsubmodel)
800
801
802 IF (flag_t24t25 == 1) grs = grnod_t24t25
803
804
805 IF ((key(1:5)=='TYPE2').AND.(flg==1)) THEN
806 CALL hm_get_intv(
'WFLAG',sptfl,is_available,lsubmodel)
807 IF ((sptfl/=25).AND.(sptfl/=26)) THEN
808 cont = 0
809 type2 = 1
810 ENDIF
811 ENDIF
812
813
815 . type2,val,tag,i,compt,passe,0,igrpp_r2r,
816 . igrnod ,igrsurf ,igrslin, igrbric)
817
818
819 IF (type2==1) THEN
820 DO j=1,igrnod(g1)%NENTITY
821 cur_id = igrnod(g1)%ENTITY(j)
822 IF (
tagno(cur_id+npart)==2) flg_tied(4) = 1
823 IF (
tagno(cur_id+npart)==4) flg_tied(5) = 1
824 END DO
825 ENDIF
826
827 IF (tag>0) THEN
828 compt_t2 = compt_t2 + 1
829
830 IF ((tag==3).OR.(tag==1).OR.(tag==4)) THEN
832 . ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,0,eani,
833 . igrsurf(g2),igrnod,g2)
834 ENDIF
835
836 IF ((tag==2).OR.(tag==1)) THEN
838 . ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,1,eani,
839 . igrsurf,igrnod,g1)
840 ENDIF
841 ENDIF
842
843
844 ELSEIF (key(1:6) == 'TYPE18') THEN
845 cont = 1
846 CALL hm_get_intv(
'ALEelemsEntityids',gr_bric,is_available,lsubmodel)
847 CALL hm_get_intv(
'ALEnodesEntityids',grs,is_available,lsubmodel)
848 CALL hm_get_intv(
'mainentityids',grm,is_available,lsubmodel)
849
850
851 IF (grs > 0) THEN
853 . type2,val,tag,i,compt,passe,0,igrpp_r2r,
854 . igrnod ,igrsurf ,igrslin, igrbric)
855 ELSEIF (gr_bric > 0) THEN
857 . type2,val,tag,i,compt,passe,3,igrpp_r2r,
858 . igrnod ,igrsurf ,igrslin, igrbric)
859 ENDIF
860
861 IF (tag > 0) THEN
862 compt_t2 = compt_t2 + 1
863
864 IF ((tag == 3) .OR. (tag == 1) .OR. (tag == 4)) THEN
866 . ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,0,eani,
867 . igrsurf(g2),igrnod,g2)
868 ENDIF
869
870 IF ((tag == 2) .OR. (tag == 1)) THEN
871 IF (grs > 0) THEN
873 . ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,1,eani,
874 . igrsurf,igrnod,g1)
875 ELSEIF (gr_bric > 0) THEN
876 DO j=1,igrbric(g1)%NENTITY
877 cur_id = igrbric(g1)%ENTITY(j)
878
879 IF ((
tag_els(cur_id+npart)<(1+cont)).AND.(
tagno(iparts(cur_id))/=val))
THEN
881 ENDIF
882 ENDDO
883 ENDIF
884 ENDIF
885 ENDIF
886
887 ELSEIF (key(1:6)=='TYPE11') THEN
888 cont = 1
889 warn = 0
890 CALL hm_get_intv(
'secondaryentityids',grs,is_available,lsubmodel)
891 CALL hm_get_intv(
'mainentityids',grm,is_available,lsubmodel)
892
894 . type2,val,tag,i,compt,passe,2,igrpp_r2r,
895 . igrnod ,igrsurf ,igrslin, igrbric)
896 IF (tag>0) THEN
897 compt_t2 = compt_t2 + 1
898
899 IF ((tag==2).OR.(tag==1)) THEN
901 . iparts,ipartc,ipartg,ipartt,ipartp,ipartr,val,cont,
902 . modif,warn,igrslin(g1))
903 ENDIF
904
905 IF ((tag==3).OR.(tag==1)) THEN
907 . iparts,ipartc,ipartg,ipartt,ipartp,ipartr,val,cont,
908 . modif,warn,igrslin(g2))
909 ENDIF
910 ENDIF
911 IF (warn==1) THEN
913 . msgtype=msgerror,
914 . anmode=anstop,
915 . i1=id_inter)
916 ENDIF
917 ELSEIF (key(1:6)=='TYPE24'.OR.key(1:6)=='TYPE21'.OR.key(1:5)=='TYPE6'.OR.
918 . key(1:6)=='TYPE23'.OR.key(1:6)=='TYPE20'.OR.key(1:6)=='TYPE15'.OR.
919 . key(1:6)=='TYPE25'.OR.((key(1:5)=='TYPE3').AND.(flg==1))) THEN
920 cont = 1
921 CALL hm_get_intv(
'secondaryentityids',grs,is_available,lsubmodel)
922 CALL hm_get_intv(
'mainentityids',grm,is_available,lsubmodel)
923 IF ((flag_t24t25 == 1).AND.(grm==0)) grm = grs
924
926 . type2,val,tag,i,compt,passe,1,igrpp_r2r,
927 . igrnod ,igrsurf ,igrslin, igrbric)
928 IF (tag>0) THEN
929 compt_t2 = compt_t2 + 1
930
931 IF ((tag==2).OR.(tag==1)) THEN
933 . ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,0,eani,
934 . igrsurf(g1),igrnod,g1)
935 ENDIF
936
937 IF ((tag==3).OR.(tag==1)) THEN
939 . ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,0,eani,
940 . igrsurf(g2),igrnod,g2)
941 ENDIF
942 ENDIF
943
944
945 ELSEIF (key(1:3)/='SUB') THEN
947 . msgtype=msgerror,
948 . anmode=aninfo,
949 . i1=id_inter,
950 . c1=line(1:13))
951 ENDIF
952
953 END DO
954
955 new_hm_ninter = compt
956 new_ninter = 0
957 new_nslash_int = 0
958
959
960
961
962
964
965 compt = 0
966 DO i=1,hm_ninter
967
969 . option_id = id_inter,
970 . unit_id = nul,
971 . submodel_id = sub_id,
972 . option_titr = titr,
973 . keyword2 = key,
974 . keyword3 = key2)
975
976 IF (key(1:3)=='SUB') THEN
977 CALL hm_get_intv(
'InterfaceId',idint,is_available,lsubmodel)
978
979 DO j=1,hm_ninter+nslash(kcur)
980 IF (
tagint(j)==idint)
THEN
982 compt = compt + 1
983 ENDIF
984 END DO
985
986 ENDIF
987
988 END DO
989
990 new_nintsub = compt
991 new_hm_ninter = new_hm_ninter + compt
992
993
994
995
996
997 ni=0
998 nb_rby = 0
999 nb_kin = 0
1000 nb_lag = 0
1001 IF (passe==0)
ALLOCATE(
tagrby(nrbody))
1003 doma = 1
1004
1005
1006
1007
1009 nrb = 0
1010 DO i=1,nrbody
1011
1012
1013
1014 key=''
1016 . option_id = id_rby,
1017 . keyword2 = key,
1018 . option_titr = titr)
1019
1020 IF(key(1:6)=='LAGMUL') cycle
1021
1022 nrb=nrb+1
1023
1025 CALL hm_get_intv(
'sens_ID',isens,is_available,lsubmodel)
1026 CALL hm_get_intv(
'grnd_ID',igu,is_available,lsubmodel)
1027
1029 DO j=1,ngrnod
1030 IF (igrnod(j)%ID==igu) gr_id = j
1031 END DO
1032
1033 tag = 0
1034 compt=igrnod(gr_id)%R2R_ALL
1035 compt2=igrnod(gr_id)%R2R_SHARE
1036
1037 IF (
tagno(
main+npart)>1) compt = compt + 1
1038 IF (
tagno(
main+npart)>1) compt2 = compt2 + 1
1039 IF (compt2==0) tag = 1
1040
1041 IF (compt>0) THEN
1042 IF(tag==1) THEN
1043
1045 ELSE
1046
1049 IF (isens/=0) THEN
1051 . msgtype=msgerror,
1052 . anmode=aninfo,
1053 . c1="FOR RBODY ID=",
1054 . i1=id_rby,
1055 . c2="- RBODY WITH SENSOR")
1056 ENDIF
1057 ENDIF
1058 ENDIF
1059
1061 nb_rby = nb_rby + 1
1062 nb_kin = nb_kin + 1
1063 ENDIF
1064 END DO
1065 new_nrbykin=nb_kin
1066
1067
1068
1069
1071 nrb = 0
1072 DO i=1,nrbody
1073
1074
1075
1076 key=''
1078 . option_id = id_rby,
1079 . keyword2 = key,
1080 . option_titr = titr)
1081
1082 IF(key(1:6)=='LAGMUL') THEN
1083 nrb=nrb+1
1084
1086 . msgtype=msgerror,
1087 . anmode=aninfo,
1088 . c1=line(1:l+9))
1089
1091 CALL hm_get_intv(
'grnd_ID',igu,is_available,lsubmodel)
1092
1094 DO j=1,ngrnod
1095 IF (igrnod(j)%ID==igu) gr_id = j
1096 END DO
1097
1098
1099
1100 tag = 0
1101 compt=igrnod(gr_id)%R2R_ALL
1102 compt2=igrnod(gr_id)%R2R_SHARE
1103
1104 IF (
tagno(
main+npart)>1) compt = compt + 1
1105 IF (
tagno(
main+npart)>1) compt2 = compt2 + 1
1106 IF (compt2==0) tag = 1
1107
1108
1109
1110 IF (compt>0) THEN
1111 IF(tag==1) THEN
1112
1114 ELSE
1115
1118 ENDIF
1119 ENDIF
1120
1122 nb_rby = nb_rby + 1
1123 nb_lag = nb_lag + 1
1124 ENDIF
1125 END IF
1126 END DO
1127
1128 new_nrby = nb_rby
1129 nrbylag = nb_lag
1130
1131
1132
1133
1134
1135 nspcondn = 0
1137 IF (passe==0)
ALLOCATE(
tagsphbcs(nspcond))
1139 DO i=1,nspcond
1142 . option_titr = titr,
1143 . keyword2 = key)
1144 CALL hm_get_intv(
'entityid',igu,is_available,lsubmodel)
1145
1146 gr_id = 0
1147 DO j=1,ngrnod
1148 IF (igrnod(j)%ID==igu) gr_id = j
1149 END DO
1150
1151 compt = 0
1152 DO l=1,igrnod(gr_id)%NENTITY
1153 cur_id =
nod2sp(igrnod(gr_id)%ENTITY(l))
1154 IF (
tagno(ipartsp(cur_id))/=0)
THEN
1155 compt = compt + 1
1156 ENDIF
1157 ENDDO
1158
1159 IF (compt>0) THEN
1160 nspcondn = nspcondn + 1
1162 ENDIF
1163 END DO
1164
1165
1166
1167
1168
1169
1170 nsphion = 0
1171 IF (passe == 0)
ALLOCATE(
tagsphio(nsphio))
1174 DO i = 1,nsphio
1175
1176 titr = ''
1179 . option_titr = titr)
1180 CALL hm_get_intv(
'pid' ,id_part ,is_available,lsubmodel)
1181 CALL hm_get_intv(
'SURF_ID' ,isur ,is_available,lsubmodel)
1182
1183 DO j=1,npart
1184 IF (ipart_l(4,j) == id_part) ids = j
1185 ENDDO
1186 DO j=1,nsurf
1187 IF (igrsurf(j)%ID == isur) g2 = j
1188 END DO
1189
1190 IF (
tagno(ids) /= 0)
THEN
1192 . ipartc,ipartg,ipartsp,1,0,modif,memtr,-2,0,eani,
1193 . igrsurf(g2),igrnod,g2)
1194 nsphion = nsphion + 1
1196 ENDIF
1197 END DO
1198
1199
1200
1201
1202
1204 IF (nalelk > 0) THEN
1206 DO i = 1, nalelk
1208 CALL hm_get_intv(
'node_ID1', n1, is_available, lsubmodel)
1209 CALL hm_get_intv(
'node_ID2', n2, is_available, lsubmodel)
1210 CALL hm_get_intv(
'grnod_ID', gr_id, is_available, lsubmodel)
1211 DO j = 1, ngrnod
1212 IF (igrnod(j)%ID == gr_id) THEN
1213 gr_id = j
1214 EXIT
1215 ENDIF
1216 ENDDO
1219 IF (n1 > 0) THEN
1220 IF ((igrnod(gr_id)%R2R_ALL > 0) .AND. (
tagno(npart+n1) < 1))
THEN
1222 ELSEIF ((igrnod(gr_id)%R2R_SHARE > 0) .AND. (
tagno(npart+n1) == 1))
THEN
1224 ELSEIF (
tagno(npart+n1) == 0)
THEN
1226 ELSEIF (
tagno(npart+n1) == -1)
THEN
1228 ENDIF
1229 ENDIF
1230 IF (n2 > 0) THEN
1231 IF ((igrnod(gr_id)%R2R_ALL > 0) .AND. (
tagno(npart+n2) < 1))
THEN
1233 ELSEIF ((igrnod(gr_id)%R2R_SHARE > 0) .AND. (
tagno(npart+n2) == 1))
THEN
1235 ELSEIF (
tagno(npart+n2) == 0)
THEN
1237 ELSEIF (
tagno(npart+n2) == -1)
THEN
1239 ENDIF
1240 ENDIF
1241 ENDDO
1242 ENDIF
1243
1244
1245
1246
1247
1249
1250 DO i=1,nrwall
1251
1253 . option_id = id_mon,
1254 . keyword2 = key)
1255
1256 IF (key(1:7) == 'LAGMUL') THEN
1257
1259 . msgtype=msgerror,
1260 . anmode=aninfo,
1261 . c1=line(1:l+6))
1262 ELSE
1263 CALL hm_get_intv(
'Node1',nod,is_available,lsubmodel)
1264 IF (nod>0) THEN
1267 ENDIF
1268 ENDIF
1269 ENDDO
1270
1271
1272
1273
1274
1275 new_ninivol = 0
1279
1282 CALL hm_get_intv(
'secondarycomponentlist', id_part, is_available, lsubmodel)
1283
1284 DO j=1,npart
1285 IF(ipart_l(4,j)==id_part) ids=j
1286 ENDDO
1287
1288 IF (
tagno(ids) > 0)
THEN
1290 new_ninivol = new_ninivol + 1
1291 ENDIF
1292 ENDDO
1293
1294
1295
1296
1297
1300
1301 DO i=1,ntrans
1302
1305 . keyword2 = key)
1306
1307 nnode_transform = 0
1308 node_transform(1:6) = 0
1309
1310 IF ((key(1:3)=='TRA').OR.(key(1:3)=='ROT').OR.(key(1:3)=='SYM')) THEN
1311 nnode_transform = 2
1312 CALL hm_get_intv(
'node1',node_transform(1),is_available,lsubmodel)
1313 CALL hm_get_intv(
'node2',node_transform(2),is_available,lsubmodel)
1314 ELSEIF (key(1:3)=='SCA') THEN
1315 nnode_transform = 1
1316 CALL hm_get_intv(
'node1',node_transform(1),is_available,lsubmodel)
1317 ELSEIF (key(1:3)=='POS') THEN
1318 nnode_transform = 6
1319 CALL hm_get_intv(
'node1',node_transform(1),is_available,lsubmodel)
1320 CALL hm_get_intv(
'node2',node_transform(2),is_available,lsubmodel)
1321 CALL hm_get_intv(
'node3',node_transform(3),is_available,lsubmodel)
1322 CALL hm_get_intv(
'node4',node_transform(4),is_available,lsubmodel)
1323 CALL hm_get_intv(
'node5',node_transform(5),is_available,lsubmodel)
1324 CALL hm_get_intv(
'node6',node_transform(6),is_available,lsubmodel)
1325 ENDIF
1326
1327 DO j=1,nnode_transform
1328 IF (node_transform(j) > 0) THEN
1331 ENDIF
1332 ENDDO
1333
1334 ENDDO
1335
1336
1337
1338
1340 DO i=1,detonators%N_DET_POINT
1342 CALL hm_get_intv(
'rad_det_node1', nod, is_available, lsubmodel)
1343 IF (nod>0) THEN
1346 ENDIF
1347 ENDDO
1348
1349
1350
1351 RETURN
1352
1353
1355 RETURN
1356
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_option_count(entity_type, hm_option_number)
integer, parameter ncharfield
integer, dimension(:), allocatable tag_els
integer, dimension(:), allocatable tagsphio
integer, dimension(:), allocatable tag_inivol
integer, dimension(:), allocatable tagsphbcs
integer, dimension(:), allocatable tagrby
integer, dimension(:), allocatable tag_elc
integer, dimension(:), allocatable tagint
integer, dimension(:,:), allocatable isurf_r2r
integer, dimension(:), allocatable taggau
integer, dimension(:), allocatable nod2sp
integer, dimension(:), allocatable, target nom_opt
integer, dimension(:), allocatable ixc
subroutine prelecsec(snstrf, ssecbuf, itabm1, flag_r2r, nom_opt, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrnod, lsubmodel, seatbelt_shell_to_spring, nb_seatbelt_shells)
subroutine r2r_count(passe, iparts, ipartc, ipartg, igrpp_r2r, pm_stack, iworksh, igrnod, igrsurf, igrslin, igrbric, ixs10, ixs20, ixs16)
subroutine modif_tag(tag, new_tag, modif)
int main(int argc, char *argv[])
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)
subroutine tag_elem_void_r2r_lin(nb, iparts, ipartc, ipartg, ipartt, ipartp, ipartr, val, cont, modif, warn, igrslin)
subroutine tag_elem_void_r2r(nb, iparts, ipartc, ipartg, ipartsp, val, cont, modif, itagl, f2, flag, eani2, igrsurf, igrnod, gr_id)
subroutine tagint_r2r(g1, g2, grs, grm, id_inter, type2, val, tag, i, compt, passe, flag, igrpp_r2r, igrnod, igrsurf, igrslin, igrbric)