!OPTIONS XOPT(NOEVAL)
SUBROUTINE SUECRADI15

!**** *SUECRADI15* - INITIALIZE DATA STRUCTURES FOR RADIATION INTERPOL.
!****                FROZEN VERSION (CYCLE 15) OF SUECRADI

!     PURPOSE.
!     --------
!           INITIALIZE DATA STRUCTURES FOR RADIATION INTERPOLATION

!**   INTERFACE.
!     ----------
!        CALL *SUECRADI15* FROM *SUECRAD15*
!              ----------        ---------

!        EXPLICIT ARGUMENTS :
!        --------------------
!        NONE

!        IMPLICIT ARGUMENTS :
!        --------------------

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.
!     ----------
!        NONE

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------
!        96-11: Ph. Dandin. Meteo-France
!        ORIGINAL BY GEORGE MOZDZYNSKI 95-03-13

!     MODIFICATIONS.
!     --------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE PARRINT  , ONLY : JPRADCW  ,JPRADCE
USE YOMDIM   , ONLY : NDGSAG   ,NDGSAL   ,NDGENG   ,NDGENL   ,NDLON
USE YOMCT0   , ONLY : N_REGIONS_NS    ,N_REGIONS_EW
USE YOMLUN   , ONLY : NULOUT
USE YOMGEM   , ONLY : NLOEN    ,NLOENG
USE YOMRAD15 , ONLY : NAER15   ,NFLUX15  ,NMODE15  ,NRAD15   ,&
 & NRADFR15 ,NRADPFR15,NRADPLA15,NRINT15  ,NOVLP15  ,&
 & NRPROMA15,NRADF2C15,NRADC2F15,LERAD6H15,LERADHS15 ,&
 & LRADAER15,LNEWAER15
USE YOMMP    , ONLY : LSPLIT   ,MY_REGION_NS   ,MY_REGION_EW   ,NSTA     ,&
 & NONL     ,NPTRFRSTLAT,NPTRLSTLAT,NFRSTLAT ,NLSTLAT  ,&
 & LSPLITLAT  
USE YOMPRAD  , ONLY : LODBGRADI,LODBGRADL,NRIRINT  ,NRFRSTOFF,&
 & NRLASTOFF,NRIMAX   ,NRIMAXT  ,NRCNEEDW ,NRCNEEDE ,&
 & NRCSNDW  ,NRCSNDE  ,NRCRCVW  ,NRCRCVE  ,NRCSNDT  ,&
 & NRCRCVT  ,NRCRCVWO ,NRCRCVEO  

IMPLICIT NONE

#include "namrad15.h"

INTEGER(KIND=JPIM) :: ILWA (2*N_REGIONS_EW)
INTEGER(KIND=JPIM) :: ILWB (2*N_REGIONS_EW)
INTEGER(KIND=JPIM) :: ILWBI(2*N_REGIONS_EW)
INTEGER(KIND=JPIM) :: ILEA (2*N_REGIONS_EW)
INTEGER(KIND=JPIM) :: ILEB (2*N_REGIONS_EW)
INTEGER(KIND=JPIM) :: ILEBI(2*N_REGIONS_EW)
INTEGER(KIND=JPIM) :: ISTA(NDGENL,2*N_REGIONS_EW)
INTEGER(KIND=JPIM) :: IONL(NDGENL,2*N_REGIONS_EW)
CHARACTER (LEN = 14) ::  CLDBG

INTEGER(KIND=JPIM) :: IAO, IAOFF, IB, IB1, IB2, IB3, IB4, IB5,&
 & IB6, ICNEED, ICTAKE, IGL, IJBXBOFF, IJBXSETA, &
 & ILE, ILEN, ILONS, ILW, IMAX, IMAXC, IMAXT, &
 & IOTHBOFF, IOTHSETA, IPROCB, IRINT, IUNIT, &
 & JA, JB, JBE, JBW, JBX, JF, JGL, JGLGLO, JL  

LOGICAL :: LLMESS, LLMYSETAISWEST
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

