Télécharger resour.eso

Retour à la liste

Numérotation des lignes :

  1. C RESOUR SOURCE CB215821 19/07/30 21:17:58 10273
  2. SUBROUTINE RESOUR(idemem,ideme0,ideme1,mrigid,if,noen,ipt8,
  3. > isouci,iverif)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C
  7. C **** Reconstitution de la solution complete apres un resou sur une
  8. C **** matrice ou les relations ont ete eliminees.
  9. C
  10. C erreur ou souci si on n'arrive pas a reconstruire
  11. C
  12. C si iverif=1 verification de la solution. Pour le moment pas de verification si
  13. C option noid car on n'a pas ku=f
  14. C
  15. -INC SMRIGID
  16. -INC CCOPTIO
  17. -INC SMCHPOI
  18. -INC SMELEME
  19. SEGMENT IDEMEM(0)
  20. segment ideme0(idemem(/1),30)
  21. segment ideme1(idemem(/1),30)
  22. C
  23. C
  24. C-------------------------------------------------------
  25. C LA SOLUTION EST CALCULEE --> ON LA MET EN FORME
  26.  
  27. SEGACT IDEMEM*mod
  28. N=IDEMEM(/1)
  29. c-----boucle sur les solutions
  30. segact mrigid
  31. ri6 = jrdepp
  32. ri2 = jrgard
  33. ri1 = jrelim
  34. DO 3 I=1,N
  35. IRET=IDEMEM(I)
  36. MCHPOI= IRET
  37. C-----------------------
  38. * reintroduction des inconnues supprimees
  39. call mucpri(mchpoi,ri6,ichp3)
  40. call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0)
  41. mchpo1=ideme1(I,if)
  42. call adchpo(ichp2,mchpo1,iret,1.D0,1D0)
  43. call dtchpo(mchpoi)
  44. call dtchpo(ichp3)
  45. call dtchpo(ichp2)
  46. mchpo1=iret
  47. segact mchpo1*mod
  48. mchpo1.jattri(1)=1
  49. C ------------- deplacements complets puis KU
  50. call mucpri(mchpo1,ri2 ,ichp5)
  51. mchpo4=ichp5
  52. segact mchpo4*mod
  53. mchpo4.jattri(1)=1
  54. ichp6= ideme0(I,if)
  55. C ------- write(6,*) ' --------- KU - F '
  56. call adchpo(ichp5,ichp6,IRET,1D0,-1D0)
  57. call remplx(ri1,iret,ichp7)
  58. * verif on a bien l'equilibre
  59. if (if.eq.1.and.iverif.eq.1) then
  60. call mucpri(ichp7,ri1,ichp3)
  61. call adchpo(iret,ichp3,ichp4,1D0,1D0)
  62. call dtchpo(iret)
  63. iptt=0
  64. if(noen.eq.1) iptt=ipt8
  65. call vechpo(ichp5,ichp6,ichp4,ipt8,isouci)
  66. call dtchpo(ichp3)
  67. call dtchpo(ichp4)
  68. endif
  69. call dtchpo(ichp5)
  70. * call dtchpo(ichp6)
  71. if (ierr.ne.0) return
  72.  
  73. call fuchpo(ichp7,mchpo1,iret)
  74. mchpoi=iret
  75. * supression des multiplicateurs dédoublés
  76. lagdua=imlag
  77. if (lagdua.gt.0) then
  78. ** write(6,*) ' appel a dbbcf lagdua ',lagdua
  79. call dbbcf(mchpoi,lagdua)
  80. ipt1=lagdua
  81. endif
  82. * write (6,*) ' mchpoi en fi de resour'
  83. segact mchpoi
  84. * call ecchpo(mchpoi,0)
  85. * les champs de points qui sortent sont de nature diffuse
  86. SEGACT MCHPOI
  87. NAT = MAX(1,JATTRI(/1))
  88. NSOUPO=IPCHP(/1)
  89. SEGADJ MCHPOI
  90. JATTRI(1)=1
  91. IRET = MCHPOI
  92. idemem(i)=iret
  93. 3 continue
  94. end
  95.  
  96.  
  97.  

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