Télécharger mrem.eso

Retour à la liste

Numérotation des lignes :

  1. C MREM SOURCE PV 19/12/09 21:15:09 10422
  2. SUBROUTINE MREM
  3. ************************************************************************
  4. * remontee de la sotution complete apres resolution a partir
  5. * d une matrice condensee par CMCT ( hors de resou )
  6. *
  7. * Syntaxe :
  8. * chpo3 = MREM chpo1 (rig1 et rig2) chpo2 ;
  9. *
  10. * chpo1 solution reduite sur les ddl non elimines
  11. * rig1 rigidites initiale (hors dependances )
  12. * rig2 rigidites de dependances
  13. *
  14. * chpo3 solution complete en deplacements et LX
  15. *
  16. *************************************************************************
  17. IMPLICIT INTEGER(I-N)
  18. IMPLICIT REAL*8(A-H,O-Z)
  19.  
  20. -INC SMRIGID
  21. -INC CCOPTIO
  22. -INC SMCHPOI
  23. -INC SMLCHPO
  24. segment idemem(0)
  25. segment ideme0(idemem(/1),30)
  26. segment ideme1(idemem(/1),30)
  27.  
  28. noen=1
  29. ipt8=0
  30. segini idemem
  31. CALL LIROBJ('CHPOINT',mchpoi,1,IRETOU)
  32. IF(IERR.NE.0) GO TO 5000
  33. idemem(**)=mchpoi
  34. segini ideme0,ideme1
  35. CALL LIROBJ('LISTCHPO',mlchpo,1,IRETOU)
  36. IF(IERR.NE.0) GO TO 5000
  37. CALL LIROBJ('LISTCHPO',mlchp1,1,IRETOU)
  38. IF(IERR.NE.0) GO TO 5000
  39. segact mlchpo,mlchp1
  40. if=mlchpo.ichpoi(/1)
  41. if (if.ne.mlchp1.ichpoi(/1)) call erreur(5)
  42. do 1000 i=1,if
  43. ideme0(1,i)=mlchpo.ichpoi(i)
  44. ideme1(1,i)=mlchp1.ichpoi(i)
  45. 1000 continue
  46.  
  47. CALL LIROBJ('RIGIDITE',mrigid,1,IRETOU)
  48. IF(IERR.NE.0) GO TO 5000
  49. do 2010 ifois=1,30
  50. segact mrigid
  51. mrigid=jrsup
  52. if (mrigid.eq.0) goto 2011
  53. segact mrigid
  54. isouci=1
  55. iverif=0
  56. call resour(idemem,ideme0,ideme1,mrigid,if,noen,ipt8,
  57. > isouci,iverif)
  58. if=if-1
  59. 2010 continue
  60. 2011 continue
  61. if (if.ne.0) call erreur(5)
  62. iret=idemem(1)
  63. call ecrobj('CHPOINT',iret)
  64.  
  65. 5000 continue
  66. return
  67. end
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  

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