Esope source files

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