Télécharger mcompa.eso

Retour à la liste

Numérotation des lignes :

  1. C MCOMPA SOURCE PV 16/11/17 22:00:41 9180
  2. SUBROUTINE MCOMPA(MATELE,MATASS,
  3. $ LCOMPA,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : MCOMPA
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : On vérifie que MATELE et MATASS ont la même
  11. C structure (matrices élémentaires portant
  12. C sur les mêmes inconnues). Seuls les valeurs des
  13. C matrices élémentaires doivent être différentes.
  14. C
  15. C LANGAGE : ESOPE
  16. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES : -
  20. C APPELE PAR : KRES2
  21. C***********************************************************************
  22. C ENTREES : MATELE, MATASS
  23. C SORTIES : LCOMPA
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v1, 17/12/99, nouvelle version initiale
  27. C HISTORIQUE : v1, 17/12/99, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35. -INC CCOPTIO
  36. POINTEUR MATELE.MATRIK
  37. POINTEUR MATASS.MATRIK
  38. POINTEUR IMATEL.IMATRI
  39. POINTEUR IMATAS.IMATRI
  40. *
  41. INTEGER IMPR,IRET
  42. *
  43. LOGICAL LCOMPA
  44. INTEGER IMATE,ITOTIN
  45. INTEGER NMATE,NTOTIN
  46. INTEGER NBMASS,NBMELE
  47. INTEGER NMATAS,NMATEL
  48. *
  49. * Executable statements
  50. *
  51. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mcompa'
  52. LCOMPA=.TRUE.
  53. *
  54. * Quelques tests
  55. *
  56. SEGACT MATASS
  57. SEGACT MATELE
  58. NMATAS=MATASS.IRIGEL(/2)
  59. NMATEL=MATELE.IRIGEL(/2)
  60. LCOMPA=LCOMPA.AND.(NMATAS.EQ.NMATEL)
  61. IF (LCOMPA) THEN
  62. NMATE=NMATAS
  63. DO 1 IMATE=1,NMATE
  64. LCOMPA=LCOMPA.AND.(MATASS.IRIGEL(7,IMATE).EQ.
  65. $ MATELE.IRIGEL(7,IMATE))
  66. IMATAS=MATASS.IRIGEL(4,IMATE)
  67. IMATEL=MATELE.IRIGEL(4,IMATE)
  68. SEGACT IMATAS
  69. SEGACT IMATEL
  70. NBMASS=IMATAS.LISPRI(/2)
  71. NBMELE=IMATEL.LISPRI(/2)
  72. LCOMPA=LCOMPA.AND.(NBMASS.EQ.NBMELE)
  73. IF (LCOMPA) THEN
  74. NTOTIN=NBMASS
  75. DO 12 ITOTIN=1,NTOTIN
  76. LCOMPA=LCOMPA.AND.(IMATAS.LISPRI(ITOTIN).EQ.
  77. $ IMATEL.LISPRI(ITOTIN))
  78. LCOMPA=LCOMPA.AND.(IMATAS.LISDUA(ITOTIN).EQ.
  79. $ IMATEL.LISDUA(ITOTIN))
  80. 12 CONTINUE
  81. LCOMPA=LCOMPA.AND.(IMATAS.LIZAFM(/1).EQ.
  82. $ IMATEL.LIZAFM(/1))
  83. ENDIF
  84. SEGDES IMATEL
  85. SEGDES IMATAS
  86. 1 CONTINUE
  87. ENDIF
  88. SEGDES MATELE
  89. SEGDES MATASS
  90. *
  91. * Normal termination
  92. *
  93. IRET=0
  94. RETURN
  95. *
  96. * Format handling
  97. *
  98. *
  99. * Error handling
  100. *
  101. 9999 CONTINUE
  102. IRET=1
  103. WRITE(IOIMP,*) 'An error was detected in subroutine mcompa'
  104. RETURN
  105. *
  106. * End of subroutine MCOMPA
  107. *
  108. END
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  

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