incoq3.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	incoq3 (irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, knod2elc, knod2eltg, nod2elc, nod2eltg, thk, nty, igeo, pm_stack, iworksh)

Function/Subroutine Documentation

incoq3()

subroutine incoq3	(	integer, dimension(4,*)	irect,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg,
		integer	nint,
		integer	nel,
		integer	neltg,
		integer	is,
			geo,
			pm,
		integer, dimension(*)	knod2elc,
		integer, dimension(*)	knod2eltg,
		integer, dimension(*)	nod2elc,
		integer, dimension(*)	nod2eltg,
			thk,
		integer	nty,
		integer, dimension(npropgi,*)	igeo,
			pm_stack,
		integer, dimension(3,*)	iworksh )

Definition at line 42 of file incoq3.F.

      use element_mod , only :nixc,nixtg
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