!      ----------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('SUECRADI15',0,ZHOOK_HANDLE)
LLMESS=.FALSE.
IUNIT=0
ALLOCATE(NRIRINT  (NDGSAG:NDGENG))
WRITE(NULOUT,9990) 'NRIRINT  ',SIZE(NRIRINT),SHAPE(NRIRINT)
ALLOCATE(NRIMAX   (NDGSAG:NDGENG,2*N_REGIONS_EW))
WRITE(NULOUT,9990) 'NRIMAX',SIZE(NRIMAX),SHAPE(NRIMAX)
IF( LLMESS )THEN
  ALLOCATE(NRFRSTOFF(NDGSAG:NDGENG,2*N_REGIONS_EW))
  WRITE(NULOUT,9990) 'NRFRSTOFF',SIZE(NRFRSTOFF),SHAPE(NRFRSTOFF)
  ALLOCATE(NRLASTOFF(NDGSAG:NDGENG,2*N_REGIONS_EW))
  WRITE(NULOUT,9990) 'NRLASTOFF',SIZE(NRLASTOFF),SHAPE(NRLASTOFF)
  ALLOCATE(NRIMAX   (NDGSAG:NDGENG,2*N_REGIONS_EW))
  WRITE(NULOUT,9990) 'NRIMAX',SIZE(NRIMAX),SHAPE(NRIMAX)
  ALLOCATE(NRCNEEDW (NDGSAG:NDGENG,2*N_REGIONS_EW))
  WRITE(NULOUT,9990) 'NRCNEEDW',SIZE(NRCNEEDW),SHAPE(NRCNEEDW)
  ALLOCATE(NRCNEEDE (NDGSAG:NDGENG,2*N_REGIONS_EW))
  WRITE(NULOUT,9990) 'NRCNEEDE',SIZE(NRCNEEDE),SHAPE(NRCNEEDE)
  ALLOCATE(NRCSNDW  (NDGSAG:NDGENG,N_REGIONS_EW,-1:1))
  WRITE(NULOUT,9990) 'NRCSNDW',SIZE(NRCSNDW),SHAPE(NRCSNDW)
  ALLOCATE(NRCSNDE  (NDGSAG:NDGENG,N_REGIONS_EW,-1:1))
  WRITE(NULOUT,9990) 'NRCSNDE',SIZE(NRCSNDE),SHAPE(NRCSNDE)
  ALLOCATE(NRCRCVW  (NDGSAG:NDGENG,N_REGIONS_EW,-1:1))
  WRITE(NULOUT,9990) 'NRCRCVW',SIZE(NRCRCVW),SHAPE(NRCRCVW)
  ALLOCATE(NRCRCVE  (NDGSAG:NDGENG,N_REGIONS_EW,-1:1))
  WRITE(NULOUT,9990) 'NRCRCVE',SIZE(NRCRCVE),SHAPE(NRCRCVE)
  ALLOCATE(NRCSNDT  (N_REGIONS_EW,-1:1))
  WRITE(NULOUT,9990) 'NRCSNDT',SIZE(NRCSNDT),SHAPE(NRCSNDT)
  ALLOCATE(NRCRCVT  (N_REGIONS_EW,-1:1))
  WRITE(NULOUT,9990) 'NRCRCVT',SIZE(NRCRCVT),SHAPE(NRCRCVT)
  ALLOCATE(NRCRCVWO (NDGSAG:NDGENG,N_REGIONS_EW,-1:1))
  WRITE(NULOUT,9990) 'NRCRCVWO',SIZE(NRCRCVWO),SHAPE(NRCRCVWO)
  ALLOCATE(NRCRCVEO (NDGSAG:NDGENG,N_REGIONS_EW,-1:1))
  WRITE(NULOUT,9990) 'NRCRCVEO',SIZE(NRCRCVEO),SHAPE(NRCRCVEO)
ENDIF
9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

