Sources Esope | Cast3M

mcompa
C MCOMPA    SOURCE    PV        20/09/26    21:18:45     10724          
      SUBROUTINE MCOMPA(MATELE,MATASS,
     $     LCOMPA,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : MCOMPA
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : On vérifie que MATELE et MATASS ont la même
C               structure (matrices élémentaires portant
C               sur les mêmes inconnues). Seuls les valeurs des
C               matrices élémentaires doivent être différentes.
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : -
C APPELE PAR       : KRES2
C***********************************************************************
C ENTREES            : MATELE, MATASS
C SORTIES            : LCOMPA
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 17/12/99, nouvelle version initiale
C HISTORIQUE : v1, 17/12/99, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
      POINTEUR MATELE.MATRIK
      POINTEUR MATASS.MATRIK
      POINTEUR IMATEL.IMATRI
      POINTEUR IMATAS.IMATRI
*
      INTEGER IMPR,IRET
*
      LOGICAL LCOMPA
      INTEGER IMATE,ITOTIN
      INTEGER NMATE,NTOTIN
      INTEGER NBMASS,NBMELE
      INTEGER NMATAS,NMATEL
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mcompa'
      LCOMPA=.TRUE.
*
* Quelques tests
*
      SEGACT MATASS
      SEGACT MATELE
      NMATAS=MATASS.IRIGEL(/2)
      NMATEL=MATELE.IRIGEL(/2)
      LCOMPA=LCOMPA.AND.(NMATAS.EQ.NMATEL)
      IF (LCOMPA) THEN
         NMATE=NMATAS
         DO 1 IMATE=1,NMATE
            LCOMPA=LCOMPA.AND.(MATASS.IRIGEL(7,IMATE).EQ.
     $           MATELE.IRIGEL(7,IMATE))
            IMATAS=MATASS.IRIGEL(4,IMATE)
            IMATEL=MATELE.IRIGEL(4,IMATE)
            SEGACT IMATAS
            SEGACT IMATEL
            NBMASS=IMATAS.LISPRI(/2)
            NBMELE=IMATEL.LISPRI(/2)
            LCOMPA=LCOMPA.AND.(NBMASS.EQ.NBMELE)
            IF (LCOMPA) THEN
               NTOTIN=NBMASS
               DO 12 ITOTIN=1,NTOTIN
                  LCOMPA=LCOMPA.AND.(IMATAS.LISPRI(ITOTIN).EQ.
     $                 IMATEL.LISPRI(ITOTIN))
                  LCOMPA=LCOMPA.AND.(IMATAS.LISDUA(ITOTIN).EQ.
     $                 IMATEL.LISDUA(ITOTIN))
 12            CONTINUE
               LCOMPA=LCOMPA.AND.(IMATAS.LIZAFM(/1).EQ.
     $              IMATEL.LIZAFM(/1))
            ENDIF
            SEGDES IMATEL
            SEGDES IMATAS
 1       CONTINUE
      ENDIF
      SEGDES MATELE
      SEGDES MATASS
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine mcompa'
      RETURN
*
* End of subroutine MCOMPA
*
      END