$debug
C-----------------------------------------------------------------------
C       L E C - V . for
C-------------------------------------------------------------------------
C
C      Lecture des fichiers vecteur et ecriture sous format .DAT 
c         pour GEOTRID, AGEOC ou G3D
C                 
C-------------------------------------------------------------------------
C
      IMPLICIT REAL*8(A-H,O-Z)
      CHARACTER*80 BID,CHN
      CHARACTER*12 FICH2,FICH3,FICH4,FICH5,FICH6
      CHARACTER*4 CHSTA, CHVIS, CHR
c
      DIMENSION DX(300),DY(300),DZ(300),SX(300),SY(300),SZ(300)
      DIMENSION CX(300),CY(300),CZ(300),RMS(300)
      DIMENSION TEX(20)
      DIMENSION JOUR(300),ISTA(300),IVIS(300),INT(150)
      DIMENSION CHSTA(300),CHVIS(300),CHR(150)
c
   91  PI=4.d0*DATAN(1.d0)
c ..............3.141592653589793D0
       RAD=PI/200.d0
      ID1=12
      ID2=13
      ID3=14      
      IZER=0
c
C----------
      write(*,*) ' Programme : LECT-V.for :'
       write(*,*) ' -----------------------'
c
c -- lecture du fichier correspondance NOM de station/ numero de station
c
      WRITE(*,*) ' Nom du fichier correspondance NOM/numero (****.cod):'
      READ(*,'(A)') FICH3
      OPEN(3,FILE=FICH3,status='OLD',err=91)
c
      READ(3,99) (TEX(I),I=1,20)
      J=0
   10 J=J+1
      READ(3,110,end=11) CHR(J),INT(J)
      WRITE(*,*) CHR(J),INT(J)
      goto 10
c
   11 NCOD=J-1 
      WRITE(*,*) ' Nom du fichier sortie (format AG3D) : ****.dat'
      READ(*,'(A)') FICH4
      OPEN(4,FILE=FICH4,status='NEW',err=91)
      WRITE(4,99) (TEX(I),I=1,20)
c
   13 WRITE(*,*) ' Nom fichier Vecteur GPPS a lire : '
      READ(*,'(A)') FICH2  
      OPEN(2,FILE=FICH2,STATUS='OLD',err=13)
   99 FORMAT(20A4)
c      write(4,*) '-----------------------------------------------------'
c
      I=0
    2 I=I+1
c
      READ(2,100,end=3) CHSTA(I),CHVIS(I),JOUR(I)
      READ(2,99,end=3) BID 
      READ(2,99,end=3) BID 
      READ(2,99,end=3) BID 
c
      READ(2,101,end=3) TDX,TDY,TDZ,TRMS
      READ(2,101,end=3) TSX,TSY,TSZ
      READ(2,101,end=3) TCX,TCY,TCZ
c
      read(2,'(A)',end=3) BID
      if(BID(1:14).EQ.'Fixed  Vector:') goto 30
      goto 31
   30 read(BID(20:29),'(F10.4)') FDX
      read(BID(35:44),'(F10.4)') FDY
      read(BID(50:59),'(F10.4)') FDZ
      READ(2,101,end=3) FSX,FSY,FSZ
      READ(2,101,end=3) FCX,FCY,FCZ
      READ(2,99,end=3) BID 
      DX(I)=FDX
      DY(I)=FDY
      DZ(I)=FDZ
      SX(I)=FSX
      SY(I)=FSY
      SZ(I)=FSZ
      CX(I)=FCX
      CY(I)=FCY
      CZ(I)=FCZ
      goto 2
   31 READ(2,99,end=3) BID 
      READ(2,99,end=3) BID 
      READ(2,99,end=3) BID
      DX(I)=TDX
      DY(I)=TDY
      DZ(I)=TDZ
      SX(I)=TSX
      SY(I)=TSY
      SZ(I)=TSZ
      CX(I)=TCX
      CY(I)=TCY
      CZ(I)=TCZ
      goto 2
c
  100 format(A4,4x,A4,1x,I3,5x)
  101 format(17x,F13.4,1X,F13.4,1x,F13.4,10x,F10.5)
  102 format(I2,2x,I3,2x,I3,1x,F12.4,1x,F8.4,2x,I2,2x,I2,2x,A4,2x,A4,I6)
  110 format(A4,I8)
c
    3 ND=I-1
c
      DO 4 I=1,ND
c
      DO 5 K=1,NCOD
      if(CHR(K).EQ.CHSTA(I)) then
   51 ISTA(I)=INT(K)
      goto 5
      else if(CHR(K).EQ.CHVIS(I)) then
   52 IVIS(I)=INT(K)
      else
      endif
    5 continue
c
      write(4,102) ID1,ISTA(I),IVIS(I),DX(I),SX(I),IZER,IZER,
     *CHSTA(I),CHVIS(I),JOUR(I)
      write(4,102) ID2,ISTA(I),IVIS(I),DY(I),SY(I),IZER,IZER,
     *CHSTA(I),CHVIS(I),JOUR(I)
      write(4,102) ID3,ISTA(I),IVIS(I),DZ(I),SZ(I),IZER,IZER,
     *CHSTA(I),CHVIS(I),JOUR(I)
    4 continue
c
      close(2)
c
      write(*,*) ' Autre fichier a lire ?'
      write(*,*) '          OUI=1 - NON=0'
      read(*,*) ISORT
      if(ISORT.EQ.1) goto 13
c
   90 write(*,*) ' -- FIN --'
      close(4)
  93  STOP
      END
c------------------------------------------------------------