Download litabs.eso

Back to the list

   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