Télécharger la plaquette Cast3M


fr en

Télécharger exinco.eso

Retour à la liste

Numérotation des lignes : 

exinco

  1. C EXINCO    SOURCE    GOUNAND   11/06/14    21:15:21     7005
  2.       SUBROUTINE EXINCO()
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : EXINCO
  7. C DESCRIPTION : Extrait d'une matrice RIGIDITE ou MATRIK
  8. C               la sous-matrice
  9. C               d'inconnues primales et duales celles données
  10. C               en argument CH*4
  11. C
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES          :
  18. C APPELES (E/S)    :
  19. C APPELES (BLAS)   :
  20. C APPELES (CALCUL) :
  21. C APPELE PAR       :
  22. C***********************************************************************
  23. C SYNTAXE GIBIANE    :
  24. C    MATRIK2  = 'KOPS'  'EXTRINCO'  MATRIK1 LMOT1 LMOT2 ;
  25. C                                   RIGI1
  26. C ENTREES            :
  27. C ENTREES/SORTIES    :
  28. C SORTIES            :
  29. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  30. C***********************************************************************
  31. C VERSION    : v1, 30/05/2011, version initiale
  32. C HISTORIQUE : v1, 30/05/2011, création
  33. C HISTORIQUE :
  34. C HISTORIQUE :
  35. C***********************************************************************
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC SMLMOTS
  40.       POINTEUR LINCP.MLMOTS
  41.       POINTEUR LINCD.MLMOTS
  42. *
  43.       INTEGER IMPR,IRET
  44.       CHARACTER*8 MONTYP
  45. *
  46. * Executable statements
  47. *
  48.       IMPR=0
  49.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans exinco.eso'
  50. *
  51. * Lecture des arguments
  52. *
  53.       CALL LIROBJ('LISTMOTS',LINCP,1,IRETOU)
  54.       IF (IERR.NE.0) RETURN
  55.       CALL LIROBJ('LISTMOTS',LINCD,1,IRETOU)
  56.       IF (IERR.NE.0) RETURN
  57.       CALL QUETYP(MONTYP,0    ,IRETOU)
  58.       IF (IRETOU.EQ.0) THEN
  59.          CALL ERREUR(533)
  60.          RETURN
  61.       ENDIF
  62. *
  63. * Avec des MATRIK
  64. *
  65.       IF (MONTYP.EQ.'MATRIK  ') THEN
  66.          CALL LIROBJ('MATRIK  ',MATIN,1,IRETOU)
  67.          IF (IERR.NE.0) RETURN
  68. *
  69.          CALL EXINCK(MATIN,LINCP,LINCD,MATOUT,IMPR,IRET)
  70.          IF (IRET.NE.0) GOTO 9999
  71. *
  72.          CALL ECROBJ('MATRIK  ',MATOUT)
  73. *
  74. * Avec des RIGIDITE
  75. *
  76.       ELSEIF (MONTYP.EQ.'RIGIDITE') THEN
  77.          CALL LIROBJ('RIGIDITE',IRIG,1,IRET)
  78.          IF (IERR.NE.0) RETURN
  79. *
  80.          CALL EXINCR(IRIG,LINCP,LINCD,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 exinco'
  102.       CALL ERREUR(5)
  103.       RETURN
  104. *
  105. * End of subroutine EXINCO
  106. *
  107.       END
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  

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