Esope source files

   1 : C MLUNIQ    SOURCE    CHAT      05/01/13    01:46:43     5004           
   2 :       SUBROUTINE MLUNIQ(GPMELS,
   3 :      $     KJSPGT,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : MLUNIQ
   9 : C PROJET      : Noyau linéaire NLIN
  10 : C DESCRIPTION : Un groupe de maillages => un maillage
  11 : C               contenant tous les points.
  12 : C
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELE PAR       : PRASEM
  18 : C***********************************************************************
  19 : C ENTREES            : GPMELS
  20 : C SORTIES            : KJSPGT
  21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22 : C***********************************************************************
  23 : C VERSION    : v1, 30/09/99, version initiale
  24 : C HISTORIQUE : v1, 30/09/99, création
  25 : C HISTORIQUE :
  26 : C HISTORIQUE :
  27 : C***********************************************************************
  28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29 : C en cas de modification de ce sous-programme afin de faciliter
  30 : C la maintenance !
  31 : C***********************************************************************
  32 : -INC CCOPTIO
  33 : -INC SMCOORD
  34 : -INC SMELEME
  35 :       POINTEUR MELCOU.MELEME
  36 :       POINTEUR SOUMEL.MELEME
  37 :       INTEGER NBELEM,NBNN,NBREF,NBSOUS
  38 :       POINTEUR KJSPGT.MELEME
  39 : -INC SMLENTI
  40 :       INTEGER JG
  41 :       POINTEUR KRSPGT.MLENTI
  42 : *
  43 : * Includes persos
  44 : *
  45 :       SEGMENT MELS
  46 :       POINTEUR LISMEL(NBMEL).MELEME
  47 :       ENDSEGMENT
  48 :       POINTEUR GPMELS.MELS
  49 : *
  50 :       INTEGER IMPR,IRET
  51 : *
  52 :       INTEGER IMEL,ISOUS,IPOEL,IELEM
  53 :       INTEGER NMEL,NSOUS,NPOEL,NELEM
  54 :       INTEGER NUMNO
  55 :       INTEGER ILDG,LDG,LAST,IPREC
  56 : *     
  57 : * Executable statements
  58 : *
  59 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mluniq'
  60 : *
  61 :       JG=XCOOR(/1)/(IDIM+1)
  62 :       SEGINI KRSPGT
  63 :       SEGACT GPMELS
  64 :       NMEL=GPMELS.LISMEL(/1)
  65 : *
  66 : * Parcourons les maillages
  67 : *      
  68 : *   degré et fin de la liste chaînée
  69 : *   le degré de la liste chaînée est aussi le nombre 
  70 : *   de points de KJSPGT
  71 :       LDG=0
  72 :       LAST=-1
  73 :       DO 1 IMEL=1,NMEL
  74 :          MELCOU=GPMELS.LISMEL(IMEL)
  75 :          SEGACT MELCOU
  76 :          NSOUS=MELCOU.LISOUS(/1)
  77 :          DO 12 ISOUS=1,MAX(1,NSOUS)
  78 :             IF (NSOUS.EQ.0) THEN
  79 :                SOUMEL=MELCOU
  80 :             ELSE
  81 :                SOUMEL=MELCOU.LISOUS(ISOUS)
  82 :                SEGACT SOUMEL
  83 :             ENDIF
  84 :             NPOEL=SOUMEL.NUM(/1)
  85 :             NELEM=SOUMEL.NUM(/2)
  86 :             DO 122 IELEM=1,NELEM
  87 :                DO 1222 IPOEL=1,NPOEL
  88 :                   NUMNO=SOUMEL.NUM(IPOEL,IELEM)
  89 :                   IF (KRSPGT.LECT(NUMNO).EQ.0) THEN
  90 :                      LDG=LDG+1
  91 :                      KRSPGT.LECT(NUMNO)=LAST
  92 :                      LAST=NUMNO
  93 :                   ENDIF
  94 :  1222          CONTINUE
  95 :  122        CONTINUE
  96 :             IF (NSOUS.NE.0) SEGDES SOUMEL
  97 :  12      CONTINUE
  98 :          SEGDES MELCOU
  99 :  1    CONTINUE
 100 :       SEGDES GPMELS
 101 : *
 102 : * On transère la liste chaînée dans KJSPGT (maillage de points)
 103 : *      
 104 :       NBNN=1
 105 :       NBELEM=LDG
 106 :       NBSOUS=0
 107 :       NBREF=0
 108 :       SEGINI KJSPGT
 109 :       KJSPGT.ITYPEL=1
 110 :       DO 2 ILDG=1,LDG
 111 :          IPREC=KRSPGT.LECT(LAST)
 112 :          KJSPGT.NUM(1,ILDG)=LAST
 113 :          LAST=IPREC
 114 :  2    CONTINUE
 115 :       SEGDES KJSPGT
 116 :       SEGSUP KRSPGT
 117 : *
 118 : * Normal termination
 119 : *
 120 :       IRET=0
 121 :       RETURN
 122 : *     
 123 : * Format handling
 124 : *
 125 : *
 126 : * Error handling
 127 : *
 128 :  9999 CONTINUE
 129 :       IRET=1
 130 :       WRITE(IOIMP,*) 'An error was detected in subroutine mluniq'
 131 :       RETURN
 132 : *
 133 : * End of subroutine MLUNIQ
 134 : *
 135 :       END
 136 :  
 137 :