Sources Esope | Cast3M

exmlli
C EXMLLI    SOURCE    CHAT      05/01/12    23:51:08     5004
      SUBROUTINE EXMLLI(MAIL,LELEM,
     $     LSTXML,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : EXMLLI
C DESCRIPTION : Extraction d'éléments d'un maillage que l'on stocke dans
C               une liste indexée.
C               LELEM est supposée ordonnée.
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          : ACTMEL, DESMEL, INIRPL, RPELEM
C APPELE PAR       : ML2LIE
C***********************************************************************
C ENTREES            : MAIL, LELEM
C SORTIES            : LSTXML
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 LELEM.MLENTI
      POINTEUR RPMAIL.MLENTI
-INC SMELEME
      POINTEUR MAIL.MELEME
      POINTEUR SOUMAI.MELEME
* Includes persos
*     Segment LSTIND (liste séquentielle indexée)
      SEGMENT LSTIND
      INTEGER IDX(NBM+1)
      INTEGER IVAL(NBTVAL)
      ENDSEGMENT
      INTEGER NBM,NBTVAL
      POINTEUR LSTXML.LSTIND
*
      INTEGER IMPR,IRET
*
      INTEGER NELEM,NNO
      INTEGER IELEM,INO,IVXML
      INTEGER NOSOMA,NUELEM,NUELMA,NUNO
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans exmlli.eso'
      CALL ACTMEL(MAIL)
      CALL INIRPL(MAIL,
     $     RPMAIL,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Dimensionnement de LSTXML
      SEGACT LELEM
      NELEM=LELEM.LECT(/1)
      NBM=NELEM
      NBTVAL=0
      SEGINI LSTXML
      SEGACT RPMAIL
      DO 1 IELEM=1,NELEM
         NUELEM=LELEM.LECT(IELEM)
         CALL RPELEM(NUELEM,RPMAIL,
     $        NOSOMA,NUELMA,
     $        IMPR,IRET)
          IF (IRET.NE.0) GOTO 9999
          IF (NOSOMA.NE.0) THEN
             SOUMAI=MAIL.LISOUS(NOSOMA)
          ELSE
             SOUMAI=MAIL
          ENDIF
          NNO=SOUMAI.NUM(/1)
          LSTXML.IDX(IELEM+1)=NNO
 1     CONTINUE
* LSTXML.IDX est transformé en la liste d'indexation sur
* LSTXML.IVAL
      LSTXML.IDX(1)=1
      DO 3 IELEM=1,NELEM
         LSTXML.IDX(IELEM+1)=LSTXML.IDX(IELEM+1)+LSTXML.IDX(IELEM)
 3    CONTINUE
      NBM=NELEM
      NBTVAL=LSTXML.IDX(NELEM+1)-1
      SEGADJ,LSTXML
* Remplissage de LSTXML
      IVXML=0
      DO 5 IELEM=1,NELEM
         NUELEM=LELEM.LECT(IELEM)
         CALL RPELEM(NUELEM,RPMAIL,
     $        NOSOMA,NUELMA,
     $        IMPR,IRET)
          IF (IRET.NE.0) GOTO 9999
          IF (NOSOMA.NE.0) THEN
             SOUMAI=MAIL.LISOUS(NOSOMA)
          ELSE
             SOUMAI=MAIL
          ENDIF
          NNO=SOUMAI.NUM(/1)
          DO 52 INO=1,NNO
             IVXML=IVXML+1
             NUNO=SOUMAI.NUM(INO,NUELMA)
             LSTXML.IVAL(IVXML)=NUNO
 52       CONTINUE
 5     CONTINUE
       SEGSUP RPMAIL
       SEGDES LSTXML
       SEGDES LELEM
       CALL DESMEL(MAIL)
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine exmlli'
      RETURN
*
* End of subroutine EXMLLI
*
      END