C CP2LR     SOURCE    CB215821  20/11/25    13:22:44     10792          
      SUBROUTINE CP2LR(CHPOD,
     $     ICPRID,ICOGLO,KRIPRI,NIPRI,
     $     KRMPRI,NPPRI,
     $     LCHPOD,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : CP2LR
C DESCRIPTION : Champoint + maillage + liste de n noms de composantes
C            => n listreels (1 par nom de composante) des valeurs du
C               champoint sur les points du maillage.
C
C
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          : LICHT2
C APPELES (E/S)    : LIROBJ, ECROBJ, ECRCHA
C APPELES (UTIL.)  : EXCOMP, DTCHPO
C APPELE PAR       : PROMAT
C***********************************************************************
C ENTREES            : CHPOD, ICPRID, ICOGLO, KRIPRI, NIPRI,
C                                             KRMPRI, NPPRI
C SORTIES            : LCHPOD
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 10/02/2000, version initiale
C HISTORIQUE : v1, 10/02/2000, 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 SMCHPOI
      POINTEUR CHPOD.MCHPOI
      POINTEUR XCHPOD.MCHPOI
      POINTEUR MPXCPD.MPOVAL
-INC SMELEME
      POINTEUR MLXCPD.MELEME
-INC SMLENTI
      POINTEUR ICPRID.MLENTI
      POINTEUR KRIPRI.MLENTI
      POINTEUR KRMPRI.MLENTI
-INC SMLMOTS
      POINTEUR ICOGLO.MLMOTS
-INC SMLREEL
      SEGMENT LLR
      POINTEUR LISLR(NBME).MLREEL
      ENDSEGMENT
      INTEGER NBME
      POINTEUR LCHPOD.LLR
      INTEGER JG
      POINTEUR SLMPD.MLREEL
*
      INTEGER NIPRI,NPPRI
      INTEGER IMPR,IRET
*
      INTEGER NIPRID,NPOCPD
      INTEGER IIPRID,IPOCPD,IIPRI
      INTEGER NULOPO
      CHARACTER*4 NOMI
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cp2lr.eso'
*
* Parcours des noms de composantes
*
      IF (CHPOD.EQ.0) THEN
         LCHPOD=0
      ELSE
         SEGACT ICPRID
         NIPRID=ICPRID.LECT(/1)
         SEGACT ICOGLO
         SEGACT KRIPRI
         SEGACT KRMPRI
         NBME=NIPRI
         SEGINI LCHPOD
         DO 1 IIPRID=1,NIPRID
            IIPRI=KRIPRI.LECT(ICPRID.LECT(IIPRID))
            IF (IIPRI.NE.0) THEN
               NOMI=ICOGLO.MOTS(ICPRID.LECT(IIPRID))(1:4)
               CALL ECROBJ('CHPOINT ',CHPOD)
               CALL ECRCHA(NOMI)
               CALL EXCOMP
               CALL LIROBJ('CHPOINT ',XCHPOD,1,IRET)
               IF (IRET.EQ.0) THEN
                  WRITE(IOIMP,*) 'Erreur extraction comp.',NOMI
                  WRITE(IOIMP,*) 'de la matrice diagonale.'
                  GOTO 9999
               ENDIF
               CALL LICHT2(XCHPOD,
     $              MPXCPD,MLXCPD,
     $              IMPR,IRET)
               IF (IRET.NE.0) GOTO 9999
               JG=NPPRI
               SEGINI,SLMPD
               SEGACT MPXCPD
               SEGACT MLXCPD
               NPOCPD=MLXCPD.NUM(/2)
               DO 12 IPOCPD=1,NPOCPD
                  NULOPO=KRMPRI.LECT(MLXCPD.NUM(1,IPOCPD))
                  IF (NULOPO.NE.0) THEN
                     SLMPD.PROG(NULOPO)=MPXCPD.VPOCHA(IPOCPD,1)
                  ENDIF
 12            CONTINUE
               SEGDES MLXCPD
               SEGDES MPXCPD
               SEGDES SLMPD
               LCHPOD.LISLR(IIPRI)=SLMPD
               CALL DTCHPO(XCHPOD)
            ENDIF
 1       CONTINUE
         SEGDES LCHPOD
         SEGDES KRMPRI
         SEGDES KRIPRI
         SEGDES ICOGLO
         SEGDES ICPRID
      ENDIF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine cp2lr'
      RETURN
*
* End of subroutine CP2LR
*
      END