SUBROUTINE cflsub (iu08, ig, indk, indi, idepthu, idelrec)  
! ----------------------------------------------------------------------
!**** *CFLSUB* - CFL-CRITERIUM IS CHECKED.
!     J.C. CARRETERO   PCM       09/97
!*    PURPOSE.
!     --------
!       TO ASURE THE STABILITY OF THE FIRST ORDER UPWIND PROPAGATION
!       SCHEME.
!       TO DEFINE THE PROPAGATION TIME STEP TO BE USED BY PROPAGS.
!**   INTERFACE.
!     ----------
!       *CALL* *CFLSUB(IU06,IG,INDK,INDI,IDEPTHU,IDELREC)*
!          *IG*      - BLOCK NUMBER.
!          *INDK*    - K INDEX OF UNSTABLE GRID POINT
!          *INDI*    - I INDEX OF UNSTABLE GRID POINT
!          *IDEPTHU* - DEPTH OF UNSTABLE GRID POINT
!          *IDELREC* - RECOMMENDED PROPAGATION TIME STEP
!     METHOD.
!     -------
!       FOR SHALLOW WATER THE VALUES OF THE TOTAL WEIGHT SUSTRACTED
!       IN A PROPAGATION TIME STEP AND EACH INDIVIDUAL WEIGHT IS
!       CHECKED TO ASSURE STABILITY. THIS IS DONE FOR ALL GRID POINTS,
!       DIRECTIONS AND FREQUENCIES. A STABLE TIME STEP IS COMPUTED FOR
!       EACH GRID POINT AND STORED IN A COMMON BLOCK.
!       THE RECOMENDED TIME STEP IS CHANGED ONLY FOR GRID POINTS
!       IN WHICH THE TIME STEP DEFINED BY THE USER WILL MAKE UNSTABLE
!       THE PROPAGATION ALGORITHM.
!       IF THE CFL IS VIOLATED BY AN INDIVIDUAL WEIGHT, THE RUN IS STOPP
!       FOR DEEP WATER ONLY THE NORTHERN GRID POINTS ARE CHECKED
!     EXTERNALS.
!     ----------
!       *OUTPP*     - PRINTER OUTPUT OF AN ARRAY.
!       *DOTDC*     - READ DOT TERMS FOR REFRACTION AND SCATTER TABLE.
!     REFERENCE.
!     ----------
!       NONE.
! ----------------------------------------------------------------------
use params
use current
use fredir
use gridpar
use map
use ndtf
use refdot
use shallow
use source
use stat
use testo
use ubuf
use propfr
implicit none

INTEGER, INTENT(IN) :: iu08, ig
INTEGER, INTENT(OUT):: indk, indi, idepthu, idelrec
INCLUDE 'globals.h'
LOGICAL  :: FRSTIMECFL
REAL     :: DTCSDLE (NIBLO), DTCSDPN (NIBLO)
REAL     :: DTCSDLA (NIBLO), DTCSDPH (NIBLO)
CHARACTER:: TITL * 100
REAL     :: DCO(NIBLO), DP1(NIBLO), DP2(NIBLO)
REAL     :: DPN(NIBLO), DPS(NIBLO), DPH(0:NIBLO)
REAL     :: DLE(NIBLO), DLW(NIBLO), DLA(0:NIBLO)
REAL     :: DOP(NIBLC), DOM(NIBLC)
REAL     :: DTP(NIBLO), DTM(NIBLO), DRGP(NIBLO), DRGM(NIBLO)
REAL     :: DRDP(NIBLD), DRDM(NIBLD), DRCP(NIBLC), DRCM(NIBLC)
REAL     :: DTC(NIBLO), CGOND(0:NIBLO)
REAL     :: GVE, DPHD, CFLP, DLHD, CFLL, XD, FRRI, DTHP, DTHM, DELPRO, DELPH0
REAL     :: DELLA0, DELTH0, SD, CD, SW1, SW2, SW3, SW4, SW5, FR1, FR2, FR3, FR4
REAL     :: FR5, FRRT, DELFR0, DFP, DFM, DLWE, DLEA, DPSO, DPNO, SDA, CDA, SP, SM, TANPH
INTEGER  :: K, IJ, ID, IDELPREC, JH, IJLA, IJPH, KP1, KM1, M, IX, IY, MP1, MM1
! ----------------------------------------------------------------------
!*    0.0 CFL CRIT. IS CHECKED FOR DEEP WATER.
!         ------------------------------------
IF (ISHALLO.EQ.1) THEN  
   GVE = G / (ZPI * FR (1) * 2.)  
   DPHD = DELPHI  
   CFLP = IDELPRO * GVE / DPHD  
   DLHD = DELLAM * COS (AMONOP * RAD)  
   CFLL = IDELPRO * GVE / DLHD  
   IF (CFLP.GT.1..OR.CFLL.GT.1.) THEN  
      WRITE (IU06,  * ) ' ******************************************'  
      WRITE (IU06,  * ) ' *                                        *'  
      WRITE (IU06,  * ) ' *       FATAL ERROR IN SUB. CFLSUB       *'  
      WRITE (IU06,  * ) ' *       ===========================      *'  
      WRITE (IU06,  * ) ' * CFL-CRITERION NOT FULFILLED.           *'  
      WRITE (IU06,  * ) ' * CFLP: ', CFLP, '  GROUP VELOCITY: ', GVE  
      WRITE (IU06,  * ) ' * CFLL: ', CFLL, '  GROUP VELOCITY: ', GVE  
      WRITE (IU06, * ) ' * PROPAGATION TIME: ', IDELPRO  
      WRITE (IU06, * ) ' * GRID DIST. AT NORTHERNMOST LAT.: ', DPHD
      WRITE (IU06,  * ) ' *     PROGRAM ABORTS   PROGRAM ABORTS    *'  
      WRITE (IU06,  * ) ' *                                        *'  
      WRITE (IU06,  * ) ' ******************************************'  
      CALL ABORT  
   ELSE  
      WRITE (IU06, * ) ' CFL-CRITERION CHECKED IN SUB CFLSUB '  
      WRITE (IU06,  * ) ' FOR DEEP WATER                      '  
   ENDIF  
   RETURN  
