1 : C TABVEC SOURCE CHAT 05/01/13 03:30:51 5004 2 : SUBROUTINE TABVEC (MTABLE,MLREEL,N) 3 : IMPLICIT INTEGER(I-N) 4 : -INC SMTABLE 5 : -INC SMLREEL 6 : -INC CCOPTIO 7 : * 8 : * transformation d'une table vecteur en listreel 9 : * 10 : * on teste d'abord le sous-type de la table puis si N n'est pas 11 : * zero on teste que le nombre d'indice trouve est bien N 12 : * 13 : LOGICAL LOGIN,LOGRE 14 : CHARACTER*8 TYPOBJ,CHARRE 15 : REAL*8 XVALIN,XVALRE 16 : CHARACTER*1 CHARIN 17 : SEGACT MTABLE 18 : TYPOBJ= 'MOT ' 18 : CALL ACCTAB(MTABLE,'MOT ',I,XVALIN,'SOUSTYPE',LOGIN,IOBIN, 19 : $ TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 20 : IF(IERR.NE.0) RETURN 21 : IF(CHARRE(1:7).NE.'VECTEUR') THEN 22 : MOTERR(1:8)='VECTEUR ' 22 : CALL ERREUR(602) 23 : RETURN 24 : ENDIF 25 : NENTRE=N 26 : SEGACT MTABLE 27 : JG=MLOTAB-1 28 : JD=0 29 : SEGINI MLREEL 30 : DO 10 I=1,MLOTAB 31 : TYPOBJ=' ' 31 : CALL ACCTAB(MTABLE,'ENTIER ',I,XVALIN,CHARIN,LOGIN,IOBIN, 32 : $ TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 33 : IF(TYPOBJ.NE.'ENTIER '.AND.TYPOBJ.NE.'FLOTTANT') GO TO 11 34 : JD=JD+1 35 : PROG(JD)=XVALRE 36 : IF(TYPOBJ.EQ.'ENTIER ') PROG(JD)=IVALRE 37 : 10 CONTINUE 38 : 11 CONTINUE 39 : IF(NENTRE.NE.0.AND.JD.NE.NENTRE) THEN 39 : CALL ERREUR(601) 40 : ENDIF 41 : IF(JD.NE.JG) THEN 42 : JG=JD 43 : SEGADJ MLREEL 44 : ENDIF 45 : N=JG 46 : SEGDES MTABLE 47 : RETURN 48 : END 49 : 50 :
© Cast3M 2003 - All rights reserved.
Disclaimer