Esope source files

   1 : C TABMAT    SOURCE    CHAT      05/01/13    03:30:36     5004           
   2 :       SUBROUTINE TABMAT (MTAB1,MXMAT,M,N)                                       
   3 :       IMPLICIT INTEGER(I-N)
   4 : -INC SMTABLE                                                                    
   5 : -INC TMXMAT                                                                     
   6 : -INC CCOPTIO
   7 : *
   8 : *   lire une table de table-vecteur
   9 : *
  10 : *   on verifie que celle ci a la dimension M N s'ils sont non nuls 
  11 : *                                                                   
  12 :       LOGICAL LOGIN,LOGRE                                                       
  13 :       CHARACTER*8 TYPOBJ,CHARRE                                                 
  14 :       REAL*8 XVALIN,XVALRE                                                      
  15 :       CHARACTER*1 CHARIN                                                        
  16 :       MXMAT=0                                                                   
  17 :       SEGACT MTAB1 
  18 :       MENTRE=M
  19 :       NENTRE=N
  20 :       NPREC=0                                                 
  21 :       M=MTAB1.MLOTAB                                                    
  22 :       DO 20 J =1,MTAB1.MLOTAB                                                   
  23 :       TYPOBJ=' '                                                                
  23 :       CALL ACCTAB(MTAB1,'ENTIER  ',J,XVALIN,CHARIN,LOGIN,IOBIN,                 
  24 :      $             TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,MTABLE)                    
  25 :       IF(TYPOBJ.EQ.'TABLE   ')  THEN     
  26 :         SEGACT MTABLE,MTAB1
  27 :         IF(J.EQ.1) THEN
  28 :           LDIM1=MTAB1.MLOTAB
  29 :           LDIM2=MLOTAB
  30 :           SEGINI MXMAT
  31 :         ENDIF
  32 :        TYPOBJ='MOT     '  
  32 :        CALL ACCTAB(MTABLE,'MOT     ',I,XVALIN,'SOUSTYPE',LOGIN,IOBIN,  
  33 :      $            TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  34 :        IF(IERR.NE.0) RETURN
  35 :        IF(CHARRE(1:7).NE.'VECTEUR')THEN
  36 :           MOTERR(1:8) ='VECTEUR '
  36 :           CALL ERREUR(602)   
  37 :           RETURN
  38 :         ENDIF
  39 :        SEGACT MTABLE               
  40 :       DO 10 I = 1,MLOTAB                                                  
  41 :            TYPOBJ=' '                                                           
  41 :         CALL ACCTAB(MTABLE,'ENTIER  ',I,XVALIN,CHARIN,LOGIN,IOBIN,           
  42 :      $                TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)            
  43 :            IF(TYPOBJ.EQ.'ENTIER  '.OR.TYPOBJ.EQ.'FLOTTANT') THEN   
  44 :               IF(TYPOBJ.EQ.'ENTIER  ')XVALRE=IVALRE
  45 :               XMAT(J,I)=XVALRE
  46 :            ELSE
  47 :               NOUV= I-1
  48 :               IF(NPREC.NE.0.AND.NPREC.NE.NOUV) THEN
  48 :                  CALL ERREUR(601)
  49 :                  SEGSUP MXMAT
  50 :                  RETURN
  51 :               ENDIF
  52 :               NPREC=NOUV
  53 :               GO TO 11
  54 :            ENDIF
  55 :    10  CONTINUE
  56 :    11  CONTINUE
  57 :        SEGDES MTABLE
  58 :        M=J
  59 :       ELSE
  60 :        M=J-1
  61 :        GO TO 21
  62 :       ENDIF
  63 :    20 CONTINUE
  64 :    21 CONTINUE
  65 :       IF(NENTRE.NE.0.AND.NENTRE.NE.NPREC) THEN
  65 :         CALL ERREUR (601)
  66 :         SEGSUP MXMAT
  67 :       ENDIF
  68 :       IF(MENTRE.NE.0.AND.MENTRE.NE.M) THEN
  68 :         CALL ERREUR (601)
  69 :         SEGSUP MXMAT
  70 :       ENDIF
  71 :       IF(NPREC.NE.LDIM2.OR.M.NE.LDIM1) THEN
  72 :         LDIM1=M
  73 :         LDIM2=NPREC
  74 :         SEGADJ MXMAT   
  75 :       ENDIF
  76 :       N=NPREC
  77 :       SEGDES MXMAT,MTAB1                                                       
  78 :       RETURN                                                                    
  79 :       END                                                                       
  80 :  
  81 :