ELSE  
!*    0.01 START OF CFL CHECK FOR SHALLOW RUN
!          ----------------------------------
   DO IJ = IJS (IG), IJL (IG)  
      IPROPFR (IJ, IG) = 1  
   END DO  
   TITL = ' DEFINED AND RECOMENDED PROPAGATION TIME STEP (S) '  
   IF (IGL.NE.1) THEN  
      IF (IG.EQ.1) REWIND IU08  
      READ (IU08) KLAT, KLON  
      DO IJ = 1, IJLT (IG)  
         XD = LOG (DEPTH (IJ, IG) / DEPTHA) / LOG (DEPTHD) + 1.
         ID = NINT (XD)  
         ID = MAX (ID, 1)  
         INDEP (IJ) = MIN (ID, NDEPTH)  
      END DO  
      IF (IG.EQ.IGL) REWIND IU08  
   ENDIF  
   FRSTIMECFL = .TRUE.  
ENDIF  
!*    0.1 READ REFRACTION DOT TERMS.
!         --------------------------
IF (IREFRA.NE.0) CALL DOTDC (IJS (IG), IJL (IG), IG, IGL, ISHALLO, IREFRA)
!*    0.2 SPHERICAL OR CARTESIAN GRID?
!         ----------------------------
IF (ICASE.EQ.1) THEN  
!*    0.2.1 SPHERICAL GRID.
!           ---------------
!*    0.2.1.1 COSINE OF LATITUDE.
!             -------------------
   DO IJ = 1, IJLT (IG)  
      JH = KXLT (IJ, IG)  
      DCO (IJ) = 1. / COSPH (JH)  
   END DO  
!*    0.2.1.2 COMPUTE COS PHI FACTOR FOR ADJOINING GRID POINT.
!             ------------------------------------------------
   DO IJ = IJS (IG), IJL (IG)  
      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  
   END DO  
   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. CFL CRIT. IS CHECKED FOR CARTESIAN GRID
!*       WITHOUT REFRACTION OR WITH DEPTH REFRATION.
!        -------------------------------------------
!
 1000 CONTINUE  
!
DELPRO = FLOAT (IDELPRO)  
DELPH0 = DELPRO / DELPHI  
DELLA0 = DELPRO / DELLAM  
DELTH0 = 0.25 * DELPRO / DELTH  
!
!*    1.1 LOOP OVER DIRECTIONS.
!         ---------------------
!
DO 1100 K = 1, NANG  
   SD = SINTH (K) * DELLA0  
   CD = COSTH (K) * DELPH0  
!
!*    1.1.1 INDEX FOR ADJOINING POINTS.
!           ---------------------------
!
   IF (SD.LT.0) THEN  
      IJLA = 2  
   ELSE  
      IJLA = 1  
   ENDIF  
   IF (CD.LT.0) THEN  
      IJPH = 2  
   ELSE  
      IJPH = 1  
   ENDIF  
!
   IF (ISHALLO.EQ.1) THEN  
!
 1120       CONTINUE  
   ELSE  
!SHALLOW
!
!*    1.1.3 SHALLOW WATER.
!           --------------
!
      SD = 0.5 * SD  
      CD = 0.5 * 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 1131 IJ = IJS (IG), IJL (IG)  
            DRDP (IJ) = (THDD (IJ, K) + THDD (IJ, KP1) ) * DELTH0  
            DRDM (IJ) = (THDD (IJ, K) + THDD (IJ, KM1) ) * DELTH0  
 1131          END DO  
      ENDIF  
!
!*    1.1.3.2 LOOP OVER FREQUENCIES.
!             ----------------------
!
      DO 1130 M = 1, NFRE  
!
!*    1.1.3.2.1 GROUP VELOCITIES.
!               -----------------
!
         CGOND (0) = TCGOND (NDEPTH, M)  
         DO 1132 IJ = 1, IJLT (IG)  
            CGOND (IJ) = TCGOND (INDEP (IJ), M)  
 1132          END DO  
!
!*    1.1.3.2.2 WEIGHTS IN INTEGRATION SCHEME.
!               ------------------------------
!
         IF (SD.GE.0.) THEN  
            DO 1133 IJ = IJS (IG), IJL (IG)  
               DLA (IJ) = SD * (CGOND (KLON (IJ, 1) ) + CGOND (IJ) &
                )
               DTC (IJ) = SD * (CGOND (KLON (IJ, 2) ) + CGOND (IJ) &
                )
               DTCSDLA (IJ) = SD * (CGOND (KLON (IJ, 2) ) + CGOND &
                (IJ) )
 1133             END DO  
         ELSE  
            DO 1134 IJ = IJS (IG), IJL (IG)  
               DLA (IJ) = - SD * (CGOND (KLON (IJ, 2) ) + CGOND ( &
                IJ) )
               DTC (IJ) = - SD * (CGOND (KLON (IJ, 1) ) + CGOND ( &
                IJ) )
               DTCSDLA (IJ) = - SD * (CGOND (KLON (IJ, 1) ) &
                + CGOND (IJ) )
 1134             END DO  

         ENDIF  
         IF (CD.GE.0.) THEN  
            DO 1135 IJ = IJS (IG), IJL (IG)  
               DPH (IJ) = CD * (CGOND (KLAT (IJ, 1) ) + CGOND (IJ) &
                )
               DTC (IJ) = DTC (IJ) + CD * (CGOND (KLAT (IJ, 2) ) &
                + CGOND (IJ) )
               DTCSDPH (IJ) = + CD * (CGOND (KLAT (IJ, 2) ) &
                + CGOND (IJ) )
 1135             END DO  
         ELSE  
            DO 1136 IJ = IJS (IG), IJL (IG)  
               DPH (IJ) = - CD * (CGOND (KLAT (IJ, 2) ) + CGOND ( &
                IJ) )
               DTC (IJ) = DTC (IJ) - CD * (CGOND (KLAT (IJ, 1) ) &
                + CGOND (IJ) )
               DTCSDPH (IJ) = - CD * (CGOND (KLAT (IJ, 1) ) &
                + CGOND (IJ) )
 1136             END DO  
         ENDIF  
