75 SUBROUTINE hm_set(SET ,LSUBMODEL ,INV_GROUP ,MAP_TABLES,IPART ,
76 . IGRSURF ,IGRNOD ,IGRSLIN ,IGRPART ,IGRBRIC ,
77 . IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS ,IGRBEAM ,
78 . IGRSPRING,IXS ,IXS10 ,IXC ,IXTG ,
79 . KNOD2ELS ,NOD2ELS ,KNOD2ELC ,NOD2ELC ,KNOD2ELTG ,
80 . NOD2ELTG ,IPARTC ,IPARTG ,IPARTS ,SH4TREE ,
81 . SH3TREE ,IXQ ,KNOD2ELQ ,NOD2ELQ ,X ,
82 . IXT ,IXP ,IXR ,IXX ,KXX ,
83 . KXSP ,IXS20 ,IXS16 ,GEO ,ITABM1 ,
84 . IBOX ,SKEW ,IPARTQ ,IPARTT ,IPARTP ,
85 . IPARTR ,SUBSET ,RBY_MSN ,ISKN ,RTRANS ,
86 . UNITAB ,BUFSF ,IAD ,SISKWN ,SSKEW ,
87 . ROOTNAM ,ROOTLEN ,INFILE_NAME ,INFILE_NAME_LEN )
116 USE create_plane_clause_mod
117 USE create_nodens_clause_mod
119 use element_mod ,
only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
123#include "implicit_f.inc"
127#include "radioss_maptable.inc"
128#include "com04_c.inc"
129#include "scr17_c.inc"
130#include "param_c.inc"
135 TYPE (SET_),
DIMENSION(NSETS),
INTENT(INOUT) :: SET
136 TYPE(SUBMODEL_DATA),
INTENT(IN)::LSUBMODEL(*)
137 TYPE(INVERTGROUP_STRUCT_),
INTENT(IN) :: INV_GROUP
138 TYPE(MAPPING_STRUCT_) :: MAP_TABLES
139 TYPE (BOX_) ,
DIMENSION(NBBOX) :: IBOX
140 TYPE (UNIT_TYPE_),
INTENT(IN) :: UNITAB
142 TYPE (GROUP_) ,
INTENT(INOUT):: IGRNOD(*)
143 TYPE (SURF_) ,
INTENT(INOUT):: IGRSURF(*)
144 TYPE (SURF_) ,
INTENT(INOUT):: IGRSLIN(*)
145 TYPE (GROUP_) ,
INTENT(INOUT):: IGRPART(*)
146 TYPE (GROUP_) ,
INTENT(INOUT):: IGRBRIC(*)
147 TYPE (GROUP_) ,
INTENT(INOUT):: IGRQUAD(*)
148 TYPE (GROUP_) ,
INTENT(INOUT):: IGRSH4N(*)
149 TYPE (GROUP_) ,
INTENT(INOUT):: IGRSH3N(*)
150 TYPE (GROUP_) ,
INTENT(INOUT):: IGRTRUSS(*)
151 TYPE (GROUP_) ,
INTENT(INOUT):: IGRBEAM(*)
152 TYPE (GROUP_) ,
INTENT(INOUT):: IGRSPRING(*)
153 TYPE (SUBSET_) ,
INTENT(INOUT) :: SUBSET(*)
155 INTEGER,
INTENT(INOUT) :: IAD
157 INTEGER,
DIMENSION(2*NUMNOD),
INTENT(IN) :: ITABM1
158 INTEGER,
DIMENSION(2*NRBODY),
INTENT(IN) :: RBY_MSN
160 INTEGER IPART(LIPART1,NPART)
161 INTEGER,
INTENT(IN) :: IXS(NIXS,*),IXS10(6,*),IXS16(8,*),IXS20(12,*),
162 . ixc(nixc,*),ixtg(nixtg,*),knod2els(*),knod2elc(*),knod2eltg(*),
163 . nod2els(*),nod2elc(*),nod2eltg(*),ipartc(*),ipartg(*),iparts(*),
164 . sh4tree(*),sh3tree(*),knod2elq(*),nod2elq(*),ixq(nixq,*),
165 . ixt(nixt,*),ixp(nixp,*),ixr(nixr,*),ixx(*),kxx(*),kxsp(nisp,*),
166 . ipartq(*),ipartt(*),ipartp(*),ipartr(*)
167 INTEGER,
INTENT(IN) :: SISKWN,SSKEW
169 . x(3,*),geo(npropg,*),skew(lskew,*)
170 INTEGER,
INTENT(IN) :: ISKN(LISKN,SISKWN/LISKN)
171 MY_REAL,
INTENT(IN) :: RTRANS(NTRANSF,NRTRANS)
173 INTEGER,
INTENT(IN) :: ROOTLEN,INFILE_NAME_LEN
174 CHARACTER(LEN=ROOTLEN),
INTENT(IN) :: ROOTNAM
175 CHARACTER(LEN=INFILE_NAME_LEN),
INTENT(IN) :: INFILE_NAME
179 INTEGER IGS, I, J, SUB_ID
180 INTEGER SET_ID,ISET_TYPE,CLAUSES_MAX,ITMP,ICODE,SETL_SIZE
181 INTEGER OPT_D,OPT_O,OPT_G,OPT_B,OPT_A,OPT_E,OPT_I,OPT_C
182 INTEGER ,
DIMENSION(:),
ALLOCATABLE :: SET_LIST,SETL
185 TYPE (SET_) :: CLAUSE
186 INTEGER CLAUSE_OPERATOR
188 INTEGER DUMMY_ARRAY(10),DSZ
190 TYPE (SET_SCRATCH) :: DELBUF
194 CHARACTER(LEN=NCHARFIELD) :: KEYSET,SET_TYPE,KEY_TYPE
195 CHARACTER(LEN=NCHARKEY) :: KEY,KEYPART
196 CHARACTER(LEN=NCHARTITLE) :: TITLE,SET_TITLE,TITLE2
203 IF (idebug == 1)
THEN
204 print*,
'------------- SET NG -------------'
211 ALLOCATE(set_list(
nsets))
212 CALL sort_set(lsubmodel ,map_tables, set_list,set,clause)
232 . option_id = set_id,
233 . option_titr = set_title,
236 . submodel_id = sub_id)
238 CALL hm_get_intv (
'iset_Type', iset_type,is_available,lsubmodel)
243 CALL set_init(set ,igs ,set_id, set_title, iset_type)
246 CALL hm_get_intv(
'clausesmax',clauses_max,is_available,lsubmodel)
249 print*,
'--------------------------------------------'
251 print*,
'MY_SET_ID =',set_id
252 print*,
'SET_TITLE =',trim(set_title)
253 print*,
' KEY =',key(1:len_trim(key))
254 print*,
'SET_TYPE =',set_type(1:len_trim(set_type))
255 print*,
'CLAUSE_MAX=',clauses_max
256 print*,
'SET_ACTIVE=',set(igs)%SET_ACTIV
266 IF(keyset(1:len_trim(keyset)) ==
'') cycle
281 itmp = len(trim(keyset))
282 icode = iachar(keyset(itmp:itmp))
284 keyset(itmp:itmp)=
' '
297 WRITE(6,
'(A,I6,A)' )
' ',j,
' --------'
298 WRITE(6,
'(A,A)')
' ',trim(keyset)
299 WRITE(6,
'(A,I2)')
' OP :',clause_operator
303 clause%SET_ID = set(igs)%SET_ID
304 clause%TITLE = trim(set(igs)%TITLE)
309 SELECT CASE (trim(keyset))
316 . clause ,map_tables%IPARTM ,j ,opt_g ,is_available ,
326 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
327 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
328 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
329 . ipart ,clause ,opt_a ,opt_o ,ixq ,
330 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
345 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
346 . ixc ,ixtg ,ixt ,ixp ,ixr ,
347 . ixx ,kxx ,kxsp ,clause ,geo,
348 . dummy_array ,dsz ,.false. )
356 . clause ,itabm1 ,j ,opt_g ,is_available ,
357 . lsubmodel,opt_b ,ibox ,x ,skew ,
367 . map_tables%ISOLM, numels,
368 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
369 . opt_c ,ibox ,x ,skew ,set_title,
370 . keyset ,nixs ,ixs ,8 ,iparts ,
371 . ipart ,admbid ,admbid ,admbid )
376 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
377 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
378 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
379 . ipart ,clause ,opt_a ,opt_o ,ixq ,
380 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
389 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
390 . ixc ,ixtg ,ixt ,ixp ,ixr ,
391 . ixx ,kxx ,kxsp ,clause ,geo ,
392 . dummy_array ,dsz ,.false. )
402 . map_tables%IQUADM, numelq,
403 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
404 . opt_c ,ibox ,x ,skew ,set_title,
405 . keyset ,nixq ,ixq ,4 ,ipartq ,
406 . ipart ,admbid ,admbid ,admbid )
411 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
412 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
413 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
414 . ipart ,clause ,opt_a ,opt_o ,ixq ,
415 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
424 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
425 . ixc ,ixtg ,ixt ,ixp ,ixr ,
426 . ixx ,kxx ,kxsp ,clause ,geo ,
427 . dummy_array ,dsz ,.false. )
437 . map_tables%ISH4NM, numelc,
438 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
439 . opt_c ,ibox ,x ,skew ,set_title,
440 . keyset ,nixc ,ixc ,4 ,ipartc ,
441 . ipart ,3 ,sh4tree ,ksh4tree )
447 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
448 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
449 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
450 . ipart ,clause ,opt_a ,opt_o ,ixq ,
451 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
460 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
461 . ixc ,ixtg ,ixt ,ixp ,ixr ,
462 . ixx ,kxx ,kxsp ,clause ,geo ,
463 . dummy_array ,dsz ,.false. )
473 . map_tables%ISH3NM, numeltg,
474 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
475 . opt_c ,ibox ,x ,skew ,set_title,
476 . keyset ,nixtg ,ixtg ,3 ,ipartg ,
477 . ipart ,3 ,sh3tree ,ksh3tree )
482 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
483 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
484 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
485 . ipart ,clause ,opt_a ,opt_o ,ixq ,
486 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
495 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
496 . ixc ,ixtg ,ixt ,ixp ,ixr ,
497 . ixx ,kxx ,kxsp ,clause ,geo ,
498 . dummy_array ,dsz ,.false. )
508 . map_tables%ITRIAM, numeltria,
509 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
510 . opt_c ,ibox ,x ,skew ,set_title,
511 . keyset ,nixtg ,ixtg ,3 ,ipartg ,
512 . ipart ,admbid ,admbid ,admbid )
518 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
519 . ixc ,ixtg ,ixt ,ixp ,ixr ,
520 . ixx ,kxx ,kxsp ,clause ,geo ,
521 . dummy_array ,dsz ,.false. )
530 . map_tables%ITRUSSM, numelt,
531 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
532 . opt_c ,ibox ,x ,skew ,set_title,
533 . keyset ,nixt ,ixt ,2 ,ipartt ,
534 . ipart ,admbid ,admbid ,admbid )
543 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
544 . ixc ,ixtg ,ixt ,ixp
545 . ixx ,kxx ,kxsp ,clause ,geo ,
546 . dummy_array ,dsz ,.false. )
555 . map_tables%IBEAMM, numelp,
557 . opt_c ,ibox ,x ,skew
559 . ipart ,admbid ,admbid ,admbid )
568 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
569 . ixc ,ixtg ,ixt ,ixp ,ixr ,
570 . ixx ,kxx ,kxsp ,clause ,geo ,
571 . dummy_array ,dsz ,.false. )
578 . clause, elt_spring,
579 . map_tables%ISPRINGM, numelr,
580 . j ,opt_g ,is_available,lsubmodel ,opt_b ,
581 . opt_c ,ibox ,x ,skew ,set_title,
582 . keyset ,nixr ,ixr ,2 ,ipartr ,
583 . ipart ,admbid ,admbid ,admbid )
592 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
593 . ixc ,ixtg ,ixt ,ixp ,ixr ,
594 . ixx ,kxx ,kxsp ,clause ,geo ,
595 . dummy_array ,dsz ,.false. )
600 ALLOCATE(setl(
nsets))
604 . map_tables%ISETM , map_tables%NSET_GENERAL,
605 . j ,opt_g ,is_available ,
606 . lsubmodel,clause,1)
612 * ixc ,ixtg ,ixt ,ixp ,ixr ,
614 * sh3tree ,knod2els ,nod2els ,knod2elc ,nod2elc,
615 * knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
616 * ipart ,opt_a ,opt_o ,knod2elq ,nod2elq,
617 * x ,keyset ,opt_e ,delbuf ,ipartq ,
624 ALLOCATE(setl(
nsets))
628 * map_tables%ISETCOLM,map_tables%NSET_COLLECT,
629 * j,opt_g ,is_available ,
639 * ixc ,ixtg ,ixt ,ixp ,ixr ,
641 * sh3tree ,knod2els ,nod2els ,knod2elc ,nod2elc,
642 * knod2eltg ,nod2eltg
643 * ipart ,opt_a ,opt_o ,knod2elq ,nod2elq,
644 * x ,keyset ,opt_e ,delbuf ,ipartq ,
678 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
679 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
680 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
681 . ipart ,clause ,opt_a ,opt_o ,ixq ,
682 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
715 CASE (
'BOX',
'BOX2' )
718 * clause ,j ,is_available,lsubmodel ,keyset ,
719 * itabm1 ,ibox ,x ,skew ,ixs10 ,
720 * set_title,ipart ,sh4tree ,sh3tree ,iparts ,
721 * ipartq ,ipartc ,ipartg
722 * ipartr ,ixs ,ixq ,ixc ,ixtg ,
723 * ixt ,ixp ,ixr ,knod2els ,nod2els ,
724 * knod2elc ,nod2elc ,knod2eltg ,nod2eltg ,knod2elq ,
725 * nod2elq ,opt_a ,opt_o ,opt_e ,delbuf ,
726 * rby_msn ,map_tables%IRBODYM)
734 . clause ,map_tables%ISUBSM ,j ,opt_g ,is_available ,
744 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
745 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
746 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
747 . ipart ,clause ,opt_a ,opt_o ,ixq ,
748 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
763 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
764 . ixc ,ixtg ,ixt ,ixp ,ixr ,
765 . ixx ,kxx ,kxsp ,clause ,geo ,
766 . dummy_array ,dsz ,.false. )
775 . clause ,map_tables%ISUBMM ,j ,opt_g ,is_available ,
785 . ixs ,ixs10 ,sh4tree ,sh3tree ,ixc ,
786 . ixtg ,knod2els ,nod2els ,knod2elc ,nod2elc ,
787 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
788 . ipart ,clause ,opt_a ,opt_o ,ixq ,
789 . knod2elq ,nod2elq ,x ,keyset ,delbuf ,
808 . clause ,map_tables%IRBODYM ,j ,opt_g ,is_available ,
809 . lsubmodel,opt_b ,ibox,x ,skew ,
810 . set_title,keyset ,rby_msn )
820 set(igs)%NB_ELLIPSE = 1
822 . clause ,nrtrans ,lsubmodel,unitab ,iskn ,
823 . iad ,ntransf ,numskw ,liskn ,lskew ,
824 . sskew ,siskwn ,nspcond ,numsph )
830 set(igs)%NB_PLANE = 1
831 CALL create_plane_clause(clause%SET_ID ,clause%TITLE ,sub_id ,clause ,lsubmodel,
832 . unitab ,iad ,nrtrans ,ntransf,rtrans )
838 CALL create_nodens_clause(clause ,itabm1 ,j ,is_available ,lsubmodel ,numnod)
842 CALL ancmsg(msgid=1906,anmode=anstop,
844 . i1 = clause%SET_ID,
845 . c1=trim(clause%TITLE),
854 . ixc ,ixtg ,ixt ,ixp ,ixr ,
856 . sh3tree ,knod2els ,nod2els ,knod2elc ,nod2elc,
857 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
858 . ipart ,opt_a ,opt_o ,knod2elq ,nod2elq,
859 . x ,keyset ,opt_e ,delbuf ,ipartq)
864 IF( trim(key) ==
'COLLECT' )
THEN
866 IF (set(igs)%SET_ACTIV == 1)
THEN
868 CALL create_set_collect(set ,set_id ,igs ,map_tables%ISETCOLM ,map_tables%NSET_COLLECT,
870 * ixc ,ixtg ,ixt ,ixp ,ixr ,
872 . sh3tree ,knod2els ,nod2els ,knod2elc ,nod2elc,
873 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
874 . ipart ,opt_a ,opt_o ,knod2elq ,nod2elq,
875 . x ,keyset ,opt_e ,delbuf ,ipartq ,
908 . igrsurf ,igrnod ,igrslin ,igrpart ,igrbric, igrquad ,
909 . igrsh4n ,igrsh3n ,igrtruss ,igrbeam ,igrspring,bufsf ,
910 . lisurf1 ,rootnam ,rootlen ,infile_name ,infile_name_len)