Télécharger vch1.eso

Retour à la liste

Numérotation des lignes :

  1. C VCH1 SOURCE PV 20/09/28 21:15:29 10727
  2. SUBROUTINE VCH1 (MMATRX,MVECTX,ISOLU,KRIGI)
  3. C
  4. C **** A PARTIR D UN OBJET DE TYPE MATRICE TRANSFORME UN VECTEUR EN
  5. C **** CHPOIN DE TYPE PREMIER MEMBRE
  6. C **** KRIGI EST LE POINTEUR DE LA RIGIDITE.SERT A SAVOIRE SI LA GEOM
  7. C **** EXISTE DEJA.
  8. C
  9. IMPLICIT INTEGER(I-N)
  10. -INC SMMATRI
  11. -INC SMCHPOI
  12. -INC SMELEME
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMVECTD
  17. -INC SMRIGID
  18. -INC TMTRAV
  19. C
  20. IF(IIMPI.EQ.3) WRITE(IOIMP,3000) MMATRX,MVECTX
  21. 3000 FORMAT(' OPERATEUR VCH1 : POINTEUR DE LA MATRICE=',I5,
  22. 1 ' POINTEUR DU VECTEUR=',I5)
  23. C
  24. C **** ACTIVATION DES SEGMENTS
  25. C
  26. MRIGID=KRIGI
  27. SEGACT,MRIGID
  28. IMGEOQ=IMGEO1
  29.  
  30. MMATRI=MMATRX
  31. SEGACT,MMATRI
  32. MILIGN=IILIGN
  33. SEGACT,MILIGN
  34. INC=IPNO(/1)
  35. SEGDES,MILIGN
  36. MINCPO=IINCPO
  37. SEGACT,MINCPO
  38. MIMIK=IIMIK
  39. SEGACT,MIMIK
  40. MHARK=IHARK
  41. SEGACT,MHARK
  42. NNIN=IMIK(/2)
  43. midua=iidua
  44. segact midua
  45. MVECTD=MVECTX
  46. SEGACT MVECTD
  47. C
  48. C **** CREATION D'UN SEGMENT DE TYPE MCHPOI(VOIR SMCHPOI)
  49. C
  50.  
  51. if( ivecri.eq.0) then
  52. NND=VECTBB(/1)
  53. MELEME=IGEOMA
  54. SEGACT,MELEME
  55. NNNOE=NUM(/2)
  56. SEGINI,MTRAV
  57. DO 40 ITYU=1,NNNOE
  58. IGEO(ITYU)=NUM(1,ITYU)
  59. 40 CONTINUE
  60. SEGDES,MELEME
  61. DO ITYU=1,NNIN
  62. NHAR(ITYU)=IHAR(ITYU)
  63. INCO(ITYU)=IMIK(ITYU)
  64. ENDDO
  65. DO I=1,NNNOE
  66. DO J=1,NNIN
  67. IK=INCPO(J,I)
  68. IF(IK.NE.0) THEN
  69. IBIN(J,I)=ik
  70. BB(J,I)=VECTBB(IK)
  71. ENDIF
  72. ENDDO
  73. ENDDO
  74. segact mrigid*mod
  75. ichoa=ichole
  76. if(ichole.eq.0) then
  77. ichole = mmatri
  78. endif
  79. CALL CRECH3(MTRAV,ISOLU,nnd,mrigid)
  80. ichole=ichoa
  81. SEGSUP,MTRAV
  82. else
  83. lvecri=ivecri
  84. CALL CRECH2(ISOLU,mvectx,lvecri,1)
  85. endif
  86.  
  87. SEGDES,MINCPO
  88. SEGDES,MIMIK
  89. segdes midua
  90. SEGDES,MMATRI
  91. SEGDES,MHARK
  92. * SEGDES MVECTD
  93. SEGDES,MRIGID
  94. IF(IIMPI.EQ.3) WRITE(IOIMP,3001) ISOLU
  95. 3001 FORMAT(' SUBROUTINE VCH1 : POINTEUR DE L'' OBJET CHPOINT=',I5)
  96. RETURN
  97. END
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  

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