C VERLX     SOURCE    CB215821  20/11/25    13:42:23     10792          
*  verification LX nuls
*
      subroutine verlx(mrigid,mchpoi,mchpo1,noen,ipt8)
*
*  verification que les LX apparaissant dand mrigid sont nuls
*  mcphpo1 sert a construire le critere en deplacement
*

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMRIGID
-INC SMELEME
-INC SMCOORD
-INC CCREEL

      segment vpoch(nbpts)


      nbnn=1
      nbsous=0
      nbref=0
      xmcrit=xpetit
      segini vpoch
*  expension des LX du chpoint
      segact mchpoi
      do 10 isoupo=1,ipchp(/1)
         msoupo=ipchp(isoupo)
         segact msoupo
         if (nocomp(/2).ne.1    ) goto 10
         if (nocomp(1) .ne.'FLX') goto 10
         mpoval=ipoval
         segact mpoval
         meleme=igeoc
         segact meleme
         do 15 i=1,vpocha(/1)
            vpoch(num(1,i))=vpocha(i,1)
            xmcrit=max(xmcrit,abs(vpocha(i,1)))
 15      continue
 10   continue
*  calcul du critere
      segact mchpo1
      do 50 isoupo=1,mchpo1.ipchp(/1)
         msoupo=mchpo1.ipchp(isoupo)
         segact msoupo
*      WRITE(IOIMP,*) ' verlx nocomp(1) ',nocomp(1)
         if (nocomp(1).eq.'FLX') goto 50
         mpoval=ipoval
         segact mpoval
         do 55 i=1,vpocha(/1)
            do 56 j=1,vpocha(/2)
               xmcrit=max(xmcrit,abs(vpocha(i,j)))
 56         continue
 55      continue
 50   continue
      xmcrit=xmcrit*1d-6
*     WRITE(IOIMP,*) ' xmcrit dans verlx ',xmcrit
*  balayer les matrices pour tester les LX y apparaissant
      segact mrigid
      do 100 irige=1,irigel(/2)
         meleme=irigel(1,irige)
         descr=irigel(3,irige)
         segact descr
         if (lisinc(1).ne.'LX') goto 100
         segact meleme
         do 110 iel=1,num(/2)
            if (abs(vpoch(num(1,iel))).gt.xmcrit) then
               if (noen.eq.0) then
                  nbelem=ipt8.num(/2)+1
                  segadj ipt8
                  ipt8.num(1,nbelem)=num(1,iel)
               else
                  interr(1)=num(1,iel)
                  moterr(1:4)='LX'
* Résolution impossible détectée au noeud %i1 pour l'inconnue %m1:4
                  call erreur(143)
               endif
            else
               vpoch(num(1,iel))=0.d0
            endif
 110     continue
 100  continue
*  remise à zero des petits FLX
      do 210 isoupo=1,ipchp(/1)
         msoupo=ipchp(isoupo)
         segact msoupo
         if (nocomp(/2).ne.1) goto 210
         if (nocomp(1).ne.'FLX') goto 210
         mpoval=ipoval
         segact mpoval*mod
         meleme=igeoc
         segact meleme
         do 215 i=1,vpocha(/1)
            vpocha(i,1)=vpoch(num(1,i))
 215     continue
 210  continue
      segsup vpoch
      end