C MKIZAT    SOURCE    GOUNAND   24/11/06    21:15:13     12073          
      SUBROUTINE MKIZAT(MELDUA,MELPRI,IMATEL,
     $     KRINCD,KRINCP,KMINCT,KRSPGT,
     $     PMTOT,
     $     IZATOT,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : MKIZAT
C DESCRIPTION : Matrice élémentaire + Profil Morse de la matrice
C               assemblée => ajout de la contribution de la transposée
C               de la matrice élémentaire aux valeurs de la matrice
C               Morse assemblée.
C
C               Le profil Morse est supposé avoir ses colonnes
C               ordonnées.
C
C !!!!!!!!
C Ce source devrait être quasiment identique à mkiza et évolué en
C même temps...
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          : REGMAI, IFIDIC, INIRPM
C APPELE PAR       : PRASEM
C***********************************************************************
C ENTREES            : MELDUA, MELPRI, IMATEL, KRINCD, KRINCP, KMINCT,
C                      KRSPGT, PMTOT
C ENTREES/SORTIES    : IZATOT
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 16/12/99
C HISTORIQUE : v1, 16/12/99, création
C HISTORIQUE : 05/01/00 : On ne suppose plus les maillages duaux et
C      primaux partitionnés de la même façon que les matrices
C      élémentaires.
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
      POINTEUR MELDUA.MELEME
      POINTEUR ML2DUA.MELEME
      POINTEUR SMLDUA.MELEME
      POINTEUR MELPRI.MELEME
      POINTEUR ML2PRI.MELEME
      POINTEUR SMLPRI.MELEME
-INC SMMATRIK
      POINTEUR IMATEL.IMATRI
      POINTEUR VMATEL.IZAFM
      POINTEUR KMINCT.MINC
      POINTEUR PMTOT.PMORS
      POINTEUR IZATOT.IZA
-INC SMLENTI
      POINTEUR KRINCD.MLENTI
      POINTEUR KRINCP.MLENTI
      POINTEUR KRSPGT.MLENTI
      POINTEUR RPMAT.MLENTI
*
      INTEGER IMPR,IRET
*
      INTEGER IDX,IDXDEB
      INTEGER ISOUM,NBSOUM,NBSOUD,NBSOUP
      INTEGER ITDDLD,ITDDLP,ITIDUA,ITIPRI,ITPODU,ITPOPR
      INTEGER NBCMPD,NBCMPP,NELPRI
      INTEGER ILMAT,JDMAT,IPMAT,IMATL
      INTEGER NLMAT,NDMAT,NPMAT,NBMATL
      INTEGER LONLIG
      INTEGER IELEM
      INTEGER NUELG,OLDISM,ISOUMA,NUELOC
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkizat'
* On régularise les maillage pour plus se faire chier si LISOUS(/1).EQ.0
* In REGMAI : SEGINI ML2DUA
      CALL REGMAI(MELDUA,ML2DUA)
* In REGMAI : SEGINI ML2PRI
      CALL REGMAI(MELPRI,ML2PRI)
*
* Activons les chapeaux (Matrices et supports)
*
      SEGACT ML2DUA
      NBSOUD=ML2DUA.LISOUS(/1)
      SEGACT ML2PRI
      NBSOUP=ML2PRI.LISOUS(/1)
      SEGACT IMATEL
      NBSOUM=NBSOUP
      NBMATL=IMATEL.LIZAFM(/2)
      IF (NBSOUD.NE.NBSOUP) THEN
         WRITE(IOIMP,*) 'Maillage primal, dual :'
         WRITE(IOIMP,*) 'partitionnment différent...'
         WRITE(IOIMP,*) 'NBSOUD=',NBSOUD
         WRITE(IOIMP,*) 'NBSOUP=',NBSOUP
         GOTO 9999
      ENDIF
*
* Tableau de repérage dans la matrice
*
* In INIRPM : SEGINI RPMAT
      CALL INIRPM(IMATEL,RPMAT,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Activons les tableaux de repérage
*
      SEGACT KRINCD
      NBCMPD=KRINCD.LECT(/1)
      SEGACT KRINCP
      NBCMPP=KRINCP.LECT(/1)
      IF (NBCMPD.NE.NBMATL.OR.NBCMPP.NE.NBMATL) THEN
         WRITE(IOIMP,*) 'KRINCD, KRINCP et IMATEL :'
         WRITE(IOIMP,*) 'nb. comp. différents...'
         GOTO 9999
      ENDIF
      SEGACT KMINCT
      SEGACT KRSPGT
      SEGACT PMTOT
      SEGACT IZATOT*MOD
*
* Parcourons les matrices élémentaires par sous-domaine et
* remplissons les valeurs de la matrice Morse.
*
      DO 1 IMATL=1,NBMATL
         ITIDUA=KRINCD.LECT(IMATL)
         ITIPRI=KRINCP.LECT(IMATL)
         NUELG=0
         OLDISM=1
         VMATEL=IMATEL.LIZAFM(OLDISM,IMATL)
         SEGACT VMATEL
         DO 12 ISOUM=1,NBSOUM
            SMLDUA=ML2DUA.LISOUS(ISOUM)
            SEGACT SMLDUA
            SMLPRI=ML2PRI.LISOUS(ISOUM)
            SEGACT SMLPRI
            NELPRI=SMLPRI.NUM(/2)
            DO 122 IELEM=1,NELPRI
               NUELG=NUELG+1
               CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET)
               IF (IRET.NE.0) GOTO 9999
               ISOUMA=MAX(ISOUMA,1)
               IF (ISOUMA.NE.OLDISM) THEN
                  SEGDES VMATEL
                  VMATEL=IMATEL.LIZAFM(ISOUMA,IMATL)
                  SEGACT VMATEL
                  OLDISM=ISOUMA
               ENDIF
               ILMAT=NUELOC
               NPMAT=VMATEL.AM(/2)
               NDMAT=VMATEL.AM(/3)
               DO 1222 JDMAT=1,NDMAT
                  ITPODU=KRSPGT.LECT(SMLDUA.NUM(JDMAT,IELEM))
                  IF (ITPODU.EQ.0) THEN
                     WRITE(IOIMP,*) 'Point dual ????'
                     GOTO 9999
                  ENDIF
C     Test du MPOS... déjà fait dans mkpmor...
                  ITDDLD=KMINCT.NPOS(ITPODU)
     $                 + KMINCT.MPOS(ITPODU,ITIDUA)-1
C     IPMAT parce que IDMAT est le nom d'un segment par défaut...
                  DO 12222 IPMAT=1,NPMAT
                     ITPOPR=KRSPGT.LECT(SMLPRI.NUM(IPMAT,IELEM))
                     IF (ITPOPR.EQ.0) THEN
                        WRITE(IOIMP,*) 'Point primal ????'
                        GOTO 9999
                     ENDIF
                     ITDDLP=KMINCT.NPOS(ITPOPR)
     $                    + KMINCT.MPOS(ITPOPR,ITIPRI)-1
                     IDXDEB=PMTOT.IA(ITDDLP)
                     LONLIG=PMTOT.IA(ITDDLP+1)-IDXDEB
                     IF (LONLIG.EQ.0) THEN
                        WRITE(IOIMP,*) 'Ligne inex. ddl pri =',ITDDLP
                        GOTO 9999
                     ENDIF
                     CALL IFIDIC(LONLIG,PMTOT.JA(IDXDEB),ITDDLD,
     $                    IDX,
     $                    IMPR,IRET)
                     IF (IRET.NE.0) GOTO 9999
                     IZATOT.A(IDXDEB+IDX-1)=IZATOT.A(IDXDEB+IDX-1)
     $                    + VMATEL.AM(ILMAT,IPMAT,JDMAT)
12222             CONTINUE
 1222          CONTINUE
 122        CONTINUE
            SEGDES VMATEL
 12      CONTINUE
         SEGDES SMLPRI
         SEGDES SMLDUA
 1    CONTINUE
      SEGDES IZATOT
      SEGDES PMTOT
      SEGDES KRSPGT
      SEGDES KMINCT
      SEGDES KRINCP
      SEGDES KRINCD
      SEGSUP RPMAT
      SEGDES IMATEL
      SEGDES ML2PRI
      SEGDES ML2DUA
      SEGSUP ML2PRI
      SEGSUP ML2DUA
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine mkizat'
      RETURN
*
* End of subroutine MKIZAT
*
      END