Télécharger cmct.eso

Retour à la liste

Numérotation des lignes :

  1. C CMCT SOURCE CHAT 09/10/09 21:16:26 6519
  2. SUBROUTINE CMCT
  3. *_______________________________________________________________________
  4. c
  5. c chapeau de l'opérateur cmct
  6. c
  7. c récupération des objets
  8. c quelques tests sur les objets obtenus
  9. c
  10. C ri2 = CMCT mrigid ri1
  11. C mrigid rigidite ( sans dependences)
  12. C ri1 rigidite de dependence
  13.  
  14. *_______________________________________________________________________
  15. IMPLICIT INTEGER(I-N)
  16. IMPLICIT REAL*8(A-H,O-Z)
  17. *
  18. -INC CCOPTIO
  19. -INC SMRIGID
  20. -INC SMELEME
  21.  
  22. *
  23. * lecture d'un objet rigidité
  24. *
  25. CALL LIROBJ('RIGIDITE',IRIG,1,IRET)
  26. IF (IERR .NE.0) THEN
  27. RETURN
  28. ENDIF
  29.  
  30.  
  31. * lecture optionnelle du champ par point
  32. *
  33. CALL LIROBJ('CHPOINT',ICHP,0,IRET)
  34. IF (IERR .NE.0) THEN
  35. RETURN
  36. ENDIF
  37.  
  38. if(iret.eq.0) then
  39. C lecture de la matrice a condenser
  40. CALL LIROBJ('RIGIDITE',IRI1,1,IRET)
  41. IF (IERR .NE.0) THEN
  42. RETURN
  43. ENDIF
  44.  
  45. * on verifie que la rigidité ne contient est bien
  46. * de type dependance
  47. mrigid = iri1
  48. SEGACT , MRIGID
  49. DO 1510 I=1,IRIGEL(/2)
  50. C write(6,*) ' irigel(/1) irigel(8,I)',irigel(/1),IRIGEL(8,I)
  51. if(irigel(/1).LT.8.or.IRIGEL(8,I).eq.0) then
  52. CALL ERREUR(888)
  53. SEGDES MRIGID
  54. RETURN
  55. ENDIF
  56. 1510 CONTINUE
  57. segdes mrigid
  58. call depen3(mrigid,ri6)
  59. call scnd2(irig,ri6,irig2)
  60. segsup ri6
  61.  
  62. else
  63. *
  64. * verification que la rigidité ne contient que des relation
  65. * c'est à dire n'est supportée que par des maillage de type22
  66. *
  67. MRIGID = IRIG
  68. SEGACT, MRIGID*NOMOD
  69. DO 100 I=1,IRIGEL(/2)
  70. MELEME = IRIGEL(1,I)
  71. SEGACT , MELEME*NOMOD
  72. IF (ITYPEL.NE.22) THEN
  73. CALL ERREUR(837)
  74. SEGDES MELEME
  75. SEGDES MRIGID
  76. RETURN
  77. ENDIF
  78. 100 CONTINUE
  79. *
  80. CALL CMCT1(ICHP,IRIG,IRIG2)
  81. *
  82. IF ( IERR .NE. 0 ) THEN
  83. RETURN
  84. ENDIF
  85.  
  86. endif
  87. *
  88. CALL ECROBJ('RIGIDITE',IRIG2)
  89. *
  90. RETURN
  91. END
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  

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