Esope source files

   1 : C KRES7     SOURCE    GOUNAND   11/06/29    21:15:10     7016           
   2 :       SUBROUTINE KRES7(MSOLC,MRIGID,KSMBR0,KSMBR1,IDTARG,
   3 :      $     MCHSOL)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 :       IMPLICIT INTEGER (I-N)
   6 : C***********************************************************************
   7 : C NOM         : KRES7
   8 : C DESCRIPTION : Effectue la décondensation des relations
   9 : C               Repris de resou.eso
  10 : C
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C VERSION    : v1, 15/06/2011, version initiale
  17 : C HISTORIQUE : v1, 15/06/2011, création
  18 : C HISTORIQUE :
  19 : C HISTORIQUE :
  20 : C***********************************************************************
  21 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  22 : C en cas de modification de ce sous-programme afin de faciliter
  23 : C la maintenance !
  24 : C***********************************************************************
  25 : -INC CCOPTIO
  26 : -INC SMRIGID
  27 : -INC SMCHPOI
  28 : -INC SMELEME
  29 : *
  30 :       MCHPOI=MSOLC
  31 :       SEGACT MRIGID
  32 : C-----------------------
  33 :       if(jrcond.ne.0) then
  34 : *      if(idepe.ne.0) then
  35 :          noen=1
  36 :          ri1=jrelim
  37 :          ri2=jrgard
  38 :          ri6=jrdepp
  39 :          lagdua=imlag
  40 : *         write(ioimp,*) 'ri1,ri2,ri6',ri1,ri2,ri6
  41 : * reintroduction des inconnues supprimees
  41 :          call mucpri(mchpoi,ri6,ichp3)
  42 : *            write (6,*) ' resou - mchpoi '
  42 : *            call ecchpo(mchpoi,0)
  43 : *            write (6,*) ' resou - ichp3'
  43 : *            call ecchpo(ichp3 ,0)
  44 : *            write (6,*) ' resou - ri6'
  44 : *            call prrigi(ri6,1)
  44 :          call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0)
  45 :          mchpo1=ksmbr1
  46 : *            write (6,*) ' resou - iret '
  46 :          call adchpo(ichp2,mchpo1,iret,1.D0,1D0)
  46 : *            call ecchpo(mchpoi)
  46 : *            call ecchpo(iret)
  46 :          if (idtarg.ne.0) call dtchpo(mchpoi)
  46 :          call dtchpo(ichp3)
  46 :          call dtchpo(ichp2)
  47 :          mchpo1=iret
  48 :          segact mchpo1*mod
  49 :          mchpo1.jattri(1)=1
  50 : C -------------     deplacements  complets   puis KU
  50 :          call mucpri(mchpo1,ri2  ,ichp5)
  51 : *            write (6,*) ' apres mucpri '
  51 : *            call ecchpo(ichp5,0)
  52 :          mchpo4=ichp5
  53 :          segact mchpo4*mod
  54 :          mchpo4.jattri(1)=1
  55 :          segdes mchpo4 
  56 :          ichp6= ksmbr0
  57 : C -------      write(6,*) ' ---------   KU - F   '
  58 : *            write (6,*) ' avant adchpo  ichp5 '
  58 : *            call ecchpo(ichp5)
  58 :          call adchpo(ichp5,ichp6,IRET,1D0,-1D0) 
  58 :          call dtchpo(ichp5)
  59 : *            write (6,*) ' apres adchpo '
  59 : *            call ecchpo(iret)
  59 :          call remplx(ri1,iret,ichp7)
  59 :          call verlx(ri2,iret,mchpo1,noen,ipt8)
  59 :          call dtchpo(iret)
  60 : *            write (6,*) ' apres remplx ichp7 '
  60 : *            call ecchpo(ichp7,0)
  60 :          call fuchpo(mchpo1,ichp7,iret)
  61 :          mchpoi=iret 
  62 : *  supression des multiplicateurs dédoublés
  63 :          if (lagdua.ne.0) then
  63 :             call dbbcf(mchpoi,lagdua)
  64 :             ipt1=lagdua
  65 :             segdes ipt1
  66 :          endif
  67 :       endif                      
  68 :       SEGDES MRIGID
  69 : *     les champs de points qui sortent sont de nature diffuse
  70 :       SEGACT MCHPOI
  71 :       NAT = MAX(1,JATTRI(/1))
  72 :       NSOUPO=IPCHP(/1)
  73 :       SEGADJ MCHPOI
  74 :       JATTRI(1)=1
  75 :       SEGDES MCHPOI
  76 :       IRET = MCHPOI
  77 :       MCHSOL=IRET
  78 :       RETURN
  79 : *
  80 : * End of subroutine KRES7
  81 : *
  82 :       END
  83 : 
  84 :