C EXMALI SOURCE PV 20/09/26 21:16:48 10724 SUBROUTINE EXMALI(IMAT,LNBME,LELEM, $ LMATR, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : EXMALI C DESCRIPTION : Matrice + liste de noms de composantes + liste de numéro C d'élément => extraction et stockage dans un tableau de C listes indexées. C C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : ACTIMA, DESIMA, INIRPM, RPELEM C APPELE PAR : PROMAT C*********************************************************************** C ENTREES : IMAT, LNBME, LELEM C SORTIES : LMATR C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 08/02/2000, version initiale C HISTORIQUE : v1, 08/02/2000, 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 SMLENTI POINTEUR LNBME.MLENTI POINTEUR LELEM.MLENTI POINTEUR RPMAT.MLENTI -INC SMMATRIK POINTEUR IMAT.IMATRI POINTEUR SIMAT.IZAFM * Includes persos * Segment LSRIND (liste séquentielle indexée) SEGMENT LSRIND INTEGER IDXX(NBM+1) REAL*8 XVAL(NBTVAL) ENDSEGMENT INTEGER NBM,NBTVAL POINTEUR SLMAT1.LSRIND POINTEUR SLMATR.LSRIND SEGMENT LLI POINTEUR LISLI(NBME).LSRIND ENDSEGMENT INTEGER NBME POINTEUR LMATR.LLI * INTEGER IMPR,IRET * INTEGER NELEM,NNBME,NPP,NPD INTEGER IELEM,INBME,IPP,IPD,IBME INTEGER IVMATR,NUELEM,NOSOMA,NUELMA INTEGER NPPD * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans exmali.eso' CALL ACTIMA(IMAT) CALL INIRPM(IMAT, $ RPMAT, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * Dimensionnment de LMATR SEGACT LNBME NNBME=LNBME.LECT(/1) NBME=NNBME SEGINI LMATR * Dimensionnement des SLMATR stocké dans SLMAT1 SEGACT RPMAT SEGACT LELEM NELEM=LELEM.LECT(/1) NBM=NELEM NBTVAL=0 SEGINI SLMAT1 DO 1 IELEM=1,NELEM NUELEM=LELEM.LECT(IELEM) CALL RPELEM(NUELEM,RPMAT, $ NOSOMA,NUELMA, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NOSOMA=MAX(1,NOSOMA) SIMAT=IMAT.LIZAFM(NOSOMA,1) NPP=SIMAT.AM(/2) NPD=SIMAT.AM(/3) NPPD=NPP*NPD SLMAT1.IDXX(IELEM+1)=NPPD 1 CONTINUE SLMAT1.IDXX(1)=1 DO 3 IELEM=1,NELEM SLMAT1.IDXX(IELEM+1)=SLMAT1.IDXX(IELEM+1)+SLMAT1.IDXX(IELEM) 3 CONTINUE * Remplissage des SLMATR DO 5 INBME=1,NNBME IBME=LNBME.LECT(INBME) NBM=NELEM NBTVAL=SLMAT1.IDXX(NELEM+1)-1 SEGINI SLMATR SLMATR.IDXX(1)=1 IVMATR=0 DO 52 IELEM=1,NELEM NUELEM=LELEM.LECT(IELEM) CALL RPELEM(NUELEM,RPMAT, $ NOSOMA,NUELMA, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NOSOMA=MAX(1,NOSOMA) SIMAT=IMAT.LIZAFM(NOSOMA,IBME) NPP=SIMAT.AM(/2) NPD=SIMAT.AM(/3) DO 522 IPD=1,NPD DO 5222 IPP=1,NPP IVMATR=IVMATR+1 SLMATR.XVAL(IVMATR)=SIMAT.AM(NUELMA,IPP,IPD) 5222 CONTINUE 522 CONTINUE SLMATR.IDXX(IELEM+1)=SLMAT1.IDXX(IELEM+1) 52 CONTINUE SEGDES SLMATR * * Bug ! * * LMATR.LISLI(IBME)=SLMATR LMATR.LISLI(INBME)=SLMATR 5 CONTINUE SEGSUP SLMAT1 SEGDES LELEM SEGSUP RPMAT SEGDES LMATR SEGDES LNBME CALL DESIMA(IMAT) * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine exmali' RETURN * * End of subroutine EXMALI * END