Télécharger la plaquette Cast3M


fr en

Télécharger prcmct.eso

Retour à la liste

Numérotation des lignes : 

prcmct

  1. C PRCMCT    SOURCE    CB215821  19/07/31    21:16:15     10277          
  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.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. *
  35.       INTEGER IMPR,IRET
  36.       CHARACTER*8 MONTYP
  37. *
  38. * Executable statements
  39. *
  40.       IMPR=IIMPI
  41.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prcmct'
  42. *
  43. * Lecture des arguments
  44. *
  45.       CALL QUETYP(MONTYP,0    ,IRETOU)
  46.       IF (IRETOU.EQ.0) THEN
  47.          CALL ERREUR(533)
  48.          RETURN
  49.       ENDIF
  50. * Deux matrices : C et B
  51. *
  52. * Avec des MATRIK
  53. *
  54.       IF (MONTYP.EQ.'MATRIK  ') THEN
  55.          CALL LIROBJ('MATRIK  ',MATC,1,IRETOU)
  56.          IF (IERR.NE.0) RETURN
  57.          CALL LIROBJ('MATRIK  ',MATB,1,IRET)
  58.          IF (IERR.NE.0) RETURN
  59. * Le chpoint matrice-masse diagonale D
  60.          CALL LIROBJ('CHPOINT ',ICHP,0,IRET)
  61.          IF (IRET.EQ.0) THEN
  62.             ICHP=0
  63.          ELSE
  64.            CALL ACTOBJ('CHPOINT ',ICHP,1)
  65.          ENDIF
  66. *
  67.          CALL PRCMCK(MATC,MATB,ICHP,MATCDB,IMPR,IRET)
  68.          IF (IRET.NE.0) GOTO 9999
  69. *
  70.          CALL ECROBJ('MATRIK  ',MATCDB)
  71. *
  72. * Avec des RIGIDITE
  73. *
  74.       ELSEIF (MONTYP.EQ.'RIGIDITE') THEN
  75.          CALL LIROBJ('RIGIDITE',IRIGC,1,IRET)
  76.          IF (IERR.NE.0) RETURN
  77.          CALL LIROBJ('RIGIDITE',IRIGB,1,IRET)
  78.          IF (IERR.NE.0) RETURN
  79. * Le chpoint matrice-masse diagonale D
  80.          CALL LIROBJ('CHPOINT ',ICHP,0,IRET)
  81.          IF (IRET.EQ.0) THEN
  82.             ICHP=0
  83.          ELSE
  84.          CALL ACTOBJ('CHPOINT ',ICHP,1)
  85.          ENDIF
  86.          CALL CMCT3(ICHP,IRIGC,IRIGB,IRIG2)
  87.          IF (IERR.NE.0) RETURN
  88. *
  89.          CALL ECROBJ('RIGIDITE',IRIG2)
  90.       ELSE
  91.          MOTERR(1:8)=MONTYP
  92.          CALL ERREUR(39)
  93.       ENDIF
  94. *
  95. * Normal termination
  96. *
  97. *      IRET=0
  98.       RETURN
  99. *
  100. * Format handling
  101. *
  102. *
  103. * Error handling
  104. *
  105.  9999 CONTINUE
  106. *     IRET=1
  107.       WRITE(IOIMP,*) 'An error was detected in subroutine prcmct'
  108.       CALL ERREUR(5)
  109.       RETURN
  110. *
  111. * End of subroutine PRCMCT
  112. *
  113.       END
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  

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