Esope source files

   1 : C KOPIDK    SOURCE    GOUNAND   11/05/24    21:15:32     6976           
   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 SMMATRIK
  55 : -INC SMLMOTS
  56 : -INC SMELEME
  57 : C  
  58 : C
  59 : C**** On controle que le MELEME soit de type POI1
  60 : C     Si non changer
  61 : C
  62 :       MELEME = IGEOM
  63 :       SEGACT MELEME
  64 :       NBSOUS = MELEME.LISOUS(/1)
  65 :       NTYP = MELEME.ITYPEL
  66 : C
  67 :       IF ((NBSOUS.NE.0).OR.(NTYP.NE.1)) THEN
  68 : * 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 :