Télécharger la plaquette Cast3M


fr en

Télécharger struct.eso

Retour à la liste

Numérotation des lignes : 

struct

  1. C STRUCT    SOURCE    FANDEUR   10/12/14    21:19:53     6812
  2.       SUBROUTINE STRUCT
  3. C
  4. C     CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C     C
  6. C     C * LECTURE D UNE STRUCTURE ELEMENTAIRE
  7. C     C SYNTAXE : S = STRU K M ;
  8. C     C * FABRICATION DE N SOUS STRUCTURES IDENTIQUES
  9. C     C SYNTAXE : S = STRU K M NFOIS;
  10. C     C
  11. C     C   S   : OBJET DE TYPE STRUCTURE
  12. C     C   K   : OBJET DE TYPE RIGIDITE .MTYMAT=RIGIDITE
  13. C     C   M   : OBJET DE TYPE RIGIDITE .MTYMAT=MASSE
  14. C     C NFOIS : ENTIER .IL Y A NFOIS STRUCTURES IDENTIQUES
  15. C     C    OU BIEN:
  16. C     C  S=STRU  CHMATE CHCARA (NFOIS);
  17. C     C   CHMATE:OBJET DE TYPE CHMELEME DE SOUS TYPE MATE
  18. C     C   CHCARA:OBJET DE TYPE CHMELEME DE SOUS TYPE CARA
  19. C     C
  20. C     CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  21. C
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24. -INC SMRIGID
  25. -INC SMSTRUC
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. C
  29.       IRIGI=0
  30.       IMASS=0
  31.  1    CALL LIROBJ('RIGIDITE',IRET,0,IRETOU)
  32.       IF(IRETOU.EQ.0) GO TO 105
  33.       MRIGID=IRET
  34.       SEGACT MRIGID
  35.       IF(MTYMAT.NE.'RIGIDITE') GO TO 100
  36.       IF(IRIGI.EQ.0) GO TO 101
  37.       MOTERR(1:8)='RIGIDITE'
  38.       MOTERR(9:16)='RIGIDITE'
  39.       CALL ERREUR(130)
  40. C     LA RIGIDITE A DEJA ETE DONNEE
  41.       SEGDES MRIGID
  42.       GO TO 5000
  43.  101  CONTINUE
  44.       IRIGI=MRIGID
  45.       SEGDES MRIGID
  46.       IF(IMASS.EQ.0) GO TO 1
  47.       GO TO 105
  48.  100  IF(MTYMAT.NE.'MASSE') GO TO 104
  49.       IF(IMASS.EQ.0) GO TO 103
  50.       MOTERR(1:8)='RIGIDITE'
  51.       MOTERR(9:16)='MASSE'
  52.       CALL ERREUR(130)
  53. C     LA MASSE A DEJA ETE DONNEE
  54.       SEGDES MRIGID
  55.       GO TO 5000
  56.  103  CONTINUE
  57.       IMASS=MRIGID
  58.       SEGDES MRIGID
  59.       IF(IRIGI.EQ.0) GO TO 1
  60.       GO TO 105
  61.  104  CONTINUE
  62.       MOTERR(1:8)='RIGIDITE'
  63.       MOTERR(9:16)=MTYMAT
  64.       CALL ERREUR(131)
  65. C     ON N ATTEND PAS CE SOUS TYPE DE RIGIDITE
  66.       SEGDES MRIGID
  67.       GO TO 5000
  68. C
  69.  105  CONTINUE
  70.       IF(IRIGI.NE.0) GO TO 106
  71.  106  CONTINUE
  72.       CALL LIRENT(N,0,IRETOU)
  73.       IF(IRETOU.EQ.0) N=1
  74.       SEGINI MSTRUC
  75.       NS=2
  76.       DO 200 I=1,N
  77.       SEGINI MSOSTU
  78.       ISRAID=IRIGI
  79.       ISMASS=IMASS
  80.       ITYSOU=0
  81.       SEGDES MSOSTU
  82.       LISTRU(I)=MSOSTU
  83.  200  CONTINUE
  84.       SEGDES MSTRUC
  85.       CALL ECROBJ('STRUCTUR',MSTRUC)
  86.  
  87.  5000 CONTINUE
  88.       RETURN
  89.       END
  90.  
  91.  
  92.  

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