Numérotation des lignes :

tabmat
C TABMAT    SOURCE    CHAT      05/01/13    03:30:36     5004      SUBROUTINE TABMAT (MTAB1,MXMAT,M,N)      IMPLICIT INTEGER(I-N)-INC SMTABLE-INC TMXMAT -INC PPARAM-INC CCOPTIO**   lire une table de table-vecteur**   on verifie que celle ci a la dimension M N s'ils sont non nuls*      LOGICAL LOGIN,LOGRE      CHARACTER*8 TYPOBJ,CHARRE      REAL*8 XVALIN,XVALRE      CHARACTER*1 CHARIN      MXMAT=0      SEGACT MTAB1      MENTRE=M      NENTRE=N      NPREC=0      M=MTAB1.MLOTAB      DO 20 J =1,MTAB1.MLOTAB      TYPOBJ=' '      CALL ACCTAB(MTAB1,'ENTIER  ',J,XVALIN,CHARIN,LOGIN,IOBIN,     $TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,MTABLE) IF(TYPOBJ.EQ.'TABLE ') THEN SEGACT MTABLE,MTAB1 IF(J.EQ.1) THEN LDIM1=MTAB1.MLOTAB LDIM2=MLOTAB SEGINI MXMAT ENDIF TYPOBJ='MOT ' CALL ACCTAB(MTABLE,'MOT ',I,XVALIN,'SOUSTYPE',LOGIN,IOBIN,$            TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)       IF(IERR.NE.0) RETURN       IF(CHARRE(1:7).NE.'VECTEUR')THEN          MOTERR(1:8) ='VECTEUR '          CALL ERREUR(602)          RETURN        ENDIF       SEGACT MTABLE      DO 10 I = 1,MLOTAB           TYPOBJ=' '        CALL ACCTAB(MTABLE,'ENTIER  ',I,XVALIN,CHARIN,LOGIN,IOBIN,     \$                TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)           IF(TYPOBJ.EQ.'ENTIER  '.OR.TYPOBJ.EQ.'FLOTTANT') THEN              IF(TYPOBJ.EQ.'ENTIER  ')XVALRE=IVALRE              XMAT(J,I)=XVALRE           ELSE              NOUV= I-1              IF(NPREC.NE.0.AND.NPREC.NE.NOUV) THEN                 CALL ERREUR(601)                 SEGSUP MXMAT                 RETURN              ENDIF              NPREC=NOUV              GO TO 11           ENDIF   10  CONTINUE   11  CONTINUE       SEGDES MTABLE       M=J      ELSE       M=J-1       GO TO 21      ENDIF   20 CONTINUE   21 CONTINUE      IF(NENTRE.NE.0.AND.NENTRE.NE.NPREC) THEN        CALL ERREUR (601)        SEGSUP MXMAT      ENDIF      IF(MENTRE.NE.0.AND.MENTRE.NE.M) THEN        CALL ERREUR (601)        SEGSUP MXMAT      ENDIF      IF(NPREC.NE.LDIM2.OR.M.NE.LDIM1) THEN        LDIM1=M        LDIM2=NPREC        SEGADJ MXMAT      ENDIF      N=NPREC      SEGDES MXMAT,MTAB1      RETURN      END   

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