IF( LLMESS )THEN

  IF( NRINT15 > 1.AND. (NRADF2C15 == 1.OR. NRADC2F15 == 1))THEN
    IF( LSPLIT .AND. N_REGIONS_NS > 1 )THEN
      WRITE(NULOUT,'("SUECRAD: FFT INTERPOLATION UNSUPPORTED",&
       & " WITH LSPLIT")')  
      CALL ABOR1('FFT INTERPOLATION UNSUPPORTED WITH LSPLIT')
    ENDIF
    IF( N_REGIONS_EW > 1 )THEN
      WRITE(NULOUT,'("SUECRAD: FFT INTERPOLATION UNSUPPORTED",&
       & " WITH N_REGIONS_EW > 1")')  
      CALL ABOR1('FFT INTERPOLATION UNSUPPORTED WITH N_REGIONS_EW > 1')
    ENDIF
  ENDIF

! INITIALISE GENERAL DATA STRUCTURES REQUIRED FOR RAD. INTERPOLATION

  DO JGL=NDGSAG,NDGENG
    NRIRINT(JGL)=0
  ENDDO
  DO JB=1,2*N_REGIONS_EW
    DO JGL=NDGSAG,NDGENG
      NRFRSTOFF(JGL,JB)=0
      NRLASTOFF(JGL,JB)=0
      NRIMAX   (JGL,JB)=0
      NRCNEEDW (JGL,JB)=0
      NRCNEEDE (JGL,JB)=0
    ENDDO
  ENDDO
  NRIMAXT=0
  DO JA=-1,1
    DO JB=1,N_REGIONS_EW
      DO JGL=NDGSAG,NDGENG
        NRCSNDW(JGL,JB,JA)=0
        NRCSNDE(JGL,JB,JA)=0
        NRCRCVW(JGL,JB,JA)=0
        NRCRCVE(JGL,JB,JA)=0
        NRCRCVWO(JGL,JB,JA)=0
        NRCRCVEO(JGL,JB,JA)=0
      ENDDO
    ENDDO
  ENDDO
  DO JA=-1,1
    DO JB=1,N_REGIONS_EW
      NRCSNDT(JB,JA)=0
      NRCRCVT(JB,JA)=0
    ENDDO
  ENDDO

  DO JB=1,2*N_REGIONS_EW
    DO JGL=1,NDGENL
      ISTA(JGL,JB)=0
      IONL(JGL,JB)=0
    ENDDO
  ENDDO
  DO JB=1,N_REGIONS_EW
    DO JGL=1,NDGENL
      IGL=NPTRFRSTLAT(MY_REGION_NS)-1+JGL
      ISTA(JGL,JB)=NSTA(IGL,JB)
      IONL(JGL,JB)=NONL(IGL,JB)
    ENDDO
  ENDDO
  IF( LSPLITLAT(NFRSTLAT(MY_REGION_NS)) )THEN
    LLMYSETAISWEST=.FALSE.
    DO JB=1,N_REGIONS_EW
      IF( NSTA(NPTRFRSTLAT(MY_REGION_NS),JB) == 1 )THEN
        LLMYSETAISWEST=.TRUE.
      ENDIF
    ENDDO
    IF( LLMYSETAISWEST )THEN
      DO JB=1,N_REGIONS_EW
        IGL=NPTRFRSTLAT(MY_REGION_NS+1)
        ISTA(1,JB+N_REGIONS_EW)=NSTA(IGL,JB)
        IONL(1,JB+N_REGIONS_EW)=NONL(IGL,JB)
      ENDDO
    ELSE
      DO JB=1,N_REGIONS_EW
        IGL=NPTRFRSTLAT(MY_REGION_NS)-1
        ISTA(1,JB+N_REGIONS_EW)=NSTA(IGL,JB)
        IONL(1,JB+N_REGIONS_EW)=NONL(IGL,JB)
      ENDDO
    ENDIF
  ENDIF
  IF( LSPLITLAT(NLSTLAT(MY_REGION_NS)) )THEN
    LLMYSETAISWEST=.FALSE.
    DO JB=1,N_REGIONS_EW
      IF( NSTA(NPTRLSTLAT(MY_REGION_NS),JB) == 1 )THEN
        LLMYSETAISWEST=.TRUE.
      ENDIF
    ENDDO
    IF( LLMYSETAISWEST )THEN
      DO JB=1,N_REGIONS_EW
        IGL=NPTRFRSTLAT(MY_REGION_NS+1)
        ISTA(NDGENL,JB+N_REGIONS_EW)=NSTA(IGL,JB)
        IONL(NDGENL,JB+N_REGIONS_EW)=NONL(IGL,JB)
      ENDDO
    ELSE
      DO JB=1,N_REGIONS_EW
        IGL=NPTRFRSTLAT(MY_REGION_NS)-1
        ISTA(NDGENL,JB+N_REGIONS_EW)=NSTA(IGL,JB)
        IONL(NDGENL,JB+N_REGIONS_EW)=NONL(IGL,JB)
      ENDDO
    ENDIF
  ENDIF

