C RELR14    SOURCE    GOUNAND   12/08/01    22:29:18     7454           
      SUBROUTINE RELR14(MLIN,KJSPGP,KJSPGD,LINCP,LINCD,
     $     MINCP,MINCD,
     $     PROFM,VALM,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : RELR14
C DESCRIPTION :
*
* Construction du profil Morse de la matrice assemblée
* Celui-ci est ordonné (les numeros de colonnes
* dans IA sont en ordre croissant)
*
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : 
C APPELES (E/S)    : 
C APPELES (BLAS)   :
C APPELES (CALCUL) :
C APPELE PAR       :
C***********************************************************************
C SYNTAXE GIBIANE    :
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            :
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 27/06/2003, version initiale
C HISTORIQUE : v1, 27/06/2003, 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 CCOPTIO
-INC SMCOORD
-INC SMRIGID
      POINTEUR MLIN.MRIGID
      POINTEUR DES.DESCR
*      POINTEUR IMAT.IMATRI
      POINTEUR XMAT.XMATRI
-INC SMELEME
      POINTEUR MEL.MELEME
* Includes persos
CBEGININCLUDE SMMINC
      SEGMENT MINC
      INTEGER     NPOS(NPT+1)
      INTEGER     MPOS(NPT,NBI+1)
      ENDSEGMENT
      SEGMENT IMINC
      INTEGER LNUPO (NDDL)
      INTEGER LNUINC(NDDL)
      ENDSEGMENT
CENDINCLUDE SMMINC
      POINTEUR MINCP.MINC
      POINTEUR MINCD.MINC
CBEGININCLUDE SMPMORS
      SEGMENT PMORS
      INTEGER IA (NTT+1)
      INTEGER JA (NJA)
      ENDSEGMENT
CENDINCLUDE SMPMORS
      POINTEUR PROFM.PMORS
      POINTEUR PMCOU.PMORS
      POINTEUR PMTMP.PMORS
CBEGININCLUDE SMIZA
      SEGMENT IZA
      REAL*8  A(NBVA)
      ENDSEGMENT
CENDINCLUDE SMIZA
      POINTEUR VALM.IZA
*     Segment LSTIND (liste séquentielle indexée)
      SEGMENT LSTIND
      INTEGER IDX(NBM+1)
      INTEGER IELRIG(NBTVAL)
      INTEGER ILIGR (NBTVAL)
      ENDSEGMENT
      POINTEUR DDDNUL.LSTIND
*
-INC SMLENTI
      POINTEUR KJSPGP.MLENTI
      POINTEUR KJSPGD.MLENTI
      POINTEUR KRSPGP.MLENTI
      POINTEUR KRSPGD.MLENTI
      POINTEUR KRINCP.MLENTI
      POINTEUR KRINCD.MLENTI
-INC SMLMOTS
      POINTEUR LINCP.MLMOTS
      POINTEUR LINCD.MLMOTS
*
      INTEGER IMPR,IRET
*
      LOGICAL LEXIST
*     
* Executable statements
*
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr14.eso' 
      SEGACT MLIN
      NRIG=MLIN.IRIGEL(/2)
*  Construction des segments de repérage dans l'ensemble des points
      SEGACT KJSPGP
      NPOPRI=KJSPGP.LECT(/1)
      JG=XCOOR(/1)/(IDIM+1)
      SEGINI KRSPGP
      CALL RSETXI(KRSPGP.LECT,KJSPGP.LECT,NPOPRI)
      SEGDES KJSPGP
      SEGACT LINCP
      NINCP=LINCP.MOTS(/2)
      SEGACT MINCP
*
      SEGACT KJSPGD
      NPODUA=KJSPGD.LECT(/1)
      JG=XCOOR(/1)/(IDIM+1)
      SEGINI KRSPGD
      CALL RSETXI(KRSPGD.LECT,KJSPGD.LECT,NPODUA)
      SEGDES KJSPGD
      SEGACT LINCD
      NINCD=LINCD.MOTS(/2)
      SEGACT MINCD
*  Initialisation du profil morse total (profil vide et non diagonal)
      NDDLPR=MINCP.NPOS(NPOPRI+1)-1
      NDDLDU=MINCD.NPOS(NPODUA+1)-1
      NTT=NDDLDU
      NJA=0
      SEGINI PROFM
      DO I=1,NDDLDU+1
         PROFM.IA(I)=1
      ENDDO
      SEGDES PROFM
      DO IRIG=1,NRIG
         MEL=MLIN.IRIGEL(1,IRIG)
         SEGACT MEL
* a effacer         NEL=MEL.NUM(/2)
         DES=MLIN.IRIGEL(3,IRIG)
         SEGACT DES
         NDDLOP=DES.NOELEP(/1)
         NDDLOD=DES.NOELED(/1)
*   Construction du segment de repérage dans les inconnues primales et duales
         JG=NDDLOP
         SEGINI KRINCP
         CALL CREPER(DES.LISINC(/1),NDDLOP,NINCP,
     $        DES.LISINC,LINCP.MOTS,
     $        KRINCP.LECT,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         JG=NDDLOD
         SEGINI KRINCD
         CALL CREPER(DES.LISDUA(/1),NDDLOD,NINCD,
     $        DES.LISDUA,LINCD.MOTS,
     $        KRINCD.LECT,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*   construction de la correspondance :
*   ieme ddl dual de la matrice assemblée <->
*   (numéro d'élément, numéro ddl dual local)
*   de la rigidité dans lesquels il apparait
*     In relr1a : SEGINI DDDNUL
         CALL RELR1A(MINCD,KRSPGD,KRINCD,
     $        MEL,DES,
     $        DDDNUL,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
* a effacer         SEGPRT,DDDNUL
*   construction de la correspondance :
*   ieme ddl dual de la matrice assemblée <->
*   (numéros des ddl primaux avec lesquels il est
*   en relation). C'est le profil morse (non ordonné)
*     In relr1b : SEGINI PMCOU
         CALL RELR1B(DDDNUL,
     $        MINCP,KRSPGP,KRINCP,
     $        MEL,DES,
     $        PMCOU,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*         WRITE(IOIMP,*) ' ',IRIG
*         WRITE(IOIMP,*) 'IRIG=',IRIG
*         WRITE(IOIMP,*) ' ',IRIG
*         CALL ECMORS(PMCOU,0,3)
* a effacer         SEGPRT,PMCOU
* In FUSPRM : SEGINI PMTMP
         CALL FUSPR2(PROFM,PMCOU,NDDLPR,
     $        PMTMP,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*         CALL ECMORS(PMTMP,0,3)
         SEGSUP PMCOU
         SEGSUP PROFM
         PROFM=PMTMP
         SEGSUP DDDNUL
         SEGSUP KRINCD
         SEGSUP KRINCP
         SEGDES DES
         SEGDES MEL
      ENDDO
*
* Ordonnancement du profil morse
*
      CALL RELR1C(PROFM,NDDLPR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*      SEGPRT,PROFM
*
* Remplissage des valeurs de la matrice Morse
*
      SEGACT PROFM
      NNZ=PROFM.JA(/1)
      NBVA=NNZ
      SEGINI VALM
      DO IRIG=1,NRIG
         COEF=MLIN.COERIG(IRIG)
         MEL=MLIN.IRIGEL(1,IRIG)
         SEGACT MEL
* a effacer         NEL=MEL.NUM(/2)
         DES=MLIN.IRIGEL(3,IRIG)
         SEGACT DES
         NDDLOP=DES.NOELEP(/1)
         NDDLOD=DES.NOELED(/1)
*   Construction du segment de repérage dans les inconnues primales et duales
         JG=NDDLOP
         SEGINI KRINCP
         CALL CREPER(DES.LISINC(/1),NDDLOP,NINCP,
     $        DES.LISINC,LINCP.MOTS,
     $        KRINCP.LECT,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         JG=NDDLOD
         SEGINI KRINCD
         CALL CREPER(DES.LISDUA(/1),NDDLOD,NINCD,
     $        DES.LISDUA,LINCD.MOTS,
     $        KRINCD.LECT,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*         IMAT=MLIN.IRIGEL(4,IRIG)
*         SEGACT IMAT
         XMAT=MLIN.IRIGEL(4,IRIG)
         SEGACT XMAT
* Compléter les valeurs de la matrice morse avec celles
* de XMAT
         CALL RELR1D(MINCP,KRSPGP,KRINCP,
     $        MINCD,KRSPGD,KRINCD,
     $        COEF,MEL,DES,XMAT,
     $        PROFM,
     $        VALM,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*         WRITE(IOIMP,*) 'IRIG=',IRIG
*         CALL ECMORS(PROFM,VALM,3) 
*         stop 16
         
*         SEGDES IMAT
         SEGDES XMAT
         SEGSUP KRINCD
         SEGSUP KRINCP
         SEGDES DES
         SEGDES MEL
      ENDDO
      SEGDES VALM
      SEGDES PROFM
      SEGDES MINCD
      SEGDES LINCD
      SEGSUP KRSPGD
      SEGDES MINCP
      SEGDES LINCP
      SEGSUP KRSPGP
      SEGDES MLIN
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine relr14'
      RETURN
*
* End of subroutine RELR14
*
      END