Sources Esope | Cast3M

kres7
C KRES7     SOURCE    GOUNAND   22/08/25    21:15:07     11434          
      SUBROUTINE KRES7(MSOLC,MRIGID,KSMBR0,KSMBR1,IDTARG,
     $     MCHSOL)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : KRES7
C DESCRIPTION : Effectue la décondensation des relations
C               Repris de resou.eso
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 VERSION    : v1, 15/06/2011, version initiale
C HISTORIQUE : v1, 15/06/2011, 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 SMRIGID
-INC SMCHPOI
-INC SMELEME
*
      MCHPOI=MSOLC
      SEGACT MRIGID
C-----------------------
      if(jrcond.ne.0) then
*      if(idepe.ne.0) then
         noen=1
         ri1=jrelim
         ri2=jrgard
         ri6=jrdepp
         lagdua=imlag
*         write(ioimp,*) 'ri1,ri2,ri6',ri1,ri2,ri6
* reintroduction des inconnues supprimees
         call mucpri(mchpoi,ri6,ichp3)
*            write (6,*) ' resou - mchpoi '
*            call ecchpo(mchpoi,0)
*            write (6,*) ' resou - ichp3'
*            call ecchpo(ichp3 ,0)
*            write (6,*) ' resou - ri6'
*            call prrigi(ri6,1)
         call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0)
         if (ierr.ne.0) return
         mchpo1=ksmbr1
*            write (6,*) ' resou - iret '
         call adchpo(ichp2,mchpo1,iret,1.D0,1D0)
*            call ecchpo(mchpoi)
*            call ecchpo(iret)
         if (ierr.ne.0) return
         if (idtarg.ne.0) call dtchpo(mchpoi)
         call dtchpo(ichp3)
         call dtchpo(ichp2)
         mchpo1=iret
         segact mchpo1*mod
         mchpo1.jattri(1)=1
C -------------     deplacements  complets   puis KU
         call mucpri(mchpo1,ri2  ,ichp5)
*            write (6,*) ' apres mucpri '
*            call ecchpo(ichp5,0)
         mchpo4=ichp5
         segact mchpo4*mod
         mchpo4.jattri(1)=1
         segdes mchpo4
         ichp6= ksmbr0
C -------      write(6,*) ' ---------   KU - F   '
*            write (6,*) ' avant adchpo  ichp5 '
*            call ecchpo(ichp5)
         call adchpo(ichp5,ichp6,IRET,1D0,-1D0)
         if (ierr.ne.0) return
         call dtchpo(ichp5)
*            write (6,*) ' apres adchpo '
*            call ecchpo(iret)
         call remplx(ri1,iret,ichp7)
C         VERLX a l'air de servir a rien (PV) : commente
C         call verlx(ri2,iret,mchpo1,noen,ipt8)
         call dtchpo(iret)
*            write (6,*) ' apres remplx ichp7 '
*            call ecchpo(ichp7,0)
         call fuchpo(mchpo1,ichp7,iret)
         mchpoi=iret
*  supression des multiplicateurs dédoublés
         if (lagdua.ne.0) then
            call dbbcf(mchpoi,lagdua)
            ipt1=lagdua
            segdes ipt1
         endif
      endif
      SEGDES MRIGID
*     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
      IRET = MCHPOI
      MCHSOL=IRET
      RETURN
*
* End of subroutine KRES7
*
      END