C EXINCO SOURCE GOUNAND 11/06/14 21:15:21 7005 SUBROUTINE EXINCO() IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : EXINCO C DESCRIPTION : Extrait d'une matrice RIGIDITE ou MATRIK C la sous-matrice C d'inconnues primales et duales celles données C en argument CH*4 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) : C APPELES (BLAS) : C APPELES (CALCUL) : C APPELE PAR : C*********************************************************************** C SYNTAXE GIBIANE : C MATRIK2 = 'KOPS' 'EXTRINCO' MATRIK1 LMOT1 LMOT2 ; C RIGI1 C ENTREES : C ENTREES/SORTIES : C SORTIES : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 30/05/2011, version initiale C HISTORIQUE : v1, 30/05/2011, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** -INC PPARAM -INC CCOPTIO -INC SMLMOTS POINTEUR LINCP.MLMOTS POINTEUR LINCD.MLMOTS * INTEGER IMPR,IRET CHARACTER*8 MONTYP * * Executable statements * IMPR=0 IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans exinco.eso' * * Lecture des arguments * CALL LIROBJ('LISTMOTS',LINCP,1,IRETOU) IF (IERR.NE.0) RETURN CALL LIROBJ('LISTMOTS',LINCD,1,IRETOU) IF (IERR.NE.0) RETURN CALL QUETYP(MONTYP,0 ,IRETOU) IF (IRETOU.EQ.0) THEN CALL ERREUR(533) RETURN ENDIF * * Avec des MATRIK * IF (MONTYP.EQ.'MATRIK ') THEN CALL LIROBJ('MATRIK ',MATIN,1,IRETOU) IF (IERR.NE.0) RETURN * CALL EXINCK(MATIN,LINCP,LINCD,MATOUT,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * CALL ECROBJ('MATRIK ',MATOUT) * * Avec des RIGIDITE * ELSEIF (MONTYP.EQ.'RIGIDITE') THEN CALL LIROBJ('RIGIDITE',IRIG,1,IRET) IF (IERR.NE.0) RETURN * CALL EXINCR(IRIG,LINCP,LINCD,IRIG2) IF (IERR.NE.0) RETURN * CALL ECROBJ('RIGIDITE',IRIG2) ELSE MOTERR(1:8)=MONTYP CALL ERREUR(39) ENDIF * * Normal termination * * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE * IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine exinco' CALL ERREUR(5) RETURN * * End of subroutine EXINCO * END