Télécharger tabmat.eso

Retour à la liste

Numérotation des lignes :

  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=' '
  24. CALL ACCTAB(MTAB1,'ENTIER ',J,XVALIN,CHARIN,LOGIN,IOBIN,
  25. $ TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,MTABLE)
  26. IF(TYPOBJ.EQ.'TABLE ') THEN
  27. SEGACT MTABLE,MTAB1
  28. IF(J.EQ.1) THEN
  29. LDIM1=MTAB1.MLOTAB
  30. LDIM2=MLOTAB
  31. SEGINI MXMAT
  32. ENDIF
  33. TYPOBJ='MOT '
  34. CALL ACCTAB(MTABLE,'MOT ',I,XVALIN,'SOUSTYPE',LOGIN,IOBIN,
  35. $ TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  36. IF(IERR.NE.0) RETURN
  37. IF(CHARRE(1:7).NE.'VECTEUR')THEN
  38. MOTERR(1:8) ='VECTEUR '
  39. CALL ERREUR(602)
  40. RETURN
  41. ENDIF
  42. SEGACT MTABLE
  43. DO 10 I = 1,MLOTAB
  44. TYPOBJ=' '
  45. CALL ACCTAB(MTABLE,'ENTIER ',I,XVALIN,CHARIN,LOGIN,IOBIN,
  46. $ TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  47. IF(TYPOBJ.EQ.'ENTIER '.OR.TYPOBJ.EQ.'FLOTTANT') THEN
  48. IF(TYPOBJ.EQ.'ENTIER ')XVALRE=IVALRE
  49. XMAT(J,I)=XVALRE
  50. ELSE
  51. NOUV= I-1
  52. IF(NPREC.NE.0.AND.NPREC.NE.NOUV) THEN
  53. CALL ERREUR(601)
  54. SEGSUP MXMAT
  55. RETURN
  56. ENDIF
  57. NPREC=NOUV
  58. GO TO 11
  59. ENDIF
  60. 10 CONTINUE
  61. 11 CONTINUE
  62. SEGDES MTABLE
  63. M=J
  64. ELSE
  65. M=J-1
  66. GO TO 21
  67. ENDIF
  68. 20 CONTINUE
  69. 21 CONTINUE
  70. IF(NENTRE.NE.0.AND.NENTRE.NE.NPREC) THEN
  71. CALL ERREUR (601)
  72. SEGSUP MXMAT
  73. ENDIF
  74. IF(MENTRE.NE.0.AND.MENTRE.NE.M) THEN
  75. CALL ERREUR (601)
  76. SEGSUP MXMAT
  77. ENDIF
  78. IF(NPREC.NE.LDIM2.OR.M.NE.LDIM1) THEN
  79. LDIM1=M
  80. LDIM2=NPREC
  81. SEGADJ MXMAT
  82. ENDIF
  83. N=NPREC
  84. SEGDES MXMAT,MTAB1
  85. RETURN
  86. END
  87.  
  88.  
  89.  

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