!
!*    1.1.3.2.3 LOOP OVER GRIDPOINTS.
!               ---------------------
!
         IF (IREFRA.EQ.0) THEN  
            DO 1138 IJ = IJS (IG), IJL (IG)  
               SW1 = DTC (IJ)  
               FR1 = FLOAT (INT (SW1) + 1)  
               SW3 = DTCSDPH (IJ)  
               FR3 = FLOAT (INT (SW3) + 1)  
               SW4 = DTCSDLA (IJ)  
               FR4 = FLOAT (INT (SW4) + 1)  
               	FRRT = MAX (FR1, FR3, FR4)  
               	FRRI = MAX (FR3, FR4)  
               	IDELPREC = IDELPRO / NINT (FRRT)  
               IF (FRRT.GT.1.0) THEN  
                  IF (FRSTIMECFL) THEN  
                     WRITE (IU06, * ) ' '  
WRITE (IU06,  * ) '  CFL-CRITERION FOR BLOCK : ', IG  
WRITE (IU06,  * ) '   GRID POINT           SUBSTRACTED WEIGHTS'  
WRITE (IU06,  * ) '   IIND KIND DPTH DIR FRQ TSUB ', '  PLAT  PLON &
&  TS-REC  DIAG'
WRITE (IU06,  * ) '   =================================', '======= &
&====================='
                  ENDIF  
                  FRSTIMECFL = .FALSE.  
               ENDIF  
               IF (FRRI.GT.1.0.OR.SW1.GE.2.0) THEN  
                  IF (M.EQ.1) WRITE (IU06, 1001) IXLG (IJ, IG) , &
                   KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, &
                   SW1, SW3, SW4, IDELPREC, ' UNSTABL'
                  INDK = KXLT (IJ, IG)  
                  INDI = IXLG (IJ, IG)  
                  IDEPTHU = NINT (DEPTH (IJ, IG) )  
                  IDELREC = IDELPREC  
                  RETURN  
               ENDIF  
               IF (SW1.GE.1.0) THEN  
                  IPROPFR (IJ, IG) = MAX (NINT (FRRT), IPROPFR ( &
                   IJ, IG) )
                  IF (M.EQ.1) WRITE (IU06, 1001) IXLG (IJ, IG) , &
                   KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, &
                   SW1, SW3, SW4, IDELPREC, ' WARNING'
               ENDIF  
 1138             END DO  
         ENDIF  
 1001 FORMAT         (3X,3I5,I3,I4,1X,3F6.3,I5,A10)  
         IF (IREFRA.EQ.1) THEN  
            DO 1139 IJ = IJS (IG), IJL (IG)  
               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)  
               SW1 = DTC (IJ)  
               FR1 = FLOAT (INT (SW1) + 1)  
               SW2 = + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)  
               FR2 = FLOAT (INT (SW2) + 1)  
               SW3 = DTCSDPH (IJ)  
               FR3 = FLOAT (INT (SW3) + 1)  
               SW4 = DTCSDLA (IJ)  
               FR4 = FLOAT (INT (SW4) + 1)  
               	FRRT = MAX (FR1, FR2, FR3, FR4)  
               	FRRI = MAX (FR2, FR3, FR4)  
               	IDELPREC = IDELPRO / NINT (FRRT)  
               IF (FRRT.GT.1.0) THEN  
                  IF (FRSTIMECFL) THEN  
                     WRITE (IU06, * ) ' '  
WRITE (IU06,  * ) '  CFL-CRITERION FOR BLOCK : ', IG  
WRITE (IU06,  * ) '   GRID POINT           SUBSTRACTED WEIGHTS'  
WRITE (IU06,  * ) '   IIND KIND DPTH DIR FRQ TSUB  PREF', '  PLAT &
& PLON  TS-REC  DIAG'
WRITE (IU06,  * ) '   =================================', '======= &
&====================='
                  ENDIF  
                  FRSTIMECFL = .FALSE.  
               ENDIF  
               IF (FRRI.GT.1.0.OR.SW1.GE.2.0) THEN  
                  IF (M.EQ.1) WRITE (IU06, 3001) IXLG (IJ, IG) , &
                   KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, &
                   SW1, SW2, SW3, SW4, IDELPREC, ' UNSTABL'
                  INDK = KXLT (IJ, IG)  
                  INDI = IXLG (IJ, IG)  
                  IDEPTHU = NINT (DEPTH (IJ, IG) )  
                  IDELREC = IDELPREC  
                  RETURN  
               ENDIF  
               IF (SW1.GE.1.0) THEN  
                  IPROPFR (IJ, IG) = MAX (NINT (FRRT), IPROPFR ( &
                   IJ, IG) )
                  IF (M.EQ.1) WRITE (IU06, 3001) IXLG (IJ, IG) , &
                   KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, &
                   SW1, SW2, SW3, SW4, IDELPREC, ' WARNING'
               ENDIF  
 1139             END DO  
         ENDIF  
