Télécharger machin.eso

Retour à la liste

Numérotation des lignes :

  1. C MACHIN SOURCE GOUNAND 11/05/25 21:15:25 6980
  2. SUBROUTINE MACHIN()
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : MACHIN
  7. C DESCRIPTION : Changement de nom d'inconnues primales et duales
  8. C d'une matrice (type RIGIDITE ou MATRIK)
  9. C
  10. C
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES :
  16. C APPELES (E/S) : LIROBJ
  17. C APPELES (BLAS) :
  18. C APPELES (CALCUL) :
  19. C APPELE PAR :
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE :
  22. C MATRIK2 = 'KOPS' 'CHANINCO' MATRIK1
  23. C LISTMOT1 LISTMOT2 LISTMOT3 LISTMOT4 ;
  24. C ENTREES : EMTK
  25. C ENTREES/SORTIES : -
  26. C SORTIES : SMTK
  27. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  28. C***********************************************************************
  29. C VERSION : v1, 04/07/2002, version initiale
  30. C HISTORIQUE : v1, 04/07/2002, création
  31. C HISTORIQUE :
  32. C HISTORIQUE :
  33. C***********************************************************************
  34. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35. C en cas de modification de ce sous-programme afin de faciliter
  36. C la maintenance !
  37. C***********************************************************************
  38. -INC CCOPTIO
  39. -INC SMLMOTS
  40. POINTEUR IEPRI.MLMOTS
  41. POINTEUR IEDUA.MLMOTS
  42. POINTEUR ISPRI.MLMOTS
  43. POINTEUR ISDUA.MLMOTS
  44. *
  45. CHARACTER*8 MONTYP
  46. *
  47. * Executable statements
  48. *
  49. *
  50. * Lecture des arguments
  51. *
  52. CALL LIROBJ('LISTMOTS',IEPRI,1,IRETOU)
  53. IF (IERR.NE.0) RETURN
  54. CALL LIROBJ('LISTMOTS',ISPRI,1,IRETOU)
  55. IF (IERR.NE.0) RETURN
  56. CALL LIROBJ('LISTMOTS',IEDUA,1,IRETOU)
  57. IF (IERR.NE.0) RETURN
  58. CALL LIROBJ('LISTMOTS',ISDUA,1,IRETOU)
  59. IF (IERR.NE.0) RETURN
  60. CALL QUETYP(MONTYP,0 ,IRETOU)
  61. * WRITE(IOIMP,*) 'MONTYP=',MONTYP
  62. IF (IRETOU.EQ.0) THEN
  63. CALL ERREUR(533)
  64. RETURN
  65. ENDIF
  66. *
  67. IF (MONTYP.EQ.'MATRIK ') THEN
  68. CALL LIROBJ('MATRIK ',IMAT,1,IRETOU)
  69. IF (IERR.NE.0) RETURN
  70. CALL MACHIK(IMAT,IEPRI,ISPRI,IEDUA,ISDUA,IMAT2)
  71. IF (IERR.NE.0) RETURN
  72. CALL ECROBJ('MATRIK ',IMAT2)
  73. ELSEIF (MONTYP.EQ.'RIGIDITE') THEN
  74. CALL LIROBJ('RIGIDITE',IMAT,1,IRETOU)
  75. IF (IERR.NE.0) RETURN
  76. * Autorise le changement de nom des multiplicateurs de Lagrange
  77. CALL ECRCHA('MULT')
  78. CALL ECROBJ('LISTMOTS',ISDUA)
  79. CALL ECROBJ('LISTMOTS',IEDUA)
  80. CALL ECROBJ('LISTMOTS',ISPRI)
  81. CALL ECROBJ('LISTMOTS',IEPRI)
  82. CALL ECROBJ('RIGIDITE',IMAT)
  83. CALL ECRCHA('INCO')
  84. CALL PRCHAN
  85. ELSE
  86. MOTERR(1:8)=MONTYP
  87. CALL ERREUR(39)
  88. ENDIF
  89. *
  90. * Normal termination
  91. *
  92. RETURN
  93. *
  94. * Format handling
  95. *
  96. *
  97. * End of subroutine MACHIN
  98. *
  99. END
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  

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