1 : C LITABS SOURCE CHAT 05/01/13 01:24:19 5004 2 : SUBROUTINE LITABS(LTAB,KTAB,NTB,NTO,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C***************************************************************************** 6 : C On cherche a lire un ensemble de NTB tables soustypes dont la liste des 7 : C soustypes se trouve dans LTAB 8 : C En retour les pointeurs sont places dans KTAB 9 : C Les NTO premiers soustypes sont obligatoires 10 : C Si la lecture a ete faite correctement en retour IRET=1 11 : C Sinon IRET=0 12 : C 13 : C***************************************************************************** 14 : DIMENSION KTAB(NTB) 15 : CHARACTER*8 LTAB(NTB),TYPE 16 : C*** 17 : C write(6,*)' ntb=',ntb,' nto=',nto 18 : IRET=0 18 : CALL INITI(KTAB,NTB,0) 19 : 20 : DO 10 I=1,NTB 20 : CALL LIRTBS(TYPE,MTABLE,IRET) 21 : C write(6,*)' apr litabs : type=',type,' mtable=',mtable,' iret=', 22 : C &iret 23 : IF(IRET.EQ.0)GO TO 30 23 : CALL OPTLI(IP,LTAB,TYPE,NTB) 24 : IF(IP.NE.0) THEN 25 : KTAB(IP)=MTABLE 26 : ENDIF 27 : 10 CONTINUE 28 : 30 CONTINUE 29 : IRET=1 30 : DO 20 I=1,NTO 31 : IF(KTAB(I).EQ.0)THEN 32 : WRITE(6,*)'On n''a pas trouve de table de soustype ',LTAB(I) 33 : IRET=0 34 : ENDIF 35 : 20 CONTINUE 36 : 37 : RETURN 38 : END 39 : 40 : 41 :
© Cast3M 2003 - All rights reserved.
Disclaimer