Download coupen.eso

Back to the list

   1 : C COUPEN    SOURCE    CHAT      05/01/12    22:24:54     5004           
   2 :       SUBROUTINE COUPEN(NUM,NBNN,NBELEM,XCOOR,IDIMP1,NBPTS,
   3 :      >                  LECT,LECT1,LECT2)
   4 : C
   5 : C     Esclave de COUPE: detection des doublons d'elements
   6 : C
   7 :       IMPLICIT INTEGER(I-N)
   8 :       IMPLICIT REAL*8(A-H,O-Z)
   9 : C
  10 :       DIMENSION NUM(NBNN,NBELEM),XCOOR(IDIMP1,NBPTS)
  11 :       DIMENSION LECT(NBELEM),LECT1(NBELEM),LECT2(NBELEM)
  12 :       LOGICAL GENTST
  13 : C
  14 :       IDIM=IDIMP1-1
  15 : C
  16 :       IFI=LECT(1)
  17 :       DO IE1=2,NBELEM
  18 :         IFF=LECT(IE1)
  19 :         IF(IFI.EQ.IFF)THEN
  20 :           JE1=LECT1(IE1-1)
  21 :           IF(LECT2(JE1).EQ.JE1)THEN
  22 :             DO IE2=IE1,NBELEM
  23 :               IFFF=LECT(IE2)
  24 :               IF(IFI.NE.IFFF)GOTO 1
  25 :               JE2=LECT1(IE2)
  26 :               IF(LECT2(JE2).EQ.JE2)THEN
  27 :                 IF(GENTST(NUM(1,JE1),NUM(1,JE2),NBNN))THEN
  28 :                   LECT2(JE1)=JE2
  29 :                   LECT2(JE2)=JE1
  30 :                 ENDIF                                  
  31 :               ENDIF               
  32 :             ENDDO             
  33 :           ENDIF
  34 :         ENDIF
  35 :  1      IFI=IFF
  36 :       ENDDO
  37 : C
  38 :       RETURN
  39 :       END
  40 :  
  41 :  

© Cast3M 2003 - All rights reserved.
Disclaimer