ELSE

  ILEN=NDGENG-NDGSAG+1
  DO JGL=NDGSAG,NDGENG
    NRIRINT(JGL)=0
    NRIMAX (JGL,1)=0
  ENDDO

ENDIF

IMAXC=NDLON/NRINT15+6
IMAXC=IMAXC+(1-MOD(IMAXC,2))

IF( LLMESS )THEN
  IF( LODBGRADI )THEN
    IUNIT=10
    WRITE(CLDBG,'("debug_a",I3.3,"b",I3.3)')MY_REGION_NS,MY_REGION_EW
    OPEN(UNIT=IUNIT,FILE=CLDBG)
    WRITE(IUNIT,'("SUECRADI: MY_REGION_NS=",I4," MY_REGION_EW=",I4)')MY_REGION_NS,MY_REGION_EW
    WRITE(IUNIT,'("SUECRADI: NDGSAL=",I4," NDGENL=",I4)') NDGSAL,NDGENL
    WRITE(IUNIT,'("SUECRADI: ")')
  ENDIF
ENDIF

! LOOP OVER OUR PARTITION LATITUDES, TO INITIALISE SIMPLE ITEMS

IF( LLMESS )THEN

  IMAXT=0

  DO JGL=1,NDGENL

    JGLGLO=NFRSTLAT(MY_REGION_NS)+JGL-1
    ILONS=NLOENG(JGLGLO)

    IRINT=1
    DO JF=1,NRINT15
      IF( MOD(ILONS,JF) == 0.AND.ILONS/JF <= IMAXC )THEN
        IRINT=JF
        GO TO 220
      ENDIF
    ENDDO
    220 CONTINUE
    NRIRINT  (JGL)=IRINT

    IF( LODBGRADI )THEN
      WRITE(IUNIT,'("SUECRADI: JGLGLO=",I4," JGL=",I4,&
       & " NLOENG=",I4," NRIRINT=",I1," LSPLITLAT=",L2)')&
       & JGLGLO,JGL,NLOENG(JGLGLO),NRIRINT(JGL),LSPLITLAT(JGLGLO)  
    ENDIF

    IF( LSPLITLAT(JGLGLO) )THEN
      IPROCB=2*N_REGIONS_EW
    ELSE
      IPROCB=N_REGIONS_EW
    ENDIF

    DO JB=1,IPROCB
      IF( IONL(JGL,JB) == 0 ) GOTO 250
      NRFRSTOFF(JGL,JB)=MOD(IRINT-MOD(ISTA(JGL,JB)-1,IRINT),IRINT)
      NRLASTOFF(JGL,JB)=&
       & MOD(IRINT-MOD(ISTA(JGL,JB)+IONL(JGL,JB)-2,IRINT),&
       & IRINT)  
      IMAX=0
      DO JL=1+NRFRSTOFF(JGL,JB),IONL(JGL,JB),IRINT
        IMAX=IMAX+1
      ENDDO
      NRIMAX(JGL,JB)=IMAX
      IF( NRFRSTOFF(JGL,JB) == 0 )THEN
        NRCNEEDW (JGL,JB)=JPRADCW-1
      ELSE
        NRCNEEDW (JGL,JB)=JPRADCW
      ENDIF
      IF( NRLASTOFF(JGL,JB) == 0 )THEN
        NRCNEEDE (JGL,JB)=JPRADCE-1
      ELSE
        NRCNEEDE (JGL,JB)=JPRADCE
      ENDIF
      IF( LODBGRADI )THEN
        WRITE(IUNIT,'("SUECRADI: JB=",I4," ISTA=",I4,&
         & " IONL=",I4," NRFRSTOFF=",I1," NRIMAX=",I3,&
         & " NRLASTOFF=",I1," CNEEDW=",I1," CNEEDE=",I1)')&
         & JB,ISTA(JGL,JB),IONL(JGL,JB),NRFRSTOFF(JGL,JB),&
         & NRIMAX(JGL,JB),NRLASTOFF(JGL,JB),&
         & NRCNEEDW(JGL,JB),NRCNEEDE(JGL,JB)  
      ENDIF
      250 continue
    ENDDO

    IF( LODBGRADI )THEN
      WRITE(IUNIT,'("SUECRADI: ")')
    ENDIF

    IMAXT=IMAXT+NRIMAX(JGL,MY_REGION_EW)

  ENDDO

  NRIMAXT=IMAXT
  IF( LODBGRADI )THEN
    WRITE(IUNIT,'("SUECRADI: NRIMAXT=",I6)') NRIMAXT
  ENDIF

