Télécharger qulx.eso

Retour à la liste

Numérotation des lignes :

  1. C QULX SOURCE CHAT 09/10/09 21:22:07 6519
  2. SUBROUTINE QULX
  3. C
  4. C ** BUT : CHERCHER DANS UN CHPOINT TOUS LES MULTIPLICATEURS
  5. C ** QUI SONT REFERENCE PAR UNE MATRICE
  6. C ** UTILE POUR LES APPUIS UNILATERAUX
  7. C
  8. IMPLICIT INTEGER(I-N)
  9. -INC CCOPTIO
  10. -INC SMRIGID
  11. -INC SMCHPOI
  12. -INC SMELEME
  13. SEGMENT TRAV
  14. INTEGER IP(NIP)
  15. REAL*8 XP(NIP)
  16. ENDSEGMENT
  17. CALL LIROBJ ('RIGIDITE',MRIGID,1,IRETOU)
  18. IF(IERR.NE.0) RETURN
  19. CALL LIROBJ ('CHPOINT ',MCHPOI,1,IRETOU)
  20. IF(IERR.NE.0) RETURN
  21. C
  22. C ** RECHERCHE DU SOUS CHAMPOINT CONTENANT LES MULTIPLICATEURS
  23. C
  24. SEGACT MCHPOI
  25. DO 1 I = 1, IPCHP(/1)
  26. MSOUPO=IPCHP(I)
  27. II=I
  28. SEGACT MSOUPO
  29. IF(NOCOMP(1).EQ.'LX ') GO TO 2
  30. SEGDES MSOUPO
  31. 1 CONTINUE
  32. CALL ERREUR (21)
  33. RETURN
  34. 2 CONTINUE
  35. NOHA=NOHARM(1)
  36. IPT1=IGEOC
  37. MPOVAL=IPOVAL
  38. SEGACT IPT1,MPOVAL
  39. NIP=1000
  40. LIP=0
  41. SEGINI TRAV
  42. NNO=IPT1.NUM(/2)
  43. C
  44. C *** RECHERCHE DES BLOQUAGES, ON REMPLIT AU FUR ET A MESURE IP
  45. C *** QUI CONTIENDRA LES NUMEROS DE NOEUDS ET XP LES VALEURS
  46. C
  47. SEGACT MRIGID
  48. DO 3 I=1,IRIGEL(/2)
  49. MELEME=IRIGEL(1,I)
  50. SEGACT MELEME
  51. IF(ITYPEL.NE.22) GO TO 4
  52. DO 5 J=1,NUM(/2)
  53. DO 6 K=1,2
  54. NN= NUM(K,J)
  55. DO 7 L=1,NNO
  56. IF(IPT1.NUM(1,L).EQ.NN) THEN
  57. IF (NIP-LIP.LT.2) THEN
  58. NIP=NIP+1000
  59. SEGADJ TRAV
  60. ENDIF
  61. IP(LIP+1)=NN
  62. XP(LIP+1)=VPOCHA(L,1)
  63. LIP=LIP+1
  64. ENDIF
  65. 7 CONTINUE
  66. 6 CONTINUE
  67. 5 CONTINUE
  68. 4 CONTINUE
  69. SEGDES MELEME
  70. 3 CONTINUE
  71. SEGDES MRIGID,MCHPOI,MSOUPO,IPT1,MPOVAL
  72. C
  73. C *** CREATION DU CHPOINT
  74. C
  75. IF(LIP.EQ.0) THEN
  76. SEGSUP TRAV
  77. NSOUPO=0
  78. NAT=1
  79. SEGINI MCHPOI
  80. JATTRI(1)=2
  81. CALL ECROBJ('CHPOINT ',MCHPOI)
  82. RETURN
  83. ENDIF
  84. NSOUPO=1
  85. NAT=1
  86. SEGINI MCHPOI
  87. JATTRI(1) = 2
  88. NC=1
  89. SEGINI MSOUPO
  90. IPCHP(1)=MSOUPO
  91. NOCOMP(1)='LX '
  92. NOHARM(1)=NOHA
  93. NBELEM=LIP
  94. NBNN=1
  95. NBSOUS=0
  96. NBREF=0
  97. N=NBELEM
  98. SEGINI MELEME
  99. ITYPEL=1
  100. SEGINI MPOVAL
  101. IPOVAL=MPOVAL
  102. IGEOC=MELEME
  103. DO 8 I=1,NBELEM
  104. NUM(1,I)=IP(I)
  105. VPOCHA(I,1)=XP(I)
  106. 8 CONTINUE
  107. SEGSUP TRAV
  108. SEGDES MPOVAL,MELEME,MSOUPO,MCHPOI
  109. CALL ECROBJ('CHPOINT ',MCHPOI)
  110. RETURN
  111. END
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  

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