SUBROUTINE SUECRADI

!**** *SUECRADI*   - INITIALIZE DATA STRUCTURES FOR RADIATION INTERPOLATION

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

!**   INTERFACE.
!     ----------
!        CALL *SUECRADI* FROM *SUECRAD*
!              --------        -------

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

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

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

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

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

!     AUTHOR.
!     -------
!        GEORGE MOZDZYNSKI 95-03-13

!     MODIFICATIONS.
!     --------------
!        980317: JJMorcrette clean-up (NRAD, NFLUX)
!        990907: JJMorcrette clean-up RRTM
!        010129: JJMorcrette clean-up LERAD1H, NLNGR1H
!        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 :   NPRGPEW  ,NPRINTLEV,LALLOPR
USE YOMLUN   , ONLY : NULOUT
USE YOMGEM   , ONLY : NLOENG
USE YOERAD   , ONLY :      &
 & NRINT      
USE YOMMP    , ONLY :    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

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

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

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

#include "abor1.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('SUECRADI',0,ZHOOK_HANDLE)
LLP = NPRINTLEV >= 1.OR. LALLOPR
IU = NULOUT
ALLOCATE(NRIRINT  (NDGSAG:NDGENG))
IF(LLP)WRITE(IU,9) 'NRIRINT   ',SIZE(NRIRINT),SHAPE(NRIRINT)
ALLOCATE(NRIMAX   (NDGSAG:NDGENG,2*NPRGPEW))
IF(LLP)WRITE(IU,9) 'NRIMAX    ',SIZE(NRIMAX),SHAPE(NRIMAX)
ALLOCATE(NRFRSTOFF(NDGSAG:NDGENG,2*NPRGPEW))
IF(LLP)WRITE(IU,9) 'NRFRSTOFF ',SIZE(NRFRSTOFF),SHAPE(NRFRSTOFF)
ALLOCATE(NRLASTOFF(NDGSAG:NDGENG,2*NPRGPEW))
IF(LLP)WRITE(IU,9) 'NRLASTOFF ',SIZE(NRLASTOFF),SHAPE(NRLASTOFF)
ALLOCATE(NRCNEEDW (NDGSAG:NDGENG,2*NPRGPEW))
IF(LLP)WRITE(IU,9) 'NRCNEEDW  ',SIZE(NRCNEEDW),SHAPE(NRCNEEDW)
ALLOCATE(NRCNEEDE (NDGSAG:NDGENG,2*NPRGPEW))
IF(LLP)WRITE(IU,9) 'NRCNEEDE  ',SIZE(NRCNEEDE),SHAPE(NRCNEEDE)
ALLOCATE(NRCSNDW  (NDGSAG:NDGENG,NPRGPEW,-1:1))
IF(LLP)WRITE(IU,9) 'NRCSNDW   ',SIZE(NRCSNDW),SHAPE(NRCSNDW)
ALLOCATE(NRCSNDE  (NDGSAG:NDGENG,NPRGPEW,-1:1))
IF(LLP)WRITE(IU,9) 'NRCSNDE   ',SIZE(NRCSNDE),SHAPE(NRCSNDE)
ALLOCATE(NRCRCVW  (NDGSAG:NDGENG,NPRGPEW,-1:1))
IF(LLP)WRITE(IU,9) 'NRCRCVW   ',SIZE(NRCRCVW),SHAPE(NRCRCVW)
ALLOCATE(NRCRCVE  (NDGSAG:NDGENG,NPRGPEW,-1:1))
IF(LLP)WRITE(IU,9) 'NRCRCVE   ',SIZE(NRCRCVE),SHAPE(NRCRCVE)
ALLOCATE(NRCSNDT  (NPRGPEW,-1:1))
IF(LLP)WRITE(IU,9) 'NRCSNDT   ',SIZE(NRCSNDT),SHAPE(NRCSNDT)
ALLOCATE(NRCRCVT  (NPRGPEW,-1:1))
IF(LLP)WRITE(IU,9) 'NRCRCVT   ',SIZE(NRCRCVT),SHAPE(NRCRCVT)
ALLOCATE(NRCRCVWO (NDGSAG:NDGENG,NPRGPEW,-1:1))
IF(LLP)WRITE(IU,9) 'NRCRCVWO  ',SIZE(NRCRCVWO),SHAPE(NRCRCVWO)
ALLOCATE(NRCRCVEO (NDGSAG:NDGENG,NPRGPEW,-1:1))
IF(LLP)WRITE(IU,9) 'NRCRCVEO  ',SIZE(NRCRCVEO),SHAPE(NRCRCVEO)

9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

! INITIALISE GENERAL DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION

DO JGL=NDGSAG,NDGENG
  NRIRINT(JGL)=0
ENDDO
DO JB=1,2*NPRGPEW
  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,NPRGPEW
    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,NPRGPEW
    NRCSNDT(JB,JA)=0
    NRCRCVT(JB,JA)=0
  ENDDO
ENDDO

DO JB=1,2*NPRGPEW
  DO JGL=1,NDGENL
    ISTA(JGL,JB)=0
    IONL(JGL,JB)=0
  ENDDO
