Télécharger pmat.eso

Retour à la liste

Numérotation des lignes :

  1. C PMAT SOURCE CHAT 11/03/16 21:29:11 6902
  2. subroutine pmat
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. *
  6. * création des matrices de bloquage pour le changement de phase
  7. * ces matrices sont de type 2 et des flx a mettre en face
  8. *
  9. * en entrée : objet modele
  10. -INC CCOPTIO
  11. -INC SMELEME
  12. -INC SMMODEL
  13. -INC SMRIGID
  14. -INC SMCOORD
  15. -INC SMCHPOI
  16. -INC SMCHAML
  17. segment icpr(XCOOR(/1)/(idim+1))
  18. segment icpr1(XCOOR(/1)/(idim+1))
  19. segment icpr2(XCOOR(/1)/(idim+1))
  20. segment icpr3(XCOOR(/1)/(idim+1))
  21. segment itvr
  22. real*8 tvr(IB)
  23. endsegment
  24. segment ide(ib)
  25. call lirobj('MMODEL',mmodel,1,iretou)
  26. if(ierr.ne.0) return
  27. segact mmodel
  28. nbsou=kmodel(/1)
  29. nrigel=nbsou
  30. nrige=8
  31. segini mrigid,icpr,icpr1,icpr2,icpr3
  32. mtymat='BLO_PHAS'
  33. ib=0
  34. do 100 i=1,nbsou
  35. imodel=kmodel(i)
  36. segact imodel
  37. meleme=imamod
  38. segact meleme
  39. do 101 mel=1,num(/2)
  40. do 101 npo=1,num(/1)
  41. ia = num(npo,mel)
  42. if(icpr(ia).eq.0) then
  43. ib=ib+1
  44. icpr(ia)=ib
  45. endif
  46. 101 continue
  47. segdes meleme
  48. 100 continue
  49. nbsous=0
  50. nbref=0
  51. nbnn=1
  52. nbelem=ib
  53. * write(6,*) 'nbelem nbnn nbref nbsous',nbelem,nbnn,nbref,nbsous
  54. segini ipt4
  55. * boucle sur les sous zones du model pour creer les matrices de
  56. * blocages
  57. idd=0
  58. do 1 i=1,nbsou
  59. imodel=kmodel(i)
  60. meleme=imamod
  61. call impp1(meleme,ipt2)
  62. segact ipt2
  63. * remplissage d'une matrice et des objets rigidite
  64. nelrig=ipt2.num(/2)
  65. segdes ipt2
  66. irigel(1,i) = ipt2
  67. irigel(5,i)=nifour
  68. coerig(i)=1.d0
  69. irigel(6,i)=2
  70. nligrp=2
  71. nligrd=2
  72. segini descr
  73. irigel(3,i)=descr
  74. lisinc(1)='LX'
  75. lisinc(2)='T'
  76. lisdua(1)='FLX'
  77. lisdua(2)='Q'
  78. noelep(1)=1
  79. noelep(2)=2
  80. noeled(1)=1
  81. noeled(2)=2
  82. segdes descr
  83. segini xmatri
  84. do iou=1,nelrig
  85. re(1,1,iou)= 0.D0
  86. re(1,2,iou)=1.D0
  87. re(2,1,iou)=1.D0
  88. re(2,2,iou)=0.D0
  89. enddo
  90. segdes xmatri
  91. * segini imatri
  92. irigel(4,i)=xmatri
  93. * do 3 j=1,nelrig
  94. * 3 imattt(j)=xmatri
  95. segdes xmatri,imodel
  96. 1 continue
  97. segdes mrigid,mmodel
  98. call ecrobj ('RIGIDITE',mrigid)
  99. return
  100. end
  101.  
  102.  
  103.  
  104.  

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