#ifdef propagation2

SUBROUTINE propags2 (isub, ijss, ijll, ijsst, ijllt)
USE params ; USE cbound ; USE current ; USE fredir  ; USE gridpar
USE map    ; USE ndtf   ; USE refdot  ; USE shallow ; USE source
USE stat   ; USE testo  ; USE ubuf
USE spe,only:FL1,FL3
IMPLICIT NONE

INTEGER, INTENT(IN) :: isub, ijss, ijll, ijsst, ijllt
INCLUDE'globals.h'
REAL, PARAMETER  :: CO = 1.1
REAL, ALLOCATABLE:: DCO(:)   , DP1(:)   , DP2(:)    , DPN(:) , DPS(:)
REAL, ALLOCATABLE:: DLE(:)   , DLW(:)   , DLA(:)    , DPHD(:), DLAD(:)
REAL, ALLOCATABLE:: DOP(:)   , DOM(:)   , DTP(:)    , DTM(:) , DRGP(:)
REAL, ALLOCATABLE:: DRDP(:)  , DRDM(:)  , DRCP(:)   , DRCM(:)
REAL, ALLOCATABLE:: DTC(:)   , CGOND(:) , DTCD(:)   , DPH(:)
REAL, ALLOCATABLE:: DLSW(:)  , DLSE(:)  , DLNW(:)   , DLNE(:)
REAL, ALLOCATABLE:: SDTT(:)  , DNOO(:)  , DEAO(:)   , DRGM(:)
REAL, ALLOCATABLE:: COLOIO(:), COLAIN(:), COLAOUT(:)
REAL, ALLOCATABLE:: DNOI(:)  , DEAI(:)  , SCROSS(:)
REAL, ALLOCATABLE:: SDIAGO(:)

INTEGER:: M, K, IG, IJ, JH, KM1, KP1, MM1, MP1
INTEGER:: IJLONG, IJLATI, IJDIAG, IJLONGO, IJLATIO, IJDIAGO
REAL   :: CD, SD, SM, SP
REAL   :: CDD, CGC, CGS, DEA, DFM, DFP, DNO, DTT, SDD
REAL   :: CGCD, CGSD, DLEA, DLWE, DPNO, DPSO, DTHP, DTHM
REAL   :: CFATT1, CFATT2, COLONG, COLATI, CROSS
REAL   :: DELFR0, DELPRO, DELPH0, DELLA0, DELTH0
REAL   :: DIAGO, DLNOEA, DLNOWE, DLSOEA, DLSOWE, TANPH
! ----------------------------------------------------------------------
!*    0. SPECTRUM AT LAND TO ZERO.
!        -------------------------
IG = 1
DO M = 1, NFRE
   DO K = 1, NANG
      FL3 (0, K, M) = 0.
   ENDDO
ENDDO
!*    0.1 READ REFRACTION DOT TERMS.
!         --------------------------
!NNIKOS IS IT PARALELISED ?
IF ( (IREFRA.NE.0) .AND. (ISUB.EQ.1) ) CALL dotdc (ijss, ijll, ig, &
                                                   igl, ishallo, irefra)
!*    0.2 SPHERICAL OR CARTESIAN GRID?
!         ----------------------------
ALLOCATE(DCO(IJSST:IJLLT)) ;  ALLOCATE(DP1(IJSS:IJLL)) ; ALLOCATE(DP2(IJSS:IJLL))

IF (ICASE.EQ.1) THEN
!*    0.2.1 SPHERICAL GRID.
!           ---------------
!*    0.2.1.1 COSINE OF LATITUDE.
!             -------------------
   DO IJ = IJSST, IJLLT
      JH = KXLT (IJ, IG)
      DCO (IJ) = 1. / COSPH (JH)
   ENDDO
!*    0.2.1.2 COMPUTE COS PHI FACTOR FOR ADJOINING GRID POINT.
!             ------------------------------------------------
   DO IJ = IJSS, IJLL
      JH = KLAT (IJ, 1)
      IF (JH.LE.0) THEN
         DP1 (IJ) = 1.
      ELSE
         DP1 (IJ) = DCO (IJ) / DCO (JH)
      ENDIF
      JH = KLAT (IJ, 2)
      IF (JH.LE.0) THEN
         DP2 (IJ) = 1.
      ELSE
         DP2 (IJ) = DCO (IJ) / DCO (JH)
      ENDIF
   ENDDO
   IF (IREFRA.NE.2) THEN
!*       BRANCH TO 3. IF WITHOUT REFRACTION OR DEPTH.
!        --------------------------------------------
      GOTO 3000
   ELSE
!*       BRANCH TO 4. IF DEPTH AND CURRENT REFRACTION.
!        ---------------------------------------------
      GOTO 4000
   ENDIF
ELSE
!*    0.2.2 CARTESIAN GRID.
!           ---------------
!*    0.2.2.1 BRANCH TO 2. IF DEPTH AND CURRENT REFRACTION.
!             ---------------------------------------------
   IF (IREFRA.EQ.2) GOTO 2000
ENDIF
! ----------------------------------------------------------------------
!*    1. PROPAGATION FOR CARTESIAN GRID
!*       WITHOUT REFRACTION OR DEPTH REFRATION.
!        --------------------------------------
1000 CONTINUE
!     DELPRO = FLOAT(IDELPRO)
DELPRO = FLOAT (IDTMIN)
DELPH0 = DELPRO / DELPHI
DELLA0 = DELPRO / DELLAM
DELTH0 = 0.25 * DELPRO / DELTH

ALLOCATE(DRDP(IJSS:IJLL))   ; ALLOCATE(DRDM(IJSS:IJLL)) ; ALLOCATE(CGOND(0:NIBLO))
ALLOCATE(DNOO(IJSS:IJLL))   ; ALLOCATE(DEAO(IJSS:IJLL)) ; ALLOCATE(SDTT(IJSS:IJLL))
ALLOCATE(DNOI(IJSS:IJLL))   ; ALLOCATE(DEAI(IJSS:IJLL)) ; ALLOCATE(SCROSS(IJSS:IJLL))
ALLOCATE(SDIAGO(IJSS:IJLL)) ; ALLOCATE(DTC(IJSS:IJLL)) ; ALLOCATE(DTP(IJSS:IJLL))
ALLOCATE(DTM(IJSS:IJLL))
!*    1.1 LOOP OVER DIRECTIONS.
!         ---------------------
DO K = 1, NANG
   SD = SINTH (K)
   CD = COSTH (K)
!     1.1.1 INDEX FOR ADJOINING POINTS
!           --------------------------
!      COEFFICIENTS INITIALIZATION
   CFATT1 = 0.
   CFATT2 = 0.
   COLONG = 0.
   COLATI = 0.
