Télécharger prcmct.eso

Retour à la liste

Numérotation des lignes :

  1. C PRCMCT SOURCE GOUNAND 11/05/25 21:15:27 6980
  2. SUBROUTINE PRCMCT()
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : PRCMCT
  7. C DESCRIPTION : Préparation du calcul de CD-1Bt, on effectue les boucles
  8. C sur les matrices élémentaires.
  9. C
  10. C LANGAGE : ESOPE
  11. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  12. C mél : gounand@semt2.smts.cea.fr
  13. C***********************************************************************
  14. C APPELES : PROMAT
  15. C APPELES (E/S) : LIROBJ, ECROBJ
  16. C APPELES (STAT) : INMSTA, PRMSTA, SUMSTA
  17. C APPELE PAR : RYO2V
  18. C***********************************************************************
  19. C SYNTAXE GIBIANE : MATCDB = 'KOPS' 'CMCT' MATC MATB CHPOD
  20. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  21. C***********************************************************************
  22. C VERSION : v1, 28/01/2000, version initiale réécrite
  23. C HISTORIQUE : v1, 28/01/2000, création
  24. C HISTORIQUE :
  25. C HISTORIQUE :
  26. C***********************************************************************
  27. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  28. C en cas de modification de ce sous-programme afin de faciliter
  29. C la maintenance !
  30. C***********************************************************************
  31. -INC CCOPTIO
  32. *
  33. INTEGER IMPR,IRET
  34. CHARACTER*8 MONTYP
  35. *
  36. * Executable statements
  37. *
  38. IMPR=IIMPI
  39. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prcmct'
  40. *
  41. * Lecture des arguments
  42. *
  43. CALL QUETYP(MONTYP,0 ,IRETOU)
  44. IF (IRETOU.EQ.0) THEN
  45. CALL ERREUR(533)
  46. RETURN
  47. ENDIF
  48. * Deux matrices : C et B
  49. *
  50. * Avec des MATRIK
  51. *
  52. IF (MONTYP.EQ.'MATRIK ') THEN
  53. CALL LIROBJ('MATRIK ',MATC,1,IRETOU)
  54. IF (IERR.NE.0) RETURN
  55. CALL LIROBJ('MATRIK ',MATB,1,IRET)
  56. IF (IERR.NE.0) RETURN
  57. * Le chpoint matrice-masse diagonale D
  58. CALL LIROBJ('CHPOINT ',ICHP,0,IRET)
  59. IF (IRET.EQ.0) THEN
  60. ICHP=0
  61. ENDIF
  62. *
  63. CALL PRCMCK(MATC,MATB,ICHP,MATCDB,IMPR,IRET)
  64. IF (IRET.NE.0) GOTO 9999
  65. *
  66. CALL ECROBJ('MATRIK ',MATCDB)
  67. *
  68. * Avec des RIGIDITE
  69. *
  70. ELSEIF (MONTYP.EQ.'RIGIDITE') THEN
  71. CALL LIROBJ('RIGIDITE',IRIGC,1,IRET)
  72. IF (IERR.NE.0) RETURN
  73. CALL LIROBJ('RIGIDITE',IRIGB,1,IRET)
  74. IF (IERR.NE.0) RETURN
  75. * Le chpoint matrice-masse diagonale D
  76. CALL LIROBJ('CHPOINT ',ICHP,0,IRET)
  77. IF (IRET.EQ.0) THEN
  78. ICHP=0
  79. ENDIF
  80. CALL CMCT3(ICHP,IRIGC,IRIGB,IRIG2)
  81. IF (IERR.NE.0) RETURN
  82. *
  83. CALL ECROBJ('RIGIDITE',IRIG2)
  84. ELSE
  85. MOTERR(1:8)=MONTYP
  86. CALL ERREUR(39)
  87. ENDIF
  88. *
  89. * Normal termination
  90. *
  91. * IRET=0
  92. RETURN
  93. *
  94. * Format handling
  95. *
  96. *
  97. * Error handling
  98. *
  99. 9999 CONTINUE
  100. * IRET=1
  101. WRITE(IOIMP,*) 'An error was detected in subroutine prcmct'
  102. CALL ERREUR(5)
  103. RETURN
  104. *
  105. * End of subroutine PRCMCT
  106. *
  107. END
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  

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