CTITLESAMPFKG  -- INVERSE TRANSFORM FROM KM TO COORDINATE XM
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA    AUTHOR      JAMES SUN/BRUCE VERWEST
CA    DESIGNER    JAMES SUN/BRUCE VERWEST
CA    LANGUAGE    VS FORTRAN
CA    SYSTEM      IBM / CRAY
CA    WRITTEN     07/01/87
C     REVISED     12-04-87  BJV  INCREASED BUFFER BLOCKING ARRAY        00070009
C                                DIMENSIONS TO 39 AND 19.               00080009
C     REVISED     03-03-88  BJV  CHANGE UNBUFFERED I/O TO USE UWOPEN
C                                AND CALLS DIRECTLY TO READWA, WRITEWA
C                                AND WUNIT INSTEAD OF USING BENCHLIB.
C     REVISED     02-20-89  JJC FOR SPARC PRODUCTION.
CA
CA    SUBROUTINE SAMPFKG(IFAXX,TRIGSX,P,Q,INDEX2,IPR)
CA
CA    THE PURPOSE OF THIS SUBROUTINE IS TO PERFORM THE INVERSE SPATIAL
CA    TRANSFORM OVER THE MID-POINT WAVE NUMBERS KM AND RETURN TO THE
CA    DEPTH POINT SPATIAL GRID XM.
CA
CA**********************************************************************
CA
CA    ARGUMENTS :
C
CA    IFAXX        INPUT          ARRAY WHICH CONTAINS THE PRIME FACTORS
CA                                FOR THE GIVEN LENGTH OF THE SPATIAL
CA                                FFT AS REQUIRED BY CFFT99. THE LENGTH
CA                                IS NKX.
CA
CA    TRIGSX       INPUT          TRIG TABLES FOR THE GIVEN LENGTH OF
CA                                SPATIAL FFT AS REQUIRED BY CFFT99
CA
CA    P            INPUT/         COMPLEX ARRAY WHICH CONTAINS THE
CA                 OUTPUT         INPUT/OUTPUT TO THE PARALLEL FFT
CA                                ROUTINE CFFT99 FOR TRANSFORMING FROM
CA                                MID-POINT WAVE NUMBER KM TO MID-POINT
CA                                SPATIAL COORDINATE.
CA
CA    Q            OUTPUT         COMPLEX WORK ARRAY OF SAME LENGTH AS
CA                                P WHICH IS REQUIRED BY CFFT99 FOR
CA                                PERFORMING THE FOURIER TRANSFORMS IN
CA                                PARALLEL.
CA
CA    INDEX2       INPUT/         WORK FILE NAME FROM WHICH THE COMPLEX
CA                                MIGRATED FIELD AS A FUNCTION OF MID-
CA                                POINT WAVE NUMBER KM IS OBTAINED AND
CA                                TO WHICH THE INVERSE SPATIAL KX TRANS-
CA                                FORMED RESULT IS WRITTEN; P(W,KX).
CA                                THIS IS THE IMAGE TRACE AS A FUNCTION
CA                                OF TEMPORAL FREQUENCY.
CA
CA    IPR          INPUT          SPARC LOGICAL UNIT NUMBER FOR PRINT
CA
CA**********************************************************************
C                                                                       00080009
      SUBROUTINE SAMPFKG(IFAXX,TRIGSX,P,Q,INDEX2,IPR)
C
      COMMON/CMPFKC/IF1,LNT,LW,LW2,IW1,ALPHA,SCALE,CMIN,VMUTE,AFFR,IKHHI
      COMMON/CMPFKT/NT,DT,NW,DW,NWD2,NWD21,NWP2
      COMMON/CMPFKX/NX,DX,NKX,DKX,NKXD2,NKXD21,NKX2,NKXP2
      COMMON/CMPFKB/IKXBF(39),IWBF(19),MKXBF(39),MWBF(19),
     +              NBF,MBF,NKXBF,NWBF
C
      COMPLEX P(NWBF,1),Q(LNT/2,1)
      DIMENSION TRIGSX(1),IFAXX(1)
C
C
           CALL WUNIT(INDEX2)
C
      LH = NWBF/3
      L2 = 2*LH
      ISEQDA=1
      I2=0
      DO 300 IBF=1,MBF
C
      I1=I2+1
      I2=IWBF(IBF)
      J2=0
        DO 250 JBF=1,NBF
        JSEQDA=J2*LNT+ISEQDA
        J1=J2+1
        J2=IKXBF(JBF)
        JF1=LNT*MKXBF(JBF)
        CALL READWA(INDEX2,Q,JSEQDA,JF1,1)
        CALL WUNIT(INDEX2)
          JI=0
          DO 240 JJ=J1,J2
          JI=JI+1
  240     CALL CCOPY(MWBF(IBF),Q(I1,JI),1,P(1,JJ),1)
  250   CONTINUE
C
       CALL CFFT99(P(1,1)   ,Q,TRIGSX,IFAXX,NWBF,1,NKX,          LH,+1)
       CALL CFFT99(P(LH+1,1),Q,TRIGSX,IFAXX,NWBF,1,NKX,          LH,+1)
       CALL CFFT99(P(L2+1,1),Q,TRIGSX,IFAXX,NWBF,1,NKX,MWBF(IBF)-L2,+1)
C
      J2=0
        DO 280 JBF=1,NBF
        JSEQDA=J2*LNT+ISEQDA
        J1=J2+1
        J2=IKXBF(JBF)
        JF1=LNT*MKXBF(JBF)
        IF (MBF .GT. 1) THEN
            CALL READWA(INDEX2,Q,JSEQDA,JF1,1)
            CALL WUNIT(INDEX2)
        ELSE
            CALL ARSET(Q,JF1,0.0)
        ENDIF
          JI=0
          DO 270 JJ=J1,J2
          JI=JI+1
  270     CALL CCOPY(MWBF(IBF),P(1,JJ),1,Q(I1,JI),1)
        CALL WRITEWA(INDEX2,Q,JSEQDA,JF1,1)
        CALL WUNIT(INDEX2)
  280   CONTINUE
C
  300 CONTINUE
C
C
      RETURN
      END