!1     0<=ALFA<45
   IF (SD.GE.0..AND.CD.GT.0..AND.ABS (SD) .LT.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 1
      IJDIAG = 3
      IJLONGO = 1
      IJLATIO = 2
      IJDIAGO = 6
      CFATT1 = 1.
      COLATI = 1.
!2     45<=ALFA<90
   ELSEIF (SD.GT.0..AND.CD.GT.0..AND.ABS (SD) .GE.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 1
      IJDIAG = 3
      IJLONGO = 2
      IJLATIO = 1
      IJDIAGO = 6
      CFATT2 = 1.
      COLONG = 1.
!3     90<=ALFA<135
   ELSEIF (SD.GT.0..AND.CD.LE.0..AND.ABS (SD) .GT.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 1
      IJDIAG = 4
      IJLONGO = 2
      IJLATIO = 1
      IJDIAGO = 5
      CFATT2 = 1.
      COLONG = 1.
!4     135<=ALFA<180
   ELSEIF (SD.GT.0..AND.CD.LT.0..AND.ABS (SD) .LE.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 2
      IJDIAG = 4
      IJLONGO = 1
      IJLATIO = 1
      IJDIAGO = 5
      CFATT1 = 1.
      COLATI = 1.
!5     180<=ALFA<225
   ELSEIF (SD.LE.0..AND.CD.LT.0..AND.ABS (SD) .LT.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 2
      IJDIAG = 6
      IJLONGO = 1
      IJLATIO = 1
      IJDIAGO = 3
      CFATT1 = 1.
      COLATI = 1.
!6     225<=ALFA<270
   ELSEIF (SD.LT.0..AND.CD.LT.0..AND.ABS (SD) .GE.ABS (CD) ) THEN
      IJLONG = 2
      IJLATI = 1
      IJDIAG = 6
      IJLONGO = 1
      IJLATIO = 1
      IJDIAGO = 3
      CFATT2 = 1.
      COLONG = 1.
!7     270<=ALFA<315
   ELSEIF (SD.LT.0..AND.CD.GE.0..AND.ABS (SD) .GT.ABS (CD) ) THEN
      IJLONG = 2
      IJLATI = 1
      IJDIAG = 5
      IJLONGO = 1
      IJLATIO = 1
      IJDIAGO = 4
      CFATT2 = 1.
      COLONG = 1.
!8     315<=ALFA<0
   ELSEIF (SD.LT.0..AND.CD.GT.0..AND.ABS (SD) .LE.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 1
      IJDIAG = 5
      IJLONGO = 1
      IJLATIO = 2
      IJDIAGO = 4
      CFATT1 = 1.
      COLATI = 1.
   ENDIF
   SD = SINTH (K) * DELLA0
   CD = COSTH (K) * DELPH0

   IF (ISHALLO.EQ.1) THEN
!*    1.1.2 DEEP WATER.
!           -----------
      SD = ABS (SD)
      CD = ABS (CD)
!*    1.1.2.1 LOOP OVER FREQUENCIES.
!             ----------------------
      DO M = 1, NFRE
         IF (MOD (ISUB, NDTADF (M) ) .EQ.0) THEN
            IDELFD = NDTADF (M)
!*    1.1.2.1.1 LOOP OVER GRIDPOINTS.
!               ---------------------
            DNO = CD * GOM (M) * NDTADF (M)
            DEA = SD * GOM (M) * NDTADF (M)
            DTT = CFATT1 * (1 - DNO) + CFATT2 * (1 - DEA)
            CROSS = CFATT1 * (DNO - DEA) + CFATT2 * (DEA - DNO)
            DIAGO = CFATT1 * DEA + CFATT2 * DNO
            DO IJ = IJSS, IJLL
!          ADVECTION MACHINE
               FL3(IJ,K,M) = DTT * FL1 (IJ, K, M)                            &
                            +COLONG * CROSS * FL1 (KLON (IJ, IJLONG), K, M)  &
                            +COLATI * CROSS * FL1 (KLAT (IJ, IJLATI), K, M)  &
                            +DIAGO * FL1(KLAT (IJ, IJDIAG), K, M)
            ENDDO
!*    BRANCH BACK TO 1.1.2.1 FOR NEXT FREQUENCY.
         ENDIF
      ENDDO
   ELSE
!SHALLOW
!*    1.1.3 SHALLOW WATER.
!           --------------
      SD = 0.5 * ABS (SD)
      CD = 0.5 * ABS (CD)
!*    1.1.3.1 DEPTH REFRACTION.
!             -----------------
      IF (IREFRA.EQ.1) THEN
         KP1 = K + 1
         IF (KP1.GT.NANG) KP1 = 1
         KM1 = K - 1
         IF (KM1.LT.1) KM1 = NANG
         DO IJ = IJSS, IJLL
            DRDP (IJ) = (THDD (IJ, K) + THDD (IJ, KP1) ) * DELTH0
            DRDM (IJ) = (THDD (IJ, K) + THDD (IJ, KM1) ) * DELTH0
         ENDDO
      ENDIF
!*    1.1.3.2 LOOP OVER FREQUENCIES.
!             ----------------------
      DO M = 1, NFRE
         IF (MOD (ISUB, NDTADF (M) ) .EQ.0) THEN
            IDELFD = NDTADF (M)
!*    1.1.3.2.1 GROUP VELOCITIES.
!               -----------------
            CGOND (0) = TCGOND (NDEPTH, M)
            DO IJ = IJSST, IJLLT
               CGOND (IJ) = TCGOND (INDEP (IJ), M)
            ENDDO
!*    1.1.3.2.2 WEIGHTS IN INTEGRATION SCHEME.
!               ------------------------------
            DO IJ = IJSS, IJLL
               DNOO (IJ) = CD * (CGOND (IJ) + CGOND (KLAT (IJ, IJLATIO) ) )
               DEAO (IJ) = SD * (CGOND (IJ) + CGOND (KLAT (IJ, IJLONGO) ) )
               SDTT (IJ) = CFATT1 * (1 - DNOO (IJ) * NDTADF (M) )                      &
                          +CFATT2 * (1 - DEAO (IJ) * NDTADF (M) )
               DNOI (IJ) = CD * (CFATT1 * (CGOND (IJ) + CGOND ( KLAT (IJ, IJLATI) ) )  &
                               + CFATT2 * (CGOND (IJ) + CGOND (KLAT (IJ, IJDIAG) ) )  )
               DEAI (IJ) = SD * (CFATT1 * (CGOND (IJ) + CGOND (KLAT (IJ, IJDIAG) ) )   &
                                +CFATT2 * (CGOND (IJ) + CGOND (KLON (IJ, IJLONG) ) ) )
               SCROSS (IJ) = CFATT1 * (DNOI (IJ) - DEAI (IJ) )                         &
                            +CFATT2 * (DEAI (IJ) - DNOI (IJ) )
               SDIAGO (IJ) = CFATT1 * DEAI (IJ) + CFATT2 * DNOI ( IJ)
            ENDDO

            IF (IREFRA.EQ.1) THEN
               DO IJ = IJSS, IJLL
                  DTHP = FCONST (IJ, M) * DRDP (IJ)
                  DTHM = FCONST (IJ, M) * DRDM (IJ)
                  DTC (IJ) = DTC (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
                  DTP (IJ) = - DTHP + ABS (DTHP)
                  DTM (IJ) = DTHM + ABS (DTHM)
               ENDDO
            ENDIF
!*    1.1.3.2.3 LOOP OVER GRIDPOINTS.
!               ---------------------
            DO IJ = IJSS, IJLL
               FL3(IJ,K,M) = SDTT(IJ) * FL1(IJ,K,M)                                     &
                            +COLONG * SCROSS(IJ) * FL1(KLON(IJ,IJLONG),K,M) * NDTADF(M) &
                            +COLATI * SCROSS(IJ) * FL1(KLAT(IJ,IJLATI),K,M) * NDTADF(M) &
                            +SDIAGO(IJ) * FL1(KLAT(IJ,IJDIAG),K,M) * NDTADF(M)
            ENDDO
            IF (IREFRA.EQ.1) THEN
               DO IJ = IJSS, IJLL
                  FL3(IJ,K,M) = FL3(IJ,K,M) + DTP(IJ) * FL1(IJ,KP1,M) * NDTADF(M)  &
                               +DTM(IJ) * FL1(IJ,KM1,M) * NDTADF(M)
               ENDDO
            ENDIF
!*    BRANCH BACK TO 1.1.3.2 FOR NEXT FREQUENCY.
         ENDIF
      ENDDO
!SHALLOW
   ENDIF
!*    BRANCH BACK TO 1.1 FOR NEXT DIRECTION.
ENDDO
!*    1.2 END OF PROPAGATION FOR CARTESIAN GRID
!*        WITHOUT REFRACTION OR DEPTH REFRACTION, RETURN.
!         -----------------------------------------------
DEALLOCATE(DCO, DP1, DP2, DRDP, DRDM, DNOO, DEAO, SDTT, DNOI, DEAI, SCROSS)
DEALLOCATE(SDIAGO, DTC, DTP, DTM, CGOND)
RETURN
! ----------------------------------------------------------------------
!*    2. PROPAGATION FOR CARTESIAN GRID
!*       WITH DEPTH AND CURRENT REFRACTION.
!        ----------------------------------
 2000 CONTINUE
DELPRO = FLOAT (IDTMIN)
DELPH0 = 0.25 * DELPRO / DELPHI
DELTH0 = 0.25 * DELPRO / DELTH
DELLA0 = 0.25 * DELPRO / DELLAM
!wluco begin
!     DELFR0 = 0.25*DELPRO/(0.1*ZPI)
DELFR0 = 0.25 * DELPRO / ( (CO - 1.) * ZPI)
!wluco end
!*    2.1 LOOP OVER DIRECTIONS.
!         ---------------------
ALLOCATE(DRDP(IJSS:IJLL)) ; ALLOCATE(DRDM(IJSS:IJLL)) ; ALLOCATE(DRCP(IJSS:IJLL))
ALLOCATE(DRCM(IJSS:IJLL)) ; ALLOCATE(CGOND(0:NIBLO))  ; ALLOCATE(DLA(0:NIBLO))
ALLOCATE(DLAD(0:NIBLO))   ; ALLOCATE(DPH(0:NIBLO))    ; ALLOCATE(DPHD(0:NIBLO))
ALLOCATE(DLE(IJSS:IJLL))  ; ALLOCATE(DLW(IJSS:IJLL))  ; ALLOCATE(DLSE(IJSS:IJLL))
ALLOCATE(DLNW(IJSS:IJLL)) ; ALLOCATE(DTC(IJSS:IJLL))  ; ALLOCATE(DTP(IJSS:IJLL))
ALLOCATE(DTM(IJSS:IJLL))  ; ALLOCATE(DTCD(IJSS:IJLL)) ; ALLOCATE(DPN(IJSS:IJLL))
ALLOCATE(DPS(IJSS:IJLL))  ; ALLOCATE(DLSW(IJSS:IJLL)) ; ALLOCATE(DLNE(IJSS:IJLL))
ALLOCATE(DOP(IJSS:IJLL))  ; ALLOCATE(DOM(IJSS:IJLL))

DO K = 1, NANG
   KP1 = K + 1
   IF (KP1.GT.NANG) KP1 = 1
   KM1 = K - 1
   IF (KM1.LT.1) KM1 = NANG
   SD = SINTH (K) * DELLA0
   CD = COSTH (K) * DELPH0
   SDD = SIN (TH (K) - PI / 4.) * DELLA0
   CDD = COS (TH (K) - PI / 4.) * DELPH0
!*    2.1.1 DEPTH REFRACTION IF SHALLOW WATER.
!           ----------------------------------
   IF (ISHALLO.NE.1) THEN
      DO IJ = IJSS, IJLL
         DRDP (IJ) = (THDD (IJ, K) + THDD (IJ, KP1) ) * DELTH0
         DRDM (IJ) = (THDD (IJ, K) + THDD (IJ, KM1) ) * DELTH0
      ENDDO
   ENDIF
!*    2.1.2 CURRENT REFRACTION.
!           -------------------
   DO IJ = IJSS, IJLL
      DRCP (IJ) = (THDC (IJ, K) + THDC (IJ, KP1) ) * DELTH0
      DRCM (IJ) = (THDC (IJ, K) + THDC (IJ, KM1) ) * DELTH0
   ENDDO
!*    2.1.3 LOOP OVER FREQUENCIES.
!           ----------------------
   DO M = 1, NFRE
      IF (MOD (ISUB, NDTADF (M) ) .EQ.0) THEN
         IDELFD = NDTADF (M)
         IF (ISHALLO.EQ.1) THEN
!*    2.1.3.1 DEEP WATER.
!             -----------
            MP1 = MIN (NFRE, M + 1)
            MM1 = MAX (1, M - 1)
            DFP = PI * 2.1 * DELFR0
!*    2.1.3.1.1 GROUP VELOCITIES.
!               -----------------
            CGS = GOM (M) * SD
            CGC = GOM (M) * CD
            CGSD = GOM (M) * SDD
            CGCD = GOM (M) * CDD
!*    2.1.3.1.2 WEIGHTS IN INTEGRATION SCHEME.
!               ------------------------------
            DLA (0) = CGS
            DPH (0) = CGC
            DLAD (0) = CGSD
            DPHD (0) = CGCD
            DO IJ = IJSST, IJLLT
               DLA (IJ) = U (IJ, IG) * DELLA0 + CGS
               DPH (IJ) = V (IJ, IG) * DELPH0 + CGC
               DLAD (IJ) = U (IJ, IG) * DELLA0 + CGSD
               DPHD (IJ) = V (IJ, IG) * DELPH0 + CGCD
            ENDDO
            DO IJ = IJSS, IJLL
               DLWE = DLA (IJ) + DLA (KLON (IJ, 1) )
               DLEA = DLA (IJ) + DLA (KLON (IJ, 2) )
               DLE (IJ) = - DLEA + ABS (DLEA)
               DLW (IJ) = DLWE+ABS (DLWE)
               DTC (IJ) = DLEA + ABS (DLEA) - DLWE+ABS (DLWE)
               DLSOEA = DLAD (IJ) + DLAD (KLON (IJ, 5) )
               DLNOWE = DLAD (IJ) + DLAD (KLON (IJ, 4) )
               DLSE (IJ) = - DLSOEA + ABS (DLSOEA)
               DLNW (IJ) = DLNOEA + ABS (DLNOEA)
               DTCD (IJ) = DTCD (IJ) + DLSOEA + ABS (DLSOEA) - DLNOWE+ABS (DLNOWE)
               DPSO = DPH (IJ) + DPH (KLAT (IJ, 1) )
               DPNO = DPH (IJ) + DPH (KLAT (IJ, 2) )
               DPN (IJ) = - DPNO + ABS (DPNO)
               DPS (IJ) = DPSO + ABS (DPSO)
               DTC (IJ) = DTC (IJ) + DPNO + ABS (DPNO) - DPSO + ABS (DPSO)
               DLSOWE = DPHD (IJ) + DPHD (KLAT (IJ, 3) )
               DLNOEA = DPHD (IJ) + DPHD (KLAT (IJ, 6) )
               DLSW (IJ) = DLSOWE+ABS (DLSOWE)
               DLNE (IJ) = - DLNOEA + ABS (DLNOEA)
               DTCD (IJ) = DLNOEA + ABS (DLNOEA) - DLSOWE+ABS (DLSOWE)
               DTHP = DRCP (IJ)
               DTHM = DRCM (IJ)
               DTP (IJ) = - DTHP + ABS (DTHP)
               DTM (IJ) = DTHM + ABS (DTHM)
               DTC (IJ) = DTC (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTCD (IJ) = DTCD (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTHP = SL (IJ, K, NFRE) * DFP
               DTC (IJ) = DTC (IJ) + 2. * ABS (DTHP)
               DTCD (IJ) = DTCD (IJ) + 2. * ABS (DTHP)
!wluco begin
!                 DOP(IJ) = (-DTHP+ABS(DTHP))/1.1
!                 DOM(IJ) = ( DTHP+ABS(DTHP))*1.1
               DOP (IJ) = ( - DTHP + ABS (DTHP) ) / CO
               DOM (IJ) = (DTHP + ABS (DTHP) ) * CO
!wluco end
            ENDDO
         ELSE
!SHALLOW
!*    2.1.3.2 SHALLOW WATER.
!             --------------
            MP1 = MIN (NFRE, M + 1)
            MM1 = MAX (1, M - 1)
            DFP = DELFR0 / FR (M)
            DFM = DELFR0 / FR (MM1)
!*    2.1.3.2.1 GROUP VELOCITIES.
!               -----------------
            CGOND (0) = TCGOND (NDEPTH, M)
            DO IJ = IJSST, IJLLT
               CGOND (IJ) = TCGOND (INDEP (IJ), M)
            ENDDO
!*    2.1.3.2.2 WEIGHTS IN INTEGRATION SCHEME.
!               ------------------------------
            DLA (0) = SD * CGOND (0)
            DPH (0) = CD * CGOND (0)
            DLAD (0) = SDD * CGOND (0)
            DPHD (0) = CDD * CGOND (0)
            DO IJ = IJSST, IJLLT
               DLA (IJ) = U (IJ, IG) * DELLA0 + SD * CGOND (IJ)
               DPH (IJ) = V (IJ, IG) * DELPH0 + CD * CGOND (IJ)
               DLAD (IJ) = U (IJ, IG) * DELLA0 + SDD * CGOND (IJ)
               DPHD (IJ) = V (IJ, IG) * DELPH0 + CDD * CGOND (IJ)
            ENDDO
            DO IJ = IJSS, IJLL
               DLWE = DLA (IJ) + DLA (KLON (IJ, 1) )
               DLEA = DLA (IJ) + DLA (KLON (IJ, 2) )
               DLE (IJ) = - DLEA + ABS (DLEA)
               DLW (IJ) = DLWE+ABS (DLWE)
               DTC (IJ) = DLEA + ABS (DLEA) - DLWE+ABS (DLWE)
               DLNOWE = DLAD (IJ) + DLAD (KLON (IJ, 4) )
               DLSOEA = DLAD (IJ) + DLAD (KLON (IJ, 5) )
               DLNW (IJ) = DLNOWE+ABS (DLNOWE)
               DLSE (IJ) = - DLSOEA + ABS (DLSOEA)
               DTCD (IJ) = DTCD (IJ) + DLSOEA + ABS (DLSOEA) - DLNOWE+ABS (DLNOWE)
               DPSO = DPH (IJ) + DPH (KLAT (IJ, 1) )
               DPNO = DPH (IJ) + DPH (KLAT (IJ, 2) )
               DPN (IJ) = - DPNO + ABS (DPNO)
               DPS (IJ) = DPSO + ABS (DPSO)
               DTC (IJ) = DTC (IJ) + DPNO + ABS (DPNO) - DPSO + ABS (DPSO)
               DLSOWE = DPHD (IJ) + DPHD (KLAT (IJ, 3) )
               DLNOEA = DPHD (IJ) + DPHD (KLAT (IJ, 6) )
               DLSW (IJ) = DLSOWE+ABS (DLSOWE)
               DLNE (IJ) = - DLNOEA + ABS (DLNOEA)
               DTCD (IJ) = DLNOEA + ABS (DLNOEA) - DLSOWE+ABS ( DLSOWE)
               DTHP = FCONST (IJ, M) * DRDP (IJ) + DRCP (IJ)
               DTHM = FCONST (IJ, M) * DRDM (IJ) + DRCM (IJ)
               DTC (IJ) = DTC (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTCD (IJ) = DTCD (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTP (IJ) = - DTHP + ABS (DTHP)
               DTM (IJ) = DTHM + ABS (DTHM)
               DTHP = (SL (IJ, K, M) + SL (IJ, K, MP1) ) * DFP
               DTHM = (SL (IJ, K, M) + SL (IJ, K, MM1) ) * DFM
               DTC (IJ) = DTC (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTCD (IJ) = DTCD (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
!wluco begin
!                 DOP(IJ) = (-DTHP+ABS(DTHP))/1.1
!                 DOM(IJ) = ( DTHM+ABS(DTHM))*1.1
               DOP (IJ) = ( - DTHP + ABS (DTHP) ) / CO
               DOM (IJ) = (DTHM + ABS (DTHM) ) * CO
!wluco end
            ENDDO
!SHALLOW
         ENDIF
!*    2.1.3.3 LOOP OVER GRIDPOINTS.
!             ---------------------
         DO IJ = IJSS, IJLL
            FL3(IJ,K,M) = (1. - 0.5 * NDTADF(M) * (DTC(IJ) + DTCD(IJ)) ) * FL1(IJ,K,M) &
                         +(0.5 * DPN(IJ) * FL1(KLAT(IJ,2),K,M)                         &
                          +0.5 * DPS(IJ) * FL1(KLAT(IJ,1),K,M)                         &
                          +0.5 * DLE(IJ) * FL1(KLON(IJ,2),K,M)                         &
                          +0.5 * DLW(IJ) * FL1(KLON(IJ,1),K,M)                         &
                          +0.5 * DLSW(IJ) * FL1(KLAT(IJ,3),K,M)                        &
                          +0.5 * DLNW(IJ) * FL1(KLON(IJ,4),K,M)                        &
                          +0.5 * DLSE(IJ) * FL1(KLON(IJ,5),K,M)                        &
                          +0.5 * DLNE(IJ) * FL1(KLAT(IJ,6),K,M)                        &
                          +DTP(IJ) * FL1(IJ,KP1,M) + DTM(IJ) * FL1(IJ,KM1,M)           &
                          +DOP(IJ) * FL1(IJ,K,MP1) + DOM(IJ) * FL1(IJ,K,MM1)) * NDTADF(M)
         ENDDO
!*    BRANCH BACK TO 2.1.3 FOR NEXT FREQUENCY.
      ENDIF
   ENDDO
!*    BRANCH BACK TO 2.1 FOR NEXT DIRECTION.
ENDDO
!*    2.2 END OF PROPAGATION FOR CARTESIAN GRID
!*        WITH DEPTH AND CURRENT REFRACTION, RETURN.
!         ------------------------------------------
DEALLOCATE(DCO, DP1, DP2, CGOND)
DEALLOCATE(DRDP, DRDM, DRCP, DRCM, DLA, DLAD, DPH, DPHD, DLE, DLW, DLSE)
DEALLOCATE(DLNW, DTCD, DPN, DPS, DLSW, DLNE, DOP, DOM, DTC, DTP, DTM)
RETURN
! ----------------------------------------------------------------------
!*    3. PROPAGATION FOR SPHERICAL LATITUDE/LONGITUDE GRID
!*       WITHOUT OR DEPTH REFRACTION.
!        -------------------------------------------------
3000 CONTINUE
DELPRO = FLOAT (IDTMIN)
DELPH0 = DELPRO / DELPHI
DELLA0 = DELPRO / DELLAM
DELTH0 = 0.25 * DELPRO / DELTH
!*    3.1 LOOP OVER DIRECTIONS.
!         ---------------------
ALLOCATE(DRGP(IJSS:IJLL))   ; ALLOCATE(DRGM(IJSS:IJLL))    ; ALLOCATE(COLOIO(IJSS:IJLL))
ALLOCATE(COLAIN(IJSS:IJLL)) ; ALLOCATE(COLAOUT(IJSS:IJLL)) ; ALLOCATE(SDTT(IJSS:IJLL))
ALLOCATE(SCROSS(IJSS:IJLL)) ; ALLOCATE(SDIAGO(IJSS:IJLL))  ; ALLOCATE(DTP(IJSS:IJLL))
ALLOCATE(DTM(IJSS:IJLL))    ; ALLOCATE(DRDP(IJSS:IJLL))    ; ALLOCATE(DRDM(IJSS:IJLL))
ALLOCATE(CGOND(0:NIBLO))    ; ALLOCATE(DNOO(IJSS:IJLL))    ; ALLOCATE(DEAO(IJSS:IJLL))
ALLOCATE(DNOI(IJSS:IJLL))   ; ALLOCATE(DEAI(IJSS:IJLL))

DO K = 1, NANG
   KP1 = K + 1
   IF (KP1.GT.NANG) KP1 = 1
   KM1 = K - 1
   IF (KM1.LT.1) KM1 = NANG

   SD = SINTH (K)
   CD = COSTH (K)
!*    3.1.1 COMPUTE GRID REFRACTION.
!           ------------------------
   SP = DELTH0 * (SINTH (K) + SINTH (KP1) ) / R
   SM = DELTH0 * (SINTH (K) + SINTH (KM1) ) / R
   DO IJ = IJSS, IJLL
      JH = KXLT (IJ, IG)
      TANPH = SINPH (JH) * DCO (IJ)
      DRGP (IJ) = TANPH * SP
      DRGM (IJ) = TANPH * SM
   ENDDO
!     3.1.2 INDEX FOR ADJOINING POINTS
!           --------------------------
!      COEFFICIENTS INITIALIZATION
   CFATT1 = 0.
   CFATT2 = 0.
   COLONG = 0.
   COLATI = 0.
!1     0<=ALFA<45
   IF (SD.GE.0..AND.CD.GT.0..AND.ABS (SD) .LT.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 1
      IJDIAG = 3
      IJLONGO = 1
      IJLATIO = 2
      IJDIAGO = 6
      CFATT1 = 1.
      COLATI = 1.
!2     45<=ALFA<90
   ELSEIF (SD.GT.0..AND.CD.GT.0..AND.ABS (SD) .GE.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 1
      IJDIAG = 3
      IJLONGO = 2
      IJLATIO = 1
      IJDIAGO = 6
      CFATT2 = 1.
      COLONG = 1.
!3     90<=ALFA<135
   ELSEIF (SD.GT.0..AND.CD.LE.0..AND.ABS (SD) .GT.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 1
      IJDIAG = 4
      IJLONGO = 2
      IJLATIO = 1
      IJDIAGO = 5
      CFATT2 = 1.
      COLONG = 1.
!4     135<=ALFA<180
   ELSEIF (SD.GT.0..AND.CD.LT.0..AND.ABS (SD) .LE.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 2
      IJDIAG = 4
      IJLONGO = 1
      IJLATIO = 1
      IJDIAGO = 5
      CFATT1 = 1.
      COLATI = 1.
!5     180<=ALFA<225
   ELSEIF (SD.LE.0..AND.CD.LT.0..AND.ABS (SD) .LT.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 2
      IJDIAG = 6
      IJLONGO = 1
      IJLATIO = 1
      IJDIAGO = 3
      CFATT1 = 1.
      COLATI = 1.
!6     225<=ALFA<270
   ELSEIF (SD.LT.0..AND.CD.LT.0..AND.ABS (SD) .GE.ABS (CD) ) THEN
      IJLONG = 2
      IJLATI = 1
      IJDIAG = 6
      IJLONGO = 1
      IJLATIO = 1
      IJDIAGO = 3
      CFATT2 = 1.
      COLONG = 1.
!7     270<=ALFA<315
   ELSEIF (SD.LT.0..AND.CD.GE.0..AND.ABS (SD) .GT.ABS (CD) ) THEN
      IJLONG = 2
      IJLATI = 1
      IJDIAG = 5
      IJLONGO = 1
      IJLATIO = 1
      IJDIAGO = 4
      CFATT2 = 1.
      COLONG = 1.
!8     315<=ALFA<0
   ELSEIF (SD.LT.0..AND.CD.GT.0..AND.ABS (SD) .LE.ABS (CD) ) THEN
      IJLONG = 1
      IJLATI = 1
      IJDIAG = 5
      IJLONGO = 1
      IJLATIO = 2
      IJDIAGO = 4
      CFATT1 = 1.
      COLATI = 1.
   ENDIF
!*    3.1.2.1 LAT/LONG CORRECTION WEIGHTS IN INT. SCHEME.
!             -----------------------------------------
   DO IJ = IJSS, IJLL
      COLOIO (IJ) = DCO (IJ)
   ENDDO
   IF (CD.GT.0.) THEN
      DO IJ = IJSS, IJLL
         COLAIN (IJ) = (DP1 (IJ) + 1.) / 2.
         COLAOUT (IJ) = (DP2 (IJ) + 1.) / 2.
      ENDDO
   ELSE
      DO IJ = IJSS, IJLL
         COLAIN (IJ) = (DP2 (IJ) + 1.) / 2.
         COLAOUT (IJ) = (DP1 (IJ) + 1.) / 2.
      ENDDO
   ENDIF
   SD = SINTH (K) * DELLA0
   CD = COSTH (K) * DELPH0
   IF (ISHALLO.EQ.1) THEN
!*    3.1.3 DEEP WATER.
!           -----------
      SD = ABS (SD)
      CD = ABS (CD)
!*    3.1.3.1 LOOP OVER FREQUENCIES.
!             ----------------------
      DO M = 1, NFRE
         IF (MOD (ISUB, NDTADF (M) ) .EQ.0) THEN
            IDELFD = NDTADF (M)
            DNO = CD * GOM (M)
            DEA = SD * GOM (M)
!         WEIGHTS IN INTEGRATION SCHEME
!         -----------------------------
            DO IJ = IJSS, IJLL
               SDTT(IJ) = CFATT1 * (1 - DNO * NDTADF(M) * COLAOUT(IJ) ) &
                         +CFATT2 * (1 - DNO * NDTADF(M) * COLAOUT(IJ)   &
                                      - (DEA - DNO) * COLOIO(IJ) * NDTADF(M) )
               SCROSS(IJ) = CFATT1 *(DNO-DEA)*COLAIN(IJ)+CFATT2*(DEA-DNO)*COLOIO(IJ)
               SDIAGO(IJ) = (CFATT1 * DEA + CFATT2 * DNO) * COLAIN (IJ)
            ENDDO
!         WEIGHTS IN ADVECTION SCHEME(REFRACTION)
!         ---------------------------------------
            DO IJ = IJSS, IJLL
               DTHP = DRGP (IJ)
               DTHM = DRGM (IJ)
               DTP (IJ) = - DTHP + ABS (DTHP)
               DTM (IJ) = DTHM + ABS (DTHM)
               SDTT (IJ) = SDTT (IJ) + (DTHP + ABS (DTHP) - DTHM + ABS (DTHM) ) * GOM (M)
            ENDDO
!*    3.1.3.3.1 LOOP OVER GRIDPOINTS.
!               ---------------------
!               ADVECTION MACHINE
            DO IJ = IJSS, IJLL
               FL3(IJ,K,M) = SDTT(IJ) * FL1(IJ,K,M)                              &
                            +(COLONG * SCROSS(IJ) * FL1(KLON(IJ,IJLONG),K,M)     &
                             +COLATI * SCROSS(IJ) * FL1(KLAT(IJ,IJLATI),K,M)     &
                             +SDIAGO(IJ) * FL1(KLAT(IJ,IJDIAG),K,M)              &
                             +DTP(IJ) * FL1(IJ,KP1,M) * GOM(M)                   &
                             +DTM(IJ) * FL1(IJ,KM1,M) * GOM(M) )      * NDTADF(M)
            ENDDO
!*    BRANCH BACK TO 3.1.3.1 FOR NEXT FREQUENCY.
         ENDIF
      ENDDO
   ELSE
!SHALLOW
!*    3.1.4 SHALLOW WATER.
!           --------------
      SD = 0.5 * ABS (SD)
      CD = 0.5 * ABS (CD)
!*    3.1.4.1 COMPUTE DEPTH REFRACTION.
!             -------------------------
      IF (IREFRA.EQ.1) THEN
         DO IJ = IJSS, IJLL
            DRDP (IJ) = (THDD (IJ, K) + THDD (IJ, KP1) ) * DELTH0
            DRDM (IJ) = (THDD (IJ, K) + THDD (IJ, KM1) ) * DELTH0
         ENDDO
      ENDIF
!*    3.1.4.2 LOOP OVER FREQUENCIES.
!             ----------------------
      DO M = 1, NFRE
         IF (MOD (ISUB, NDTADF (M) ) .EQ.0) THEN
            IDELFD = NDTADF (M)
!*    3.1.4.2.1 GROUP VELOCITIES.
!               -----------------
            CGOND (0) = TCGOND (NDEPTH, M)
            DO IJ = IJSST, IJLLT
               CGOND (IJ) = TCGOND (INDEP (IJ), M)
            ENDDO
!*    3.1.4.3.2 LAT / LONG WEIGHTS IN INTEGRATION SCHEME.
!               -----------------------------------------
            DO IJ = IJSS, IJLL
               DNOO (IJ) = CD * (CGOND (IJ) + CGOND (KLAT (IJ, IJLATIO) ) )
               DEAO (IJ) = SD * (CGOND (IJ) + CGOND (KLAT (IJ, IJLONGO) ) )
               SDTT (IJ) = CFATT1 * (1 - DNOO (IJ) * COLAOUT (IJ) * NDTADF (M) )        &
                          +CFATT2 * (1 - DNOO (IJ) * COLAOUT (IJ) * NDTADF (M)          &
                                       -(DEAO(IJ) - DNOO(IJ))  * COLOIO(IJ) * NDTADF(M) )

               DNOI (IJ) = CD * (CFATT1 * (CGOND (IJ) + CGOND (KLAT (IJ, IJLATI) ) )    &
                                +CFATT2 * (CGOND (IJ) + CGOND (KLAT (IJ, IJDIAG) ) ) )

               DEAI (IJ) = SD * (CFATT1 * (CGOND (IJ) + CGOND (KLAT (IJ, IJDIAG) ) )    &
                          +CFATT2 * (CGOND (IJ) + CGOND (KLON (IJ, IJLONG) ) ) )
               SCROSS (IJ) = CFATT1 * (DNOI (IJ) - DEAI (IJ) ) * COLAIN (IJ)            &
                            +CFATT2 * (DEAI (IJ) - DNOI (IJ) ) * COLOIO (IJ)
               SDIAGO (IJ) = (CFATT1 * DEAI (IJ) + CFATT2 * DNOI (IJ) ) * COLAIN (IJ)
            ENDDO
!*    3.1.4.2.3 REFRACTION WEIGHTS IN INTEGRATION SCHEME.
!               -----------------------------------------
            IF (IREFRA.EQ.0) THEN
               DO IJ = IJSS, IJLL
                  DTHP = DRGP (IJ) * CGOND (IJ)
                  DTHM = DRGM (IJ) * CGOND (IJ)
                  SDTT(IJ) = SDTT(IJ) - (DTHP + ABS(DTHP) - DTHM + ABS(DTHM)) * NDTADF(M)
                  DTP(IJ) = - DTHP + ABS (DTHP)
                  DTM(IJ) = DTHM + ABS (DTHM)
               ENDDO
            ELSE
               DO IJ = IJSS, IJLL
                  DTHP = DRGP (IJ) * CGOND (IJ) + FCONST (IJ, M) * DRDP (IJ)
                  DTHM = DRGM (IJ) * CGOND (IJ) + FCONST (IJ, M) * DRDM (IJ)
                  SDTT(IJ) = SDTT(IJ) - (DTHP + ABS(DTHP) - DTHM + ABS(DTHM)) * NDTADF(M)
                  DTP (IJ) = - DTHP + ABS (DTHP)
                  DTM (IJ) = DTHM + ABS (DTHM)
               ENDDO
            ENDIF
!*    3.1.4.2.4 LOOP OVER GRIDPOINTS.
!               ---------------------
            DO IJ = IJSS, IJLL
               FL3(IJ,K,M) = SDTT(IJ) * FL1(IJ,K,M) &
                            +(COLONG * SCROSS(IJ) * FL1(KLON(IJ,IJLONG),K,M) &
                             +COLATI * SCROSS(IJ) * FL1(KLAT(IJ,IJLATI),K,M) &
                             +SDIAGO(IJ) * FL1(KLAT(IJ,IJDIAG),K,M)          &
                             +DTP(IJ) * FL1(IJ,KP1,M)                        &
                             +DTM(IJ) * FL1(IJ,KM1,M) ) * NDTADF(M)
            ENDDO
!*    BRANCH BACK TO 3.1.4.2 FOR NEXT FREQUENCY.
         ENDIF
      ENDDO
!SHALLOW
   ENDIF
!*    BRANCH BACK TO 3.1 FOR NEXT DIRECTION.
ENDDO
!*    3.2 END OF PROPAGATION FOR SPHERICAL GRID
!*        WITHOUT REFRACTION OR DEPTH REFRACTION, RETURN.
!         -----------------------------------------------
DEALLOCATE(DCO, DP1, DP2)
DEALLOCATE(DRGP, DRGM, COLOIO, COLAIN, COLAOUT, SDTT, SCROSS, SDIAGO)
DEALLOCATE(DTP, DTM, DRDP, DRDM, CGOND, DNOO, DEAO, DNOI, DEAI)
RETURN
! ----------------------------------------------------------------------
!*    4. PROPAGATION FOR SPHERICAL LATITUDE/LONGITUDE GRID
!*       WITH DEPTH AND CURRENT REFRACTION.
!        -------------------------------------------------
4000 CONTINUE
DELPRO = FLOAT (IDTMIN)
DELPH0 = 0.25 * DELPRO / DELPHI
DELTH0 = 0.25 * DELPRO / DELTH
DELLA0 = 0.25 * DELPRO / DELLAM
!wluco begin
!     DELFR0 = 0.25*DELPRO/(0.1*ZPI)
DELFR0 = 0.25 * DELPRO / ( (CO - 1.) * ZPI)
!wluco end
ALLOCATE(DRGP(IJSS:IJLL)) ; ALLOCATE(DRGM(IJSS:IJLL)) ; ALLOCATE(DRDP(IJSS:IJLL))
ALLOCATE(DRDM(IJSS:IJLL)) ; ALLOCATE(DRCP(IJSS:IJLL)) ; ALLOCATE(DRCM(IJSS:IJLL))
ALLOCATE(DLA(0:NIBLO))    ; ALLOCATE(DLAD(0:NIBLO))   ; ALLOCATE(DPH(0:NIBLO))
ALLOCATE(DPHD(0:NIBLO))   ; ALLOCATE(DLE(IJSS:IJLL))  ; ALLOCATE(DLW(IJSS:IJLL))
ALLOCATE(DTC(IJSS:IJLL))  ; ALLOCATE(DLNW(IJSS:IJLL)) ; ALLOCATE(DLSE(IJSS:IJLL))
ALLOCATE(DTCD(IJSS:IJLL)) ; ALLOCATE(DPN(IJSS:IJLL))  ; ALLOCATE(DPS(IJSS:IJLL))
ALLOCATE(DLNE(IJSS:IJLL)) ; ALLOCATE(DLSW(IJSS:IJLL)) ; ALLOCATE(DTP(IJSS:IJLL))
ALLOCATE(DTM(IJSS:IJLL))  ; ALLOCATE(DOP(IJSS:IJLL))  ; ALLOCATE(DOM(IJSS:IJLL))
ALLOCATE(CGOND(0:NIBLO))
!*    4.1 LOOP OVER DIRECTIONS.
!         ---------------------
DO K = 1, NANG
   KP1 = K + 1
   IF (KP1.GT.NANG) KP1 = 1
   KM1 = K - 1
   IF (KM1.LT.1) KM1 = NANG
   SD = SINTH (K) * DELLA0
   CD = COSTH (K) * DELPH0
   SDD = SIN (TH (K) - PI / 4.) * DELLA0
   CDD = COS (TH (K) - PI / 4.) * DELPH0
!*    4.1.1 COMPUTE GRID REFRACTION.
!           ------------------------
   SP = DELTH0 * (SINTH (K) + SINTH (KP1) ) / R
   SM = DELTH0 * (SINTH (K) + SINTH (KM1) ) / R
   DO IJ = IJSS, IJLL
      JH = KXLT (IJ, IG)
      TANPH = SINPH (JH) * DCO (IJ)
      DRGP (IJ) = TANPH * SP
      DRGM (IJ) = TANPH * SM
   ENDDO
!*    4.1.2 COMPUTE DEPTH REFRACTION.
!           -------------------------
   IF (ISHALLO.NE.1) THEN
      DO IJ = IJSS, IJLL
         DRDP (IJ) = (THDD (IJ, K) + THDD (IJ, KP1) ) * DELTH0
         DRDM (IJ) = (THDD (IJ, K) + THDD (IJ, KM1) ) * DELTH0
      ENDDO
   ENDIF
!*    4.1.3 COMPUTE CURRENT REFRACTION.
!           ---------------------------
   DO IJ = IJSS, IJLL
      DRCP (IJ) = (THDC (IJ, K) + THDC (IJ, KP1) ) * DELTH0
      DRCM (IJ) = (THDC (IJ, K) + THDC (IJ, KM1) ) * DELTH0
   ENDDO
!*    4.1.4 LOOP OVER FREQUENCIES.
!           ----------------------
   DO M = 1, NFRE
      IF (MOD (ISUB, NDTADF (M) ) .EQ.0) THEN
         IDELFD = NDTADF (M)
         MP1 = MIN (NFRE, M + 1)
         MM1 = MAX (1, M - 1)
         IF (ISHALLO.EQ.1) THEN
!*    4.1.4.1 DEEP WATER.
!             -----------
!*    4.1.4.1.1 GROUP VELOCITIES.
!               -----------------
            DFP = PI * 2.1 * DELFR0
            CGS = GOM (M) * SD
            CGC = GOM (M) * CD
            CGSD = GOM (M) * SDD
            CGCD = GOM (M) * CDD
!*    4.1.4.1.2 WEIGHTS IN INTEGRATION SCHEME.
!               ------------------------------
            DLA (0) = CGS
            DPH (0) = CGC
            DLAD (0) = CGSD
            DPHD (0) = CGCD
            DO IJ = IJSST, IJLLT
               DLA (IJ) = (U (IJ, IG) * DELLA0 + CGS) * DCO (IJ)
               DPH (IJ) = V (IJ, IG) * DELPH0 + CGC
               DLAD (IJ) = (U (IJ, IG) * DELLA0 + CGSD) * DCO (IJ)
               DPHD (IJ) = V (IJ, IG) * DELPH0 + CGCD
            ENDDO
            DO IJ = IJSS, IJLL
               DLWE = DLA (IJ) + DLA (KLON (IJ, 1) )
               DLEA = DLA (IJ) + DLA (KLON (IJ, 2) )
               DLE (IJ) = - DLEA + ABS (DLEA)
               DLW (IJ) = DLWE+ABS (DLWE)
               DTC (IJ) = DLEA + ABS (DLEA) - DLWE+ABS (DLWE)
               DLSOEA = DLAD (IJ) + DLAD (KLON (IJ, 5) ) * DP1 (IJ)
               DLNOWE = DLAD (IJ) + DLAD (KLON (IJ, 4) ) * DP2 (IJ)
               DLNW (IJ) = - DLNOWE+ABS (DLNOWE)
               DLSE (IJ) = DLSOEA + ABS (DLSOEA)
               DTCD (IJ) = DTCD (IJ) + DLNOWE+ABS (DLNOWE) - DLSOEA + ABS (DLSOEA)
               DPSO = DPH (IJ) + DPH (KLAT (IJ, 1) ) * DP1 (IJ)
               DPNO = DPH (IJ) + DPH (KLAT (IJ, 2) ) * DP2 (IJ)
               DPN (IJ) = - DPNO + ABS (DPNO)
               DPS (IJ) = DPSO + ABS (DPSO)
               DTC (IJ) = DTC (IJ) + DPNO + ABS (DPNO) - DPSO + ABS (DPSO)
               DLSOWE = DPHD (IJ) + DPHD (KLAT (IJ, 3) )
               DLNOEA = DPHD (IJ) + DPHD (KLAT (IJ, 6) )
               DLNE (IJ) = - DLNOEA + ABS (DLNOEA)
               DLSW (IJ) = DLSOWE+ABS (DLSOWE)

               DTCD (IJ) = DLNOEA + ABS (DLNOEA) - DLSOWE+ABS (DLSOWE)
               DTHP = DRGP (IJ) * GOM (M) + DRCP (IJ)
               DTHM = DRGM (IJ) * GOM (M) + DRCM (IJ)
               DTC (IJ) = DTC (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTCD (IJ) = DTCD (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTP (IJ) = - DTHP + ABS (DTHP)

               DTM (IJ) = DTHM + ABS (DTHM)
               DTHP = SL (IJ, K, NFRE) * DFP
               DTC (IJ) = DTC (IJ) + 2. * ABS (DTHP)
               DTCD (IJ) = DTCD (IJ) + 2. * ABS (DTHP)
!wluco begin
!                 DOP(IJ)  = (-DTHP+ABS(DTHP))/1.1
!                 DOM(IJ)  = ( DTHP+ABS(DTHP))*1.1
               DOP (IJ) = ( - DTHP + ABS (DTHP) ) / CO
               DOM (IJ) = (DTHP + ABS (DTHP) ) * CO
!wluco end
            ENDDO
         ELSE
!SHALLOW
!*    4.1.4.2 SHALLOW WATER.
!             --------------
!*    4.1.4.2.1 GROUP VELOCITIES.
!               -----------------
            DFP = DELFR0 / FR (M)
            DFM = DELFR0 / FR (MM1)
            CGOND (0) = TCGOND (NDEPTH, M)
            DO IJ = IJSST, IJLLT
               CGOND (IJ) = TCGOND (INDEP (IJ), M)
            ENDDO
!*    4.1.4.2.2 LON/LAT/DIR WEIGHTS IN INTEGRATION SCHEME.
!               ------------------------------------------
            DLA (0) = SD * CGOND (0)
            DPH (0) = CD * CGOND (0)
            DLAD (0) = SDD * CGOND (0)
            DPHD (0) = CDD * CGOND (0)
            DO IJ = IJSST, IJLLT
               DLA (IJ) = (U (IJ, IG) * DELLA0 + SD * CGOND (IJ) ) * DCO (IJ)
               DPH (IJ) = V (IJ, IG) * DELPH0 + CD * CGOND (IJ)
               DLAD (IJ) = (U (IJ, IG) * DELLA0 + SDD * CGOND (IJ)) * DCO (IJ)
               DPHD (IJ) = V (IJ, IG) * DELPH0 + CDD * CGOND (IJ)
            ENDDO
            DO IJ = IJSS, IJLL
               DLWE = DLA (IJ) + DLA (KLON (IJ, 1) )
               DLEA = DLA (IJ) + DLA (KLON (IJ, 2) )
               DLE (IJ) = - DLEA + ABS (DLEA)
               DLW (IJ) = DLWE+ABS (DLWE)
               DTC (IJ) = DLEA + ABS (DLEA) - DLWE+ABS (DLWE)
               DLSOEA = DLAD (IJ) + DLAD (KLON (IJ, 5) ) * DP1 (IJ)
               DLNOWE = DLAD (IJ) + DLAD (KLON (IJ, 4) ) * DP2 (IJ)
               DLSE (IJ) = - DLSOEA + ABS (DLSOEA)
               DLNW (IJ) = DLNOWE+ABS (DLNOWE)
               DTCD (IJ) = DTCD (IJ) + DLSOEA + ABS (DLSOEA) - DLNOWE+ABS (DLNOWE)
               DPSO = DPH (IJ) + DPH (KLAT (IJ, 1) ) * DP1 (IJ)
               DPNO = DPH (IJ) + DPH (KLAT (IJ, 2) ) * DP2 (IJ)
               DPN (IJ) = - DPNO + ABS (DPNO)
               DPS (IJ) = DPSO + ABS (DPSO)
               DTC (IJ) = DTC (IJ) + DPNO + ABS (DPNO) - DPSO + ABS (DPSO)
               DLSOWE = DPHD (IJ) + DPHD (KLAT (IJ, 3) )
               DLNOEA = DPHD (IJ) + DPHD (KLAT (IJ, 6) )
               DLNE (IJ) = - DLNOEA + ABS (DLNOEA)
               DLSW (IJ) = DLSOWE+ABS (DLSOWE)
               DTCD (IJ) = DLNOEA + ABS (DLNOEA) - DLSOWE+ABS (DLSOWE)
               DTHP = DRGP (IJ) * CGOND (IJ) + FCONST (IJ, M) * DRDP (IJ) + DRCP (IJ)
               DTHM = DRGM (IJ) * CGOND (IJ) + FCONST (IJ, M) * DRDM (IJ) + DRCM (IJ)
               DTC (IJ) = DTC (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTCD (IJ) = DTCD (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTP (IJ) = - DTHP + ABS (DTHP)
               DTM (IJ) = DTHM + ABS (DTHM)
               DTHP = (SL (IJ, K, M) + SL (IJ, K, MP1) ) * DFP
               DTHM = (SL (IJ, K, M) + SL (IJ, K, MM1) ) * DFM
               DTC (IJ) = DTC (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
               DTCD (IJ) = DTCD (IJ) + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)
!wluco begin
!                 DOP(IJ)  = (-DTHP+ABS(DTHP))/1.1
!                 DOM(IJ)  = ( DTHM+ABS(DTHM))*1.1
               DOP (IJ) = ( - DTHP + ABS (DTHP) ) / CO
               DOM (IJ) = (DTHM + ABS (DTHM) ) * CO
!wluco end
            ENDDO
!SHALLOW
         ENDIF
!*    4.1.4.3 LOOP OVER GRIDPOINTS.
!             ---------------------
         DO IJ = IJSS, IJLL
            FL3(IJ,K,M) = (1. - 0.5 * NDTADF(M) * (DTC(IJ) + DTCD(IJ))) * FL1(IJ,K,M)   &
                         +(0.5 * DPN(IJ) * FL1(KLAT(IJ,2),K,M)                          &
                          +0.5 * DPS(IJ) * FL1(KLAT(IJ,1),K,M)                          &
                          +0.5 * DLE(IJ) * FL1(KLON(IJ,2),K,M)                          &
                          +0.5 * DLW(IJ) * FL1(KLON(IJ,1),K,M)                          &
                          +0.5 * DLSW(IJ) * FL1(KLAT(IJ,3),K,M)                         &
                          +0.5 * DLNE(IJ) * FL1(KLAT(IJ,6),K,M)                         &
                          +0.5 * DLSE(IJ) * FL1(KLON(IJ,5),K,M)                         &
                          +0.5 * DLNW(IJ) * FL1(KLON(IJ,4),K,M)                         &
                          +DTP(IJ) * FL1(IJ,KP1,M) + DTM(IJ) * FL1(IJ,KM1,M)            &
                          +DOP(IJ) * FL1(IJ,K,MP1) + DOM(IJ) * FL1(IJ,K,MM1)) * NDTADF(M)
         ENDDO
!*    BRANCH BACK TO 4.1.4 FOR NEXT FREQUENCY.
      ENDIF
   ENDDO
!*    BRANCH BACK TO 4.2 FOR NEXT DIRECTION.
ENDDO
!*    4.4 END OF PROPAGATION FOR SPHERICAL GRID
!*        WITH DEPTH AND CURRENT REFRACTION.
!         -------------------------------------
!     5.0 INCLUDE ANGULAR DIFFUSION:
!         --------------------------
DEALLOCATE(DCO, DP1, DP2)
DEALLOCATE(DRGP, DRGM, DRDP, DRDM, DRCP, DRCM, DLA, DLAD, DPH, DPHD)
DEALLOCATE(DLE, DLW, DTC, DLNW, DLSE, DTCD, DPN, DPS, DLNE, DLSW, DTP)
DEALLOCATE(DTM, DOP, DOM, CGOND)
RETURN

END SUBROUTINE propags2
#endif