ELSE

  DO JGL=NDGSAG,NDGENG

    ILONS=NLOEN(JGL)

    IRINT=1
    DO JF=1,NRINT15
      IF( MOD(ILONS,JF) == 0.AND.ILONS/JF <= IMAXC )THEN
        IRINT=JF
        GO TO 221
      ENDIF
    ENDDO
    221 CONTINUE

    NRIRINT(JGL)=IRINT
    NRIMAX (JGL,1)=ILONS/IRINT

  ENDDO

ENDIF

IF( LLMESS )THEN

! NOW LOOP OVER OUR PARTITION LATITUDES, TO DETERMINE SEND AND RECEIVE
! INFORMATION

  DO JGL=1,NDGENL

! TEST IF WE HAVE ANY FINE POINTS
! IF WE HAVEN'T, THEN WE DON'T HAVE TO SEND OR RECEIVE ANYTHING

    IF( IONL(JGL,MY_REGION_EW) == 0 ) GOTO 700
    JGLGLO=NFRSTLAT(MY_REGION_NS)+JGL-1

! TEST IF CURRENT LATITUDE IS SPLIT ACROSS SET A's
! TO SET IPROCB TO THE MAXIMUM NUMBER OF SETB's WE MUST CONSIDER IN
! THE FOLLOWING CODE FOR THIS LATITUDE

    IF( LSPLITLAT(JGLGLO) )THEN
      IPROCB=2*N_REGIONS_EW
    ELSE
      IPROCB=N_REGIONS_EW
    ENDIF

! NOW CONSIDER EACH PARTITION (ON THIS LATITUDE) IN TURN TO SEE WHO
! WILL BE SENDING TO AND RECEIVING FROM IT, AND OBVIOUSLY NOTING
! PERTINENT INFO IF OUR PARTITION IS SENDING OR RECEIVING

    DO JBX=1,IPROCB

! LET'S START BY BUILDING UP A LIST OF WESTERLY AND EASTERLY PARTITIONS
! CONTAINING ONE OR MORE FINE POINTS, SO THAT WE CAN SUBSEQUENTLY IGNORE
! ISSUES ABOUT WHETHER THIS IS A SPLIT LATITUDE AND THAT THE EARTH IS
! ROUND. ALSO THE PARTITION BEING CONSIDERED (JBX) ALWAYS APPEARS AT THE
! END OF EACH OF THESE LISTS, BECAUSE JBX MAY NEED TO 'LOGICALLY'
! SEND/RECEIVE COURSE POINTS TO/FROM ITS OWN PARTITION FOR THIS LATITUDE

      ILW=0
      ILE=0
      IF( LSPLITLAT(JGLGLO) )THEN

! DETERMINE WHETHER THE SET A SHARING THIS LATITUDE IS (ABOVE,LEFT) OR
! (BELOW,RIGHT). WE DETERMINE THIS BY TESTING IF ANY SETB ON THIS
! LATITUDE
! STARTS AT 1.

        IAOFF=-1
        DO JB=1,N_REGIONS_EW
          IF( ISTA(JGL,JB) == 1 )THEN
            IAOFF=1
            GOTO 411
          ENDIF
        ENDDO
        411 CONTINUE
        IF( JBX <= N_REGIONS_EW )THEN
          IJBXSETA=MY_REGION_NS
          IOTHSETA=MY_REGION_NS+IAOFF
          IJBXBOFF=0
          IOTHBOFF=N_REGIONS_EW
        ELSE
          IJBXSETA=MY_REGION_NS+IAOFF
          IOTHSETA=MY_REGION_NS
          IJBXBOFF=N_REGIONS_EW
          IOTHBOFF=0
        ENDIF
