Télécharger chvns.eso

Retour à la liste

Numérotation des lignes :

  1. C CHVNS SOURCE PV 16/11/17 21:58:29 9180
  2. SUBROUTINE CHVNS(MMATRX,ISECO,MVECTX,NOID)
  3. C
  4. C **** SUBROUTINE QUI A PARTIR D UN OBJET DE TYPE MATRICE ET D UN
  5. C **** CHPOINT FABRIQUE UN VECTEUR SECOND MEMBRE
  6. C **** LE CHPOIN EST DE TYPE SECOND MEMBRE
  7. C
  8. IMPLICIT INTEGER(I-N)
  9. -INC SMMATRI
  10. -INC SMCHPOI
  11. -INC SMELEME
  12. -INC CCOPTIO
  13. -INC SMVECTD
  14. -INC SMCOORD
  15. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  16. SEGMENT,ICOR(NC1)
  17. C
  18. IF(IIMPI.EQ.3) WRITE(IOIMP,1000) MMATRX,ISECO
  19. 1000 FORMAT(' SUBROUTINE CHV2 : POINTEUR DE LA MATRICE=',I5,
  20. 1 ' POINTEUR DE L''OBJET CHPOINT=',I5)
  21. C
  22. C **** ACTIVATION DES SEGMENTS
  23. C
  24. C ... ceux dépendant de MMATRI ...
  25.  
  26. MMATRI=MMATRX
  27. SEGACT,MMATRI
  28.  
  29. MILIGN=IILIGN
  30. SEGACT,MILIGN
  31. INC=IPNO(/1)
  32. SEGDES,MILIGN
  33. C ... La taille de MVECTD est INC ...
  34. SEGINI,MVECTD
  35.  
  36. MIDUA=IIDUA
  37. SEGACT,MIDUA
  38. IDU=IDUA(/2)
  39.  
  40. MHARK=IHARDU
  41. SEGACT,MHARK
  42.  
  43. MINCPO=IDUAPO
  44. SEGACT,MINCPO
  45.  
  46. MELEME=IGEOMA
  47. SEGACT,MELEME
  48. N2=NUM(/2)
  49.  
  50. C ... ceux dépendant de MCHPOI ...
  51.  
  52. MCHPOI=ISECO
  53. SEGACT MCHPOI
  54. NSOUPO=IPCHP(/1)
  55. C
  56. C **** DANS ICPR ON COMPTE LES POINTS DE MELEME
  57. C
  58. SEGINI ICPR
  59. DO 25 I=1,N2
  60. ICPR(NUM(1,I))=I
  61. 25 CONTINUE
  62. C
  63. C
  64. C **** FABRICATION D'UN VECTEUR SECOND MEMBRE DANS MVECTD
  65. C **** ON VERIFIE QUE TOUTES LES COMPOSANTES DU VECTEUR EXISTENT DANS
  66. C **** LA MATRICE SI NOID=0 .
  67. C
  68. DO 1 I=1,NSOUPO
  69. MSOUPO=IPCHP(I)
  70. SEGACT,MSOUPO
  71. IPT1=IGEOC
  72. SEGACT,IPT1
  73. NC=NOCOMP(/2)
  74. C ... NC1 = taille de ICOR ...
  75. NC1=NC
  76. SEGINI,ICOR
  77. DO 110 KKIL = 1,NC1
  78. 110 ICOR(KKIL)=0
  79.  
  80. DO 11 KI=1,NC
  81. DO 10 J=1,IDU
  82. IF(NOCOMP(KI).NE.IDUA(J)) GO TO 10
  83. IF(NOHARM(KI).NE.IHAR(J)) GO TO 10
  84. C ... dans ICOR on met la correspondance entre les composantes du champ
  85. C et les variables duales de la matrice, s'il y a un zero, alors !!! ...
  86. ICOR(KI)=J
  87. GO TO 11
  88. 10 CONTINUE
  89. 11 CONTINUE
  90.  
  91. MPOVAL=IPOVAL
  92. SEGACT,MPOVAL
  93. C ... N = nombre de valeurs de chaque composante (=> noeuds) ...
  94. N=VPOCHA(/1)
  95. DO 20 J=1,N
  96. C ... K = n° d'ordre du noeud examiné dans la rigidité, 0 => !!! ...
  97. K=ICPR(IPT1.NUM(1,J))
  98. IF(K.NE.0) GO TO 4
  99. IF(NOID.EQ.1) GO TO 20
  100. C
  101. C **** LE NUMERO DU NOEUD DU VECTEUR N'EXISTAIT PAS DANS LA MATRICE
  102. C
  103. ITYP=53
  104. INTERR(1) = IPT1.NUM(1,J)
  105. CALL ERREUR (ITYP)
  106. RETURN
  107.  
  108. 4 CONTINUE
  109. ccc 40 CONTINUE
  110. DO 2 LI=1,NC
  111. C ... KKIL = n° local dans la matrice de la composante LI ...
  112. KKIL=ICOR(LI)
  113. IF (KKIL.EQ.0) GOTO 55
  114.  
  115. C ... KI = n° global du DDL dual ...
  116. KI=INCPO(KKIL,K)
  117. IF(KI.NE.0) GO TO 6
  118.  
  119. 55 CONTINUE
  120. IF(NOID.EQ.1) GO TO 2
  121. C
  122. C **** LE TYPE D'INCONNUE N'EXISTAIT PAS DANS LA MATRICE
  123. C
  124. ITYP=54
  125. MOTERR(1:4) = NOCOMP(LI)
  126. INTERR(1) = NOHARM (LI)
  127. INTERR(2) = IPT1.NUM(1,J)
  128. CALL ERREUR(ITYP)
  129. RETURN
  130.  
  131. 6 CONTINUE
  132. VECTBB(KI)=VPOCHA(J,LI)
  133. 2 CONTINUE
  134. 20 CONTINUE
  135.  
  136. SEGDES,MPOVAL
  137. SEGDES,MSOUPO
  138. SEGSUP,ICOR
  139. SEGDES,IPT1
  140.  
  141. 1 CONTINUE
  142.  
  143. SEGSUP ICPR
  144. SEGDES,MELEME
  145. SEGDES,MCHPOI
  146. SEGDES MMATRI
  147. SEGDES,MIDUA
  148. SEGDES,MHARK
  149. SEGDES,MINCPO
  150. MVECTX=MVECTD
  151. C
  152. IF(IIMPI.EQ.3) WRITE(IOIMP,1002)MVECTD
  153. 1002 FORMAT(' SUBROUTINE CHV2 : POINTEUR DU VECTEUR =',I5)
  154. SEGDES MVECTD
  155. RETURN
  156. END
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  

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