Télécharger vch2.eso

Retour à la liste

Numérotation des lignes :

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

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