!
!*    BRANCH BACK TO 1.1.3.2 FOR NEXT FREQUENCY.
!
 1130       END DO  
!SHALLOW
   ENDIF  
!
!*    BRANCH BACK TO 1.1 FOR NEXT DIRECTION.
!
 1100 END DO  
!
!*    1.2 END OF CFL CHECK FOR CARTESIAN GRID
!*        WITHOUT REFRACTION OR WITH DEPTH REFRACTION, RETURN.
!         ----------------------------------------------------
!
DO 1115 IJ = IJS (IG), IJL (IG)  
   IX = IXLG (IJ, IG)  
   IY = NGY - KXLT (IJ, IG) + 1  
   GRDFR (IX, IY) = REAL (IDELPRO / IPROPFR (IJ, IG) )  
 1115 END DO  
IF (IG.EQ.IGL) THEN  
WRITE (IU06,  * ) '   =================================', '======= &
&====================='
   CALL OUTPP (IDATEA, IU06, TITL, 1., GRDFR, AMOWEP, AMOSOP, &
    AMOEAP, AMONOP)
   WRITE (IU06, * ) ' '  
ENDIF  
!
RETURN  
!
! ----------------------------------------------------------------------
!
!*    2. CFL CRIT. IS CHECKED FOR CARTESIAN GRID
!*       WITH DEPTH AND CURRENT REFRACTION.
!        ---------------------------------------
!
 2000 CONTINUE  
!
DELPRO = FLOAT (IDELPRO)  
DELPH0 = 0.25 * DELPRO / DELPHI  
DELTH0 = 0.25 * DELPRO / DELTH  
DELLA0 = 0.25 * DELPRO / DELLAM  
DELFR0 = 0.25 * DELPRO / (0.1 * ZPI)  
!
!*    2.1 LOOP OVER DIRECTIONS.
!         ---------------------
!
DO 2100 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  
!
!*    2.1.1 DEPTH REFRACTION IF SHALLOW WATER.
!           ----------------------------------
!
   IF (ISHALLO.NE.1) THEN  
      DO 2101 IJ = IJS (IG), IJL (IG)  
         DRDP (IJ) = (THDD (IJ, K) + THDD (IJ, KP1) ) * DELTH0  
         DRDM (IJ) = (THDD (IJ, K) + THDD (IJ, KM1) ) * DELTH0  
 2101       END DO  
   ENDIF  
!
!*    2.1.2 CURRENT REFRACTION.
!           -------------------
!
   DO 2102 IJ = IJS (IG), IJL (IG)  
      DRCP (IJ) = (THDC (IJ, K) + THDC (IJ, KP1) ) * DELTH0  
      DRCM (IJ) = (THDC (IJ, K) + THDC (IJ, KM1) ) * DELTH0  
 2102    END DO  
!
!*    2.1.3 LOOP OVER FREQUENCIES.
!           ----------------------
!
   DO 2130 M = 1, NFRE  
      IF (ISHALLO.EQ.1) THEN  
!
!*    2.1.3.1 DEEP WATER.
!             -----------
!
 2132          CONTINUE  
      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 2133 IJ = 1, IJLT (IG)  
            CGOND (IJ) = TCGOND (INDEP (IJ), M)  
 2133          END DO  
!
!*    2.1.3.2.2 WEIGHTS IN INTEGRATION SCHEME.
!               ------------------------------
!
         DLA (0) = SD * CGOND (0)  
         DPH (0) = CD * CGOND (0)  
         DO 2134 IJ = 1, IJLT (IG)  
            DLA (IJ) = U (IJ, IG) * DELLA0 + SD * CGOND (IJ)  
            DPH (IJ) = V (IJ, IG) * DELPH0 + CD * CGOND (IJ)  
 2134          END DO  
         DO 2135 IJ = IJS (IG), IJL (IG)  
            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)  
            SW4 = DLEA + ABS (DLEA) - DLWE+ABS (DLWE)  

            FR4 = FLOAT (INT (SW4) + 1)  
            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)
            SW5 = + DPNO + ABS (DPNO) - DPSO + ABS (DPSO)  

            FR5 = FLOAT (INT (SW5) + 1)  
            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)
            SW2 = + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)  
            FR2 = FLOAT (INT (SW2) + 1)  
            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)
            SW3 = + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)  
            FR3 = FLOAT (INT (SW3) + 1)  
            DOP (IJ) = ( - DTHP + ABS (DTHP) ) / 1.1  

            DOM (IJ) = (DTHM + ABS (DTHM) ) * 1.1  
            SW1 = DTC (IJ)  
            FR1 = FLOAT (INT (SW1) + 1)  
            	FRRT = MAX (FR1, FR2, FR3, FR4, FR5)  
            	FRRI = MAX (FR2, FR3, FR4, FR5)  
            	IDELPREC = IDELPRO / NINT (FRRT)  
            IF (FRRT.GT.1.0) THEN  
               IF (FRSTIMECFL) THEN  
                  WRITE (IU06, * ) ' '  