! INITIALISE WEST LIST, SPLIT LAT
        IF( JBX <= N_REGIONS_EW )THEN
          IB1=JBX-1
          IB2=1
          IB3=2*N_REGIONS_EW
          IB4=N_REGIONS_EW+1
          IB5=N_REGIONS_EW
          IB6=JBX
        ELSE
          IB1=JBX-1
          IB2=N_REGIONS_EW+1
          IB3=N_REGIONS_EW
          IB4=1
          IB5=2*N_REGIONS_EW
          IB6=JBX
        ENDIF
        DO JB=IB1,IB2,-1
          IF( IONL(JGL,JB) > 0 )THEN
            ILW=ILW+1
            ILWA (ILW)=IJBXSETA
            ILWB (ILW)=JB-IJBXBOFF
            ILWBI(ILW)=JB
          ENDIF
        ENDDO
        DO JB=IB3,IB4,-1
          IF( IONL(JGL,JB) > 0 )THEN
            ILW=ILW+1
            ILWA (ILW)=IOTHSETA
            ILWB (ILW)=JB-IOTHBOFF
            ILWBI(ILW)=JB
          ENDIF
        ENDDO
        DO JB=IB5,IB6,-1
          IF( IONL(JGL,JB) > 0 )THEN
            ILW=ILW+1
            ILWA (ILW)=IJBXSETA
            ILWB (ILW)=JB-IJBXBOFF
            ILWBI(ILW)=JB
          ENDIF
        ENDDO
! INITIALISE EAST LIST, SPLIT LAT
        IF( JBX <= N_REGIONS_EW )THEN
          IB1=JBX+1
          IB2=N_REGIONS_EW
          IB3=N_REGIONS_EW+1
          IB4=2*N_REGIONS_EW
          IB5=1
          IB6=JBX
        ELSE
          IB1=JBX+1
          IB2=2*N_REGIONS_EW
          IB3=1
          IB4=N_REGIONS_EW
          IB5=N_REGIONS_EW+1
          IB6=JBX
        ENDIF
        DO JB=IB1,IB2
          IF( IONL(JGL,JB) > 0 )THEN
            ILE=ILE+1
            ILEA (ILE)=IJBXSETA
            ILEB (ILE)=JB-IJBXBOFF
            ILEBI(ILE)=JB
          ENDIF
        ENDDO
        DO JB=IB3,IB4
          IF( IONL(JGL,JB) > 0 )THEN
            ILE=ILE+1
            ILEA (ILE)=IOTHSETA
            ILEB (ILE)=JB-IOTHBOFF
            ILEBI(ILE)=JB
          ENDIF
        ENDDO
        DO JB=IB5,IB6
          IF( IONL(JGL,JB) > 0 )THEN
            ILE=ILE+1
            ILEA (ILE)=IJBXSETA
            ILEB (ILE)=JB-IJBXBOFF
            ILEBI(ILE)=JB
          ENDIF
        ENDDO
      ELSE
        IAOFF=0
! INITIALISE WEST LIST, NOT SPLIT LAT
        DO JB=JBX-1,1,-1
          IF( IONL(JGL,JB) > 0 )THEN
            ILW=ILW+1
            ILWA (ILW)=MY_REGION_NS
            ILWB (ILW)=JB
            ILWBI(ILW)=JB
          ENDIF
        ENDDO
        DO JB=N_REGIONS_EW,JBX,-1
          IF( IONL(JGL,JB) > 0 )THEN
            ILW=ILW+1
            ILWA (ILW)=MY_REGION_NS
            ILWB (ILW)=JB
            ILWBI(ILW)=JB
          ENDIF
        ENDDO
