Sources Esope | Cast3M

exmali
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