Télécharger la plaquette Cast3M


fr en

Télécharger kopidk.eso

Retour à la liste

Numérotation des lignes : 

kopidk

  1. C KOPIDK    SOURCE    PV        20/09/26    21:18:07     10724          
  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.  
  54. -INC PPARAM
  55. -INC CCOPTIO
  57. -INC SMLMOTS
  58. -INC SMELEME
  59. C
  60. C
  61. C**** On controle que le MELEME soit de type POI1
  62. C     Si non changer
  63. C
  64.       MELEME = IGEOM
  65.       SEGACT MELEME
  66.       NBSOUS = MELEME.LISOUS(/1)
  67.       NTYP = MELEME.ITYPEL
  68. C
  69.       IF ((NBSOUS.NE.0).OR.(NTYP.NE.1)) THEN
  70. * In CHANGE : SEGINI MELEME
  71.          CALL CHANGE(MELEME,1)
  72.          IPT1 = IGEOM
  73.          SEGDES IPT1
  74.          IF (IERR.NE.0) GOTO 9999
  75.       ENDIF
  76. C
  77.       NRIGE = 7
  78.       NMATRI = 1
  79.       NKID = 9
  80.       NKMT = 7
  81. C
  82.       SEGINI MATRIK
  83. C
  84. C**** Pointeurs sur les maillages primale et duale
  85. C
  86.       MATRIK.IRIGEL(1,1)=MELEME
  87.       MATRIK.IRIGEL(2,1)=MELEME
  88. C
  89. C**** La matrice est diagonale.
  90. C
  91.       MATRIK.IRIGEL(7,1)=5
  92. C
  93. C**** MATRIK.IRIGEL(4,1) contient le pointeur sur IMATRI
  94. C
  95.       MLMOTS = LPRIM
  96.       SEGACT MLMOTS
  97.       NBME = MLMOTS.MOTS(/2)
  98.       NBSOUS = 1
  99.       SEGINI IMATRI
  100.       MATRIK.IRIGEL(4,1) = IMATRI
  101.       SEGDES MATRIK
  102.       DO ICON = 1, NBME, 1
  103.          IMATRI.LISPRI(ICON) = MLMOTS.MOTS(ICON)
  104.          IMATRI.LISDUA(ICON) = MLMOTS.MOTS(ICON)
  105.       ENDDO
  106.       SEGDES MLMOTS
  107. C
  108. C**** On rempli la matrice identité
  109. C
  110.       NBEL = MELEME.NUM(/2)
  111.       NP = 1
  112.       MP = 1
  113.       DO ICON = 1, NBME , 1
  114.          SEGINI IZAFM
  115.          DO IELEM = 1, NBEL, 1
  116.             IMATRI.LIZAFM(1,ICON) = IZAFM
  117.             IZAFM.AM(IELEM,1,1) = 1.0D0
  118.          ENDDO
  119.          SEGDES IZAFM
  120.       ENDDO
  121. C
  122.       SEGDES IMATRI
  123.       SEGDES MELEME
  124. C
  125.  9999 RETURN
  126.       END
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  

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