Télécharger exinco.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  37. -INC SMLMOTS
  38. POINTEUR LINCP.MLMOTS
  39. POINTEUR LINCD.MLMOTS
  40. *
  41. INTEGER IMPR,IRET
  42. CHARACTER*8 MONTYP
  43. *
  44. * Executable statements
  45. *
  46. IMPR=0
  47. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans exinco.eso'
  48. *
  49. * Lecture des arguments
  50. *
  51. CALL LIROBJ('LISTMOTS',LINCP,1,IRETOU)
  52. IF (IERR.NE.0) RETURN
  53. CALL LIROBJ('LISTMOTS',LINCD,1,IRETOU)
  54. IF (IERR.NE.0) RETURN
  55. CALL QUETYP(MONTYP,0 ,IRETOU)
  56. IF (IRETOU.EQ.0) THEN
  57. CALL ERREUR(533)
  58. RETURN
  59. ENDIF
  60. *
  61. * Avec des MATRIK
  62. *
  63. IF (MONTYP.EQ.'MATRIK ') THEN
  64. CALL LIROBJ('MATRIK ',MATIN,1,IRETOU)
  65. IF (IERR.NE.0) RETURN
  66. *
  67. CALL EXINCK(MATIN,LINCP,LINCD,MATOUT,IMPR,IRET)
  68. IF (IRET.NE.0) GOTO 9999
  69. *
  70. CALL ECROBJ('MATRIK ',MATOUT)
  71. *
  72. * Avec des RIGIDITE
  73. *
  74. ELSEIF (MONTYP.EQ.'RIGIDITE') THEN
  75. CALL LIROBJ('RIGIDITE',IRIG,1,IRET)
  76. IF (IERR.NE.0) RETURN
  77. *
  78. CALL EXINCR(IRIG,LINCP,LINCD,IRIG2)
  79. IF (IERR.NE.0) RETURN
  80. *
  81. CALL ECROBJ('RIGIDITE',IRIG2)
  82. ELSE
  83. MOTERR(1:8)=MONTYP
  84. CALL ERREUR(39)
  85. ENDIF
  86. *
  87. * Normal termination
  88. *
  89. * IRET=0
  90. RETURN
  91. *
  92. * Format handling
  93. *
  94. *
  95. * Error handling
  96. *
  97. 9999 CONTINUE
  98. * IRET=1
  99. WRITE(IOIMP,*) 'An error was detected in subroutine exinco'
  100. CALL ERREUR(5)
  101. RETURN
  102. *
  103. * End of subroutine EXINCO
  104. *
  105. END
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  

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