      SUBROUTINE AMPLI(NSTAT,IST)
c      IMPLICIT REAL*8 (A-H,O-Z)
      INTEGER*2 IST(50,3)
      DIMENSION AZ2(4),AW(4),CUBE(500),TUBE(500)
      COMMON/FRIOUL/ X(5,500),D(50),Y(4,500)
      COMMON/DATA/ASS(5,500),FAIS(5,500),DIST(50),AZ(50),TB(500)
     *,AM(50),DT(50),NTOT
      COMMON/MODD/TK(500),R(500),NRAD,NMOD,MOD(20),NT0,EIP(500)
     *,NF(4),NLA(4)
      COMMON/FRER/QI(500)
      COMMON/SPECTR/RER(5,500),AIMR(5,500),X0(5,500),XX(5,500),XM0
      COMMON/EIGEN/AS(500),AP(500),AQ(500),CT(500),UU(500),Q(500)
     *,TT(500)
      COMMON/TDKP/TOUL(20),QI1(20),QI2(20),JOY,RAP(20)
      COMMON/COOL/EIGL(500),IWW
      COMMON/VIEL/DWGC(4,500),VPGC(4,500),ER(4)
      PRINT*,'AMPLI ENTERED'
      PI=3.1415926535
      NST1=NSTAT/2
      IF(NSTAT.EQ.1)NST1=1
      DO 234 I=1,NSTAT
234   AW(I)=NF(I)
      CALL MAXMIN(AW,1,NSTAT,AMA1,AMA2,KM)
      NL1=INT(AMA1)
      DO 235 I=1,NSTAT
235   AW(I)=NLA(I)
      CALL MAXMIN(AW,1,NSTAT,AMA1,AMA2,KM)
      NL2=INT(AMA2)
      PRINT*,'NL1',NL1,NL2
      NIE=NL2-NL1+1
      PRINT*,'NIE',NIE
      WRITE(6,114)NSTAT,NST1
C     WRITE(1,201)(ASS(1,L),L=1,NT0)
C201     FORMAT(' ASS',6E12.5)
114     FORMAT(' NSTAT NST1',2I5)
      DO 10 I=1,NST1
      IF(I.EQ.1)II=I
C     WRITE(1,110)II,AM(II)
110   FORMAT(' II AM',I5,F8.3)
      K=FLOAT(AM(II))+1
      D(K)=DIST(II)
      AZ2(K)=AZ(II)
      WRITE(6,112)IST(II,1),IST(II,2),IST(II,3)
C     WRITE(1,3000)II,K
111   FORMAT(' II K',2I5)
C     IF(IWW.EQ.1)THEN
C                 CALL COPOLE(GTHE,PHIM,THER)
C                 POL2=1.-3.*DCOS(GTHE)*DCOS(GTHE)
C                 POL1=DCOS(GTHE)
C                 READ(18,*)JOY
C                 DO 48 IHI=1,JOY
C48                READ(18,*)TOUL(IHI),QI1(IHI),QI2(IHI),RAP(IHI)
C     ENDIF
      DO 15 L=NL1,NL2
       Y(K,L)=ASS(II,L)
15     CONTINUE
c	print*,(Y(K,L),L=1,NT0)
      IND=0
      I1=II+1
20      CONTINUE
      DO 30 J=I1,NSTAT
      WRITE(6,112)IST(J,1),IST(J,2),IST(J,3)
112    FORMAT(3A2)
      IF(IST(J,1).NE.IST(II,1))GO TO 30
      IF(IST(J,2).NE.IST(II,2))GO TO 30
      IF(IST(J,3).NE.IST(II,3))GO TO 30
35     CONTINUE
      IF(J.EQ.I1)II=II+1
      IND=IND+1
      K=AM(J)+1
      PRINT*,'J K AM DIST',J,K,AM(J),DIST(K)
      D(K)=DIST(J)
      AZ2(K)=AZ(J)
c	print*,'ii,k,d(k)',II,K,D(K)
3000      FORMAT(1X,' I K ',4I5,'D',F9.3)
      DO 40 L=NL1,NL2
      XX(K,L)=X0(J,L)
      Y(K,L)=ASS(J,L)

40     continue
      PRINT*,'IND',IND
30    CONTINUE
45      CONTINUE
50      CONTINUE
C     NOB=NL2-NL1+1
C     WRITE(1,2000)IST(II,1),IST(II,2),IST(II,3)
2000      FORMAT(' STATION:',2X,3A2)
13        FORMAT(1X,2A2,1X,'DISTANCE',F11.2,2X,'AZIMUTH',2F8.2,I5)
C
C     INVERSION
C
      IF(IND.LE.1)GO TO 65