WRITE (IU06,  * ) '  CFL-CRITERION FOR BLOCK : ', IG  
WRITE (IU06,  * ) '   GRID POINT           SUBSTRACTED WEIGHTS'  
WRITE (IU06,  * ) '   IIND KIND DPTH DIR FRQ TSUB  PREF PFRQ', ' &
&PLON  PLAT  TS-REC  DIAG'
WRITE (IU06,  * ) '   =================================', '======= &
&=========================='
               ENDIF  
               FRSTIMECFL = .FALSE.  
            ENDIF  
            IF (FRRI.GT.1.0.OR.SW1.GE.2.0) THEN  
               IF (M.EQ.1) WRITE (IU06, 4101) IXLG (IJ, IG) , &
                KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, SW1, &
                SW2, SW3, SW4, SW5, IDELPREC, ' UNSTABL'
               INDK = KXLT (IJ, IG)  
               INDI = IXLG (IJ, IG)  
               IDEPTHU = NINT (DEPTH (IJ, IG) )  
               IDELREC = IDELPREC  
               RETURN  
            ENDIF  
            IF (SW1.GE.1.0) THEN  
               IPROPFR (IJ, IG) = MAX (NINT (FRRT), IPROPFR (IJ, &
                IG) )
               IF (M.EQ.1) WRITE (IU06, 4101) IXLG (IJ, IG) , &
                KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, SW1, &
                SW2, SW3, SW4, SW5, IDELPREC, ' WARNING'
            ENDIF  
 2135          END DO  
!SHALLOW
      ENDIF  
!
!*    BRANCH BACK TO 2.1.3 FOR NEXT FREQUENCY.
!
 2130    END DO  
!
!*    BRANCH BACK TO 2.1 FOR NEXT DIRECTION.
!
 2100 END DO  
!
!*    2.2 END OF CFL CHECK FOR CARTESIAN GRID
!*        WITH DEPTH AND CURRENT REFRACTION, RETURN.
!         ------------------------------------------
!
DO 2115 IJ = IJS (IG), IJL (IG)  
   IX = IXLG (IJ, IG)  
   IY = NGY - KXLT (IJ, IG) + 1  
   GRDFR (IX, IY) = REAL (IDELPRO / IPROPFR (IJ, IG) )  
 2115 END DO  
IF (IG.EQ.IGL) THEN  
WRITE (IU06,  * ) '   =================================', '======= &
&====================='
   CALL OUTPP (IDATEA, IU06, TITL, 1., GRDFR, AMOWEP, AMOSOP, &
    AMOEAP, AMONOP)
   WRITE (IU06, * ) ' '  
ENDIF  
!
RETURN  
!
! ----------------------------------------------------------------------
!
!*    3. CFL CRITERIUM CHECKED FOR SPHERICAL LATITUDE/LONGITUDE
!*       GRID WITHOUT REFRACTION OR WITH DEPTH AND GRID REFRACTION.
!        ----------------------------------------------------------
!
 3000 CONTINUE  
!
DELPRO = FLOAT (IDELPRO)  
DELTH0 = 0.25 * DELPRO / DELTH  
DELPH0 = 0.5 * DELPRO / DELPHI  
IF (ISHALLO.EQ.1) THEN  
   DELLA0 = DELPRO / DELLAM  
ELSE  
   DELLA0 = 0.5 * DELPRO / DELLAM  
ENDIF  
!
!*    3.1 LOOP OVER DIRECTIONS.
!         ---------------------
!
DO 3100 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  
   SDA = ABS (SD)  
   CDA = ABS (CD)  
!
!*    3.1.1 COMPUTE GRID REFRACTION.
!           ------------------------
!
   SP = DELTH0 * (SINTH (K) + SINTH (KP1) ) / R  
   SM = DELTH0 * (SINTH (K) + SINTH (KM1) ) / R  
   DO 3101 IJ = IJS (IG), IJL (IG)  
      JH = KXLT (IJ, IG)  
      TANPH = SINPH (JH) * DCO (IJ)  
      DRGP (IJ) = TANPH * SP  
      DRGM (IJ) = TANPH * SM  
 3101    END DO  
!
!*    3.1.2 INDEX FOR ADJOINING POINTS.
!           ---------------------------
!
   IF (SD.LT.0) THEN  
      IJLA = 2  
   ELSE  
      IJLA = 1  
   ENDIF  
   IF (CD.LT.0) THEN  
      IJPH = 2  
   ELSE  
      IJPH = 1  
   ENDIF  
!
   IF (ISHALLO.EQ.1) THEN  
!
 3135       CONTINUE  
!
   ELSE  
!SHALLOW
!
!*    3.1.4 SHALLOW WATER.
!           --------------
!
!
!*    3.1.4.1 COMPUTE DEPTH REFRACTION.
!             -------------------------
!
      IF (IREFRA.EQ.1) THEN  
         DO 3141 IJ = IJS (IG), IJL (IG)  
            DRDP (IJ) = (THDD (IJ, K) + THDD (IJ, KP1) ) * DELTH0  
            DRDM (IJ) = (THDD (IJ, K) + THDD (IJ, KM1) ) * DELTH0  
 3141          END DO  
      ENDIF  
!
!*    3.1.4.2 LOOP OVER FREQUENCIES.
!             ----------------------
!
      DO 3142 M = 1, NFRE  
!
!*    3.1.4.2.1 GROUP VELOCITIES.
!               -----------------
!
         CGOND (0) = TCGOND (NDEPTH, M)  
         DO 3143 IJ = 1, IJLT (IG)  
            CGOND (IJ) = TCGOND (INDEP (IJ), M)  
 3143          END DO  
