58#include "implicit_f.inc"
69 INTEGER NOM_OPT(LNOPT1,*)
71 TYPE (GROUP_) ,
DIMENSION(NGRNOD) :: IGRNOD
72 TYPE (SURF_) ,
TARGET,
DIMENSION(NSURF) :: IGRSURF
73 TYPE (SURF_) ,
TARGET,
DIMENSION(NSLIN) :: IGRSLIN
79 INTEGER I,NI,NOINT,L,J,K,NISUB,ID,IDINT,IDGRN,IDSURF,IDSURF1,IDSURF2,TRU,N,J10(10),IA,ITH,INDEX_NOM_OPT
80 INTEGER UID,SUB_ID,ID1,ID2,ID3,INTSUB_TYP(NINTSUB),ISLIN1,ISLIN2,ISU1,ISU2,ISURF1,ISURF2,NFLAG,STAT
81 INTEGER,
DIMENSION(:),
ALLOCATABLE :: ID_INTER,FLAG_INTER
83 CHARACTER(LEN=NCHARTITLE) :: TITR
85 CHARACTER(LEN=NCHARLINE) :: KEY,COPT
86 CHARACTER(LEN=NCHARFIELD) :: KEY2
87 INTEGER,
DIMENSION(:),
POINTER :: INGR2USR
88 INTEGER :: II, NVAR, IDSMAX, NTHINTER,IVAR,NB,ID_TYPE19,OKSURF
97 DATA mess/
'INTERFACES '/
103 ALLOCATE (id_inter(hm_ninter),stat=stat)
104 id_inter(1:(hm_ninter)) = 0
105 ALLOCATE (flag_inter(hm_ninter),stat=stat)
106 flag_inter(1:(hm_ninter)) = 0
127 . option_titr = titr,
130 IF(key(1:len_trim(key))/=
'SUB')
THEN
132 index_nom_opt=index_nom_opt+1
136 CALL hm_get_intv(
'ID_TYPE19',id_type19,is_available,lsubmodel)
138 SELECT CASE(key(1:len_trim(key)))
143 CASE (
'TYPE7',
'TYPE10',
'TYPE24')
145 IF (id_type19/=0)
THEN
151 IF (id_type19/=0)
THEN
160 nom_opt(1,index_nom_opt)=noint
162 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,ni),ltitr)
192 . submodel_index = sub_id,
195 IF(key(1:len_trim(key))==
'SUB')
THEN
197 nom_opt(1,ninter+nisub)=id
198 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,
199 . ninter+nisub),ltitr)
203 CALL hm_get_intv(
'InterfaceId',idint,is_available,lsubmodel)
204 CALL hm_get_intv(
'mainentityids',id1,is_available,lsubmodel)
205 CALL hm_get_intv(
'secondaryentityids',id2,is_available,lsubmodel)
206 CALL hm_get_intv(
'Main_ID2',id3,is_available,lsubmodel)
208 nom_opt(2,ninter+nisub)=idint
209 nom_opt(3,ninter+nisub)=id1
210 nom_opt(4,ninter+nisub)=id2
211 nom_opt(6,ninter+nisub)=id3
218 CALL udouble(nom_opt,lnopt1,ninter+nintsub,mess,0,bid)
223 idint=nom_opt(2,ninter+i)
224 id=nom_opt(1,ninter+i)
226 . nom_opt(lnopt1-ltitr+1,ninter+i),ltitr)
229 IF(id_inter(ni) == idint)
THEN
230 intsub_typ(i) = flag_inter(ni)
243 IF(flag_inter(ni)==-1)
THEN
259 IF (intsub_typ(i)==25 )
THEN
263 idsurf=nom_opt(3,ninter+i)
264 id=nom_opt(1,ninter+i)
265 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,
268 IF(igrsurf(j)%ID==idsurf)
THEN
269 nom_opt(3,ninter+i)=j
281 idgrn=nom_opt(4,ninter+i)
284 IF (igrnod(j)%ID==idgrn)
THEN
285 nom_opt(4,ninter+i)=j
298 idsurf=nom_opt(6,ninter+i)
301 IF(igrsurf(j)%ID==idsurf)
THEN
302 nom_opt(6,ninter+i)=j
315 idsurf1=nom_opt(3,ninter+i)
316 idsurf2=nom_opt(6,ninter+i)
317 idgrn=nom_opt(4,ninter+i)
318 IF(idsurf1/=0.AND.idsurf2==0.AND.idgrn==0)
THEN
320 . msgtype=msgwarning,
325 IF(idsurf2/=0.AND.idsurf1==0.AND.idgrn==0)
THEN
327 . msgtype=msgwarning,
332 IF(idgrn/=0.AND.idsurf1==0.AND.idsurf2==0)
THEN
334 . msgtype=msgwarning,
339 ELSEIF (intsub_typ(i)==0 )
THEN
343 idsurf=nom_opt(3,ninter+i)
344 id=nom_opt(1,ninter+i)
345 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,
348 IF(igrsurf(j)%ID==idsurf)
THEN
349 nom_opt(3,ninter+i)=j
360 idgrn=nom_opt(4,ninter+i)
362 IF (igrnod(j)%ID==idgrn)
THEN
363 nom_opt(4,ninter+i)=j
375 ELSEIF (intsub_typ(i)==1)
THEN
379 isu1=nom_opt(3,ninter+i)
380 isu2=nom_opt(4,ninter+i)
381 id=nom_opt(1,ninter+i)
382 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,
385 ingr2usr => igrslin(1:nslin)%ID
386 islin1=ngr2usr(isu1,ingr2usr,nslin)
387 islin2=ngr2usr(isu2,ingr2usr,nslin)
388 nom_opt(3,ninter+i)=islin1
389 nom_opt(4,ninter+i)=islin2
409 ELSEIF (intsub_typ(i)==2)
THEN
413 isu1=nom_opt(3,ninter+i)
414 isu2=nom_opt(4,ninter+i)
415 id=nom_opt(1,ninter+i)
416 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,
420 IF ((isu1==0).AND.(isu2/=0))
THEN
422 ELSEIF ((isu1/=0).AND.(isu2==0))
THEN
426 ingr2usr => igrsurf(1:nsurf)%ID
427 isurf1=ngr2usr(isu1,ingr2usr,nsurf)
428 isurf2=ngr2usr(isu2,ingr2usr
450 ELSEIF (intsub_typ(i)==100 )
THEN
455 idsurf=nom_opt(6,ninter+i)
456 id=nom_opt(1,ninter+i)
457 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,
461 IF(igrsurf(j)%ID==idsurf)
THEN
462 nom_opt(6,ninter+i)=j
466 IF(oksurf == 0 )
THEN
475 idsurf=nom_opt(3,ninter+i)
479 IF(igrsurf(j)%ID==idsurf)
THEN
480 nom_opt(3,ninter+i)=j
484 IF(oksurf == 0 )
THEN
507 CALL HM_OPTION_START('/th/inter
')
508 IF (NTHINTER > 0) THEN
510 CALL HM_OPTION_READ_KEY(LSUBMODEL, OPTION_ID=ID, OPTION_TITR=TITR)
511 CALL HM_GET_INTV('idsmax
',IDSMAX,IS_AVAILABLE,LSUBMODEL)
513 CALL HM_GET_INT_ARRAY_INDEX('ids
',N,IVAR,IS_AVAILABLE,LSUBMODEL)
515 IF(N==NOM_OPT(1,NINTER+K))THEN
516 NOM_OPT(5,NINTER+K)=1
527 ID =NOM_OPT(1,NINTER+I)
528 IDINT =NOM_OPT(2,NINTER+I)
529 ITH =NOM_OPT(5,NINTER+I)
530 IF (INTSUB_TYP(I)==25) THEN
531 IDSURF1=IGRSURF(NOM_OPT(3,NINTER+I))%ID
532 IDGRN =NOM_OPT(4,NINTER+I)
533 IF(IDGRN/=0) IDGRN =IGRNOD(IDGRN)%ID
534 IDSURF2=NOM_OPT(6,NINTER+I)
535 IF(IDSURF2/=0)IDSURF2=IGRSURF(IDSURF2)%ID
536 WRITE(IOUT,1125) ID,IDINT,IDSURF1,IDSURF2,IDGRN,ITH
537 ELSEIF (INTSUB_TYP(I)==0) THEN
538 IDSURF=IGRSURF(NOM_OPT(3,NINTER+I))%ID
539 IDGRN =IGRNOD(NOM_OPT(4,NINTER+I))%ID
540 WRITE(IOUT,1100) ID,IDINT,IDSURF,IDGRN,ITH
541 ELSEIF (INTSUB_TYP(I)==1) THEN
542 ISU1 = IGRSLIN(NOM_OPT(3,NINTER+I))%ID
543 ISU2 = IGRSLIN(NOM_OPT(4,NINTER+I))%ID
544 WRITE(IOUT,1200) ID,IDINT,ISU1,ISU2,ITH
545 ELSEIF (INTSUB_TYP(I)==2) THEN
546 ISURF1 = IGRSURF(NOM_OPT(3,NINTER+I))%ID
547 ISURF2 = IGRSURF(NOM_OPT(4,NINTER+I))%ID
548 WRITE(IOUT,1300) ID,IDINT,ISU1,ISU2,ITH
552 DEALLOCATE(ID_INTER,FLAG_INTER)
554 1000 FORMAT( /1X,' sub-interfaces
' /
555 . 1X,' --------------
'// )
557 . ' sub-
INTERFACE id. . . . . . . . . . . . .
',I10/,
558 . ' INTERFACE id. . . . . . . . . . . . . . .
',I10/,
559 . ' surface id. . . . . . . . . . . . . . . .
',I10/,
560 . ' nodes group id. . . . . . . . . . . . . .
',I10/,
561 . ' output to th(0:no,1:yes) . . . . . . . .
',I10/)
563 . ' sub-
INTERFACE id. . . . . . . . . . . . .
',I10/,
564 . ' INTERFACE id. . . . . . . . . . . . . . .
',I10/,
565 . ' surface id 1. . . . . . . . . . . . . . .
',I10/,
566 . ' surface id 2. . . . . . . . . . . . . . .
',I10/,
567 . ' nodes group id. . . . . . . . . . . . . .
',I10/,
570 . ' sub-
INTERFACE id. . . . . . . . . . . . .
',I10/,
571 . ' INTERFACE id. . . . . . . . . . . . . . .
',I10/,
572 . ' main line id
',I10/,
573 . ' secondary line id . . . . . . . . . . . .
',I10/,
574 . ' output to th(0:no,1:yes) . . . . . . . .
',I10/)
576 . ' sub-
INTERFACE id. . . . . . . . . . . . .
',I10/,
577 . ' INTERFACE id. . . . . . . . . . . . . . .
',I10/,
578 . ' main surface id. . . . . . . . . . . . . .
',I10/,
579 . ' secondary surface id. . . . . . . . . . .
',I10/,
580 . ' output to th(0:no,1:yes) . . . . . . . .
',I10/)
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)