Télécharger lumpin.eso

Retour à la liste

Numérotation des lignes :

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

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