C
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CTITLESADM3DI- 45 DEGREE PHASE SHIFT AND FREQUENCY-DEPENDENT GAIN FACTOR
CA
CA   DESIGNER     JAMES SUN
CA   AUTHOR       JAMES SUN
CA   LANGUAGE     FORTRAN 77
CA   SYSTEM       CRAY AND IBM
CA   WRITTEN      12/03/87
C    REVISED      12/17/91  JJC - MODIFIED TO MEET SPARC STANDARDS.
CA
CA
CA CALLING PROCEDURE:
CA     SUBROUTINE SADM3DI(OTR,WSQRT,Q,WORKN)
CA
C   CALLING ARGUMENTS
CA
CA     IN/OUT    OTR   = INPUT DATA                                R4
CA     INPUT     WSQRT = ARRAY STROING SQUARE ROOT OF FREQUIENCIES R4
CA     IN/OUT    Q     = COMPLEX INPUT / OUTPUT ARRAY              C4
CA     INPUT     WORKN = WORK ARRAY                                R4
C
      SUBROUTINE SADM3DI(OTR,WSQRT,Q,WORKN)                             19780027
C                                                                       19800006
      IMPLICIT INTEGER (A-Z)
C
      COMMON  /USER/ SLOCAL(50),ULOCAL(220)                             19810016
C                                                                       19820016
C
      EQUIVALENCE (IPR     , ULOCAL( 56))                               19870016
      EQUIVALENCE (NT      , ULOCAL(132))                               19870016
      EQUIVALENCE (NW      , ULOCAL(137))                               19880016
      EQUIVALENCE (NWD2    , ULOCAL(138))                               04390015
      EQUIVALENCE (NWD21   , ULOCAL(139))                               04400015
C                                                                       19900016
C
      REAL         OTR(1)                                               19940006
      REAL       WORKN(1)                                               19940006
      REAL       WSQRT(1)                                               19960006
      COMPLEX        Q(1)                                               19980006
C                                                                       20020006
C                                                                       20020006
      CALL ARSET(Q,NW+2,0.0)
      CALL SCOPY(NT,OTR,1,Q,1)
C                                                                       20020006
C
      CALL RCFFT2(0,-1,NW,Q,WORKN,Q)                                    20030006
C                                                                       20040006
C
      Q(NWD21)=0.                                                       20060006
C                                                                       20070006
C
      DO 100 IW=1,NWD2                                                  20090009
  100 Q(IW)=Q(IW)*CMPLX(WSQRT(IW),-WSQRT(IW))                           20100009
C                                                                       20070006
C
      CALL CRFFT2(0,+1,NW,Q,WORKN,Q)                                    20030006
C                                                                       20110006
C
      CALL SCOPY(NT,Q,1,OTR,1)
C                                                                       20110006
C                                                                       20110006
      RETURN                                                            20140006
      END                                                               20150006