C FIXMEL    SOURCE    CHAT      05/01/13    00:01:55     5004
      SUBROUTINE FIXMEL(MELPRI,MELDUA,
     $     MELPR2,MELDU2,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : FIXMEL
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : On corrige les maillages primaux et duaux s'ils n'ont
C      pas le même nombre de sous-objets géométriques.
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 (UTIL.)  : RSETI
C APPELE PAR       : PRASEM
C***********************************************************************
C ENTREES            : MELPRI, MELDUA
C SORTIES            : MELPR2, MELDU2
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 16/11/99, version initiale
C HISTORIQUE : v1, 16/11/99, 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 SMELEME
      INTEGER NBNN,NBELEM,NBSOUS,NBREF
      POINTEUR MELPRI.MELEME
      POINTEUR MELDUA.MELEME
      POINTEUR MELPR2.MELEME
      POINTEUR MELDU2.MELEME
      POINTEUR SMLPRI.MELEME
      POINTEUR SMLDUA.MELEME
      POINTEUR SMLPR2.MELEME
      POINTEUR SMLDU2.MELEME
-INC SMLENTI
      INTEGER JG
      POINTEUR NBLPRI.MLENTI
      POINTEUR NBLDUA.MLENTI
      POINTEUR NBLMIX.MLENTI
*
        INTEGER IDXPRI,IDXDUA
        INTEGER NELPRI,NELDUA
        INTEGER NUPRI,NUDUA,NUMIX
        INTEGER ISOUS,ISOUP,ISOUD,ISOUM
        INTEGER NSOUS,NSOUP,NSOUD,NSOUM
*
        INTEGER IMPR,IRET
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans fixmel'
*
* Comptage des éléments dans chaque MELEME
*
* primal...
      SEGACT MELPRI
      NSOUS=MELPRI.LISOUS(/1)
      JG=MAX(1,NSOUS)+1
      SEGINI NBLPRI
      NBLPRI.LECT(1)=1
      DO 1 ISOUS=1,MAX(1,NSOUS)
         IF (NSOUS.EQ.0) THEN
            SMLPRI=MELPRI
         ELSE
            SMLPRI=MELPRI.LISOUS(ISOUS)
            SEGACT SMLPRI
         ENDIF
         NBLPRI.LECT(ISOUS+1)=NBLPRI.LECT(ISOUS)+SMLPRI.NUM(/2)
         IF (NSOUS.NE.0) SEGDES SMLPRI
 1    CONTINUE
      SEGDES MELPRI
* ... et dual
      SEGACT MELDUA
      NSOUS=MELDUA.LISOUS(/1)
      JG=MAX(1,NSOUS)+1
      SEGINI NBLDUA
      NBLDUA.LECT(1)=1
      DO 3 ISOUS=1,MAX(1,NSOUS)
         IF (NSOUS.EQ.0) THEN
            SMLDUA=MELDUA
         ELSE
            SMLDUA=MELDUA.LISOUS(ISOUS)
            SEGACT SMLDUA
         ENDIF
         NBLDUA.LECT(ISOUS+1)=NBLDUA.LECT(ISOUS)+SMLDUA.NUM(/2)
         IF (NSOUS.NE.0) SEGDES SMLDUA
 3    CONTINUE
      SEGDES MELDUA
*
* D'où les nombres d'éléments (+1)...
*
      NSOUP=NBLPRI.LECT(/1)-1
      NELPRI=NBLPRI.LECT(NSOUP+1)
      NSOUD=NBLDUA.LECT(/1)-1
      NELDUA=NBLDUA.LECT(NSOUD+1)
      IF (NELPRI.NE.NELDUA) THEN
         WRITE(IOIMP,*) 'Maillage primaux et duaux : nbel différents'
         GOTO 9999
      ENDIF
      IF (NSOUP.EQ.NSOUD) THEN
         MELPR2=MELPRI
         MELDU2=MELDUA
      ELSE
*
*     On détermine combien il faudra de sous-maillages
*     avec quels nombres d'éléments par sous-maillage
*
         NSOUM=NSOUP*NSOUD
         JG=NSOUM+1
         SEGINI NBLMIX
         ISOUP=1
         ISOUD=1
         ISOUM=0
         NUPRI=NBLPRI.LECT(ISOUP+1)
         NUDUA=NBLDUA.LECT(ISOUD+1)
         NBLMIX.LECT(ISOUM+1)=1
 5       CONTINUE
         IF (NUPRI.LT.NUDUA) THEN
            ISOUM=ISOUM+1
            NBLMIX.LECT(ISOUM+1)=NUPRI
            ISOUP=ISOUP+1
            NUPRI=NBLPRI.LECT(ISOUP+1)
            GOTO 5
         ELSEIF (NUPRI.GT.NUDUA) THEN
            ISOUM=ISOUM+1
            NBLMIX.LECT(ISOUM+1)=NUDUA
            ISOUD=ISOUD+1
            NUDUA=NBLDUA.LECT(ISOUD+1)
            GOTO 5
         ELSE
            ISOUM=ISOUM+1
            NBLMIX.LECT(ISOUM+1)=NUDUA
            IF (NUPRI.LT.NELPRI.AND.NUDUA.LT.NELDUA) THEN
               ISOUP=ISOUP+1
               ISOUD=ISOUD+1
               NUPRI=NBLPRI.LECT(ISOUP+1)
               NUDUA=NBLDUA.LECT(ISOUD+1)
               GOTO 5
            ELSEIF (.NOT.(NUPRI.EQ.NELPRI.AND.NUDUA.EQ.NELDUA)) THEN
               WRITE(IOIMP,*) 'Erreur de programmation'
               GOTO 9999
            ENDIF
         ENDIF
*
*     On remplit MELPR2 et MELDU2 (partitionnés) comme il faut.
*
         NBNN=0
         NBELEM=0
         NBSOUS=ISOUM
         NBREF=0
         SEGINI MELPR2
         SEGINI MELDU2
         ISOUP=1
         ISOUD=1
         ISOUM=0
         SEGACT MELPRI
         NSOUP=MELPRI.LISOUS(/1)
         IF (NSOUP.EQ.0) THEN
            SMLPRI=MELPRI
         ELSE
            SMLPRI=MELPRI.LISOUS(1)
            SEGACT SMLPRI
         ENDIF
         SEGACT MELDUA
         NSOUD=MELDUA.LISOUS(/1)
         IF (NSOUD.EQ.0) THEN
            SMLDUA=MELDUA
         ELSE
            SMLDUA=MELDUA.LISOUS(1)
            SEGACT SMLDUA
         ENDIF
         NUPRI=NBLPRI.LECT(ISOUP+1)
         NUDUA=NBLDUA.LECT(ISOUD+1)
         NUMIX=NBLMIX.LECT(ISOUM+1)
 7       CONTINUE
         IF (NUPRI.LT.NUDUA) THEN
            ISOUM=ISOUM+1
            NBNN=SMLPRI.NUM(/1)
            NBELEM=NUPRI-NUMIX
            NBSOUS=0
            NBREF=0
            SEGINI SMLPR2
            SMLPR2.ITYPEL=SMLPRI.ITYPEL
            IDXPRI=NUMIX-NBLPRI.LECT(ISOUP)+1
            CALL RSETI(SMLPR2.NUM,SMLPRI.NUM(1,IDXPRI),NBELEM*NBNN)
            SEGDES SMLPR2
            MELPR2.LISOUS(ISOUM)=SMLPR2
            NBNN=SMLDUA.NUM(/1)
            SEGINI SMLDU2
            SMLDU2.ITYPEL=SMLDUA.ITYPEL
            IDXDUA=NUMIX-NBLDUA.LECT(ISOUD)+1
            CALL RSETI(SMLDU2.NUM,SMLDUA.NUM(1,IDXDUA),NBELEM*NBNN)
            SEGDES SMLDU2
            MELDU2.LISOUS(ISOUM)=SMLDU2
            SEGDES SMLPRI
            ISOUP=ISOUP+1
            SMLPRI=MELPRI.LISOUS(ISOUP)
            SEGACT SMLPRI
            NUPRI=NBLPRI.LECT(ISOUP+1)
            NUMIX=NBLMIX.LECT(ISOUM+1)
            GOTO 7
         ELSEIF (NUPRI.GT.NUDUA) THEN
            ISOUM=ISOUM+1
            NBNN=SMLPRI.NUM(/1)
            NBELEM=NUDUA-NUMIX
            NBSOUS=0
            NBREF=0
            SEGINI SMLPR2
            SMLPR2.ITYPEL=SMLPRI.ITYPEL
            IDXPRI=NUMIX-NBLPRI.LECT(ISOUP)+1
            CALL RSETI(SMLPR2.NUM,SMLPRI.NUM(1,IDXPRI),NBELEM*NBNN)
            SEGDES SMLPR2
            MELPR2.LISOUS(ISOUM)=SMLPR2
            NBNN=SMLDUA.NUM(/1)
            SEGINI SMLDU2
            SMLDU2.ITYPEL=SMLDUA.ITYPEL
            IDXDUA=NUMIX-NBLDUA.LECT(ISOUD)+1
            CALL RSETI(SMLDU2.NUM,SMLDUA.NUM(1,IDXDUA),NBELEM*NBNN)
            SEGDES SMLDU2
            MELDU2.LISOUS(ISOUM)=SMLDU2
            SEGDES SMLDUA
            ISOUD=ISOUD+1
            SMLDUA=MELDUA.LISOUS(ISOUD)
            SEGACT SMLDUA
            NUDUA=NBLDUA.LECT(ISOUD+1)
            NUMIX=NBLMIX.LECT(ISOUM+1)
            GOTO 7
         ELSE
            ISOUM=ISOUM+1
            NBNN=SMLPRI.NUM(/1)
            NBELEM=NUDUA-NUMIX
            NBSOUS=0
            NBREF=0
            SEGINI SMLPR2
            SMLPR2.ITYPEL=SMLPRI.ITYPEL
            IDXPRI=NUMIX-NBLPRI.LECT(ISOUP)+1
            CALL RSETI(SMLPR2.NUM,SMLPRI.NUM(1,IDXPRI),NBELEM*NBNN)
            SEGDES SMLPR2
            MELPR2.LISOUS(ISOUM)=SMLPR2
            NBNN=SMLDUA.NUM(/1)
            SEGINI SMLDU2
            SMLDU2.ITYPEL=SMLDUA.ITYPEL
            IDXDUA=NUMIX-NBLDUA.LECT(ISOUD)+1
            CALL RSETI(SMLDU2.NUM,SMLDUA.NUM(1,IDXDUA),NBELEM*NBNN)
            SEGDES SMLDU2
            MELDU2.LISOUS(ISOUM)=SMLDU2
            IF (NUPRI.LT.NELPRI.AND.NUDUA.LT.NELDUA) THEN
               SEGDES SMLPRI
               ISOUP=ISOUP+1
               SMLPRI=MELPRI.LISOUS(ISOUP)
               SEGACT SMLPRI
               SEGDES SMLDUA
               ISOUD=ISOUD+1
               SMLDUA=MELDUA.LISOUS(ISOUD)
               SEGACT SMLDUA
               NUPRI=NBLPRI.LECT(ISOUP+1)
               NUDUA=NBLDUA.LECT(ISOUD+1)
               NUMIX=NBLMIX.LECT(ISOUM+1)
               GOTO 7
            ELSEIF (.NOT.(NUPRI.EQ.NELPRI.AND.NUDUA.EQ.NELDUA)) THEN
               WRITE(IOIMP,*) 'Erreur de programmation'
               GOTO 9999
            ENDIF
         ENDIF
         IF (NSOUD.NE.0) SEGDES SMLDUA
         SEGDES MELDUA
         IF (NSOUP.NE.0) SEGDES SMLPRI
         SEGDES MELPRI
         SEGDES MELDU2
         SEGDES MELPR2
         SEGSUP NBLMIX
      ENDIF
      SEGSUP NBLDUA
      SEGSUP NBLPRI
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine fixmel'
      RETURN
*
* End of subroutine FIXMEL
*
      END