Télécharger verlx.eso

Retour à la liste

Numérotation des lignes :

  1. C VERLX SOURCE GOUNAND 14/10/21 21:15:10 8186
  2. * verification LX nuls
  3. *
  4. subroutine verlx(mrigid,mchpoi,mchpo1,noen,ipt8)
  5. *
  6. * verification que les LX apparaissant dand mrigid sont nuls
  7. * mcphpo1 sert a construire le critere en deplacemento
  8. *
  9. implicit real*8 (a-h,o-z)
  10. -INC CCOPTIO
  11. -INC SMCHPOI
  12. -INC SMRIGID
  13. -INC SMELEME
  14. -INC SMCOORD
  15. -INC CCREEL
  16. segment vpoch(xcoor(/1)/(idim+1))
  17. nbnn=1
  18. nbsous=0
  19. nbref=0
  20. xmcrit=xpetit
  21. segact mcoord
  22. segini vpoch
  23. * expension des LX du chpoint
  24. segact mchpoi
  25. do 10 isoupo=1,ipchp(/1)
  26. msoupo=ipchp(isoupo)
  27. segact msoupo
  28. if (nocomp(/2).ne.1) goto 10
  29. if (nocomp(1).ne.'FLX') goto 10
  30. mpoval=ipoval
  31. segact mpoval
  32. meleme=igeoc
  33. segact meleme
  34. do 15 i=1,vpocha(/1)
  35. vpoch(num(1,i))=vpocha(i,1)
  36. xmcrit=max(xmcrit,abs(vpocha(i,1)))
  37. 15 continue
  38. 10 continue
  39. * calcul du critere
  40. segact mchpo1
  41. do 50 isoupo=1,mchpo1.ipchp(/1)
  42. msoupo=mchpo1.ipchp(isoupo)
  43. segact msoupo
  44. * WRITE(IOIMP,*) ' verlx nocomp(1) ',nocomp(1)
  45. if (nocomp(1).eq.'FLX') goto 50
  46. mpoval=ipoval
  47. segact mpoval
  48. do 55 i=1,vpocha(/1)
  49. do 56 j=1,vpocha(/2)
  50. xmcrit=max(xmcrit,abs(vpocha(i,j)))
  51. 56 continue
  52. 55 continue
  53. 50 continue
  54. xmcrit=xmcrit*1d-6
  55. * WRITE(IOIMP,*) ' xmcrit dans verlx ',xmcrit
  56. * balayer les matrices pour tester les LX y apparaissant
  57. segact mrigid
  58. do 100 irige=1,irigel(/2)
  59. meleme=irigel(1,irige)
  60. descr=irigel(3,irige)
  61. segact descr
  62. if (lisinc(1).ne.'LX') goto 100
  63. segact meleme
  64. do 110 iel=1,num(/2)
  65. if (abs(vpoch(num(1,iel))).gt.xmcrit) then
  66. if (noen.eq.0) then
  67. nbelem=ipt8.num(/2)+1
  68. segadj ipt8
  69. ipt8.num(1,nbelem)=num(1,iel)
  70. else
  71. interr(1)=num(1,iel)
  72. moterr(1:4)='LX'
  73. * Résolution impossible détectée au noeud %i1 pour l'inconnue %m1:4
  74. call erreur(143)
  75. endif
  76. else
  77. vpoch(num(1,iel))=0.d0
  78. endif
  79. 110 continue
  80. 100 continue
  81. * remise à zero des petits FLX
  82. do 210 isoupo=1,ipchp(/1)
  83. msoupo=ipchp(isoupo)
  84. segact msoupo
  85. if (nocomp(/2).ne.1) goto 210
  86. if (nocomp(1).ne.'FLX') goto 210
  87. mpoval=ipoval
  88. segact mpoval*mod
  89. meleme=igeoc
  90. segact meleme
  91. do 215 i=1,vpocha(/1)
  92. vpocha(i,1)=vpoch(num(1,i))
  93. 215 continue
  94. 210 continue
  95. segsup vpoch
  96. end
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  

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