$debug
C-----------------------------------------------------------------------
C       L E C T - S . for
C-------------------------------------------------------------------------
C
C      Lecture des fichiers "o", issus de GPPS et ecriture
c         sous format  .STA  et  .DAT (vecteur, distance ou vect.simplifi‚) 
c         pour GEOTRID, AGEOC ou G3D
C      sortie sous 3 formes  .STA,  .VEC,  et  .DIS           
c
c      J.C. Ruegg - octobre 1993
C-------------------------------------------------------------------------
C
      IMPLICIT REAL*8(A-H,O-Z)
      CHARACTER*80 BID,CHN
      CHARACTER*20 TITRE
      CHARACTER*12 FICH2,FICH3,FICH4,FICH5,FICH6
      CHARACTER*8 FIC
      CHARACTER*4 CHSTA, CHVIS, CHR , TSOL
c
      DIMENSION XSTA(300),YSTA(300),ZSTA(300)
      DIMENSION XVIS(300),YVIS(300),ZVIS(300)
      DIMENSION DX(300),DY(300),DZ(300),SX(300),SY(300),SZ(300)
      DIMENSION CX(300),CY(300),CZ(300),RMS(300),DD(300)
      DIMENSION TEX(20)
      DIMENSION JOUR(300),ISTA(300),IVIS(300),JSOL(300),INT(50)
      DIMENSION CHSTA(300),CHVIS(300),CHR(50),TSOL(300),FIC(300)
c
   98  PI=4.d0*DATAN(1.d0)
c ..............3.141592653589793D0
       RAD=PI/200.d0
      ID1=12
      ID2=13
      ID3=14      
      IF=1
      FZ=1.000
      IZER=0
c
C----------
      write(*,*) ' Programme : LECT-S.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=98)
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 
c
      WRITE(*,*) ' Type de sortie : '
      WRITE(*,*) '      - fichier station (.STA): 1 '
      WRITE(*,*) '      - fichier vecteur (.VEC): 2 '
      WRITE(*,*) '      - fichier station (.DIS): 3 '
      WRITE(*,*) '      - les 3 types :           4 '
      WRITE(*,*) '      - fichier vect. simpl.:   5 '
c
      READ(*,*) JSOR
c
      WRITE(*,*) ' Nom du fichier sortie (format AG3D) :'
      READ(*,'(A)') FICH5
      OPEN(5,FILE=FICH5,status='NEW',err=98)
c
      if(JSOR.EQ.1) TITRE='Coord. approch‚es : '
      if(JSOR.EQ.2) TITRE='Donn‚es VECTEURS  : '
      if(JSOR.EQ.3) TITRE='Donn‚es DISTANCES : '
      if(JSOR.EQ.4) TITRE='STA.- VECT.- DIST.: '
      if(JSOR.EQ.5) TITRE='Vecteur simplifi‚ : '
c
      WRITE(5,'(A12,3x,A20)') FICH5,TITRE
c
      I=0
c
   14 WRITE(*,*) ' Nom fichier S (resum‚ GPPS) a lire : '
      READ(*,'(A)') FICH2  
   13 OPEN(2,FILE=FICH2,STATUS='OLD',err=14)
   99 FORMAT(20A4)
c
c
    1 read(2,'(A)',end=3) BID
      if(BID(1:14).EQ.'VECTOR SUMMARY') goto 20
      if(BID(1:9).EQ.' Station1') goto 23
c
      if(BID(10:16).EQ.'CorrHI:') goto 21
      if(BID(1:9).EQ.' E1 N1 U1') goto 22
c
      if(BID(1:9).EQ.'THE FLOAT') goto 30
      if(BID(1:9).EQ.'THE FIXED') goto 31
c
      goto 1
c
   20 I=I+1
      read(BID(16:19),'(A)') CHSTA(I)
      read(BID(24:27),'(A)') CHVIS(I)
      read(FICH2(1:8),'(A)') FIC(I)
      goto 1
c
   21 read(2,'(14x,3(F13.4,1x))') XSTA(I),YSTA(I),ZSTA(I)
      write(*,104) I,CHSTA(I), XSTA(I),YSTA(I),ZSTA(I)
      goto 1
c
   22 read(2,'(14x,3(F13.4,1x))') XVIS(I),YVIS(I),ZVIS(I)
      write(*,104) I,CHVIS(I), XVIS(I),YVIS(I),ZVIS(I)
  104 format(I3,1x,A4,1x,3(1X,F12.4))
      goto 1
c
   23 read(2,'(A)') BID
      read(2,'(20x,I3)') JOUR(I)
      goto 1
c
   30 TSOL(I)=' Fl.'
      read(2,'(A)',end=3) BID
      if(BID(1:7).NE.'Vector:') goto 30
      read(BID(9:22),'(F14.4)') FDX
      read(BID(24:37),'(F14.4)') FDY
      read(BID(39:52),'(F14.4)') FDZ
cc      read(2,'(7x,3(1x,F14.4))') FDX,FDY,FDZ
      DX(I)=FDX
      DY(I)=FDY
      DZ(I)=FDZ
      DD(I)=dsqrt(FDX**2+FDY**2+FDZ**2)
      read(2,'(7x,3(6x,F9.4))') SDX,SDY,SDZ
      SX(I)=SDX
      SY(I)=SDY
      SZ(I)=SDZ
      read(2,'(15x,F5.2,10x,F5.2,10x,F5.2)') CRX,CRY,CRZ
      CX(I)=CRX
      CY(I)=CRY
      CZ(I)=CRZ
