insolt10.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    insolt10               ../starter/source/interfaces/inter3d1/insolt10.F
!||--- called by ------------------------------------------------------
!||    i12sol3                ../starter/source/interfaces/inter3d1/insol3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE insolt10(IXS,IXS10,IRECT,NOINT,NRTM,ITAB,
     .                    KNOD2ELS,NOD2ELS,NTY,NSV ,MSEGTYP,ID,TITR)
C
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
      use element_mod , only :nixs
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
      END