insolt10.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	insolt10 (ixs, ixs10, irect, noint, nrtm, itab, knod2els, nod2els, nty, nsv, msegtyp, id, titr)

Function/Subroutine Documentation

insolt10()

subroutine insolt10	(	integer, dimension(nixs,*)	ixs,
		integer, dimension(6,*)	ixs10,
		integer, dimension(4,*)	irect,
		integer	noint,
		integer	nrtm,
		integer, dimension(*)	itab,
		integer, dimension(*)	knod2els,
		integer, dimension(*)	nod2els,
		integer	nty,
		integer, dimension(*)	nsv,
		integer, dimension(*)	msegtyp,
		integer	id,
		character(len=nchartitle)	titr )

Definition at line 32 of file insolt10.F.

C
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXS(NIXS,*),IXS10(6,*),IRECT(4,*),NOINT,NRTM,
     .        ITAB(*), KNOD2ELS(*), NOD2ELS(*),NTY,NSV(*),MSEGTYP(*)
      INTEGER ID
      CHARACTER(LEN=NCHARTITLE) :: TITR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,IW,I1,I2,I3,IPERM1(6),IPERM2(6),IPERM3(6),
     .        IDBID, IAD, IEDGE, N, N10, NC(4)
      DATA nc/2,4,7,6/
      DATA iperm1/2,4,7,2,6,7/
      DATA iperm2/4,7,2,6,4,6/
      DATA iperm3/1,2,3,4,5,6/
      DATA idbid/0/
      INTEGER IDEGEN(6)
C-----------------------------------------------
C  Previous version in inint3.F
C-----------------------------------------------
C
 
      DO i=1,nrtm
        IF (msegtyp(i) /= 10) cycle
        DO iedge=1,4
          IF (nty == 5)THEN
            i1=nsv(irect(iedge,i))
            i2=nsv(irect(mod(iedge,4)+1,i))
          ELSE
            i1=irect(iedge,i)
            i2=irect(mod(iedge,4)+1,i)
          ENDIF
          IF(i2==i1)cycle
 
          DO iad=knod2els(i1)+1,knod2els(i1+1)
           n = nod2els(iad)
           IF(numels8 < n .AND. n <= numels8+numels10)THEN
             n10=n-numels8
             DO j=1,4
               IF(ixs(nc(j),n10)==i2)THEN
                 DO k=1,6
                   IF((i1==ixs(iperm1(k),n10).AND.
     .                 i2==ixs(iperm2(k),n10)).OR.
     .                (i2==ixs(iperm1(k),n10).AND.
     .                 i1==ixs(iperm2(k),n10)))THEN
                       i3=ixs10(iperm3(k),j)
                     IF(i3/=0)THEN
               ixs10(iperm3(k),n10)=-abs(ixs10(iperm3(k),n10))
                     END IF
             END IF
           END DO
               END IF
             END DO
           END IF
          ENDDO
        ENDDO
      ENDDO
C
      DO j=1,numels10
        iw=0
        DO k=1,6
          i3=ixs10(iperm3(k),j)
          IF(i3 < 0)THEN
            iw=1
            ixs10(iperm3(k),j)=0
          END IF
        ENDDO 
        IF(iw==1)THEN
             idegen=0
             IF(ixs10(1,j)/=0)THEN
              idegen(1)=itab(ixs10(1,j))
             ENDIF
             IF(ixs10(2,j)/=0)THEN
              idegen(2)=itab(ixs10(2,j))
             ENDIF
             IF(ixs10(3,j)/=0)THEN
              idegen(3)=itab(ixs10(3,j))
             ENDIF
             IF(ixs10(4,j)/=0)THEN
              idegen(4)=itab(ixs10(4,j))
             ENDIF
             IF(ixs10(5,j)/=0)THEN
              idegen(5)=itab(ixs10(5,j))
             ENDIF
             IF(ixs10(6,j)/=0)THEN
              idegen(6)=itab(ixs10(6,j))
             ENDIF
             CALL ancmsg(msgid=344,
     .                   msgtype=msgwarning,
     .                   anmode=aninfo_blind_2,
     .                   i1=id,
     .                   c1=titr,
     .                   i2=ixs(nixs,j),
     .                   i3=itab(ixs(2,j)),
     .                   i4=itab(ixs(4,j)),
     .                   i5=itab(ixs(7,j)),
     .                   i6=itab(ixs(6,j)),
C
     .                   i7=idegen(1),
     .                   i8=idegen(2),
     .                   i9=idegen(3),
     .                   i10=idegen(4),
     .                   i11=idegen(5),
     .                   i12=idegen(6))
        ENDIF
      ENDDO
C
      RETURN