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

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