!
!*    3.1.4.3.2 LAT / LONG WEIGHTS IN INTEGRATION SCHEME.
!               -----------------------------------------
!
         IF (SD.GT.0.) THEN  
            DO 3144 IJ = IJS (IG), IJL (IG)  
               DTC (IJ) = 1. - DCO (IJ) * SDA * (CGOND (KLON (IJ, &
                2) ) + CGOND (IJ) )
               DTCSDLE (IJ) = DCO (IJ) * SDA * (CGOND (KLON (IJ, &
                2) ) + CGOND (IJ) )
               DLE (IJ) = DCO (IJ) * SDA * (CGOND (KLON (IJ, 1) ) &
                + CGOND (IJ) )
 3144             END DO  
         ELSE  
            DO 3145 IJ = IJS (IG), IJL (IG)  
               DTC (IJ) = 1. - DCO (IJ) * SDA * (CGOND (KLON (IJ, &
                1) ) + CGOND (IJ) )
               DTCSDLE (IJ) = DCO (IJ) * SDA * (CGOND (KLON (IJ, &
                1) ) + CGOND (IJ) )
               DLE (IJ) = DCO (IJ) * SDA * (CGOND (KLON (IJ, 2) ) &
                + CGOND (IJ) )
 3145             END DO  
         ENDIF  
         IF (CD.GT.0.) THEN  
            DO 3146 IJ = IJS (IG), IJL (IG)  
               DTC (IJ) = DTC (IJ) - CDA * (CGOND (KLAT (IJ, 2) ) &
                * DP2 (IJ) + CGOND (IJ) )
               DTCSDPN (IJ) = CDA * (CGOND (KLAT (IJ, 2) ) &
                * DP2 (IJ) + CGOND (IJ) )
               DPN (IJ) = CDA * (CGOND (KLAT (IJ, 1) ) * DP1 (IJ) &
                + CGOND (IJ) )
 3146             END DO  
         ELSE  
            DO 3147 IJ = IJS (IG), IJL (IG)  
               DTC (IJ) = DTC (IJ) - CDA * (CGOND (KLAT (IJ, 1) ) &
                * DP1 (IJ) + CGOND (IJ) )
               DTCSDPN (IJ) = CDA * (CGOND (KLAT (IJ, 1) ) &
                * DP1 (IJ) + CGOND (IJ) )
               DPN (IJ) = CDA * (CGOND (KLAT (IJ, 2) ) * DP2 (IJ) &
                + CGOND (IJ) )
 3147             END DO  
         ENDIF  
!
!*    3.1.4.2.3 REFRACTION WEIGHTS IN INTEGRATION SCHEME.
!               -----------------------------------------
!
         IF (IREFRA.EQ.0) THEN  
            DO 3148 IJ = IJS (IG), IJL (IG)  
               DTHP = DRGP (IJ) * CGOND (IJ)  
               DTHM = DRGM (IJ) * CGOND (IJ)  
               DTC (IJ) = DTC (IJ) - DTHP - ABS (DTHP) + DTHM - &
                ABS (DTHM)
               DTP (IJ) = - DTHP + ABS (DTHP)  
               DTM (IJ) = DTHM + ABS (DTHM)  
               SW1 = 1 - DTC (IJ)  
               SW2 = - ( - DTHP - ABS (DTHP) + DTHM - ABS (DTHM) )  
               SW3 = DTCSDPN (IJ)  
               SW4 = DTCSDLE (IJ)  
               FR1 = FLOAT (INT (SW1) + 1)  
               FR2 = FLOAT (INT (SW2) + 1)  
               FR3 = FLOAT (INT (SW3) + 1)  
               FR4 = FLOAT (INT (SW4) + 1)  
               	FRRT = MAX (FR1, FR2, FR3, FR4)  
               	FRRI = MAX (FR2, FR3, FR4)  
               	IDELPREC = IDELPRO / NINT (FRRT)  
               IF (FRRT.GT.1.0) THEN  
                  IF (FRSTIMECFL) THEN  
                     WRITE (IU06, * ) ' '  
WRITE (IU06,  * ) '  CFL-CRITERION FOR BLOCK : ', IG  
WRITE (IU06,  * ) '   GRID POINT           SUBSTRACTED WEIGHTS'  
WRITE (IU06,  * ) '   IIND KIND DPTH DIR FRQ TSUB  PREF', '  PLAT &
& PLON  TS-REC  DIAG'
WRITE (IU06,  * ) '   =================================', '======= &
&====================='
                  ENDIF  
                  FRSTIMECFL = .FALSE.  
               ENDIF  
               IF (FRRI.GT.1.0.OR.SW1.GE.2.0) THEN  
                  IF (M.EQ.1) WRITE (IU06, 3001) IXLG (IJ, IG) , &
                   KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, &
                   SW1, SW2, SW3, SW4, IDELPREC, ' UNSTABL'
                  INDK = KXLT (IJ, IG)  
                  INDI = IXLG (IJ, IG)  
                  IDEPTHU = NINT (DEPTH (IJ, IG) )  
                  IDELREC = IDELPREC  
                  RETURN  
               ENDIF  
               IF (SW1.GE.1.0) THEN  
                  IPROPFR (IJ, IG) = MAX (NINT (FRRT), IPROPFR ( &
                   IJ, IG) )
                  IF (M.EQ.1) WRITE (IU06, 3001) IXLG (IJ, IG) , &
                   KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, &
                   SW1, SW2, SW3, SW4, IDELPREC, ' WARNING'
               ENDIF  
 3148             END DO  
         ELSE  
            DO 3149 IJ = IJS (IG), IJL (IG)  
               DTHP = DRGP (IJ) * CGOND (IJ) + FCONST (IJ, M) &
                * DRDP (IJ)
               DTHM = DRGM (IJ) * CGOND (IJ) + 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)  
               SW1 = 1 - DTC (IJ)  
               SW2 = - ( - DTHP - ABS (DTHP) + DTHM - ABS (DTHM) )  
               SW3 = DTCSDPN (IJ)  
               SW4 = DTCSDLE (IJ)  
               FR1 = FLOAT (INT (SW1) + 1)  
               FR2 = FLOAT (INT (SW2) + 1)  
               FR3 = FLOAT (INT (SW3) + 1)  
               FR4 = FLOAT (INT (SW4) + 1)  
               	FRRT = MAX (FR1, FR2, FR3, FR4)  
               	FRRI = MAX (FR2, FR3, FR4)  
               	IDELPREC = IDELPRO / NINT (FRRT)  
               IF (FRRT.GT.1.0) THEN  
                  IF (FRSTIMECFL) THEN  
                     WRITE (IU06, * ) ' '  