200   FORMAT(' Y',6E12.3)
      DO 70 L=NL1,NL2
       X(1,L)=Y(4,L)-Y(3,L)-Y(2,L)+Y(1,L)
        X(2,L)=Y(4,L)-Y(2,L)+Y(3,L)-Y(1,L)
      X(1,L)=-0.5*X(1,L)
      X(2,L)=-0.5*X(2,L)
      DD=D(1)+D(2)
c      PRINT*,'DD',D(1),D(2),DD
      X(2,L)=X(2,L)/DD
c	print*,'y',(y(ij,l),ij=1,4)
2500     FORMAT(' TK',F9.3,' MOYENNE FOC.=',E12.5,2X,' MOY. ATT.=',
     *E12.5)
70       CONTINUE
      DO 80 L=NL1,NL2
      X(3,L)=(Y(1,L)-Y(4,L)+2.*Y(2,L))*0.5
      X(4,L)=(2.*Y(2,L)-Y(4,L)-Y(1,L))*0.5
      XP=X(4,L)/D(1)
      X(4,L)=XP
c      X(5,L)=Y(1,L)-Y(2,L)
      WRITE(1,3500)TK(L),XX(1,L),X(3,L),XP
3500      FORMAT(' T=',F8.3,' X0=',E12.5,' X=',E12.5,2X,'ATT.MINOR ARC='
     *,E12.5)
80       CONTINUE
      WRITE(16,4020)D(1),D(2),AZ2(1),TK(NL1),TK(NL2),NIE
4020  FORMAT(2F8.2,3(1X,F6.2),1X,I3)
4021  FORMAT(F8.2,3(1X,F6.2),1X,2I3)
4030  FORMAT(10F7.4)
4050  FORMAT(10F7.3)
4040  FORMAT(9F8.2)
      WRITE(16,4004)
4004      FORMAT('ATTENUATION AND FOCUSSING')
      WRITE(16,4003)
4003      FORMAT(' PERIODE ATTMA   ATTGC   FOCMA   FOCGC')
      WRITE(16,4002)(TK(L),X(4,L),X(2,L),X(3,L),X(1,L),L=NL1,NL2)
      WRITE(6,113)II
113     FORMAT(' II',I5)
4000      FORMAT((1X,F8.2,5E12.5))
4001  FORMAT((1X,F8.2,2E12.5))
4002  FORMAT((1X,F8.2,4E12.5))
C
C   ATTENUATION ONLY
C
      DO 90 L=NL1,NL2
      X(2,L)=(Y(1,L)-Y(3,L))
      X(4,L)=(Y(2,L)-Y(1,L)+X(2,L))/2.
      X(2,L)=X(2,L)/DD
      X(4,L)=X(4,L)/D(1)
90        CONTINUE
      WRITE(16,4005)
4005      FORMAT(' ATTENUATION ONLY')
      WRITE(16,4006)
4006      FORMAT(' PERIOD ATTMA   ATTGC')
      WRITE(16,4007)(TK(L),X(4,L),X(2,L),L=NL1,NL2)
4007     FORMAT(3(F8.2,2E12.5,1X))
C
C   GREAT CIRCLE ATTENUATION ONLY
C
      DO 95 L=NL1,NL2
      X(1,L)=Y(1,L)-Y(3,L)
      X(1,L)=X(1,L)/DD
      X(2,L)=Y(2,L)-Y(4,L)
      X(2,L)=X(2,L)/DD
95       CONTINUE
      WRITE(16,4010)
4010    FORMAT(' GREAT CIRCLE VALUES')
      WRITE(16,4011)
4011     FORMAT(' PERIOD R3R1 R4R2')
      WRITE(16,4007)(TK(L),X(1,L),X(2,L),L=NL1,NL2)
      IF(II.LT.NST1)GO TO 11
      GO TO 999
65       CONTINUE
      WRITE(6,1000)IST(II,1),IST(II,2),IST(II,3),ind
1000     FORMAT(' NO INVERSION FOR STATION:',2X,3A2,'ind=',i5)
      WRITE(16,4014)D(1),D(2),AZ2(1),TK(NL1),TK(NL2),NIE,ind
4014	format(2f9.2,3f8.2,2i5)
      DO 85 L=NL1,NL2
      X(1,L)=-Y(1,L)/D(1)
85       CONTINUE
c      WRITE(16,4013)(TK(L),L=NL1,NL2)
	do l=nl1,nl2
	write(16,4008)tk(l),x(1,l)
	enddo
c	do ij=1,ind
c	write(16,4012)(y(ij,l),l=nl1,nl2)
c	enddo
4013	format(10f8.2)
4012	format(8e12.5)
4008     FORMAT(4(F8.2,E12.4,1X))
11      II=II+1
10       CONTINUE
999     CONTINUE
      RETURN
      END
