C MACHIN SOURCE GOUNAND 21/04/14 21:15:01 10964 SUBROUTINE MACHIN() IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : MACHIN 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 PPARAM -INC CCOPTIO -INC SMLMOTS POINTEUR IEPRI.MLMOTS POINTEUR IEDUA.MLMOTS POINTEUR ISPRI.MLMOTS POINTEUR ISDUA.MLMOTS * CHARACTER*4 MEPRI,MEDUA,MSPRI,MSDUA CHARACTER*8 MONTYP * * Executable statements * * * Lecture des arguments * CALL LIROBJ('LISTMOTS',IEPRI,0,ILMOTS) IF (ILMOTS.EQ.0) THEN CALL LIRCHA(MEPRI,1,iretou) IF( ierr.ne.0) RETURN CALL LIRCHA(MSPRI,1,iretou) IF( ierr.ne.0) RETURN CALL LIRCHA(MEDUA,1,iretou) IF( ierr.ne.0) RETURN CALL LIRCHA(MSDUA,1,iretou) IF( ierr.ne.0) RETURN JGN=4 JGM=1 segini iepri,ispri,iedua,isdua iepri.mots(1)=mepri ispri.mots(1)=mspri iedua.mots(1)=medua isdua.mots(1)=msdua ELSE CALL LIROBJ('LISTMOTS',ISPRI,1,IRETOU) IF (IERR.NE.0) RETURN CALL LIROBJ('LISTMOTS',IEDUA,1,IRETOU) IF (IERR.NE.0) RETURN CALL LIROBJ('LISTMOTS',ISDUA,1,IRETOU) IF (IERR.NE.0) RETURN ENDIF CALL QUETYP(MONTYP,0 ,IRETOU) * WRITE(IOIMP,*) 'MONTYP=',MONTYP IF (IRETOU.EQ.0) THEN CALL ERREUR(533) RETURN ENDIF * IF (MONTYP.EQ.'MATRIK ') THEN CALL LIROBJ('MATRIK ',IMAT,1,IRETOU) IF (IERR.NE.0) RETURN CALL MACHIK(IMAT,IEPRI,ISPRI,IEDUA,ISDUA,IMAT2) IF (IERR.NE.0) RETURN CALL ECROBJ('MATRIK ',IMAT2) ELSEIF (MONTYP.EQ.'RIGIDITE') THEN CALL LIROBJ('RIGIDITE',IMAT,1,IRETOU) IF (IERR.NE.0) RETURN * Autorise le changement de nom des multiplicateurs de Lagrange CALL ECRCHA('MULT') CALL ECROBJ('LISTMOTS',ISDUA) CALL ECROBJ('LISTMOTS',IEDUA) CALL ECROBJ('LISTMOTS',ISPRI) CALL ECROBJ('LISTMOTS',IEPRI) CALL ECROBJ('RIGIDITE',IMAT) CALL ECRCHA('INCO') CALL PRCHAN ELSE MOTERR(1:8)=MONTYP CALL ERREUR(39) ENDIF * * Normal termination * RETURN * * Format handling * * * End of subroutine MACHIN * END