WRITE (IU06,  * ) '  CFL-CRITERION FOR BLOCK : ', IG  
WRITE (IU06,  * ) '   GRID POINT           SUBSTRACTED WEIGHTS'  
WRITE (IU06,  * ) '   IIND KIND DPTH DIR FRQ TSUB  PREF', '  PLAT &
& PLON  TS-REC  DIAG'
WRITE (IU06,  * ) '   =================================', '======= &
&====================='
                  ENDIF  
                  FRSTIMECFL = .FALSE.  
               ENDIF  
               IF (FRRI.GT.1.0.OR.SW1.GE.2.0) THEN  
                  IF (M.EQ.1) WRITE (IU06, 3001) IXLG (IJ, IG) , &
                   KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, &
                   SW1, SW2, SW3, SW4, IDELPREC, ' UNSTABL'
                  INDK = KXLT (IJ, IG)  
                  INDI = IXLG (IJ, IG)  
                  IDEPTHU = NINT (DEPTH (IJ, IG) )  
                  IDELREC = IDELPREC  
                  RETURN  
               ENDIF  
               IF (SW1.GE.1.0) THEN  
                  IPROPFR (IJ, IG) = MAX (NINT (FRRT), IPROPFR ( &
                   IJ, IG) )
                  IF (M.EQ.1) WRITE (IU06, 3001) IXLG (IJ, IG) , &
                   KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, &
                   SW1, SW2, SW3, SW4, IDELPREC, ' WARNING'
               ENDIF  
 3149             END DO  
         ENDIF  
 3001 FORMAT          (3X,3I5,I3,I4,1X,4F6.3,I5,A10)  
!
!*    BRANCH BACK TO 3.1.4.2 FOR NEXT FREQUENCY.
!
 3142       END DO  
!SHALLOW
   ENDIF  
!
!*    BRANCH BACK TO 3.1 FOR NEXT DIRECTION.
!
 3100 END DO  
!
!*    3.2 END OF CFL CRITERIUM CHECK FOR SPHERICAL LATITUDE/LONGITUDE
!*        GRID WITHOUT REFRACTION OR WITH DEPTH AND GRID REFRACTION.
!         -----------------------------------------------------------
!
DO 3115 IJ = IJS (IG), IJL (IG)  
   IX = IXLG (IJ, IG)  
   IY = NGY - KXLT (IJ, IG) + 1  
   GRDFR (IX, IY) = REAL (IDELPRO / IPROPFR (IJ, IG) )  
 3115 END DO  
IF (IG.EQ.IGL) THEN  
WRITE (IU06,  * ) '   =================================', '======= &
&====================='
   CALL OUTPP (IDATEA, IU06, TITL, 1., GRDFR, AMOWEP, AMOSOP, &
    AMOEAP, AMONOP)
   WRITE (IU06, * ) ' '  
ENDIF  
!
RETURN  
!
! ----------------------------------------------------------------------
!
!*    4. CFL IS CHECKED FOR SPHERICAL LATITUDE/LONGITUDE GRID
!*       WITH DEPTH AND CURRENT REFRACTION.
!        ----------------------------------------------------
!
 4000 CONTINUE  
!
DELPRO = FLOAT (IDELPRO)  
DELPH0 = 0.25 * DELPRO / DELPHI  
DELTH0 = 0.25 * DELPRO / DELTH  
DELLA0 = 0.25 * DELPRO / DELLAM  
DELFR0 = 0.25 * DELPRO / (0.1 * ZPI)  
!
!*    4.1 LOOP OVER DIRECTIONS.
!         ---------------------
!
DO 4100 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  
!
!*    4.1.1 COMPUTE GRID REFRACTION.
!           ------------------------
!
   SP = DELTH0 * (SINTH (K) + SINTH (KP1) ) / R  
   SM = DELTH0 * (SINTH (K) + SINTH (KM1) ) / R  
   DO 4111 IJ = IJS (IG), IJL (IG)  
      JH = KXLT (IJ, IG)  
      TANPH = SINPH (JH) * DCO (IJ)  
      DRGP (IJ) = TANPH * SP  
      DRGM (IJ) = TANPH * SM  
 4111    END DO  
!
!*    4.1.2 COMPUTE DEPTH REFRACTION.
!           -------------------------
!
   IF (ISHALLO.NE.1) THEN  
      DO 4121 IJ = IJS (IG), IJL (IG)  
         DRDP (IJ) = (THDD (IJ, K) + THDD (IJ, KP1) ) * DELTH0  
         DRDM (IJ) = (THDD (IJ, K) + THDD (IJ, KM1) ) * DELTH0  
 4121       END DO  
   ENDIF  
!
!*    4.1.3 COMPUTE CURRENT REFRACTION.
!           ---------------------------
!
   DO 4131 IJ = IJS (IG), IJL (IG)  
      DRCP (IJ) = (THDC (IJ, K) + THDC (IJ, KP1) ) * DELTH0  
      DRCM (IJ) = (THDC (IJ, K) + THDC (IJ, KM1) ) * DELTH0  
 4131    END DO  
