i25trc_edg.F File Reference

#include "implicit_f.inc"
#include "assert.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i25trc_edg (nedge, i_stok, cand_s, cand_m, cand_p, cand_a, nin, nedge_l, ifq, cand_fx, cand_fy, cand_fz, ifpen)

Function/Subroutine Documentation

i25trc_edg()

subroutine i25trc_edg	(	integer	nedge,
		integer	i_stok,
		integer, dimension(i_stok)	cand_s,
		integer, dimension(i_stok)	cand_m,
			cand_p,
		integer, dimension(*)	cand_a,
		integer	nin,
		integer	nedge_l,
		integer	ifq,
			cand_fx,
			cand_fy,
			cand_fz,
		integer, dimension(*)	ifpen )

Definition at line 30 of file i25trc_edg.F.

C-----------------------------------------------
      USE tri7box
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      "assert.inc"
C-----------------------------------------------
C   ROLE DE LA ROUTINE:
C   ===================
C   TRI sur N de CAND_S CAND_M CAND_F
C   et elimination des noeuds en rebond 
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER :: I_STOK,NEDGE,NIN,NEDGE_L,IFQ
      INTEGER :: CAND_S(I_STOK),CAND_M(I_STOK),CAND_A(*),IFPEN(*)
      my_real
     .        cand_p(*),cand_fx(*) ,cand_fy(*) ,cand_fz(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, I_ST0,N,NN,K,E,CAND_T,
     .        IGET(I_STOK),IPUT(I_STOK)
      my_real
     .        cand_tf
C=======================================================================
C
 
      DO n=1,nedge+3
        cand_a(n) = 0
      ENDDO
 
      DO i=1,i_stok
        nn = cand_s(i)
        e  = cand_m(i)
 
        assert(cand_s(i) > 0)
        assert(cand_s(i) <= nedge) ! ici nedge = nedge + nedge_remote
 
 
C       IF(NN<=NEDGE_L)THEN
        IF (ifq == 0) THEN
          IF(cand_p(i)==zero)THEN
            cand_s(i) = nedge+1
          ENDIF
        ELSE
         IF(ifpen(i)==0.AND.cand_p(i)==zero)THEN
            cand_s(i) = nedge+1
          ENDIF 
        ENDIF
C       ELSE ! remote
C       ENDIF
      ENDDO
 
C=======================================================================
C     CAND_A : DENOMBREMENT DE CHAQUE NOEUD 
C     APRES 300 CAND_A[3:NEDGE+3] : OCCURENCE DES NOEUDS [1:NEDGE+1] 
C=======================================================================
      DO i=1,i_stok
        nn = cand_s(i) + 2
        cand_a(nn) = cand_a(nn) + 1
      ENDDO
      
C=======================================================================
C     CAND_A : ADRESSE DE CHAQUE NOEUD 
C     APRES 400 CAND_A[2:NEDGE+2] : ADRESSE DES NOEUDS [1:NEDGE+1] 
C=======================================================================
      cand_a(1) = 1
      cand_a(2) = 1
      DO  n=3,nedge+2
        cand_a(n) = cand_a(n) + cand_a(n-1)
      ENDDO
C=======================================================================
C     IPUT(I) ADRESSE OU DOIT ALLER I
C     IGET(K) ADRESSE D'OU DOIT VENIR K
C     APRES 500 CAND_A[1:NEDGE+1] : ADRESSE DES NOEUDS [1:NEDGE+1] 
C=======================================================================
      DO i=1,i_stok
        nn = cand_s(i) + 1
        k = cand_a(nn)
        iput(i) = k
        iget(k) = i
        assert(i > 0)
        assert(k > 0)
        assert(nn < nedge + 4 )
        cand_a(nn) = cand_a(nn) + 1
      ENDDO
C=======================================================================
C     TRI DE CAND_S CAND_M CAND_P
C     SUR N CROISSANT
C     PERMUTATION 1 PASSE
C============================================= 
        DO k=1,i_stok
          i = iget(k)
          assert(i > 0)
C
          cand_t    = cand_s(k)
          cand_s(k) = cand_s(i)
          cand_s(i) = cand_t
C
          cand_t    = cand_m(k)
          cand_m(k) = cand_m(i)
          cand_m(i) = cand_t
C
          cand_tf   = cand_p(k)
          cand_p(k) = cand_p(i)
          cand_p(i) = cand_tf
C
          cand_tf   = cand_fx(k)
          cand_fx(k) = cand_fx(i)
          cand_fx(i) = cand_tf
C
          cand_tf   = cand_fy(k)
          cand_fy(k) = cand_fy(i)
          cand_fy(i) = cand_tf
C
          cand_tf   = cand_fz(k)
          cand_fz(k) = cand_fz(i)
          cand_fz(i) = cand_tf
C
          cand_t    = ifpen(k)
          ifpen(k) = ifpen(i)
          ifpen(i) = cand_t
C 
          iput(i) = iput(k)
          assert(iput(i) > 0)
          assert(iput(i) <= i_stok)
          iget(iput(i)) = i
 
        ENDDO
C=======================================================================
C     CAND_A[NEDGE+1] : ADRESSE DE NEDGE+1 
C=======================================================================
      i_stok = cand_a(nedge+1) - 1
      cand_a(nedge+2) = cand_a(nedge+1)
C
      RETURN