! INITIALISE EAST LIST, NOT SPLIT LAT
        DO JB=JBX+1,N_REGIONS_EW
          IF( IONL(JGL,JB) > 0 )THEN
            ILE=ILE+1
            ILEA (ILE)=MY_REGION_NS
            ILEB (ILE)=JB
            ILEBI(ILE)=JB
          ENDIF
        ENDDO
        DO JB=1,JBX
          IF( IONL(JGL,JB) > 0 )THEN
            ILE=ILE+1
            ILEA (ILE)=MY_REGION_NS
            ILEB (ILE)=JB
            ILEBI(ILE)=JB
          ENDIF
        ENDDO
      ENDIF
      IF( ILW > 2*N_REGIONS_EW .OR. ILE > 2*N_REGIONS_EW )THEN
        WRITE(NULOUT,'("SUECRAD: ILW > 2*N_REGIONS_EW .OR. ",&
         & "ILE > 2*N_REGIONS_EW, ILW=",I6," ILE=",I6)') ILW,ILE  
        CALL ABOR1('SUECRADI:ILW/E > 2*N_REGIONS_EW')
      ENDIF

! DETERMINE FOR PARTITION JBX THOSE PARTITIONS THAT IT HAS TO RECEIVE
! COURSE POINTS FROM.
! DO THIS BY SEARCHING DOWN THE WESTERN LIST OF PARTITIONS FIRST AND
! THEN FOR THE EASTERN LIST OF PARTITIONS.
! THE SEND AND RECEIVE INFO FOR THIS (MY_REGION_NS,MY_REGION_EW) IS DETERMINED BY
! SIMPLY NOTING WHETHER (MY_REGION_NS,MY_REGION_EW) IS A SENDER OR RECEIVER IN THE
! ABOVE LIST SEARCH PROCESS.

      ICNEED=NRCNEEDW(JGL,JBX)

      DO JBW=1,ILW
        IF( ICNEED == 0 ) GOTO 541

! DOES THIS PARTITION HAVE ANY COURSE POINTS

        IF( NRIMAX(JGL,ILWBI(JBW)) > 0 )THEN

! YES, IT DOES
! THEN TEST IF IT HAS ENOUGH TO SATISFY OUR NEED

          IF( NRIMAX(JGL,ILWBI(JBW)) >= ICNEED )THEN
            ICTAKE=ICNEED
          ELSE
            ICTAKE=NRIMAX(JGL,ILWBI(JBW))
          ENDIF
          IF( MY_REGION_NS == ILWA(JBW).AND.MY_REGION_EW == ILWB(JBW) )THEN
! WE (MY_REGION_NS,MY_REGION_EW) ARE THE SENDER (SENDING EAST COURSE POINTS)
            IF( JBX <= N_REGIONS_EW )THEN
              IB =JBX
              IAO=0
            ELSE
              IB =JBX-N_REGIONS_EW
              IAO=IAOFF
            ENDIF
            NRCSNDE(JGL,IB,IAO)=ICTAKE
            NRCSNDT(IB,IAO)=NRCSNDT(IB,IAO)+ICTAKE
          ENDIF
          IF( JBX == MY_REGION_EW )THEN
! WE (MY_REGION_NS,MY_REGION_EW) ARE THE RECEIVER
            IB =ILWB(JBW)
            IAO=ILWA(JBW)-MY_REGION_NS
            NRCRCVW (JGL,IB,IAO)=ICTAKE
            NRCRCVWO(JGL,IB,IAO)=ICNEED-ICTAKE
            NRCRCVT (IB,IAO)=NRCRCVT(IB,IAO)+ICTAKE
          ENDIF
          ICNEED=ICNEED-ICTAKE
        ENDIF
      ENDDO

      541 CONTINUE

      ICNEED=NRCNEEDE(JGL,JBX)

      DO JBE=1,ILE
        IF( ICNEED == 0 ) GOTO 551

! DOES THIS PARTITION HAVE ANY COURSE POINTS

        IF( NRIMAX(JGL,ILEBI(JBE)) > 0 )THEN

