Télécharger la plaquette Cast3M


fr en

Télécharger tabmat.eso

Retour à la liste

Numérotation des lignes : 

tabmat

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales