C MACHIK SOURCE GOUNAND 11/05/25 21:15:24 6980 SUBROUTINE MACHIK(EMTK,EPRI,SPRI,EDUA,SDUA,SMTK) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : MACHIK C DESCRIPTION : Changement de nom d'inconnues primales et duales C d'une matrice (type RIGIDITE ou MATRIK) C C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : C APPELES (E/S) : LIROBJ C APPELES (BLAS) : C APPELES (CALCUL) : C APPELE PAR : C*********************************************************************** C SYNTAXE GIBIANE : C MATRIK2 = 'KOPS' 'CHANINCO' MATRIK1 C LISTMOT1 LISTMOT2 LISTMOT3 LISTMOT4 ; C ENTREES : EMTK C ENTREES/SORTIES : - C SORTIES : SMTK C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 04/07/2002, version initiale C HISTORIQUE : v1, 04/07/2002, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO -INC SMLMOTS POINTEUR EPRI.MLMOTS POINTEUR EDUA.MLMOTS POINTEUR SPRI.MLMOTS POINTEUR SDUA.MLMOTS -INC SMMATRIK POINTEUR EMTK.MATRIK POINTEUR SMTK.MATRIK POINTEUR EIMAT.IMATRI POINTEUR SIMAT.IMATRI * INTEGER IRETOU INTEGER LEPRI,LSPRI,LEDUA,LSDUA INTEGER IEPRI,IEDUA INTEGER NRIGE,NMATRI,NKID,NKMT,NBME INTEGER IRIGE,JMATRI, IBME * * Executable statements * * * Lecture des arguments * SEGACT,EPRI,SPRI,EDUA,SDUA LEPRI=EPRI.MOTS(/2) LSPRI=SPRI.MOTS(/2) LEDUA=EDUA.MOTS(/2) LSDUA=SDUA.MOTS(/2) IF (LEPRI.NE.LSPRI.OR.LEDUA.NE.LSDUA) THEN CALL ERREUR(854) RETURN ENDIF * * Initialisation du chapeau Matrik résultat et mise à zéro * de toute information de préconditionnement. * SEGACT EMTK NRIGE=EMTK.IRIGEL(/1) NMATRI=EMTK.IRIGEL(/2) NKID=EMTK.KIDMAT(/1) NKMT=EMTK.KKMMT(/1) SEGINI,SMTK DO JMATRI=1,NMATRI DO IRIGE=1,NRIGE SMTK.IRIGEL(IRIGE,JMATRI)=EMTK.IRIGEL(IRIGE,JMATRI) ENDDO * On ne sait pas si la matrice résultante est symétrique * (et on s'en fout) * mais c'est mieux de garder le type ! * SMTK.IRIGEL(7,JMATRI)=3 ENDDO SEGDES,EMTK * * Duplication des segments IMATRI et changement éventuel des noms * d'inconnues * DO JMATRI=1,NMATRI EIMAT=SMTK.IRIGEL(4,JMATRI) SEGINI,SIMAT=EIMAT SMTK.IRIGEL(4,JMATRI)=SIMAT NBME=SIMAT.LIZAFM(/2) DO IBME=1,NBME DO IEPRI=1,LEPRI IF (SIMAT.LISPRI(IBME)(1:4).EQ.EPRI.MOTS(IEPRI)(1:4)) $ THEN SIMAT.LISPRI(IBME)(1:4)=SPRI.MOTS(IEPRI)(1:4) ENDIF ENDDO DO IEDUA=1,LEDUA IF (SIMAT.LISDUA(IBME)(1:4).EQ.EDUA.MOTS(IEDUA)(1:4)) $ THEN SIMAT.LISDUA(IBME)(1:4)=SDUA.MOTS(IEDUA)(1:4) ENDIF ENDDO ENDDO SEGDES,SIMAT ENDDO SEGDES,SMTK SEGDES,EPRI,SPRI,EDUA,SDUA * * Normal termination * RETURN * * Format handling * * * End of subroutine MACHIK * END