Sources Esope | Cast3M

vermat
C VERMAT    SOURCE    PV        20/09/26    21:20:11     10724          
      SUBROUTINE VERMAT(MATRIK,IMPR,IRET)
C***********************************************************************
C NOM         : VERMAT
C DESCRIPTION :
C      Ce sous-programme vérifie l'objet matrice morse assemblée
C      du segment MATRIK (segments
C      MINC duaux et primaux identiques, nb d'inconnues...)
C      en vue de la résolution itérative.
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES  : -
C***********************************************************************
C ENTREES            : MATRIK, IMPR
C ENTREES/SORTIES    : -
C SORTIES            : IRET
C CODE RETOUR (IRET) : 0 si ok
C                     &lt;0 si problème
C     MATRIK : pointeur sur segment MATRIK de l'include SMMATRIK
C              contenant la matrice morse à vérifier
C     IMPR   : niveau d'impression (0..3)
C***********************************************************************
C VERSION    : v1, 01/04/98, version initiale
C HISTORIQUE : v1, 01/04/98, 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***********************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
      POINTEUR KMORS.PMORS
      POINTEUR KISA.IZA
      CHARACTER*4 NOMINC
      LOGICAL OK
C***
 
      IRET=0
      OK=.TRUE.
C     On récupère les segments utiles
      IF (IMPR.GT.5) THEN
         WRITE(IOIMP,*) 'vermat.eso : Checking MATRIK',MATRIK
      ENDIF
      SEGACT MATRIK*MOD
C Vérification des dimensions
      KMORS=KIDMAT(4)
      KISA =KIDMAT(5)
      IF (KMORS.EQ.0.OR.KISA.EQ.0) THEN
         WRITE(IOIMP,*) 'Le segment ne contient pas de matrice morse'
         WRITE(IOIMP,*) 'KMORS=',KMORS
         WRITE(IOIMP,*) 'KISA =',KISA
         IRET=-1
      ELSE
         IF(IMPR.GT.5) THEN
            WRITE(IOIMP,*) 'Vérification des dimensions...'
         ENDIF
         SEGACT KMORS
         NTT =KMORS.IA(/1)-1
         NJA =KMORS.JA(/1)
         SEGDES KMORS
         IF (KNTTT.EQ.0) KNTTT=NTT
         IF (KNTTP.EQ.0) KNTTP=NTT
         IF (KNTTD.EQ.0) KNTTD=NTT
         IF (KNTTT.NE.NTT.OR.KNTTP.NE.NTT.OR.KNTTD.NE.NTT) THEN
            WRITE(IOIMP,*) 'Dimensions non concordantes.'
            IRET=-2
            OK=.FALSE.
         ENDIF
         IF(IMPR.GT.5.OR.(.NOT.OK)) THEN
            WRITE(IOIMP,*) 'KNTTT=',KNTTT
            WRITE(IOIMP,*) 'KNTTP=',KNTTP
            WRITE(IOIMP,*) 'KNTTD=',KNTTD
            WRITE(IOIMP,*) 'NTT  =',NTT
            WRITE(IOIMP,*) 'NJA  =',NJA
            WRITE(IOIMP,*) 'Vérification des supports géométriques...'
         ENDIF
         ISPG=0
         OK=.TRUE.
         IF (KISPGP.NE.0) ISPG=KISPGP
         IF (KISPGD.NE.0) ISPG=KISPGD
         IF (KISPGT.NE.0) ISPG=KISPGT
         IF (ISPG.EQ.0) THEN
            WRITE(IOIMP,*) 'Pas de supports géométriques ?'
            IRET=-3
            OK=.FALSE.
         ENDIF
         IF (KISPGP.EQ.0) KISPGP=ISPG
         IF (KISPGD.EQ.0) KISPGD=ISPG
         IF (KISPGT.EQ.0) KISPGT=ISPG
         IF (KISPGP.NE.ISPG.OR.KISPGD.NE.ISPG.OR.KISPGT.NE.ISPG) THEN
            WRITE(IOIMP,*) 'SPGs non concordants.'
            IRET=-4
            OK=.FALSE.
         ENDIF
         IF(IMPR.GT.5.OR.(.NOT.OK)) THEN
            WRITE(IOIMP,*) 'KISPGT=',KISPGT
            WRITE(IOIMP,*) 'KISPGP=',KISPGP
            WRITE(IOIMP,*) 'KISPGD=',KISPGD
            WRITE(IOIMP,*) 'Vérification des segments MINC...'
         ENDIF
         IMINC=0
         OK=.TRUE.
         IF (KMINCP.NE.0) IMINC=KMINCP
         IF (KMINCD.NE.0) IMINC=KMINCD
         IF (KMINC .NE.0) IMINC=KMINC
         IF (IMINC.EQ.0) THEN
            WRITE(IOIMP,*) 'Pas de supports géométriques ?'
            IRET=-5
            OK=.FALSE.
         ENDIF
         IF (KMINCP.EQ.0) KMINCP=IMINC
         IF (KMINCD.EQ.0) KMINCD=IMINC
         IF (KMINC .EQ.0) KMINC =IMINC
         IF (KMINCP.NE.IMINC.OR.KMINCD.NE.IMINC.OR.KMINC.NE.IMINC) THEN
            WRITE(IOIMP,*) 'Segments MINC non concordants.'
            IRET=-6
            OK=.FALSE.
         ENDIF
         IF(IMPR.GT.5.OR.(.NOT.OK)) THEN
            WRITE(IOIMP,*) 'KMINC =',KMINC
            WRITE(IOIMP,*) 'KMINCP=',KMINCP
            WRITE(IOIMP,*) 'KMINCD=',KMINCD
         ENDIF
      ENDIF
      SEGDES MATRIK
      IF (IRET.NE.0) GOTO 9999
*
*     Normal termination
*
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      WRITE(IOIMP,*) 'An error was detected in vermat.eso'
      RETURN
*
*     End of VERMAT
*
      END