Télécharger kres7.eso

Retour à la liste

Numérotation des lignes :

  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
  42. call mucpri(mchpoi,ri6,ichp3)
  43. * write (6,*) ' resou - mchpoi '
  44. * call ecchpo(mchpoi,0)
  45. * write (6,*) ' resou - ichp3'
  46. * call ecchpo(ichp3 ,0)
  47. * write (6,*) ' resou - ri6'
  48. * call prrigi(ri6,1)
  49. call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0)
  50. mchpo1=ksmbr1
  51. * write (6,*) ' resou - iret '
  52. call adchpo(ichp2,mchpo1,iret,1.D0,1D0)
  53. * call ecchpo(mchpoi)
  54. * call ecchpo(iret)
  55. if (idtarg.ne.0) call dtchpo(mchpoi)
  56. call dtchpo(ichp3)
  57. call dtchpo(ichp2)
  58. mchpo1=iret
  59. segact mchpo1*mod
  60. mchpo1.jattri(1)=1
  61. C ------------- deplacements complets puis KU
  62. call mucpri(mchpo1,ri2 ,ichp5)
  63. * write (6,*) ' apres mucpri '
  64. * call ecchpo(ichp5,0)
  65. mchpo4=ichp5
  66. segact mchpo4*mod
  67. mchpo4.jattri(1)=1
  68. segdes mchpo4
  69. ichp6= ksmbr0
  70. C ------- write(6,*) ' --------- KU - F '
  71. * write (6,*) ' avant adchpo ichp5 '
  72. * call ecchpo(ichp5)
  73. call adchpo(ichp5,ichp6,IRET,1D0,-1D0)
  74. call dtchpo(ichp5)
  75. * write (6,*) ' apres adchpo '
  76. * call ecchpo(iret)
  77. call remplx(ri1,iret,ichp7)
  78. call verlx(ri2,iret,mchpo1,noen,ipt8)
  79. call dtchpo(iret)
  80. * write (6,*) ' apres remplx ichp7 '
  81. * call ecchpo(ichp7,0)
  82. call fuchpo(mchpo1,ichp7,iret)
  83. mchpoi=iret
  84. * supression des multiplicateurs dédoublés
  85. if (lagdua.ne.0) then
  86. call dbbcf(mchpoi,lagdua)
  87. ipt1=lagdua
  88. segdes ipt1
  89. endif
  90. endif
  91. SEGDES MRIGID
  92. * les champs de points qui sortent sont de nature diffuse
  93. SEGACT MCHPOI
  94. NAT = MAX(1,JATTRI(/1))
  95. NSOUPO=IPCHP(/1)
  96. SEGADJ MCHPOI
  97. JATTRI(1)=1
  98. SEGDES MCHPOI
  99. IRET = MCHPOI
  100. MCHSOL=IRET
  101. RETURN
  102. *
  103. * End of subroutine KRES7
  104. *
  105. END
  106.  
  107.  
  108.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales