Télécharger la plaquette Cast3M


fr en

Télécharger clstru.eso

Retour à la liste

Numérotation des lignes : 

clstru

  1. C CLSTRU    SOURCE    CHAT      09/10/09    21:16:21     6519
  2.       SUBROUTINE CLSTRU
  3. C
  4. C  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C  INDIQUE LA SS-STRUC ELEM A LAQUELLE APPARTIENT UN OBJET CL1 DDL FIXES
  6. C  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  7. C
  8.       IMPLICIT INTEGER(I-N)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -INC SMCLSTR
  13. -INC SMSTRUC
  14. -INC SMELEME
  15. -INC SMRIGID
  16.       I22=22
  17.       SEGMENT ITRAV(0)
  18.       SEGMENT ITRA1(0)
  19. C
  20. C     LECTURE DE L'OBJET RIGIDITE CL1
  21. C
  22.       CALL LIROBJ('RIGIDITE',IRET,1,IRETOU)
  23.       IF(IERR.EQ.0) GOTO 10
  24.       MOTERR(1:8)='RIGIDITE'
  25.       CALL ERREUR(37)
  26. C *** PAS D'OBJET DE TYPE RIGIDITE
  27.       CALL ERREUR(37)
  28.       RETURN
  29.    10 MRIGID=IRET
  30. C
  31. C     LECTURE DE LA SOUS-STRUCTURE
  32. C
  33.       CALL LIROBJ('STRUCTUR',KOBJET,1,IRETOU)
  34.       IF(IERR.EQ.0) GOTO 25
  35.       MOTERR(1:8)='STRUCTUR'
  36. C *** PAS D'OBJET DE TYPE STRUCTURE
  37.       CALL ERREUR(37)
  38.       RETURN
  39.    25 MSTRUC=KOBJET
  40.       SEGACT MRIGID
  41.       NRIGEL=IRIGEL(/2)
  42.       SEGINI ITRAV
  43.       DO 30 NR=1,NRIGEL
  44.       MELEME=IRIGEL(1,NR)
  45.       SEGACT MELEME
  46.       IF(ITYPEL.EQ.I22) GOTO 26
  47.       SEGSUP ITRAV
  48.       SEGDES MELEME
  49.       SEGDES MRIGID
  50.       CALL ERREUR(99)
  51. C  *** L'OBJET RIGIDITE N'EST PAS DE TYPE CL1
  52.       RETURN
  53.    26 SEGDES MELEME
  54.       ITRAV(**)=MELEME
  55.    30 CONTINUE
  56.       SEGDES MRIGID
  57.       SEGACT MSTRUC
  58.       NSTRU=LISTRU(/1)
  59.       IF(NSTRU.EQ.1) GOTO 35
  60. C
  61. C   LECTURE DU NUMERO DE LA SOUS-STRUCTURE ELEMENTAIRE
  62. C
  63.       CALL LIRENT(NSTRU,1,IRETOU)
  64.       IF(IERR.EQ.0) GOTO 35
  65.       SEGDES MSTRUC
  66.       SEGSUP ITRAV
  67. C *** L'OBJET CL1 DOIT APPARTENIR A UNE SS STRUC ELEMENTAIRE
  68.       INTERR(1)=MSTRUC
  69.       CALL ERREUR(90)
  70.       RETURN
  71.    35 MSOSTU=LISTRU(NSTRU)
  72.       SEGACT MSOSTU
  73.       MRIGID=ISRAID
  74.       SEGACT MRIGID
  75.       SEGINI ITRA1
  76.       NRIGEL=IRIGEL(/2)
  77.       DO 40 IAA=1,NRIGEL
  78.       ITRA1(**)=IRIGEL(1,IAA)
  79.    40 CONTINUE
  80.       SEGDES MRIGID
  81.       SEGDES MSOSTU
  82.       SEGDES MSTRUC
  83.       NL=ITRA1(/1)
  84.       NBPT=ITRAV(/1)
  85.       DO 65 I=1,NBPT
  86.       IKI=ITRAV(I)
  87.       DO 60 J=1,NL
  88.       IF(ITRA1(J).EQ.IKI) GOTO 65
  89.    60 CONTINUE
  90. C  *** UN BLOCAGE N'APPARTIENT PAS A LA SOUS-STRUCTURE
  91.       INTERR(1)=IKI
  92.       INTERR(2)=MSTRUC
  93.       CALL ERREUR(91)
  94.       RETURN
  95.    65 CONTINUE
  96.       SEGSUP ITRAV
  97.       SEGSUP ITRA1
  98.       N=1
  99.       SEGINI MCLSTR
  100.       IRIGCL(1)=IRET
  101.       ISOSTR(1)=MSOSTU
  102. C
  103. C     ECRITURE DU MCLSTR
  104. C
  105.       CALL ECROBJ('BLOQSTRU',MCLSTR)
  106.       SEGDES MCLSTR
  107.       RETURN
  108.       END
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  

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