C RDSCRM    SOURCE    MB234859  25/07/17    21:15:02     12328          
      SUBROUTINE RDSCRM(MRIGID)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : RDSCRM
C DESCRIPTION : Quelquefois, les points de IRIGEL(1,I) ne sont pas
C     tous references par le segment DESCR (cas des QUAFs notamment).
C     Dans ce cas, on fait une reduction du MELEME et on le stocke dans
C     IRIGEL(2,I)
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
C               mel : gounand@semt2.smts.cea.fr
C***********************************************************************
C VERSION    : v1, 08/11/2024, version initiale
C HISTORIQUE : v1, 08/11/2024, creation
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
-INC PPARAM
-INC CCOPTIO
-INC SMRIGID
-INC SMELEME
      SEGMENT ICNN(NBNN)
      SEGMENT IBNN(NCNN)
*
* Executable statements
*
      SEGACT MRIGID*MOD
      NNVA=IRIGEL(/2)
      irmel=0
      DO I=1,NNVA
         ipt1=irigel(1,i)
         segact ipt1
         nbnn=ipt1.num(/1)
         segini icnn
         ncnn=0
         descr=irigel(3,i)
         segact descr
         nligrp=noelep(/1)
         nligrd=noeled(/1)
         if ((nligrp.eq.0).or.(nligrd.eq.0)) then
           nbnn=0
           nbelem=0
           nbref=0
           nbsous=0
           segini ipt2
           goto 1
         endif

         do iligrp=1,nligrp
            if (icnn(noelep(iligrp)).eq.0) then
               icnn(noelep(iligrp))=1
               ncnn=ncnn+1
            endif
         enddo
         if (irigel(7,i).ge.2) then
            nligrd=noeled(/1)
            do iligrd=1,nligrd
               if (icnn(noeled(iligrd)).eq.0) then
                  icnn(noeled(iligrd))=1
                  ncnn=ncnn+1
               endif
            enddo
         endif
         if (ncnn.NE.nbnn) then
            segini ibnn
            ic=0
            do ib=1,nbnn
               if (icnn(ib).ne.0) then
                  ic=ic+1
                  ibnn(ic)=ib
               endif
            enddo
            nbnn=ncnn
            nbelem=ipt1.num(/2)
            nbref=0
            nbsous=0
            segini ipt2
            ipt2.itypel=28
            do ibelem=1,nbelem
               do ic=1,ncnn
                  ipt2.num(ic,ibelem)=ipt1.num(ibnn(ic),ibelem)
               enddo
            enddo
            segsup ibnn
            irmel=irmel+1
         else
            ipt2=0
         endif
  1      continue
         segsup icnn
         IF (irigel(2,i).ne.0) then
            moterr(1:8)='rdscrm'
            call erreur(349)
            return
         ELSE
            irigel(2,i)=ipt2
         ENDIF
      ENDDO
*      segact mrigid*nomod
*
* Normal termination
*
      RETURN
*
* Format handling
*
*
* Error handling
*
*
* End of subroutine RDSCRM
*
      END