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

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