Télécharger machik.eso

Retour à la liste

Numérotation des lignes :

  1. C MACHIK SOURCE PV 16/11/17 22:00:38 9180
  2. SUBROUTINE MACHIK(EMTK,EPRI,SPRI,EDUA,SDUA,SMTK)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : MACHIK
  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 EPRI.MLMOTS
  41. POINTEUR EDUA.MLMOTS
  42. POINTEUR SPRI.MLMOTS
  43. POINTEUR SDUA.MLMOTS
  44. POINTEUR EMTK.MATRIK
  45. POINTEUR SMTK.MATRIK
  46. POINTEUR EIMAT.IMATRI
  47. POINTEUR SIMAT.IMATRI
  48. *
  49. INTEGER IRETOU
  50. INTEGER LEPRI,LSPRI,LEDUA,LSDUA
  51. INTEGER IEPRI,IEDUA
  52. INTEGER NRIGE,NMATRI,NKID,NKMT,NBME
  53. INTEGER IRIGE,JMATRI, IBME
  54. *
  55. * Executable statements
  56. *
  57. *
  58. * Lecture des arguments
  59. *
  60. SEGACT,EPRI,SPRI,EDUA,SDUA
  61. LEPRI=EPRI.MOTS(/2)
  62. LSPRI=SPRI.MOTS(/2)
  63. LEDUA=EDUA.MOTS(/2)
  64. LSDUA=SDUA.MOTS(/2)
  65. IF (LEPRI.NE.LSPRI.OR.LEDUA.NE.LSDUA) THEN
  66. CALL ERREUR(854)
  67. RETURN
  68. ENDIF
  69. *
  70. * Initialisation du chapeau Matrik résultat et mise à zéro
  71. * de toute information de préconditionnement.
  72. *
  73. SEGACT EMTK
  74. NRIGE=EMTK.IRIGEL(/1)
  75. NMATRI=EMTK.IRIGEL(/2)
  76. NKID=EMTK.KIDMAT(/1)
  77. NKMT=EMTK.KKMMT(/1)
  78. SEGINI,SMTK
  79. DO JMATRI=1,NMATRI
  80. DO IRIGE=1,NRIGE
  81. SMTK.IRIGEL(IRIGE,JMATRI)=EMTK.IRIGEL(IRIGE,JMATRI)
  82. ENDDO
  83. * On ne sait pas si la matrice résultante est symétrique
  84. * (et on s'en fout)
  85. * mais c'est mieux de garder le type !
  86. * SMTK.IRIGEL(7,JMATRI)=3
  87. ENDDO
  88. SEGDES,EMTK
  89. *
  90. * Duplication des segments IMATRI et changement éventuel des noms
  91. * d'inconnues
  92. *
  93. DO JMATRI=1,NMATRI
  94. EIMAT=SMTK.IRIGEL(4,JMATRI)
  95. SEGINI,SIMAT=EIMAT
  96. SMTK.IRIGEL(4,JMATRI)=SIMAT
  97. NBME=SIMAT.LIZAFM(/2)
  98. DO IBME=1,NBME
  99. DO IEPRI=1,LEPRI
  100. IF (SIMAT.LISPRI(IBME)(1:4).EQ.EPRI.MOTS(IEPRI)(1:4))
  101. $ THEN
  102. SIMAT.LISPRI(IBME)(1:4)=SPRI.MOTS(IEPRI)(1:4)
  103. ENDIF
  104. ENDDO
  105. DO IEDUA=1,LEDUA
  106. IF (SIMAT.LISDUA(IBME)(1:4).EQ.EDUA.MOTS(IEDUA)(1:4))
  107. $ THEN
  108. SIMAT.LISDUA(IBME)(1:4)=SDUA.MOTS(IEDUA)(1:4)
  109. ENDIF
  110. ENDDO
  111. ENDDO
  112. SEGDES,SIMAT
  113. ENDDO
  114. SEGDES,SMTK
  115. SEGDES,EPRI,SPRI,EDUA,SDUA
  116. *
  117. * Normal termination
  118. *
  119. RETURN
  120. *
  121. * Format handling
  122. *
  123. *
  124. * End of subroutine MACHIK
  125. *
  126. END
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  

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