ig3dgrhead.F File Reference

#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	ig3dgrhead (kxig3d, geo, inum, itr1, eadd, index, itri, ipartig3d, nd, igrsurf, cep, xep, igeo, ipm, pm, nige, knotlocel)

Function/Subroutine Documentation

ig3dgrhead()

subroutine ig3dgrhead	(	integer, dimension(nixig3d,*)	kxig3d,
			geo,
		integer, dimension(nixig3d+1,*)	inum,
		integer, dimension(*)	itr1,
		integer, dimension(*)	eadd,
		integer, dimension(*)	index,
		integer, dimension(4,*)	itri,
		integer, dimension(*)	ipartig3d,
		integer	nd,
		type (surf_), dimension(nsurf)	igrsurf,
		integer, dimension(*)	cep,
		integer, dimension(*)	xep,
		integer, dimension(npropgi,numgeo), intent(in)	igeo,
		integer, dimension(npropmi,nummat)	ipm,
			pm,
		integer, dimension(*)	nige,
			knotlocel )

Definition at line 31 of file ig3dgrhead.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_mod
C-----------------------------------------------
C            A R G U M E N T S
C-----------------------------------------------
C     KXIG3D(NIXIG3D,NUMELIG3D)  TABLEAU CONECS+PID+No ElEMENTS         E
C     GEO(NPROPG,NUMGEO)TABLEAU DES CARACS DES PID                      E
C     INUM(8,NUMELIG3D)    TABLEAU DE TRAVAIL                         E/S
C     ITR1(NSELR)       TABLEAU DE TRAVAIL                            E/S
C     EADD(NUMELIG3D)      TABLEAU DES ADRESSES DANS IDAM CHGT DAMIER   S
C     INDEX(NUMELIG3D)     TABLEAU DE TRAVAIL                         E/S
C     ITRI(4,NUMELIG3D)    TABLEAU DE TRAVAIL                         E/S
C     IPARTIG3D(NUMELIG3D)    TABLEAU PART                            E/S
C     CEP(NUMELIG3D)    TABLEAU PROC                                  E/S
C     XEP(NUMEX)    TABLEAU PROC                                      E/S
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      "vect01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C   D U M M Y   A R G U M E N T S
C-----------------------------------------------
      INTEGER KXIG3D(NIXIG3D,*),INUM(NIXIG3D+1,*),IPARTIG3D(*),
     .        EADD(*),ITR1(*),INDEX(*),ITRI(4,*),
     .        ND, CEP(*), XEP(*),
     .        IPM(NPROPMI,NUMMAT),NIGE(*)
      INTEGER,INTENT(IN) :: IGEO(NPROPGI,NUMGEO)
      my_real geo(npropg,numgeo),pm(npropm,nummat),knotlocel(*)
C
      TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
      INTEGER 
     .        I, K, NG, ISSN, NPN, NN, N, MID, PID ,
     .        II, J, II2,JJ2,JJ, II3, JJ3, L,NGROU,
     .        MODE, WORK(70000),NCTRL,MLN,JALE_FROM_MAT,JALE_FROM_PROP
      EXTERNAL my_shiftl,my_shiftr,my_and
      INTEGER MY_SHIFTL,MY_SHIFTR,MY_AND
      my_real
     .    knotlocelindx(sknotlocel)
C
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
C----------------------------------------------------------
C   TRI GLOBAL SUR TOUS LES CRITERES POUR TOUS LES ELEMENTS
C----------------------------------------------------------
C
      DO i=1,numelig3d
        eadd(i)=1
        itri(4,i)=i
        index(i)=i
        inum(1,i)=ipartig3d(i)
        DO j=1,nixig3d
          inum(j+1,i)=kxig3d(j,i)
        ENDDO
        DO j=1,6
          knotlocelindx((i-1)*6+j)=knotlocel((i-1)*6+j)
        ENDDO
      ENDDO
 
      DO i = 1, numelig3d
        mid= kxig3d(1,i)
        mln = nint(pm(19,abs(mid)))
        pid= kxig3d(2,i)
        nctrl= kxig3d(3,i)
C
        jale_from_mat = nint(pm(72,mid))
        jale_from_prop = igeo(62,pid)
        jale = max(jale_from_mat, jale_from_prop) !if inconsistent, error message was displayed in PART reader
 
        jlag=0
        IF(jale==0.AND.mln/=18)jlag=1
        jeul=0
        IF(jale==2)THEN
          jale=0
          jeul=1
        ELSEIF(jale == 3) THEN
          jlag = 1
          jale = 1
        ENDIF
        IF(mln/=50)jtur=nint(pm(70,mid))
        jthe=nint(pm(71,mid))
C
        itri(1,i)=nctrl
        itri(2,i)=mid
        itri(3,i)=pid
        itri(4,i)=0
      ENDDO
C
      mode=0
      CALL my_orders( mode, work, itri, index, numelig3d , 4)
C
      DO i=1,numelig3d
        ipartig3d(i) =inum(1,index(i))
        DO j=1,6
          knotlocel((i-1)*6+j)=knotlocelindx((index(i)-1)*6+j)
        ENDDO    
      ENDDO
 
      DO  k=1,nixig3d     
        DO  i=1,numelig3d
          kxig3d(k,i)=inum(k+1,index(i))
        ENDDO
      ENDDO
C
C INVERSION DE INDEX (DANS ITR1)
C
      DO i=1,numelig3d
        itr1(index(i))=i
      ENDDO
C
C RENUMEROTATION POUR SURFACES
C
      DO i=1,nsurf
        nn=igrsurf(i)%NSEG_IGE
        DO j=1,nn
          IF(igrsurf(i)%ELTYP_IGE(j) == 101)
     .       igrsurf(i)%ELEM_IGE(j) = itr1(igrsurf(i)%ELEM_IGE(j))
        ENDDO
      ENDDO
C
      DO i=1,numfakenodigeo
        nige(i)=itr1(nige(i))
      ENDDO
C
C--------------------------------------------------------------
C         DETERMINATION DES SUPER_GROUPES
C--------------------------------------------------------------
      nd=1
      DO i=2,numelig3d
        ii=itri(1,index(i))
        jj=itri(1,index(i-1))
        ii2=itri(2,index(i))
        jj2=itri(2,index(i-1))
        ii3=itri(3,index(i))
        jj3=itri(3,index(i-1))
        IF(ii/=jj.OR.ii2/=jj2.OR.ii3/=jj3) THEN
          nd=nd+1
          eadd(nd)=i
        ENDIF
      ENDDO
      eadd(nd+1) = numelig3d+1
C
      RETURN