Télécharger la plaquette Cast3M


fr en

Télécharger additi.eso

Retour à la liste

Numérotation des lignes : 

additi

  1. C ADDITI    SOURCE    CB215821  19/08/20    21:15:09     10287          
  2. C   CE SOUS PROGRAMME AJOUTE LE POINT X A UN OBJET ELEMENTAIRE
  3. C   IL RELAIE A ADDITEL
  4. C
  5.       SUBROUTINE ADDITI(X,IPT1,IPT2,ICPR)
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8.       DIMENSION X(3)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -INC SMELEME
  13.       SEGACT IPT1
  14. C  ON TRAVAILLE SUR LES SOUS-OBJETS ET SUR LES REFERENCES ELEMENTAIRES
  15.       IF (IPT1.LISOUS(/1).NE.0) GOTO 50
  16.       CALL ADDITE(X,IPT1,IPT2,ICPR,1)
  17.       IF (IPT1.LISREF(/1).EQ.0) GOTO 100
  18.       NBREF=IPT1.LISREF(/1)
  19.       GO TO 60
  20.   50  NBELEM=0
  21.       NBNN=0
  22.       NBSOUS=IPT1.LISOUS(/1)
  23.       NBREF=IPT1.LISREF(/1)
  24.       SEGINI IPT2
  25.       DO 51 I=1,IPT1.LISOUS(/1)
  26.       IPT3=IPT1.LISOUS(I)
  27.       SEGACT IPT3
  28. C  ON ENLEVE LES REFERENCES
  29.       CALL ADDITE(X,IPT3,IPT5,ICPR,0)
  30.       IPT2.LISOUS(I)=IPT5
  31.   51  CONTINUE
  32.   60  CONTINUE
  33.       IF (IPT1.LISREF(/1).EQ.0) GOTO 100
  34. C  POUR LES REFERENCES  ON ESSAYE D'EN PRENDRE LES REFERENCES ICI
  35.       DO 61 I=1,IPT1.LISREF(/1)
  36.       IPT3=IPT1.LISREF(I)
  37.       SEGACT IPT3
  38.       IF (IPT3.LISOUS(/1).NE.0) GOTO 67
  39.       CALL ADDITE(X,IPT3,IPT5,ICPR,1)
  40.       IF (IPT5.LISREF(/1).EQ.0) GOTO 62
  41.       DO 63 J=1,IPT3.LISREF(/1)
  42.       IPT6=IPT3.LISREF(J)
  43.       SEGACT IPT6
  44.       IF (IPT6.LISOUS(/1).NE.0) GOTO 64
  45.       CALL ADDITE(X,IPT6,IPT8,ICPR,0)
  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.       IPT2.LISREF(I)=IPT5
  53.       GOTO 68
  54.   67  CONTINUE
  55.       NBREF=0
  56.       NBSOUS=IPT3.LISOUS(/1)
  57.       NBNN=0
  58.       NBELEM=0
  59.       SEGINI IPT8
  60.       DO 69 I2=1,IPT3.LISOUS(/1)
  61.       IPT5=IPT3.LISOUS(I2)
  62.       SEGACT IPT5
  63.       CALL ADDITE(X,IPT5,IPT7,ICPR,0)
  64.       IPT8.LISOUS(I2)=IPT7
  65.   69  CONTINUE
  66.       IPT2.LISREF(I)=IPT8
  67.   68  CONTINUE
  68.   61  CONTINUE
  69.  100  CONTINUE
  70.       END
  71.  
  72.  
  73.  

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