Télécharger lumpin.eso

Retour à la liste

Numérotation des lignes :

  1. C LUMPIN SOURCE CHAT 09/10/09 21:20:30 6519
  2. SUBROUTINE LUMPIN(IRIG,LMOT,ILUM)
  3. ************************************************************************
  4. *
  5. * LUMPING D'UNE MATRICE
  6. * ENTREE : IRIG POINTEUR SUR LA MATRICE A LUMPER
  7. * LMOT POINTEUR SUR LISTMOTS, 0 SI PAS DONNE
  8. *
  9. * SORTIE : ILUM POINTEUR SUR LA MATRICE LUMPEE
  10. *
  11. * M. PETIT DECEMBRE 89
  12. *
  13. ************************************************************************
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8 (A-H,O-Z)
  16. -INC SMRIGID
  17. -INC SMLMOTS
  18. *
  19. * NE PAS ENLEVER LA CARTE DEBILE QUI SUIT
  20. *
  21. MLMOTS=IRIG
  22. *
  23. NMOT=0
  24. IF (LMOT.NE.0) THEN
  25. MLMOTS=LMOT
  26. SEGACT MLMOTS
  27. NMOT=MOTS(/2)
  28. ENDIF
  29. *
  30. RI1=IRIG
  31. SEGACT RI1
  32. NRIGE=RI1.IRIGEL(/1)
  33. NRIGEL=RI1.IRIGEL(/2)
  34. SEGINI MRIGID
  35. ILUM=MRIGID
  36. DO 100 I=1,NRIGEL
  37. DESCR=RI1.IRIGEL(3,I)
  38. SEGACT DESCR
  39. NLIGRP=LISINC(/2)
  40. NLIGRD=LISDUA(/2)
  41. *
  42. * TEST DE MATRICE CARREE
  43. *
  44. IF(NLIGRP.NE.NLIGRD) THEN
  45. CALL ERREUR(26)
  46. SEGDES DESCR,RI1
  47. SEGSUP MRIGID
  48. IF(LMOT.NE.0) SEGDES MLMOTS
  49. RETURN
  50. ENDIF
  51. *
  52. xMATR1=RI1.IRIGEL(4,I)
  53. SEGACT xMATR1
  54. NELRIG=xMATR1.re(/3)
  55. SEGINI xMATRI
  56. IRIGEL(4,I)=xMATRI
  57. DO 200 J=1,NELRIG
  58. * XMATR1=IMATR1.IMATTT(J)
  59. * SEGACT XMATR1
  60. * SEGINI XMATRI
  61. * IMATTT(J)=XMATRI
  62. *
  63. DO 300 K=1,NLIGRP
  64. SOMM=0.D0
  65. IF (LMOT.EQ.0) THEN
  66. DO 40 JJ=1,NLIGRP
  67. RE(K,JJ)=0.D0
  68. SOMM=SOMM+XMATR1.RE(K,JJ,j)
  69. 40 CONTINUE
  70. RE(K,K,j)=SOMM
  71. ELSE
  72. KDIAG=0
  73. DO 21 KK=1,NMOT
  74. IF (MOTS(KK).EQ.LISINC(K)) THEN
  75. KDIAG=1
  76. GO TO 20
  77. ENDIF
  78. 21 CONTINUE
  79. 20 CONTINUE
  80. *
  81. IF(KDIAG.EQ.0) THEN
  82. DO 50 JJ=1,NLIGRP
  83. RE(K,JJ)=0.D0
  84. DO 51 JJJ=1,NMOT
  85. IF (MOTS(JJJ).EQ.LISINC(JJ)) GOTO 50
  86. 51 CONTINUE
  87. SOMM=SOMM+XMATR1.RE(K,JJ,j)
  88. 50 CONTINUE
  89. RE(K,K,j)=SOMM
  90. ELSE
  91. DO 52 JJ=1,NLIGRP
  92. RE(K,JJ,j)=0.D0
  93. 52 CONTINUE
  94. RE(K,K,j)=XMATR1.RE(K,K,j)
  95. ENDIF
  96. ENDIF
  97. 300 CONTINUE
  98. * SEGDES XMATR1,XMATRI
  99. 200 CONTINUE
  100. SEGDES xMATR1,xMATRI
  101. SEGINI,DES1=DESCR
  102. IRIGEL(3,I)=DES1
  103. SEGDES DESCR,DES1
  104. IRIGEL(1,I)=RI1.IRIGEL(1,I)
  105. IRIGEL(2,I)=RI1.IRIGEL(2,I)
  106. IRIGEL(5,I)=RI1.IRIGEL(5,I)
  107. IRIGEL(6,I)=RI1.IRIGEL(6,I)
  108. COERIG(I)=RI1.COERIG(I)
  109. 100 CONTINUE
  110. MTYMAT=RI1.MTYMAT
  111. IFORIG=RI1.IFORIG
  112. ISUPEQ=RI1.ISUPEQ
  113. SEGDES RI1
  114. IMGEO1=0
  115. IMGEO2=0
  116. ICHOLE=0
  117. SEGDES MRIGID
  118. IF (LMOT.NE.0) SEGDES MLMOTS
  119. RETURN
  120. END
  121.  
  122.  
  123.  

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