Télécharger kopidk.eso

Retour à la liste

Numérotation des lignes :

  1. C KOPIDK SOURCE PV 16/11/17 22:00:16 9180
  2. SUBROUTINE KOPIDK(IGEOM,LPRIM,MATRIK)
  3. C
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : KOPIDK
  9. C
  10. C DESCRIPTION : Cette subroutine cree la matrice identité
  11. C sous la forme des objets elementaires de type
  12. C MATRIK
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  15. C
  16. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  17. C
  18. C************************************************************************
  19. C
  20. C
  21. C APPELES (Outils) :
  22. C
  23. C APPELES (Calcul) :
  24. C
  25. C
  26. C************************************************************************
  27. C
  28. C PHRASE D'APPELLE GIBIANE
  29. C
  30. C MAT1 = 'KOPS' 'MATIDE' LMOT1 GEO1 'MATRIK' ;
  31. C
  32. C ENTREES : LMOT1 : objet de type LISTMOTS des variables primales (et
  33. C duales)
  34. C
  35. C GEO1 : objet de type MAILLAGE, des variables primales
  36. C (et duales)
  37. C
  38. C SORTIES: MAT1 : objet de type MATRIK, qui contient la matrice
  39. C identité
  40. C
  41. C************************************************************************
  42. C
  43. C HISTORIQUE (Anomalies et modifications éventuelles)
  44. C
  45. C HISTORIQUE : Cree le 23-8-2000
  46. C
  47. C************************************************************************
  48. C
  49. C**** Les includes
  50. C
  51. IMPLICIT REAL*8 (A-H,O-Z)
  52. IMPLICIT INTEGER(I-N)
  53. -INC CCOPTIO
  54. -INC SMLMOTS
  55. -INC SMELEME
  56. C
  57. C
  58. C**** On controle que le MELEME soit de type POI1
  59. C Si non changer
  60. C
  61. MELEME = IGEOM
  62. SEGACT MELEME
  63. NBSOUS = MELEME.LISOUS(/1)
  64. NTYP = MELEME.ITYPEL
  65. C
  66. IF ((NBSOUS.NE.0).OR.(NTYP.NE.1)) THEN
  67. * In CHANGE : SEGINI MELEME
  68. CALL CHANGE(MELEME,1)
  69. IPT1 = IGEOM
  70. SEGDES IPT1
  71. IF (IERR.NE.0) GOTO 9999
  72. ENDIF
  73. C
  74. NRIGE = 7
  75. NMATRI = 1
  76. NKID = 9
  77. NKMT = 7
  78. C
  79. SEGINI MATRIK
  80. C
  81. C**** Pointeurs sur les maillages primale et duale
  82. C
  83. MATRIK.IRIGEL(1,1)=MELEME
  84. MATRIK.IRIGEL(2,1)=MELEME
  85. C
  86. C**** La matrice est diagonale.
  87. C
  88. MATRIK.IRIGEL(7,1)=5
  89. C
  90. C**** MATRIK.IRIGEL(4,1) contient le pointeur sur IMATRI
  91. C
  92. MLMOTS = LPRIM
  93. SEGACT MLMOTS
  94. NBME = MLMOTS.MOTS(/2)
  95. NBSOUS = 1
  96. SEGINI IMATRI
  97. MATRIK.IRIGEL(4,1) = IMATRI
  98. SEGDES MATRIK
  99. DO ICON = 1, NBME, 1
  100. IMATRI.LISPRI(ICON) = MLMOTS.MOTS(ICON)
  101. IMATRI.LISDUA(ICON) = MLMOTS.MOTS(ICON)
  102. ENDDO
  103. SEGDES MLMOTS
  104. C
  105. C**** On rempli la matrice identité
  106. C
  107. NBEL = MELEME.NUM(/2)
  108. NP = 1
  109. MP = 1
  110. DO ICON = 1, NBME , 1
  111. SEGINI IZAFM
  112. DO IELEM = 1, NBEL, 1
  113. IMATRI.LIZAFM(1,ICON) = IZAFM
  114. IZAFM.AM(IELEM,1,1) = 1.0D0
  115. ENDDO
  116. SEGDES IZAFM
  117. ENDDO
  118. C
  119. SEGDES IMATRI
  120. SEGDES MELEME
  121. C
  122. 9999 RETURN
  123. END
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  

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