Esope source files

   1 : C EXMLLI    SOURCE    CHAT      05/01/12    23:51:08     5004           
   2 :       SUBROUTINE EXMLLI(MAIL,LELEM,
   3 :      $     LSTXML,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : EXMLLI
   9 : C DESCRIPTION : Extraction d'éléments d'un maillage que l'on stocke dans
  10 : C               une liste indexée. 
  11 : C               LELEM est supposée ordonnée.
  12 : C
  13 : C
  14 : C LANGAGE     : ESOPE
  15 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16 : C               mél : gounand@semt2.smts.cea.fr
  17 : C***********************************************************************
  18 : C APPELES          : ACTMEL, DESMEL, INIRPL, RPELEM
  19 : C APPELE PAR       : ML2LIE
  20 : C***********************************************************************
  21 : C ENTREES            : MAIL, LELEM
  22 : C SORTIES            : LSTXML
  23 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24 : C***********************************************************************
  25 : C VERSION    : v1, 08/02/2000, version initiale
  26 : C HISTORIQUE : v1, 08/02/2000, création
  27 : C HISTORIQUE :
  28 : C HISTORIQUE :
  29 : C***********************************************************************
  30 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31 : C en cas de modification de ce sous-programme afin de faciliter
  32 : C la maintenance !
  33 : C***********************************************************************
  34 : -INC CCOPTIO
  35 : -INC SMLENTI
  36 :       POINTEUR LELEM.MLENTI
  37 :       POINTEUR RPMAIL.MLENTI
  38 : -INC SMELEME
  39 :       POINTEUR MAIL.MELEME
  40 :       POINTEUR SOUMAI.MELEME
  41 : * Includes persos
  42 : *     Segment LSTIND (liste séquentielle indexée)
  43 :       SEGMENT LSTIND
  44 :       INTEGER IDX(NBM+1)
  45 :       INTEGER IVAL(NBTVAL)
  46 :       ENDSEGMENT
  47 :       INTEGER NBM,NBTVAL
  48 :       POINTEUR LSTXML.LSTIND
  49 : *
  50 :       INTEGER IMPR,IRET
  51 : *
  52 :       INTEGER NELEM,NNO
  53 :       INTEGER IELEM,INO,IVXML
  54 :       INTEGER NOSOMA,NUELEM,NUELMA,NUNO
  55 : *     
  56 : * Executable statements
  57 : *
  58 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans exmlli.eso' 
  58 :       CALL ACTMEL(MAIL)
  58 :       CALL INIRPL(MAIL,
  59 :      $     RPMAIL,
  60 :      $     IMPR,IRET)
  61 :       IF (IRET.NE.0) GOTO 9999
  62 : * Dimensionnement de LSTXML
  63 :       SEGACT LELEM
  64 :       NELEM=LELEM.LECT(/1)
  65 :       NBM=NELEM
  66 :       NBTVAL=0
  67 :       SEGINI LSTXML
  68 :       SEGACT RPMAIL
  69 :       DO 1 IELEM=1,NELEM
  70 :          NUELEM=LELEM.LECT(IELEM)
  70 :          CALL RPELEM(NUELEM,RPMAIL,
  71 :      $        NOSOMA,NUELMA,
  72 :      $        IMPR,IRET)
  73 :           IF (IRET.NE.0) GOTO 9999
  74 :           IF (NOSOMA.NE.0) THEN
  75 :              SOUMAI=MAIL.LISOUS(NOSOMA)
  76 :           ELSE 
  77 :              SOUMAI=MAIL
  78 :           ENDIF
  79 :           NNO=SOUMAI.NUM(/1)
  80 :           LSTXML.IDX(IELEM+1)=NNO
  81 :  1     CONTINUE
  82 : * LSTXML.IDX est transformé en la liste d'indexation sur
  83 : * LSTXML.IVAL
  84 :       LSTXML.IDX(1)=1
  85 :       DO 3 IELEM=1,NELEM
  86 :          LSTXML.IDX(IELEM+1)=LSTXML.IDX(IELEM+1)+LSTXML.IDX(IELEM)
  87 :  3    CONTINUE
  88 :       NBM=NELEM
  89 :       NBTVAL=LSTXML.IDX(NELEM+1)-1
  90 :       SEGADJ,LSTXML
  91 : * Remplissage de LSTXML
  92 :       IVXML=0
  93 :       DO 5 IELEM=1,NELEM
  94 :          NUELEM=LELEM.LECT(IELEM)
  94 :          CALL RPELEM(NUELEM,RPMAIL,
  95 :      $        NOSOMA,NUELMA,
  96 :      $        IMPR,IRET)
  97 :           IF (IRET.NE.0) GOTO 9999
  98 :           IF (NOSOMA.NE.0) THEN
  99 :              SOUMAI=MAIL.LISOUS(NOSOMA)
 100 :           ELSE 
 101 :              SOUMAI=MAIL
 102 :           ENDIF
 103 :           NNO=SOUMAI.NUM(/1)
 104 :           DO 52 INO=1,NNO
 105 :              IVXML=IVXML+1
 106 :              NUNO=SOUMAI.NUM(INO,NUELMA)
 107 :              LSTXML.IVAL(IVXML)=NUNO
 108 :  52       CONTINUE
 109 :  5     CONTINUE
 110 :        SEGSUP RPMAIL
 111 :        SEGDES LSTXML
 112 :        SEGDES LELEM
 112 :        CALL DESMEL(MAIL)
 113 : *
 114 : * Normal termination
 115 : *
 116 :       IRET=0
 117 :       RETURN
 118 : *
 119 : * Format handling
 120 : *
 121 : *
 122 : * Error handling
 123 : *
 124 :  9999 CONTINUE
 125 :       IRET=1
 126 :       WRITE(IOIMP,*) 'An error was detected in subroutine exmlli'
 127 :       RETURN
 128 : *
 129 : * End of subroutine EXMLLI
 130 : *
 131 :       END
 132 : 
 133 :  
 134 :