ENDDO
DO JB=1,NPRGPEW
  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,NPRGPEW
    IF( NSTA(NPTRFRSTLAT(MY_REGION_NS),JB) == 1 )THEN
      LLMYSETAISWEST=.TRUE.
    ENDIF
  ENDDO
  IF( LLMYSETAISWEST )THEN
    DO JB=1,NPRGPEW
      IGL=NPTRFRSTLAT(MY_REGION_NS+1)
      ISTA(1,JB+NPRGPEW)=NSTA(IGL,JB)
      IONL(1,JB+NPRGPEW)=NONL(IGL,JB)
    ENDDO
  ELSE
    DO JB=1,NPRGPEW
      IGL=NPTRFRSTLAT(MY_REGION_NS)-1
      ISTA(1,JB+NPRGPEW)=NSTA(IGL,JB)
      IONL(1,JB+NPRGPEW)=NONL(IGL,JB)
    ENDDO
  ENDIF
ENDIF
IF( LSPLITLAT(NLSTLAT(MY_REGION_NS)) )THEN
  LLMYSETAISWEST=.FALSE.
  DO JB=1,NPRGPEW
    IF( NSTA(NPTRLSTLAT(MY_REGION_NS),JB) == 1 )THEN
      LLMYSETAISWEST=.TRUE.
    ENDIF
  ENDDO
  IF( LLMYSETAISWEST )THEN
    DO JB=1,NPRGPEW
      IGL=NPTRFRSTLAT(MY_REGION_NS+1)
      ISTA(NDGENL,JB+NPRGPEW)=NSTA(IGL,JB)
      IONL(NDGENL,JB+NPRGPEW)=NONL(IGL,JB)
    ENDDO
  ELSE
    DO JB=1,NPRGPEW
      IGL=NPTRFRSTLAT(MY_REGION_NS)-1
      ISTA(NDGENL,JB+NPRGPEW)=NSTA(IGL,JB)
      IONL(NDGENL,JB+NPRGPEW)=NONL(IGL,JB)
    ENDDO
  ENDIF
ENDIF

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

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

! LOOP OVER OUR PARTITION LATITUDES, TO INITIALISE SIMPLE ITEMS

IMAXT=0

DO JGL=1,NDGENL

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

  IRINT=1
  DO JF=1,NRINT
    IF( MOD(ILONS,JF) == 0.AND.ILONS/JF <= IMAXC )THEN
      IRINT=JF
      EXIT
    ENDIF
  ENDDO
  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*NPRGPEW
  ELSE
    IPROCB=NPRGPEW
  ENDIF

  DO JB=1,IPROCB
    IF( IONL(JGL,JB) == 0 ) CYCLE
    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
  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

! 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 ) CYCLE
  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*NPRGPEW
  ELSE
    IPROCB=NPRGPEW
  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,NPRGPEW
        IF( ISTA(JGL,JB) == 1 )THEN
          IAOFF=1
          EXIT
        ENDIF
      ENDDO

      IF( JBX <= NPRGPEW )THEN
        IJBXSETA=MY_REGION_NS
        IOTHSETA=MY_REGION_NS+IAOFF
        IJBXBOFF=0
        IOTHBOFF=NPRGPEW
      ELSE
        IJBXSETA=MY_REGION_NS+IAOFF
        IOTHSETA=MY_REGION_NS
        IJBXBOFF=NPRGPEW
        IOTHBOFF=0
      ENDIF
! INITIALISE WEST LIST, SPLIT LAT
      IF( JBX <= NPRGPEW )THEN
        IB1=JBX-1
        IB2=1
        IB3=2*NPRGPEW
        IB4=NPRGPEW+1
        IB5=NPRGPEW
        IB6=JBX
      ELSE
        IB1=JBX-1
        IB2=NPRGPEW+1
        IB3=NPRGPEW
        IB4=1
        IB5=2*NPRGPEW
        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 <= NPRGPEW )THEN
        IB1=JBX+1
        IB2=NPRGPEW
        IB3=NPRGPEW+1
        IB4=2*NPRGPEW
        IB5=1
        IB6=JBX
      ELSE
        IB1=JBX+1
        IB2=2*NPRGPEW
        IB3=1
        IB4=NPRGPEW
        IB5=NPRGPEW+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=NPRGPEW,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,NPRGPEW
        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*NPRGPEW .OR. ILE > 2*NPRGPEW )THEN
      WRITE(NULOUT,'("SUECRAD: ILW > 2*NPRGPEW .OR. ",&
       & "ILE > 2*NPRGPEW, ILW=",I6," ILE=",I6)') ILW,ILE  
      CALL ABOR1('SUECRADI:ILW/E > 2*NPRGPEW')
    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 ) EXIT

! 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 <= NPRGPEW )THEN
            IB =JBX
            IAO=0
          ELSE
            IB =JBX-NPRGPEW
            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

    ICNEED=NRCNEEDE(JGL,JBX)
    
    DO JBE=1,ILE
      IF( ICNEED == 0 ) EXIT

! 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 <= NPRGPEW )THEN
            IB =JBX
            IAO=0
          ELSE
            IB =JBX-NPRGPEW
            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

  ENDDO

! END OF JBX LOOP OVER PARTITIONS

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,NPRGPEW
      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,NPRGPEW
      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

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

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