Télécharger la plaquette Cast3M


fr en

Télécharger ksigma.eso

Retour à la liste

Numérotation des lignes : 

ksigma

  1. C KSIGMA    SOURCE    CB215821  23/01/25    21:15:26     11573          
  2.       SUBROUTINE KSIGMA
  3. C_______________________________________________________________________
  4. C
  5. C     OPERATEUR KSIGMA
  6. C
  7. C     Construction de la matrice de raideur geometrique @ partir d'un
  8. C     MCHAML de contraintes
  9. C
  10. C     Nouvelle syntaxe:
  11. C     _________________
  12. C
  13. C       RIG1 =KSIG MOD1 SIG1 ( CAR1 ) 'FLAM';
  14. C
  15. C       MOD1=OBJET DE TYPE MMODEL
  16. C       SIG1=MCHAML de CONTRAINTES
  17. C       CAR1=MCHAML de CARACTERISTIQUES
  18. C
  19. C       RIG1=Matrice KSIGMA de sous type RIGIDITE
  20. C
  21. C       Passage aux nouveaux MCHAMLs par I.Monnier le 14.06.90
  22. C
  23. C_______________________________________________________________________
  24. C
  25.       IMPLICIT INTEGER(I-N)
  26.       IMPLICIT REAL*8(A-H,O-Z)
  27. C
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMCOORD
  32. C
  33.       CHARACTER*4 MOFLAM(1)
  34.       DATA MOFLAM/'FLAM'/
  35. C
  36.       IPCHA1=0
  37.       IPCHA2=0
  38.       IPCHE1=0
  39.       IPCHE2=0
  40.       IFLAM=0
  41. C
  42.       CALL LIRMOT(MOFLAM,1,IFLAM,0)
  43.       IF (IERR.NE.0) RETURN
  44. C
  45.       CALL LIROBJ('MMODEL',IPMODL,1,IRT1)
  46.       IF (IERR.NE.0) RETURN
  47.       CALL ACTOBJ('MMODEL  ',IPMODL,1)
  48. C
  49.         CALL LIROBJ('MCHAML',IPIN,1,IRT1)
  50.         IF (IERR.NE.0) RETURN
  51.           CALL ACTOBJ('MCHAML  ',IPIN,1)
  52.           CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  53.           IF(IR   .NE. 1) CALL ERREUR(KER)
  54.           IF(IERR .NE. 0) RETURN
  55. C
  56.         CALL LIROBJ('MCHAML',IPIN,0,IRT1)
  57.         IF (IERR.NE.0) RETURN
  58.         IPCHA2=0
  59.         IF (IRT1 .EQ. 1) THEN
  60.           CALL ACTOBJ('MCHAML  ',IPIN,1)
  61.           CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
  62.           IF(IR   .NE. 1) CALL ERREUR(KER)
  63.           IF(IERR .NE. 0) RETURN
  64.         ENDIF
  65. C
  66.         CALL RNGCHA(IPCHA1,IPCHA2,'CONTRAINTES',
  67.      1              'CARACTERISTIQUES',IPCHE1,IPCHE2)
  68. C
  69.         IF(IPCHE1.EQ.0)THEN
  70.           MOTERR(1:16)='CONTRAINTES'
  71.           CALL ERREUR(565)
  72.           RETURN
  73.         ENDIF
  74. C
  75.       segact mcoord
  76.       CALL KSIGMP(IPMODL,IPCHE1,IPCHE2,IFLAM,IPRIGG)
  77.       segdes mcoord
  78. C
  79.       IF (IERR.EQ.0.AND.IPRIGG.NE.0) CALL ECROBJ('RIGIDITE',IPRIGG)
  80. C
  81.       RETURN
  82.       END
  83.  
  84.  

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