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.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. POINTEUR MATELE.MATRIK
  39. POINTEUR MATASS.MATRIK
  40. POINTEUR IMATEL.IMATRI
  41. POINTEUR IMATAS.IMATRI
  42. *
  43. INTEGER IMPR,IRET
  44. *
  45. LOGICAL LCOMPA
  46. INTEGER IMATE,ITOTIN
  47. INTEGER NMATE,NTOTIN
  48. INTEGER NBMASS,NBMELE
  49. INTEGER NMATAS,NMATEL
  50. *
  51. * Executable statements
  52. *
  53. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mcompa'
  54. LCOMPA=.TRUE.
  55. *
  56. * Quelques tests
  57. *
  58. SEGACT MATASS
  59. SEGACT MATELE
  60. NMATAS=MATASS.IRIGEL(/2)
  61. NMATEL=MATELE.IRIGEL(/2)
  62. LCOMPA=LCOMPA.AND.(NMATAS.EQ.NMATEL)
  63. IF (LCOMPA) THEN
  64. NMATE=NMATAS
  65. DO 1 IMATE=1,NMATE
  66. LCOMPA=LCOMPA.AND.(MATASS.IRIGEL(7,IMATE).EQ.
  67. $ MATELE.IRIGEL(7,IMATE))
  68. IMATAS=MATASS.IRIGEL(4,IMATE)
  69. IMATEL=MATELE.IRIGEL(4,IMATE)
  70. SEGACT IMATAS
  71. SEGACT IMATEL
  72. NBMASS=IMATAS.LISPRI(/2)
  73. NBMELE=IMATEL.LISPRI(/2)
  74. LCOMPA=LCOMPA.AND.(NBMASS.EQ.NBMELE)
  75. IF (LCOMPA) THEN
  76. NTOTIN=NBMASS
  77. DO 12 ITOTIN=1,NTOTIN
  78. LCOMPA=LCOMPA.AND.(IMATAS.LISPRI(ITOTIN).EQ.
  79. $ IMATEL.LISPRI(ITOTIN))
  80. LCOMPA=LCOMPA.AND.(IMATAS.LISDUA(ITOTIN).EQ.
  81. $ IMATEL.LISDUA(ITOTIN))
  82. 12 CONTINUE
  83. LCOMPA=LCOMPA.AND.(IMATAS.LIZAFM(/1).EQ.
  84. $ IMATEL.LIZAFM(/1))
  85. ENDIF
  86. SEGDES IMATEL
  87. SEGDES IMATAS
  88. 1 CONTINUE
  89. ENDIF
  90. SEGDES MATELE
  91. SEGDES MATASS
  92. *
  93. * Normal termination
  94. *
  95. IRET=0
  96. RETURN
  97. *
  98. * Format handling
  99. *
  100. *
  101. * Error handling
  102. *
  103. 9999 CONTINUE
  104. IRET=1
  105. WRITE(IOIMP,*) 'An error was detected in subroutine mcompa'
  106. RETURN
  107. *
  108. * End of subroutine MCOMPA
  109. *
  110. END
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  

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