c
      write(*,105) I,CHSTA(I),CHVIS(I),FDX,FDY,FDZ,TSOL(I)
      write(*,106) SDX,SDY,SDZ
      write(*,106) CRX,CRY,CRZ
  105 format(I3,1x,A4,1x,A4,1X,3(1X,F12.4),2x,A4)
  106 format(14x,3(1X,F12.4))
c
      goto 1
c
   31 TSOL(I)=' Fx.'
      read(2,'(A)',end=3) BID
      if(BID(1:12).EQ.'NOT COMPUTED') goto 35
      if(BID(1:7).NE.'Vector:') goto 31
      read(BID(9:22),'(F14.4)') FDX
      read(BID(24:37),'(F14.4)') FDY
      read(BID(39:52),'(F14.4)') FDZ
cc      read(2,'(7x,3(1x,F14.4))') FDX,FDY,FDZ
      DX(I)=FDX
      DY(I)=FDY
      DZ(I)=FDZ
      DD(I)=dsqrt(FDX**2+FDY**2+FDZ**2)
      read(2,'(7x,3(6x,F9.4))') SDX,SDY,SDZ
      SX(I)=SDX
      SY(I)=SDY
      SZ(I)=SDZ
      read(2,'(15x,F5.2,10x,F5.2,10x,F5.2)') CRX,CRY,CRZ
      CX(I)=CRX
      CY(I)=CRY
      CZ(I)=CRZ
      write(*,105) I,CHSTA(I),CHVIS(I),FDX,FDY,FDZ,TSOL(I)
      write(*,106) SDX,SDY,SDZ
      write(*,106) CRX,CRY,CRZ
      goto 1
c
   35 TSOL(I)=' Fl.'
      goto 1
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
     *,2x,A4,1x,A8)
  110 format(A4,I8)
c
c
    3 close(2)
      write(*,*) ' Fichier a lire (ou FIN) ?'
      read(*,'(A)') FICH2
      if(FICH2.EQ.'FIN') goto 15
      if(FICH2.EQ.'fin') goto 15
      if(FICH2.EQ.'     FIN') goto 15
      if(FICH2.EQ.'     fin') goto 15
      goto 13
c -------------------------
   15  ND=I
c
      goto (6,7,8,6,9) JSOR
c
    6 DO 61 I=1,ND
c
      DO 65 K=1,NCOD
      if(CHR(K).EQ.CHSTA(I)) then
        ISTA(I)=INT(K)
      goto 65
      else if(CHR(K).EQ.CHVIS(I)) then
        IVIS(I)=INT(K)
	      else
      endif
   65 continue
c
      write(5,103) IF,ISTA(I),XSTA(I),YSTA(I),ZSTA(I),FZ,FZ,FZ,
     *CHSTA(I),JOUR(I)
      write(5,103) IF,IVIS(I),XVIS(I),YVIS(I),ZVIS(I),FZ,FZ,FZ,
     *CHVIS(I),JOUR(I)
   61 continue
      if(JSOR.NE.4) goto 90
c -----------------
    7 DO 71 I=1,ND
c
      DO 75 K=1,NCOD
      if(CHR(K).EQ.CHSTA(I)) then
         ISTA(I)=INT(K)
      goto 75
      else if(CHR(K).EQ.CHVIS(I)) then
         IVIS(I)=INT(K)
	      else
      endif
   75 continue
c
      write(5,102) ID1,ISTA(I),IVIS(I),DX(I),SX(I),IZER,IZER,
     *CHSTA(I),CHVIS(I),JOUR(I),TSOL(I),FIC(I)
      write(5,102) ID2,ISTA(I),IVIS(I),DY(I),SY(I),IZER,IZER,
     *CHSTA(I),CHVIS(I),JOUR(I),TSOL(I),FIC(I)
      write(5,102) ID3,ISTA(I),IVIS(I),DZ(I),SZ(I),IZER,IZER,
     *CHSTA(I),CHVIS(I),JOUR(I),TSOL(I),FIC(I)
c
   71 continue
      if(JSOR.NE.4) goto 90
c -------------
    8 DO 81 I=1,ND
c
      DO 85 K=1,NCOD
      if(CHR(K).EQ.CHSTA(I)) then
          ISTA(I)=INT(K)
      goto 85
      else if(CHR(K).EQ.CHVIS(I)) then
          IVIS(I)=INT(K)
	      else
      endif
   85 continue
c
      SDD=dsqrt(SX(I)**2+SY(I)**2+SZ(I)**2)
      write(5,102) IF,ISTA(I),IVIS(I),DD(I),SDD,IZER,IZER,
     *CHSTA(I),CHVIS(I),JOUR(I),TSOL(I),FIC(I)
c
   81 continue
c -------------
c -------------
    9 DO 91 I=1,ND
c
      DO 95 K=1,NCOD
      if(CHR(K).EQ.CHSTA(I)) then
	  ISTA(I)=INT(K)
      goto 95
      else if(CHR(K).EQ.CHVIS(I)) then
	  IVIS(I)=INT(K)
	      else
      endif
   95 continue
c
      SDD=dsqrt(SX(I)**2+SY(I)**2+SZ(I)**2)
      write(5,109) DD(I),SDD,DX(I),DY(I),DZ(I),
     *CHSTA(I),CHVIS(I),JOUR(I),TSOL(I),FIC(I)
  109 format(1x,F10.3,1x,F5.3,3(1x,F10.3),2(1x,A4),1x,
     *I3,A4,1X,A8)
c
   91 continue
c -------------
  103 format(I1,2x,I3,3(1X,F12.3),1x,3(2x,F5.3),1x,A4,1x,'J',I4)
c
c -------------------------
   90 write(*,*) ' -- FIN --'
      close(5)
  93  STOP
      END
c------------------------------------------------------------