Télécharger la plaquette Cast3M


fr en

Télécharger impos5.eso

Retour à la liste

Numérotation des lignes : 

impos5

  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.  
  74.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales