Esope source files

   1 : C VERMAT    SOURCE    MAGN      09/07/30    21:21:08     6458           
   2 :       SUBROUTINE VERMAT(MATRIK,IMPR,IRET)
   3 : C***********************************************************************
   4 : C NOM         : VERMAT
   5 : C DESCRIPTION : 
   6 : C      Ce sous-programme vérifie l'objet matrice morse assemblée
   7 : C      du segment MATRIK (segments
   8 : C      MINC duaux et primaux identiques, nb d'inconnues...)
   9 : C      en vue de la résolution itérative.
  10 : C
  11 : C
  12 : C
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELES  : -
  18 : C***********************************************************************
  19 : C ENTREES            : MATRIK, IMPR
  20 : C ENTREES/SORTIES    : -
  21 : C SORTIES            : IRET
  22 : C CODE RETOUR (IRET) : 0 si ok
  23 : C                     <0 si problème
  24 : C     MATRIK : pointeur sur segment MATRIK de l'include SMMATRIK
  25 : C              contenant la matrice morse à vérifier
  26 : C     IMPR   : niveau d'impression (0..3)
  27 : C***********************************************************************
  28 : C VERSION    : v1, 01/04/98, version initiale
  29 : C HISTORIQUE : v1, 01/04/98, création
  30 : C HISTORIQUE :
  31 : C HISTORIQUE :
  32 : C***********************************************************************
  33 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34 : C en cas de modification de ce sous-programme afin de faciliter
  35 : C la maintenance !
  36 : C***********************************************************************
  37 :       IMPLICIT INTEGER(I-N)
  38 :       IMPLICIT REAL*8 (A-H,O-Z)
  39 : 
  40 : -INC CCOPTIO
  41 : -INC SMMATRIK
  42 :       POINTEUR KMORS.PMORS
  43 :       POINTEUR KISA.IZA
  44 :       CHARACTER*4 NOMINC
  45 :       LOGICAL OK
  46 : C***  
  47 : 
  48 :       IRET=0
  49 :       OK=.TRUE.
  50 : C     On récupère les segments utiles
  51 :       IF (IMPR.GT.5) THEN
  52 :          WRITE(IOIMP,*) 'vermat.eso : Checking MATRIK',MATRIK
  53 :       ENDIF
  54 :       SEGACT MATRIK*MOD
  55 : C Vérification des dimensions
  56 :       KMORS=KIDMAT(4)
  57 :       KISA =KIDMAT(5)
  58 :       IF (KMORS.EQ.0.OR.KISA.EQ.0) THEN
  59 :          WRITE(IOIMP,*) 'Le segment ne contient pas de matrice morse'
  60 :          WRITE(IOIMP,*) 'KMORS=',KMORS
  61 :          WRITE(IOIMP,*) 'KISA =',KISA
  62 :          IRET=-1
  63 :       ELSE
  64 :          IF(IMPR.GT.5) THEN
  65 :             WRITE(IOIMP,*) 'Vérification des dimensions...'
  66 :          ENDIF
  67 :          SEGACT KMORS
  68 :          NTT =KMORS.IA(/1)-1
  69 :          NJA =KMORS.JA(/1)
  70 :          SEGDES KMORS
  71 :          IF (KNTTT.EQ.0) KNTTT=NTT
  72 :          IF (KNTTP.EQ.0) KNTTP=NTT
  73 :          IF (KNTTD.EQ.0) KNTTD=NTT
  74 :          IF (KNTTT.NE.NTT.OR.KNTTP.NE.NTT.OR.KNTTD.NE.NTT) THEN
  75 :             WRITE(IOIMP,*) 'Dimensions non concordantes.'
  76 :             IRET=-2
  77 :             OK=.FALSE.
  78 :          ENDIF
  79 :          IF(IMPR.GT.5.OR.(.NOT.OK)) THEN
  80 :             WRITE(IOIMP,*) 'KNTTT=',KNTTT
  81 :             WRITE(IOIMP,*) 'KNTTP=',KNTTP
  82 :             WRITE(IOIMP,*) 'KNTTD=',KNTTD
  83 :             WRITE(IOIMP,*) 'NTT  =',NTT
  84 :             WRITE(IOIMP,*) 'NJA  =',NJA
  85 :             WRITE(IOIMP,*) 'Vérification des supports géométriques...'
  86 :          ENDIF
  87 :          ISPG=0
  88 :          OK=.TRUE.
  89 :          IF (KISPGP.NE.0) ISPG=KISPGP
  90 :          IF (KISPGD.NE.0) ISPG=KISPGD
  91 :          IF (KISPGT.NE.0) ISPG=KISPGT
  92 :          IF (ISPG.EQ.0) THEN
  93 :             WRITE(IOIMP,*) 'Pas de supports géométriques ?'
  94 :             IRET=-3
  95 :             OK=.FALSE.
  96 :          ENDIF
  97 :          IF (KISPGP.EQ.0) KISPGP=ISPG
  98 :          IF (KISPGD.EQ.0) KISPGD=ISPG
  99 :          IF (KISPGT.EQ.0) KISPGT=ISPG
 100 :          IF (KISPGP.NE.ISPG.OR.KISPGD.NE.ISPG.OR.KISPGT.NE.ISPG) THEN
 101 :             WRITE(IOIMP,*) 'SPGs non concordants.'
 102 :             IRET=-4
 103 :             OK=.FALSE.
 104 :          ENDIF
 105 :          IF(IMPR.GT.5.OR.(.NOT.OK)) THEN
 106 :             WRITE(IOIMP,*) 'KISPGT=',KISPGT
 107 :             WRITE(IOIMP,*) 'KISPGP=',KISPGP
 108 :             WRITE(IOIMP,*) 'KISPGD=',KISPGD
 109 :             WRITE(IOIMP,*) 'Vérification des segments MINC...'
 110 :          ENDIF
 111 :          IMINC=0
 112 :          OK=.TRUE.
 113 :          IF (KMINCP.NE.0) IMINC=KMINCP
 114 :          IF (KMINCD.NE.0) IMINC=KMINCD
 115 :          IF (KMINC .NE.0) IMINC=KMINC
 116 :          IF (IMINC.EQ.0) THEN
 117 :             WRITE(IOIMP,*) 'Pas de supports géométriques ?'
 118 :             IRET=-5
 119 :             OK=.FALSE.
 120 :          ENDIF
 121 :          IF (KMINCP.EQ.0) KMINCP=IMINC
 122 :          IF (KMINCD.EQ.0) KMINCD=IMINC
 123 :          IF (KMINC .EQ.0) KMINC =IMINC
 124 :          IF (KMINCP.NE.IMINC.OR.KMINCD.NE.IMINC.OR.KMINC.NE.IMINC) THEN
 125 :             WRITE(IOIMP,*) 'Segments MINC non concordants.'
 126 :             IRET=-6
 127 :             OK=.FALSE.
 128 :          ENDIF
 129 :          IF(IMPR.GT.5.OR.(.NOT.OK)) THEN
 130 :             WRITE(IOIMP,*) 'KMINC =',KMINC
 131 :             WRITE(IOIMP,*) 'KMINCP=',KMINCP
 132 :             WRITE(IOIMP,*) 'KMINCD=',KMINCD
 133 :          ENDIF
 134 :       ENDIF
 135 :       SEGDES MATRIK
 136 :       IF (IRET.NE.0) GOTO 9999
 137 : *
 138 : *     Normal termination
 139 : *
 140 :       RETURN
 141 : *
 142 : * Format handling
 143 : *
 144 : *
 145 : * Error handling
 146 : *
 147 :  9999 CONTINUE
 148 :       WRITE(IOIMP,*) 'An error was detected in vermat.eso'
 149 :       RETURN
 150 : *
 151 : *     End of VERMAT
 152 : *
 153 :       END
 154 : 
 155 :  
 156 :  
 157 :  
 158 :  
 159 :