set_poin_ump.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	set_poin_ump (ipart, ipm, tab_ump, poin_ump, taille)

Function/Subroutine Documentation

set_poin_ump()

subroutine set_poin_ump	(	integer, dimension(lipart1,*)	ipart,
		integer, dimension(npropmi,*)	ipm,
		integer, dimension(5,npart)	tab_ump,
		integer, dimension(nummat)	poin_ump,
		integer	taille )

Definition at line 30 of file set_poin_ump.F.

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      "scr17_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
      LOGICAL LOI_FLUID
      EXTERNAL loi_fluid
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPART(LIPART1,*),IPM(NPROPMI,*),
     .        POIN_UMP(NUMMAT),TAB_UMP(5,NPART),TAILLE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER RES,MARQUEUR,MARQUEUR2,TAB_LOCAL(NPART),TAB_LOCAL2(NUMMAT),
     .   K1,K2,I,J,ILAW, IMID
 
C=======================================================================
 
!     ---------------------------------
!     Timer Mat/Prop
      IF(npart>0) THEN
       DO i=1,npart
         ilaw=0
         imid=ipart(1,i)
         IF(imid > 0) ilaw = ipm(2,imid)
         tab_ump(1,i) = ipart(5,i)
         tab_ump(2,i) = ipart(6,i)
         tab_ump(3,i) = ipart(1,i)
         tab_ump(4,i) = ipart(2,i)
         tab_ump(5,i) = ilaw
         tab_local(i) = 0
       ENDDO
 
       taille = npart
       IF(npart>1) THEN
        DO i=2,npart
          DO j=1,i-1
           IF( (tab_local(j) == 0 )       .AND.
     .        (tab_ump(3,i)==tab_ump(3,j)).AND.
     .        (tab_ump(4,i)==tab_ump(4,j)))    THEN
            tab_local(j) = -1
            taille = taille - 1
           ENDIF
         ENDDO
        ENDDO
       ENDIF
       IF(taille<npart) THEN
        marqueur2 = 0
        DO i=1,npart
          IF(tab_local(i)==0) THEN
           marqueur2 = marqueur2 + 1
           tab_ump(1,marqueur2) = tab_ump(1,i)
           tab_ump(2,marqueur2) = tab_ump(2,i)
           tab_ump(3,marqueur2) = tab_ump(3,i)
           tab_ump(4,marqueur2) = tab_ump(4,i)
           tab_ump(5,marqueur2) = tab_ump(5,i)
          ENDIF
        ENDDO
        DO i= taille+1,npart
           tab_ump(1,i) = 0
           tab_ump(2,i) = 0
           tab_ump(3,i) = 0
           tab_ump(4,i) = 0
           tab_ump(5,i) = 0
        ENDDO
       ENDIF
 
 
       i = taille
       IF(taille>1) THEN
        marqueur = 0
        IF(nummat>1) THEN
         DO WHILE ((marqueur==0).AND.(i>0)) 
           marqueur=1
           DO j=1,i-1
             IF(tab_ump(1,j) > tab_ump(1,j+1)) THEN
              marqueur = tab_ump(1,j)
              tab_ump(1,j) = tab_ump(1,j+1)
              tab_ump(1,j+1) = marqueur
              marqueur = tab_ump(2,j)
              tab_ump(2,j) = tab_ump(2,j+1)
              tab_ump(2,j+1) = marqueur
              marqueur = tab_ump(3,j)
              tab_ump(3,j) = tab_ump(3,j+1)
              tab_ump(3,j+1) = marqueur
              marqueur = tab_ump(4,j)
              tab_ump(4,j) = tab_ump(4,j+1)
              tab_ump(4,j+1) = marqueur
              marqueur = tab_ump(5,j)
              tab_ump(5,j) = tab_ump(5,j+1)
              tab_ump(5,j+1) = marqueur
              marqueur=0
             ENDIF
           ENDDO
           i=i-1
         ENDDO    
         j = 1
         marqueur = 1
         poin_ump = 0
         poin_ump(tab_ump(3,1)) = 1
         tab_local2 = 0
         tab_local2(1) = 1
         DO i=2,taille
           IF(tab_ump(3,i-1)/=tab_ump(3,i)) THEN
            marqueur = marqueur + 1
            poin_ump(tab_ump(3,i)) = i
            tab_local2(marqueur) = i
           ENDIF
         ENDDO
        ELSE      
         poin_ump(1) = 1    
        ENDIF 
 
        IF(marqueur>1) THEN
         k1=tab_local2(1)
         DO i=2,marqueur    
          marqueur2 = 0
          k2 = tab_local2(i)-1
 
          DO WHILE ((marqueur2==0).AND.(k2>k1).AND.
     .              (k2*k1>0)) 
           marqueur2=1
           DO j=k1,k2-1
             IF(tab_ump(2,j) > tab_ump(2,j+1)) THEN
              marqueur2 = tab_ump(2,j)
              tab_ump(2,j) = tab_ump(2,j+1)
              tab_ump(2,j+1) = marqueur2
              marqueur2 = tab_ump(4,j)
              tab_ump(4,j) = tab_ump(4,j+1)
              tab_ump(4,j+1) = marqueur2
              marqueur2=0
             ENDIF
           ENDDO
           k2=k2-1
          ENDDO
          k1=tab_local2(i)
         ENDDO
        ELSEIF(marqueur==1) THEN
         marqueur2 = 0
         i=taille
         DO WHILE ((marqueur2==0).AND.(i>0)) 
           marqueur2=1
           DO j=1,i-1
             IF(tab_ump(2,j) > tab_ump(2,j+1)) THEN
              marqueur2 = tab_ump(2,j)
              tab_ump(2,j) = tab_ump(2,j+1)
              tab_ump(2,j+1) = marqueur2
              marqueur2 = tab_ump(4,j)
              tab_ump(4,j) = tab_ump(4,j+1)
              tab_ump(4,j+1) = marqueur2
              marqueur2=0
             ENDIF
           ENDDO
           i=i-1
         ENDDO
        ENDIF
       ELSE
        poin_ump(1:nummat) = 0
        IF(tab_ump(3,1) > 0) poin_ump(tab_ump(3,1)) = 1
       ENDIF    
      ENDIF
C