Télécharger blopha.eso

Retour à la liste

Numérotation des lignes :

  1. C BLOPHA SOURCE CB215821 19/07/31 21:15:28 10277
  2. SUBROUTINE BLOPHA
  3.  
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7. * +------------------------------------------------------------------------+
  8. * | création des matrices de bloquage pour le modele CHANGEMENT_PHASE |
  9. * | RIGIDITE sont de type 2 avec des 'FLX' a mettre en face |
  10. * +------------------------------------------------------------------------+
  11.  
  12. -INC CCOPTIO
  13. -INC SMELEME
  14. -INC SMMODEL
  15. -INC SMRIGID
  16. -INC SMCOORD
  17. -INC SMCHPOI
  18. -INC SMCHAML
  19.  
  20. * +------------------------------------------------------------------------+
  21. call LIROBJ('MMODEL ',mmodel,1,iretou)
  22. call ACTOBJ('MMODEL ',mmodel,1)
  23. if(ierr.ne.0) return
  24. segact mmodel
  25. nbsou =kmodel(/1)
  26. nrigel=0
  27. do 100 i=1,nbsou
  28. imodel=kmodel(i)
  29. segact imodel
  30.  
  31. nfor=imodel.formod(/2)
  32. call place(imodel.formod,nfor,iplac,'CHANGEMENT_PHASE')
  33. if (iplac .eq. 0) goto 100
  34.  
  35. nrigel=nrigel+1
  36. meleme=imamod
  37. segact,meleme
  38. 100 continue
  39.  
  40. nrigel=nbsou
  41. segini,mrigid
  42. mtymat='BLO_PHAS'
  43.  
  44. * Boucle sur les sous zones du model pour creer les matrices de blocages
  45. do 1 i=1,nbsou
  46. imodel=kmodel(i)
  47.  
  48. nfor=imodel.formod(/2)
  49. call place(imodel.formod,nfor,iplac,'CHANGEMENT_PHASE')
  50. if (iplac .eq. 0) goto 1
  51.  
  52. IF(tymode(2) .NE. 'MAILLAGE')THEN
  53. CALL ERREUR(5)
  54. ENDIF
  55. ipt2=ivamod(2)
  56. segact,ipt2
  57.  
  58. * Remplissage d'une matrice et des objets rigidite
  59. irigel(1,i)=ipt2
  60. irigel(5,i)=nifour
  61. coerig(i) =1.d0
  62. irigel(6,i)=2
  63.  
  64. nligrp=2
  65. nligrd=2
  66. segini,descr
  67. irigel(3,i)=descr
  68.  
  69. NOMID=lnomid(1)
  70. segact,nomid
  71. lisinc(1)='LX'
  72. lisinc(2)= nomid.lesobl(1)
  73.  
  74. NOMID=lnomid(2)
  75. segact,nomid
  76. lisdua(1)='FLX'
  77. lisdua(2)= nomid.lesobl(1)
  78.  
  79. noelep(1)=1
  80. noelep(2)=2
  81. noeled(1)=1
  82. noeled(2)=2
  83. segact,descr*nomod
  84.  
  85. nelrig=ipt2.num(/2)
  86. segini xmatri
  87. irigel(4,i)=xmatri
  88. do iou=1,nelrig
  89. re(1,1,iou)= 0.D0
  90. re(2,1,iou)= 1.D0
  91. re(1,2,iou)= 1.D0
  92. re(2,2,iou)= 0.D0
  93. enddo
  94. segact,xmatri*nomod
  95. 1 continue
  96. segact,mrigid*nomod
  97.  
  98. call ECROBJ('RIGIDITE',mrigid)
  99.  
  100. end
  101.  
  102.  
  103.  

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