Esope source files

   1 : C IMPOS5    SOURCE    CHAT      05/01/13    00:33:59     5004           
   2 :       SUBROUTINE IMPOS5(MCTC1,MCTC2,ICODE)
   3 : c
   4 : c     regarde si les deux contacts ont un point en commun
   5 : c
   6 : c     les deux segments en entrée sont actifs
   7 : c
   8 :       IMPLICIT INTEGER(I-N)
   9 :       IMPLICIT REAL*8 (A-H,O-Z)
  10 :       SEGMENT MCTC
  11 :         INTEGER IPOT1(NNO1)
  12 :         INTEGER IPOT2(NNO2)
  13 :       ENDSEGMENT
  14 :       POINTEUR MCTC1.MCTC,MCTC2.MCTC,MCTC3.MCTC
  15 : c executable
  16 :  1    ICODE = 0
  17 :       ICOD1 = 0
  18 :       ICOD2 = 0
  19 : c
  20 : c boucle sur la premiere couche du second segment
  21 : c
  22 :       DO 100 I=1,MCTC2.IPOT1(/1)
  23 :         DO 10 J= 1,MCTC1.IPOT1(/1)
  24 :           IF (MCTC1.IPOT1(J) .EQ. MCTC2.IPOT1(I)) THEN
  25 :              ICOD1 = 1
  26 :           ENDIF
  27 :  10    CONTINUE
  28 :         DO 20 J= 1,MCTC1.IPOT2(/1)
  29 :           IF (MCTC1.IPOT2(J) .EQ. MCTC2.IPOT1(I)) THEN
  30 :              ICOD2 = -1
  31 :           ENDIF
  32 :  20    CONTINUE
  33 :  100  CONTINUE
  34 : c
  35 :       IF ( (ICOD1 * ICOD2) .EQ. -1 ) THEN
  36 : c        petite magouille pour les fonds de fissures
  37 : c        par exemple deux lignes de contacts ont un point en commun
  38 :          IF (MCTC2.IPOT1(/1).EQ.2 .AND. MCTC2.IPOT2(/1).EQ.1) THEN
  39 : c           un des cote du triangle a ses points dans les deux couches
  40 : c           on effectue une permutation circulaire
  41 :               IDUMY = MCTC2.IPOT1(1)
  42 :               MCTC2.IPOT1(1) = MCTC2.IPOT2(1)
  43 :               MCTC2.IPOT1(2) = MCTC2.IPOT2(1)
  44 :               MCTC2.IPOT2(1) = IDUMY
  45 :               GOTO 1
  46 :          ENDIF
  47 :          ICODE = -1
  48 :          RETURN
  49 :       ELSE 
  50 :              ICODE = ICOD1 + ICOD2
  51 :              IF (ICODE .NE. 0) RETURN
  52 :       ENDIF
  53 : c
  54 : c boucle sur la seconde couche du second segment
  55 : c
  56 :       DO 200 I=1,MCTC2.IPOT2(/1)
  57 :         DO 110 J= 1,MCTC1.IPOT1(/1)
  58 :           IF (MCTC1.IPOT1(J) .EQ. MCTC2.IPOT2(I)) THEN
  59 :              ICODE = -1
  60 :              RETURN
  61 :           ENDIF
  62 :  110   CONTINUE
  63 :         DO 120 J= 1,MCTC1.IPOT2(/1)
  64 :           IF (MCTC1.IPOT2(J) .EQ. MCTC2.IPOT2(I)) THEN
  65 :              ICODE = 1
  66 :              RETURN
  67 :           ENDIF
  68 :  120    CONTINUE
  69 :  200  CONTINUE
  70 :       RETURN
  71 :       END
  72 : 
  73 :