Esope source files

   1 : C MACHIK    SOURCE    GOUNAND   11/05/25    21:15:24     6980           
   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 : -INC SMMATRIK
  45 :       POINTEUR EMTK.MATRIK
  46 :       POINTEUR SMTK.MATRIK
  47 :       POINTEUR EIMAT.IMATRI
  48 :       POINTEUR SIMAT.IMATRI
  49 : *
  50 :       INTEGER IRETOU
  51 :       INTEGER LEPRI,LSPRI,LEDUA,LSDUA
  52 :       INTEGER IEPRI,IEDUA
  53 :       INTEGER NRIGE,NMATRI,NKID,NKMT,NBME
  54 :       INTEGER IRIGE,JMATRI,          IBME
  55 : *     
  56 : * Executable statements
  57 : *
  58 : *
  59 : * Lecture des arguments
  60 : *
  61 :       SEGACT,EPRI,SPRI,EDUA,SDUA
  62 :       LEPRI=EPRI.MOTS(/2)
  63 :       LSPRI=SPRI.MOTS(/2)
  64 :       LEDUA=EDUA.MOTS(/2)
  65 :       LSDUA=SDUA.MOTS(/2)
  66 :       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 :