!
!*    4.1.4 LOOP OVER FREQUENCIES.
!           ----------------------
!
   DO 4140 M = 1, NFRE  
      MP1 = MIN (NFRE, M + 1)  
      MM1 = MAX (1, M - 1)  
      IF (ISHALLO.EQ.1) THEN  
!
!*    4.1.4.1 DEEP WATER.
!             -----------
!
 4142          CONTINUE  
!
      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 4143 IJ = 1, IJLT (IG)  
            CGOND (IJ) = TCGOND (INDEP (IJ), M)  
 4143          END DO  
!
!*    4.1.4.2.2 LON/LAT/DIR WEIGHTS IN INTEGRATION SCHEME.
!               ------------------------------------------
!
         DLA (0) = SD * CGOND (0)  
         DPH (0) = CD * CGOND (0)  
         DO 4144 IJ = 1, IJLT (IG)  
            DLA (IJ) = (U (IJ, IG) * DELLA0 + SD * CGOND (IJ) ) &
             * DCO (IJ)
            DPH (IJ) = V (IJ, IG) * DELPH0 + CD * CGOND (IJ)  
 4144          END DO  
         DO 4145 IJ = IJS (IG), IJL (IG)  
            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)  
            SW4 = DLEA + ABS (DLEA) - DLWE+ABS (DLWE)  

            FR4 = FLOAT (INT (SW4) + 1)  
            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)
            SW5 = DPNO + ABS (DPNO) - DPSO + ABS (DPSO)  

            FR5 = FLOAT (INT (SW5) + 1)  
            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)
            DTP (IJ) = - DTHP + ABS (DTHP)  
            DTM (IJ) = DTHM + ABS (DTHM)  
            SW2 = + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)  

            FR2 = FLOAT (INT (SW2) + 1)  
            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)
            DOP (IJ) = ( - DTHP + ABS (DTHP) ) / 1.1  
            DOM (IJ) = (DTHM + ABS (DTHM) ) * 1.1  
            SW3 = + DTHP + ABS (DTHP) - DTHM + ABS (DTHM)  

            FR3 = FLOAT (INT (SW3) + 1)  
            SW1 = DTC (IJ)  
            FR1 = FLOAT (INT (SW1) + 1)  
            	FRRT = MAX (FR1, FR2, FR3, FR4, FR5)  
            	FRRI = MAX (FR2, FR3, FR4, FR5)  
            	IDELPREC = IDELPRO / NINT (FRRT)  
            IF (FRRT.GT.1.0) THEN  
               IF (FRSTIMECFL) THEN  
                  WRITE (IU06, * ) ' '  
WRITE (IU06,  * ) '  CFL-CRITERION FOR BLOCK : ', IG  
WRITE (IU06,  * ) '   GRID POINT           SUBSTRACTED WEIGHTS'  
WRITE (IU06,  * ) '   IIND KIND DPTH DIR FRQ TSUB  PREF PFRQ', ' &
&PLON  PLAT  TS-REC  DIAG'
WRITE (IU06,  * ) '   =================================', '======= &
&=========================='
               ENDIF  
               FRSTIMECFL = .FALSE.  
            ENDIF  
            IF (FRRI.GT.1.0.OR.SW1.GE.2.0) THEN  
               IF (M.EQ.1) WRITE (IU06, 4101) IXLG (IJ, IG) , &
                KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, SW1, &
                SW2, SW3, SW4, SW5, IDELPREC, ' UNSTABL'
               INDK = KXLT (IJ, IG)  
               INDI = IXLG (IJ, IG)  
               IDEPTHU = NINT (DEPTH (IJ, IG) )  
               IDELREC = IDELPREC  
               RETURN  
            ENDIF  
            IF (SW1.GE.1.0) THEN  
               IPROPFR (IJ, IG) = MAX (NINT (FRRT), IPROPFR (IJ, &
                IG) )
               IF (M.EQ.1) WRITE (IU06, 4101) IXLG (IJ, IG) , &
                KXLT (IJ, IG) , NINT (DEPTH (IJ, IG) ) , K, M, SW1, &
                SW2, SW3, SW4, SW5, IDELPREC, ' WARNING'

            ENDIF  
 4145          END DO  
!SHALLOW
      ENDIF  
!
!*    BRANCH BACK TO 4.1.4 FOR NEXT FREQUENCY.
!
 4140    END DO  
!
!*    BRANCH BACK TO 4.2 FOR NEXT DIRECTION.
!
 4100 END DO  
 4101 FORMAT(3X,3I5,I3,I4,1X,5F6.3,I5,A10)  
!
!*    4.4 END OF CFL CHECK   FOR SPHERICAL GRID
!*        WITH DEPTH AND CURRENT REFRACTION, RETURN.
!         ------------------------------------------
!
DO IJ = IJS (IG), IJL (IG)  
   IX = IXLG (IJ, IG)  
   IY = NGY - KXLT (IJ, IG) + 1  
   GRDFR (IX, IY) = REAL (IDELPRO / IPROPFR (IJ, IG) )  
END DO  
IF (IG.EQ.IGL) THEN  
WRITE (IU06,  * ) '   =================================', '======= &
&====================='
!        CALL OUTPP ( IDAREA, IU06, TITL, 1.,
   CALL OUTPP (IDATEA, IU06, TITL, 1., GRDFR, AMOWEP, AMOSOP, &
    AMOEAP, AMONOP)
   WRITE (IU06, * ) ' '  

ENDIF  
RETURN  
END SUBROUTINE cflsub
