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.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC SMCHPOI
  20. -INC SMELEME
  21. SEGMENT IDEMEM(0)
  22. segment ideme0(idemem(/1),30)
  23. segment ideme1(idemem(/1),30)
  24. C
  25. C
  26. C-------------------------------------------------------
  27. C LA SOLUTION EST CALCULEE --> ON LA MET EN FORME
  28.  
  29. SEGACT IDEMEM*mod
  30. N=IDEMEM(/1)
  31. c-----boucle sur les solutions
  32. segact mrigid
  33. ri6 = jrdepp
  34. ri2 = jrgard
  35. ri1 = jrelim
  36. DO 3 I=1,N
  37. IRET=IDEMEM(I)
  38. MCHPOI= IRET
  39. C-----------------------
  40. * reintroduction des inconnues supprimees
  41. call mucpri(mchpoi,ri6,ichp3)
  42. call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0)
  43. mchpo1=ideme1(I,if)
  44. call adchpo(ichp2,mchpo1,iret,1.D0,1D0)
  45. call dtchpo(mchpoi)
  46. call dtchpo(ichp3)
  47. call dtchpo(ichp2)
  48. mchpo1=iret
  49. segact mchpo1*mod
  50. mchpo1.jattri(1)=1
  51. C ------------- deplacements complets puis KU
  52. call mucpri(mchpo1,ri2 ,ichp5)
  53. mchpo4=ichp5
  54. segact mchpo4*mod
  55. mchpo4.jattri(1)=1
  56. ichp6= ideme0(I,if)
  57. C ------- write(6,*) ' --------- KU - F '
  58. call adchpo(ichp5,ichp6,IRET,1D0,-1D0)
  59. call remplx(ri1,iret,ichp7)
  60. * verif on a bien l'equilibre
  61. if (if.eq.1.and.iverif.eq.1) then
  62. call mucpri(ichp7,ri1,ichp3)
  63. call adchpo(iret,ichp3,ichp4,1D0,1D0)
  64. call dtchpo(iret)
  65. iptt=0
  66. if(noen.eq.1) iptt=ipt8
  67. call vechpo(ichp5,ichp6,ichp4,ipt8,isouci)
  68. call dtchpo(ichp3)
  69. call dtchpo(ichp4)
  70. endif
  71. call dtchpo(ichp5)
  72. * call dtchpo(ichp6)
  73. if (ierr.ne.0) return
  74.  
  75. call fuchpo(ichp7,mchpo1,iret)
  76. mchpoi=iret
  77. * supression des multiplicateurs dédoublés
  78. lagdua=imlag
  79. if (lagdua.gt.0) then
  80. ** write(6,*) ' appel a dbbcf lagdua ',lagdua
  81. call dbbcf(mchpoi,lagdua)
  82. ipt1=lagdua
  83. endif
  84. * write (6,*) ' mchpoi en fi de resour'
  85. segact mchpoi
  86. * call ecchpo(mchpoi,0)
  87. * les champs de points qui sortent sont de nature diffuse
  88. SEGACT MCHPOI
  89. NAT = MAX(1,JATTRI(/1))
  90. NSOUPO=IPCHP(/1)
  91. SEGADJ MCHPOI
  92. JATTRI(1)=1
  93. IRET = MCHPOI
  94. idemem(i)=iret
  95. 3 continue
  96. end
  97.  
  98.  
  99.  

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