Télécharger la plaquette Cast3M


fr en

Télécharger chditi.eso

Retour à la liste

Numérotation des lignes : 

chditi

  1. C CHDITI    SOURCE    CHAT      05/01/12    21:56:21     5004
  2. C   CE SOUS PROGRAMME AJOUTE LE CHPOINT IPCH A UN OBJET ELEMENTAIRE
  3. C   IL RELAIE A CHDITE
  4. C
  5.       SUBROUTINE CHDITI(IPCH,IPT1,IPT2,ICPR,ISENS)
  6.       IMPLICIT INTEGER(I-N)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC SMELEME
  11.       SEGACT IPT1
  12. C  ON TRAVAILLE SUR LES SOUS-OBJETS ET SUR LES REFERENCES ELEMENTAIRES
  13.       IF (IPT1.LISOUS(/1).NE.0) GOTO 50
  14.       CALL CHDITE(IPCH,IPT1,IPT2,ICPR,1,ISENS)
  15.       IF (IPT1.LISREF(/1).EQ.0) GOTO 100
  16.       NBREF=IPT1.LISREF(/1)
  17.       GO TO 60
  18.   50  NBELEM=0
  19.       NBNN=0
  20.       NBSOUS=IPT1.LISOUS(/1)
  21.       NBREF=IPT1.LISREF(/1)
  22.       SEGINI IPT2
  23.       DO 51 I=1,IPT1.LISOUS(/1)
  24.       IPT3=IPT1.LISOUS(I)
  25.       SEGACT IPT3
  26. C  ON ENLEVE LES REFERENCES
  27.       CALL CHDITE(IPCH,IPT3,IPT5,ICPR,0,ISENS)
  28.       SEGDES IPT3,IPT5
  29.       IPT2.LISOUS(I)=IPT5
  30.   51  CONTINUE
  31.   60  CONTINUE
  32.       IF (IPT1.LISREF(/1).EQ.0) GOTO 100
  33. C  POUR LES REFERENCES  ON ESSAYE D'EN PRENDRE LES REFERENCES ICI
  34.       DO 61 I=1,IPT1.LISREF(/1)
  35.       IPT3=IPT1.LISREF(I)
  36.       SEGACT IPT3
  37.       IF (IPT3.LISOUS(/1).NE.0) GOTO 67
  38.       CALL CHDITE(IPCH,IPT3,IPT5,ICPR,1,ISENS)
  39.       IF (IPT5.LISREF(/1).EQ.0) GOTO 62
  40.       DO 63 J=1,IPT3.LISREF(/1)
  41.       IPT6=IPT3.LISREF(J)
  42.       SEGACT IPT6
  43.       IF (IPT6.LISOUS(/1).NE.0) GOTO 64
  44.       CALL CHDITE(IPCH,IPT6,IPT8,ICPR,0,ISENS)
  45.       SEGDES IPT6,IPT8
  46.       IPT5.LISREF(J)=IPT8
  47.       GOTO 63
  48. C  FAUX MAIS NE PLANTE PAS
  49.   64  IPT5.LISREF(J)=IPT6
  50.   63  CONTINUE
  51.   62  CONTINUE
  52.       SEGDES IPT5
  53.       IPT2.LISREF(I)=IPT5
  54.       GOTO 68
  55.   67  CONTINUE
  56.       NBREF=0
  57.       NBSOUS=IPT3.LISOUS(/1)
  58.       NBNN=0
  59.       NBELEM=0
  60.       SEGINI IPT8
  61.       DO 69 I2=1,IPT3.LISOUS(/1)
  62.       IPT5=IPT3.LISOUS(I2)
  63.       SEGACT IPT5
  64.       CALL CHDITE(IPCH,IPT5,IPT7,ICPR,0,ISENS)
  65.       IPT8.LISOUS(I2)=IPT7
  66.       SEGDES IPT5,IPT7
  67.   69  CONTINUE
  68.       IPT2.LISREF(I)=IPT8
  69.   68  CONTINUE
  70.       SEGDES IPT3
  71.   61  CONTINUE
  72.  100  CONTINUE
  73.       SEGDES IPT1,IPT2
  74.       RETURN
  75.       END
  76.  
  77.  

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