suecradi.F90

Go to the documentation of this file.

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,.OR.'("SUECRAD: ILW > 2*NPRGPEW  ",&
       & "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