Sources Esope | Cast3M

mrem1
C MREM1     SOURCE    CB215821  20/11/25    13:34:32     10792          
        SUBROUTINE MREM1(mchpoi,ri1,ri2,ri3,ri4,ichp6,mchpo1,iret)
*  remontee  des LX sur les points supports des multiplicateurs
*  dans le cas des resolution avexc matrices de dependances
*         ri2 rigidite  complete avant condensation
*         ri1 rigidite de dependance brute
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8(A-H,O-Z)
-INC SMRIGID
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMCOORD
-INC SMELEME
      segment LXOK(nbpts)
*  fabrication du bon ri2 : ri2 + les conditions de ri4 dont les LX
*  sont dans ri3
       segini lxok
       mrigid=ri3
       segact mrigid
       do 10 irig=1,irigel(/2)
       meleme=irigel(1,irig)
       segact meleme
       if (itypel.ne.22) call erreur(5)
        descr=irigel(3,irig)
        segact descr
       do 20 j=1,num(/2)
         lxok(num(1,j))=1
  20   continue
       segdes meleme
  10   continue
       segini,ri5=ri4
       mrigid=ri5
       do 100 irig=1,irigel(/2)
        ipt1=irigel(1,irig)
        xmatr1=irigel(4,irig)
        segini,meleme=ipt1
        segini,xmatri=xmatr1
        if (itypel.ne.22) call erreur(5)
        jj=0
        do 110 j=1,num(/2)
          if (lxok(num(1,j)).eq.0) num(1,j)=0
          if (num(1,j).ne.0) then
            jj=jj+1
            do 120 in=1,num(/1)
             num(in,jj)=num(in,j)
 120        continue
            do io=1,re(/2)
                do iu=1,re(/1)
                     re(iu,io,jj)=re(iu,io,j)
                enddo
            enddo
*            imattt(jj)=imattt(j)
          endif
 110    continue
        nbnn=num(/1)
        nbelem=jj
        nbsous=0
        nbref=0
        segadj meleme
        irigel(1,irig)=meleme
        nelrig=jj
        nligrp=re(/2)
        nligrd=re(/1)
        segadj xmatri
        irigel(4,irig)=xmatri
 100   continue
       segsup lxok
       call fusrig(ri2,mrigid,iret)
       ri2=iret
C         remontee sur les ddl condenses
       call depen3(ri1,ri6)
       call mucpri(mchpoi,ri6,ichp3)
*      write (6,*) 'mchpoi dans mrem1 '
*      call ecchpo(mchpoi)
*
*   on peut tuer ri6
*
       segact ri6
       do 55 i=1,ri6.irigel(/2)
       ipt4=ri6.irigel(1,i)
       segsup ipt4
       des1=ri6.irigel(3,i)
       segsup des1
       xmatr6=ri6.irigel(4,i)
*       segact imatr6
*       do 56 j=1,imatr6.imattt(/1)
*        xmatr6=imatr6.imattt(j)
*        segsup xmatr6
*   56  continue
       segsup xmatr6
   55  continue
       call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0)
       call adchpo(ichp2,mchpo1,iret,1.D0,1D0)
       mchpo1=iret
       call mucpri(mchpo1,ri2  ,ichp5)
       call adchpo(ichp5,ichp6,IRET,1D0,-1D0)
       call remplx(ri1,iret,ichp7)
       mchpoi=mchpo1
*     les champs de points qui sortent sont de nature diffuse
         SEGACT MCHPOI
         NAT = MAX(1,JATTRI(/1))
         NSOUPO=IPCHP(/1)
         SEGADJ MCHPOI
         JATTRI(1)=1
         SEGDES MCHPOI
*      write (6,*) 'mchpo1 dans mrem1 '
*      call ecchpo(mchpo1)
*      write (6,*) 'ichp7  dans mrem1 '
*      call ecchpo(ichp7)
       call fuchpo(mchpo1,ichp7,iret)
       mchpoi=iret
*     les champs de points qui sortent sont de nature diffuse
         SEGACT MCHPOI
         NAT = MAX(1,JATTRI(/1))
         NSOUPO=IPCHP(/1)
         SEGADJ MCHPOI
         JATTRI(1)=1
         SEGDES MCHPOI
       return
       end