incoq3.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/.
C
!||====================================================================
!||    incoq3               ../starter/source/interfaces/inter3d1/incoq3.F
!||--- called by ------------------------------------------------------
!||    i1chk3               ../starter/source/interfaces/inter3d1/i1chk3.F
!||    i20sti3              ../starter/source/interfaces/inter3d1/i20sti3.f
!||    i21els3              ../starter/source/interfaces/inter3d1/i21els3.F
!||    i23gap3              ../starter/source/interfaces/inter3d1/i23gap3.F
!||    i24gapm              ../starter/source/interfaces/inter3d1/i24sti3.F
!||    i25gapm              ../starter/source/interfaces/inter3d1/i25sti3.F
!||    i2buc1               ../starter/source/interfaces/inter3d1/i2buc1.F
!||    i2chk3               ../starter/source/interfaces/inter3d1/i2chk3.F
!||    i2cor3               ../starter/source/interfaces/inter3d1/i2cor3.F
!||    i3sti3               ../starter/source/interfaces/inter3d1/i3sti3.F
!||    i7sti3               ../starter/source/interfaces/inter3d1/i7sti3.F
!||    inintr_orthdirfric   ../starter/source/interfaces/interf1/inintr_orthdirfric.F
!||    r2r_count            ../starter/source/coupling/rad2rad/r2r_count.F
!||====================================================================
      SUBROUTINE incoq3(IRECT ,IXC ,IXTG ,NINT ,NEL      ,
     .                  NELTG ,IS  ,GEO  ,PM   ,KNOD2ELC ,
     .              KNOD2ELTG ,NOD2ELC ,NOD2ELTG,THK,NTY,
     .              IGEO ,PM_STACK , IWORKSH )
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NINT, NEL, IS, NELTG,NTY
      INTEGER IRECT(4,*), IXC(NIXC,*), IXTG(NIXTG,*),
     .        KNOD2ELC(*) ,KNOD2ELTG(*) ,NOD2ELC(*) ,NOD2ELTG(*),
     .        igeo(npropgi,*),iworksh(3,*)
C     REAL
      my_real
     .   geo(npropg,*), pm(npropm,*),thk(*),pm_stack(20,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N, J, II, K, IAD,IGTYP, IPGMAT,IGMAT,ISUBSTACK
C     REAL
      my_real
     .   dxm, stm, dx, st
C-----------------------------------------------
      nel=0
      neltg=0
      dxm = zero
      stm = zero
      ipgmat = 700
      IF(irect(3,is)==irect(4,is).AND.numeltg/=0)THEN
       IF(irect(1,is)>numnod) RETURN
       DO 230 iad=knod2eltg(irect(1,is))+1,knod2eltg(irect(1,is)+1)
        n = nod2eltg(iad)
        DO 220 j=1,3
          ii=irect(j,is)
          DO 210 k=1,3
            IF(ixtg(k+1,n)==ii) GOTO 220
  210     CONTINUE
          GOTO 230
  220   CONTINUE
          igtyp = igeo(11,ixtg(5,n)) 
          IF ( thk(numelc+n) /= zero .AND. iintthick == 0 .AND.
     .       (nty == 7 .OR. nty == 20.OR. nty == 22)) THEN
            dx=thk(numelc+n)
          ELSEIF(igtyp == 17 .OR. igtyp == 51 .OR.igtyp ==52) THEN
           dx=thk(numelc+n) 
        ELSE
          dx = geo(1,ixtg(5,n))
        ENDIF
        igmat = igeo(98,ixtg(5,n))
        IF (ixtg(1,n)>0) THEN
          IF(igtyp == 11 .AND. igmat > 0) THEN
            st = geo(ipgmat + 2 ,ixtg(5,n)) 
          ELSEIF(igtyp ==52 .OR.
     .          ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
            isubstack = iworksh(3,numelc + n)
             st = pm_stack(2 ,isubstack) 
          ELSE
            st = pm(20,ixtg(1,n))
          ENDIF  
        ELSE
          st = 0.
        ENDIF
        IF (dx>dxm) THEN
          dxm = dx
          neltg = n
          stm = st
        ELSEIF(dx==dxm) THEN
          IF ((st>=stm).OR.(stm==0.)) THEN
            neltg = n
            stm = st
          ENDIF
        ENDIF       
  230  CONTINUE
      ENDIF
C
      IF(numelc/=0) THEN
       DO 430 iad=knod2elc(irect(1,is))+1,knod2elc(irect(1,is)+1)
        n = nod2elc(iad)
        DO 420 j=1,4
          ii=irect(j,is)
          DO 410 k=1,4
            IF(ixc(k+1,n)==ii) GOTO 420
  410     CONTINUE
          GOTO 430
  420   CONTINUE
        igtyp = igeo(11,ixc(6,n))
          IF ( thk(n) /= zero .AND. iintthick == 0 .AND.
     .       (nty == 7 .OR. nty == 20.OR. nty == 22)) THEN
            dx=thk(n)
          ELSEIF(igtyp == 17 .OR. igtyp ==51 .OR. igtyp ==52) THEN
            dx=thk(n)
        ELSE 
          dx = geo(1,ixc(6,n))
          ENDIF
        IF (ixc(1,n)>0) THEN
          st = pm(20,ixc(1,n))
        ELSE
          st = zero
        ENDIF
        IF (dx>dxm) THEN
          dxm = dx
          nel = n
          stm = st
        ELSEIF(dx==dxm) THEN
          IF ((st>stm).OR.(stm==zero)) THEN
            nel = n
            stm = st
          ENDIF
        ENDIF       
  430  CONTINUE
      ENDIF
      RETURN
      END