Télécharger la plaquette Cast3M


fr en

Télécharger fusevo.eso

Retour à la liste

Numérotation des lignes : 

fusevo

  1. C FUSEVO    SOURCE    BP208322  16/11/18    21:17:18     9177           
  2. C  CE SOUS-PROGRAMME REALISE L'OPERATION " ET " SUR LES DEUX OBJETS
  3. C  IPT1 ET IPT2  LE RESULTAT EST RANGE DANS IPT3
  4. C  IPT1 ET IPT2 DOIVENT ETRE DE TYPE VOLUME
  5. C           PAS DE SOUS OBJETS LA
  6.       SUBROUTINE FUSEVO(IPT1,IPT2,IPT3,LTELQ)
  7.       IMPLICIT INTEGER(I-N)
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC SMELEME
  12. -INC CCGEOME
  13.       LOGICAL LTELQ
  14.  
  15.       NBREF=0
  16.       IF (IPT1.LISREF(/1).EQ.0.OR.IPT2.LISREF(/1).EQ.0) GOTO 100
  17.       IF (IPT1.LISREF(/1).EQ.1.OR.IPT2.LISREF(/1).EQ.1) NBREF=1
  18.       IF (NBREF.EQ.1) GOTO 1
  19. C  AU MOINS DEUX REFERENCES CHAQUE
  20.       IPT8=IPT1.LISREF(2)
  21.       IPT4=IPT2.LISREF(1)
  22.       IF (IPT8.EQ.IPT4) GOTO 2
  23.       SEGACT IPT8,IPT4
  24.       IF (IPT8.LISOUS(/1).EQ.0.OR.IPT4.LISOUS(/1).NE.IPT8.LISOUS(/1))
  25.      #  GOTO 1
  26.       DO 3 I=1,IPT8.LISOUS(/1)
  27.       IF (IPT8.LISOUS(I).NE.IPT4.LISOUS(I)) GOTO 1
  28.     3 CONTINUE
  29.       SEGDES IPT8,IPT4
  30.     2 CONTINUE
  31. C   OK ON FUSIONNE
  32.       NBREF=3
  33.       IF (IPT1.LISREF(/1).EQ.2.OR.IPT2.LISREF(/1).EQ.2) NBREF=2
  34.       IF (NBREF.EQ.2) GOTO 11
  35. C  A REVOIR NE MARCHE QUE SI LE POURTOUR EST FORME D'UN TYPE D'ELEMENT
  36.       IPT8=IPT1.LISREF(3)
  37.       SEGACT IPT8
  38.       IF (IPT1.LISREF(/1).EQ.3) GOTO 4
  39.       DO 5 I=4,IPT1.LISREF(/1)
  40.       IPT4=IPT1.LISREF(I)
  41.       SEGACT IPT4
  42.       IF (IPT4.NUM(/2).NE.0) GOTO 6
  43.       NBREF=2
  44.       SEGDES IPT4
  45.       GOTO 11
  46.     6 IF (KSURF(IPT4.ITYPEL).EQ.0) CALL FUSELI(IPT8,IPT4,IPT5,LTELQ)
  47.       IF (KSURF(IPT4.ITYPEL).NE.0) CALL FUSESU(IPT8,IPT4,IPT5,LTELQ)
  48.       SEGDES IPT8,IPT4
  49.       IPT8=IPT5
  50.     5 CONTINUE
  51.     4 CONTINUE
  52.       IPT6=IPT2.LISREF(3)
  53.       SEGACT IPT6
  54.       IF (IPT2.LISREF(/1).EQ.3) GOTO 10
  55.       DO 9 I=4,IPT2.LISREF(/1)
  56.       IPT4=IPT2.LISREF(I)
  57.       SEGACT IPT4
  58.       IF (IPT4.NUM(/2).NE.0) GOTO 8
  59.       NBREF=2
  60.       SEGDES IPT4
  61.       GOTO 11
  62.    8  IF (KSURF(IPT4.ITYPEL).EQ.0) CALL FUSELI(IPT6,IPT4,IPT5,LTELQ)
  63.       IF (KSURF(IPT4.ITYPEL).NE.0) CALL FUSESU(IPT6,IPT4,IPT5,LTELQ)
  64.       SEGDES IPT6,IPT4
  65.       IPT6=IPT5
  66.    9  CONTINUE
  67.   10  CONTINUE
  68.       CALL OUEXCL(IPT8,IPT6,IPT7)
  69.       SEGDES IPT8,IPT6,IPT7
  70.       GOTO 11
  71.    1  CONTINUE
  72. C  ON EST SENSE TOUT FUSIONNER A VOIR PLUS TARD
  73.       NBREF=0
  74.   11  CONTINUE
  75.  100  CONTINUE
  76. C  REFERENCES OK : IPT1.LISREF(1) IPT2.LISREF(2) IPT7
  77.       NBNN=IPT1.NUM(/1)
  78.       NBSOUS=0
  79.       NBELE1=IPT1.NUM(/2)
  80.       NBELE2=IPT2.NUM(/2)
  81.       NBELEM=NBELE1+NBELE2
  82.       SEGINI IPT3
  83.       IPT3.ITYPEL=IPT1.ITYPEL
  84.       IF (NBREF.EQ.0) GOTO 20
  85.       IPT3.LISREF(1)=IPT1.LISREF(1)
  86.       IPT3.LISREF(2)=IPT2.LISREF(2)
  87.       IF (NBREF.EQ.2) GOTO 20
  88.       IPT3.LISREF(3)=IPT7
  89.       SEGDES IPT7
  90.   20  CONTINUE
  91.       DO 21 I=1,NBNN
  92.       DO 22 J=1,NBELE1
  93.       IPT3.NUM(I,J)=IPT1.NUM(I,J)
  94.   22  CONTINUE
  95.       DO 23 J=1,NBELE2
  96.       IPT3.NUM(I,J+NBELE1)=IPT2.NUM(I,J)
  97.   23  CONTINUE
  98.   21  CONTINUE
  99.       DO 25 I=1,NBELE1
  100.               IPT3.ICOLOR(I)=IPT1.ICOLOR(I)
  101.   25  CONTINUE
  102.       DO 27 I=1,NBELE2
  103.               IPT3.ICOLOR(I+NBELE1)=IPT2.ICOLOR(I)
  104.   27  CONTINUE
  105.       RETURN
  106.       END
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  

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