Télécharger vch1.eso

Retour à la liste

Numérotation des lignes :

  1. C VCH1 SOURCE PV 16/11/17 22:01:40 9180
  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 41 ITYU=1,NNIN
  62. NHAR(ITYU)=IHAR(ITYU)
  63. 41 INCO(ITYU)=IMIK(ITYU)
  64. DO 23 I=1,NNNOE
  65. DO 23 J=1,NNIN
  66. IK=INCPO(J,I)
  67. IF(IK.EQ.0) GO TO 23
  68. IBIN(J,I)=ik
  69. BB(J,I)=VECTBB(IK)
  70. 23 CONTINUE
  71. segact mrigid*mod
  72. ichoa=ichole
  73. if(ichole.eq.0) then
  74. ichole = mmatri
  75. endif
  76. CALL CRECH3(MTRAV,ISOLU,nnd,mrigid)
  77. ichole=ichoa
  78. SEGSUP,MTRAV
  79. else
  80. lvecri=ivecri
  81. CALL CRECH2(ISOLU,mvectx,lvecri,1)
  82. endif
  83.  
  84. SEGDES,MINCPO
  85. SEGDES,MIMIK
  86. segdes midua
  87. SEGDES,MMATRI
  88. SEGDES,MHARK
  89. * SEGDES MVECTD
  90. SEGDES,MRIGID
  91. IF(IIMPI.EQ.3) WRITE(IOIMP,3001) ISOLU
  92. 3001 FORMAT(' SUBROUTINE VCH1 : POINTEUR DE L'' OBJET CHPOINT=',I5)
  93. RETURN
  94. END
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  

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