! YES, IT DOES
! THEN TEST IF IT HAS ENOUGH TO SATISFY OUR NEED

          IF( NRIMAX(JGL,ILEBI(JBE)) >= ICNEED )THEN
            ICTAKE=ICNEED
          ELSE
            ICTAKE=NRIMAX(JGL,ILEBI(JBE))
          ENDIF
          IF( MY_REGION_NS == ILEA(JBE).AND.MY_REGION_EW == ILEB(JBE) )THEN
! WE (MY_REGION_NS,MY_REGION_EW) ARE THE SENDER (SENDING WEST COURSE POINTS)
            IF( JBX <= N_REGIONS_EW )THEN
              IB =JBX
              IAO=0
            ELSE
              IB =JBX-N_REGIONS_EW
              IAO=IAOFF
            ENDIF
            NRCSNDW(JGL,IB,IAO)=ICTAKE
            NRCSNDT(IB,IAO)=NRCSNDT(IB,IAO)+ICTAKE
          ENDIF
          IF( JBX == MY_REGION_EW )THEN
! WE (MY_REGION_NS,MY_REGION_EW) ARE THE RECEIVER
            IB =ILEB(JBE)
            IAO=ILEA(JBE)-MY_REGION_NS
            NRCRCVE (JGL,IB,IAO)=ICTAKE
            NRCRCVEO(JGL,IB,IAO)=NRCNEEDW(JGL,JBX)+NRCNEEDE(JGL,JBX)-ICNEED
            NRCRCVT (IB,IAO)=NRCRCVT(IB,IAO)+ICTAKE
          ENDIF
          ICNEED=ICNEED-ICTAKE
        ENDIF
      ENDDO

      551 CONTINUE

    ENDDO

! END OF JBX LOOP OVER PARTITIONS

    700 continue
  ENDDO

! END OF JGL LOOP OVER LATITUDES

! WRITE OUT SEND/RECEIVE TABLES IF DEBUGGING

  IF( LODBGRADI )THEN
    DO JA=-1,1
      WRITE(IUNIT,'("SUECRADI: ")')
      DO JB=1,N_REGIONS_EW
        IF( NRCSNDT(JB,JA) > 0.OR. NRCRCVT(JB,JA) > 0 )THEN
          WRITE(IUNIT,'("SUECRADI: SETA=",I4," SETB=",I4,&
           & " NRCSNDT=",I6," NRCRCVT=",I6)')&
           & JA+MY_REGION_NS,JB,NRCSNDT(JB,JA),NRCRCVT(JB,JA)  
        ENDIF
      ENDDO
    ENDDO

    WRITE(IUNIT,'("SUECRADI: ")')

    DO JA=-1,1
      WRITE(IUNIT,'("SUECRADI: ")')
      DO JB=1,N_REGIONS_EW
        DO JGL=1,NDGENL
          JGLGLO=NFRSTLAT(MY_REGION_NS)+JGL-1
          IF( NRCSNDW(JGL,JB,JA) > 0.OR.&
             & NRCSNDE(JGL,JB,JA) > 0.OR.&
             & NRCRCVW(JGL,JB,JA) > 0.OR.&
             & NRCRCVE(JGL,JB,JA) > 0 )THEN  
            WRITE(IUNIT,'("SUECRADI: JGLGLO=",I4," JGL=",I4,&
             & " SETA=",I4," SETB=",I4,&
             & " CSNDW=",I6," CSNDE=",I6,&
             & " CRCVW=",I6," CRCVE=",I6,&
             & " CRCVWO=",I1," CRCVEO=",I1)')&
             & JGLGLO,JGL,JA+MY_REGION_NS,JB,&
             & NRCSNDW(JGL,JB,JA),NRCSNDE(JGL,JB,JA),&
             & NRCRCVW(JGL,JB,JA),NRCRCVE(JGL,JB,JA),&
             & NRCRCVWO(JGL,JB,JA),NRCRCVEO(JGL,JB,JA)  
          ENDIF
        ENDDO
      ENDDO
    ENDDO
    IF( .NOT.LODBGRADL )THEN
      CLOSE(UNIT=IUNIT)
    ENDIF
  ENDIF

ENDIF

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('SUECRADI15',1,ZHOOK_HANDLE)
END SUBROUTINE SUECRADI15