SUBROUTINE SLCSET(CDSL,KSLWIDE,KSLRPTSUR,KSLSPTSUR,KASET,KBSET,&
 & KDGLG,KDLON,KDGSAG,KDGENG,KDGUXL,KDGUXG,KDGSAL,KDGENL,&
 & KDSUR1,KDLSUR,KDGSUR,KGPTOT,KGPTOT_CAP,&
 & KPTRFLOFF,KFRSTLOFF,KYFRSTACTLAT,KYLSTACTLAT,&
 & KSTA,KONL,KLOENG,KPTRFRSTLAT,KFRSTLAT,KLSTLAT,&
 & PMU,PSQM2,&
 & KSLSTA,KSLONL,KSLOFF,KSLEXT,KSLCORE,KASLB1,&
 & KSLPROCS,KSLRPT,KSLSPT,&
 & KSLSENDPOS,KSLRECVPOS,KSENDPTR,KRECVPTR,KSLCOMM,KMAP,KMAPLEN)  

!**** *SLCSET * - Routine to initialize parallel environment
!                 necessary for horizontal interpolations. 
!                 Works with a lateral band of KSLWIDE latitudes in the halo. 

!                 Called only if DM code.
!                 For distributed memory computations are DM-local.

!     Purpose.
!     --------
!     initialise communication tables and test for horizontal 
!     interpolations.

!     Additional remarks for ALADIN:
!     - For the semi-Lagrangian or the observations interpolations the
!       calculations concern the sub-domain C+I; the consequence is that
!       KGPTOT_CAP and KDGUXG are used instead of KGPTOT and KDGENG 
!       (KGPTOT_CAP < or = KGPTOT; KDGUXG < or = KDGENG).
!     - For FULL-POS interpolations the 
!       calculations concern the whole domain C+I+E
!     - This program assumes that in ALADIN: KDGSAG=KDGSAL=1, KDGENG=KDGLG,
!       KLOENG(jgl)=KDLON for all latitudes, so simplications using
!       hard coded KDLON are not made in order to make the code as common
!       as possible between ARPEGE and ALADIN.

!**   Interface.
!     ----------
!        *CALL* *SLCSET *

!        Explicit arguments :
!        --------------------
!         INPUT:
!          CDSL        - two letter code, ex:
!                        'SL': initialisation of environment based on NSLWIDE.
!                        'OB': initialisation of environment based on NOBWIDE.
!                        'FP': initialisation of environment based on NFPWIDE.
!                        'RO': initialisation of environment based on NRIWIDE.
!                        'RI': initialisation of environment based on NROWIDE.
!          KSLWIDE     - number of rows the model lagged part runs behind.
!          KSLRPTSUR   - integer > or = KSLRPT already computed in SUSC2.
!          KSLSPTSUR   - integer > or = KSLSPT already computed in SUSC2.
!          KDGLG       - number of latitude rows
!          KDLON       - length of a row of latitude near equator
!          KDGSAG      - Global version of KDGSA
!          KDGENG      - Global version of KDGEN
!          KDGUXL      - local last row in C+I zone in distributed memory Aladin
!          KDGUXG      - Global version of NDGUX (to be removed !)
!          KDGSAL      - Local version of KDGSA , always 1
!          KDGENL      - No. of latitude rows for which this process has grid points
!          KDSUR1      - over dimensioning of KDLON for technical reasons
!          KDLSUR      - KDLON+KDSUR1
!          KDGSUR      - number of additional rows at each pole for semi-lagrangian
!                        job or calculation of observation equivalents
!          KGPTOT      - Total number of grid columns on a PE
!          KGPTOT_CAP  - Size of grid points arrays for ALADIN
!          KSTA        - Position of first grid column for the latitudes on
!                        a processor
!          KONL        - number of grid columns for the latitudes on a processor
!          KLOENG      - Number of grid points per latitude
!          KPTRFRSTLAT - pointer to the first latitude of each a-set in
!                        KSTA and KONL arrays
!          KFRSTLAT    - first lat of each a-set in grid-point space
!          KLSTLAT     - last lat of each a-set in grid-point space
!          KPTRFLOFF   - offset for pointer to the first latitude of own a-set
!                        KSTA and KONL arrays
!          KFRSTLOFF   - offset for first lat of own a-set in grid-point space,
!                        i.e. kfrstloff=kfrstlat(kaset)-1
!          KYFRSTACTLAT- first actual lat on this PE in grid-point space,
!                        it is kfrstlat(kaset)
!          KYLSTACTLAT - last actual lat on this PE in grid-point space,
!                        it is klstlat(kaset)
!          PMU         - mu              sin(theta)
!          PSQM2       - SQRT(R1MU2)     cos(theta)

!         OUTPUT:
!          KSLSTA      - interpolation buffer start position of grid columns.
!          KSLONL      - interpolation buffer number of grid column on latitudes
!          KSLOFF      - interpolation buffer offset to start of each row in.
!          KSLEXT      - pointer that makes sure addressing of points in the 
!                        east-west extension zone is correct. 
!                        It also handles the half
!                        latitude shift of extension latitudes at the poles.
!          KSLCORE     - pointer to this processors core region points
!                        within the interpolation buffer.
!          KASLB1      - local inner dimension of interpolation buffer.
!          KSLPROCS    - number of processors to communicate with.
!          KSLRPT      - dimension for KSLRECVPOS.
!                        The number of columns received from other PE's when
!                        computing the halo for interpolations.
!          KSLSPT      - dimension for KSLSENDPOS.
!                        The number of columns sent to other PE's when
!                        computing the halo for interpolations.
!          KSLSENDPOS  - the addresses within the interpolation buffer
!                        of point sent from this PE.
!                        Computed only if NPROC > 1.
!          KSLRECVPOS  - the addresses within the interpolation buffer
!                        of point received on this PE.
!                        Computed only if NPROC > 1.
!          KSENDPTR    - pointer to the first point for each of the PE's
!                        that has to receive interpolation halo-data from
!                        this. Used for addressing KSLSENDPOS().
!                        Computed only if NPROC > 1.
!          KRECVPTR    - pointer to the first point for each of the PE's
!                        that are sending interpolation halo-data to this PE.
!                        Used for addressing KSLRECVPOS().
!                        Computed only if NPROC > 1.
!          KSLCOMM     - list of the processors this processor has to 
!                        communicate with.
!                        Computed only if NPROC > 1.
!          KMAP        - Halo map info for SL adjoint reproducibility

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------
!      Calls SLRSET if NPROC > 1.
!      Is called by SUSC2.

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS
!        Documentation about FULL-POS.
!        Documentation about distributed memory.

!     Author.
!     -------
!        MPP Group *ECMWF*

!     Modifications.
!     --------------
!        Original : 95-10-01
!        K. YESSAD (JAN 1998): merge of old routines SLCSET of Lars ISAKSEN 
!         and SUFPCSET.
!        K. YESSAD (MAY 1998): additional cleaning.
!        K. YESSAD (JUNE 1998): adaptation to ALADIN;
!         merge of SLCSET and ESLCSET.
!        G. Mozdzynski (July 2000): bit reproducibility support
!        G. Mozdzynski (Dec 2001): support radiation grid
!        A. Bogatchev (April 2002): fixed bug for IALFGLO in LELAM case
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        F. Vana  (August 2007): optimized size of SL buffer for NEC SX
!        Y. Seity (May 2009): bf for B-level parrallelisation for LAMs (ZDIST)
!        R. El Khatib 02-Jul-2009 Bugfix for Aladin
!     ------------------------------------------------------------------

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

USE YOMCT0   , ONLY : NPROC    ,NPRINTLEV,LOUTPUT  ,LMPDIAG  ,LALLOPR  ,&
 & LELAM    ,LSLAG   ,NCONF    ,N_REGIONS_NS    ,N_REGIONS_EW
USE YOMMP    , ONLY : NSLPAD
USE YOMDIM   , ONLY : NFLEVG
USE YOMLUN   , ONLY : NULOUT
USE YOMCST   , ONLY : RPI
USE YOMSLREP , ONLY : NSLMAP   ,RSASIGN

IMPLICIT NONE

!     DUMMY:
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLWIDE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLRPTSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLSPTSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KASET
INTEGER(KIND=JPIM),INTENT(IN)    :: KBSET
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGLG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGSAG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGENG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGSAL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGENL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGPTOT 
CHARACTER(LEN=2)  ,INTENT(IN)    :: CDSL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGUXL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGUXG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDSUR1 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGPTOT_CAP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPTRFLOFF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFRSTLOFF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KYFRSTACTLAT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KYLSTACTLAT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTA(KDGSAG:KDGENG+N_REGIONS_NS-1,N_REGIONS_EW) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KONL(KDGSAG:KDGENG+N_REGIONS_NS-1,N_REGIONS_EW) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLOENG(KDGSAG:KDGENG) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPTRFRSTLAT(N_REGIONS_NS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFRSTLAT(N_REGIONS_NS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLSTLAT(N_REGIONS_NS) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU(KDGSAG:KDGENG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSQM2(KDGSAG:KDGENG) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLSTA(KDGSAL-KSLWIDE:KDGENL+KSLWIDE) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLONL(KDGSAL-KSLWIDE:KDGENL+KSLWIDE) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLOFF(KDGSAL-KSLWIDE:KDGENL+KSLWIDE) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSLEXT(1-KDLON:KDLON+KDLON,1-KSLWIDE:KDGENL+KSLWIDE) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSLCORE(KGPTOT) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KASLB1 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLPROCS 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLRPT 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLSPT 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSLSENDPOS(KSLSPTSUR) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSLRECVPOS(KSLRPTSUR) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSENDPTR(NPROC+1) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KRECVPTR(NPROC+1) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLCOMM(NPROC) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KMAP(4,KDGLG) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KMAPLEN 
REAL(KIND=JPRB) :: ZLSA(1:KDGENL)
REAL(KIND=JPRB) :: ZLFA(1:KDGENL)

INTEGER(KIND=JPIM) :: IALF, IALFGLO, IALS, IALSGLO, IBIG, &
 & IDGENG, IDLSUREAST, IDLSURWEST, IFF, IGLGLO, &
 & IGLLOC, IGPREM, IGPTOT, ILF, ILON, ILS, IPERIOD, &
 & IPTF, IPTS, IPTSET, IROFINC, ISLPAD, ISLWM2, &
 & ISS, IU, JGLGLO, JGLGLO2, JGLLOC, JGLLOC2, &
 & JLON, JROC, JROF, JLP, IPT, ILPT, IST, IEND, &
 & JFLD, IGLSLOC, IGLSGLO  

LOGICAL :: LLCOND, LLP, LLNOR, LLSUD, LLHALO

REAL(KIND=JPRB) :: Z1GP, Z1GPMAX, ZANGLE, ZBIG, ZDEN, ZDIST,&
 & ZDL, ZDLMAX, ZDLSE, ZDLSW, ZGPTS, ZISLWM2, &
 & ZMAXA, ZMINA, ZNUM, ZRAP  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "slrset.intfb.h"

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

!*       1. COMPUTATION OF KSLSTA,KSLONL,KSLOFF.
!        ---------------------------------------

IF (LHOOK) CALL DR_HOOK('SLCSET',0,ZHOOK_HANDLE)
LLP = NPRINTLEV >= 1.OR. LALLOPR
IU = NULOUT
KMAPLEN=0

!IF (LELAM .AND. CDSL == 'SL') THEN
!  Wrong : KGPTOT_CAP is a global variable
!  IDGENG=KDGUXG
!  IGPTOT=KGPTOT_CAP
!ELSE
  IDGENG=KDGENG
  IGPTOT=KGPTOT
!ENDIF

!     IDLSURWEST: number of extra points at start of complete latitude.
!     IDLSUREAST: number of extra points at end of complete latitude.
!     IPERIOD : extra points at start/end of complete latitude to ensure
!               interpolation can be performed correctly
IDLSURWEST=1
IDLSUREAST=2
IF (KDLON == 1) THEN
  IPERIOD=KDSUR1
ELSE
  IPERIOD=IDLSURWEST+IDLSUREAST
ENDIF
IF (IPERIOD /= (KDLSUR-KDLON)) THEN
  CALL ABOR1(' SLCSET: IPERIOD AND KDLSUR ARE NOT CONSISTENT')
ENDIF

DO JGLLOC=KDGSAL-KSLWIDE,KDGENL+KSLWIDE
  KSLSTA(JGLLOC)=-999999999
  KSLONL(JGLLOC)=-999999999
  KSLOFF(JGLLOC)=-999999999
ENDDO

DO JGLGLO=KFRSTLAT(KASET),KLSTLAT(KASET)
  IGLLOC=MAX(-KSLWIDE,JGLGLO-KFRSTLOFF)
  IF (KONL(KPTRFLOFF+IGLLOC,KBSET) > 0) THEN
    ISS=KSTA(KPTRFLOFF+IGLLOC,KBSET)
    IFF=ISS+KONL(KPTRFLOFF+IGLLOC,KBSET)-1
    ZLSA(IGLLOC)=REAL(ISS-1,JPRB)/REAL(KLOENG(JGLGLO),JPRB)
    ZLFA(IGLLOC)=REAL(IFF-1,JPRB)/REAL(KLOENG(JGLGLO),JPRB)
  ENDIF
ENDDO

IPTSET=0

ISLWM2=KSLWIDE-KDGSUR+1
ZISLWM2=REAL(ISLWM2,JPRB)

!OCL  NOPREEX
IF (LELAM) THEN
  ZDIST=ZISLWM2/REAL(KDLON,JPRB)
ELSE
  ZDIST=(RPI*ZISLWM2)/(REAL(KDGLG,JPRB)+0.5_JPRB)
ENDIF

ILS = MAX(KDGSAG,KYFRSTACTLAT-KSLWIDE)-KFRSTLOFF
ILF = MIN(IDGENG,KYLSTACTLAT +KSLWIDE)-KFRSTLOFF

!     Loop over my processors lats, -/+ KSLWIDE, but bound by KDGSAG,IDGENG.

DO JGLLOC=ILS,ILF

  IALS=MAX(KYFRSTACTLAT,JGLLOC+KFRSTLOFF-KSLWIDE)-KFRSTLOFF
  IALF=MIN(KYLSTACTLAT ,JGLLOC+KFRSTLOFF+KSLWIDE)-KFRSTLOFF
  IF( IALS < 1.OR. IALS > KDGENL )THEN
    CALL ABOR1(' SLCSET: INVALID STARTING LOCAL LATITUDE IALS')
  ENDIF
  IF( IALF < 1.OR. IALF > KDGENL )THEN
    CALL ABOR1(' SLCSET: INVALID ENDING LOCAL LATITUDE IALF')
  ENDIF

  ZMINA=1.0_JPRB
  ZMAXA=0.0_JPRB

!       For DM-local latitude JGLLOC, loop -/+ KSLWIDE latitudes to find 
!       max and min angles for my core region.

  LLHALO=.FALSE.
  DO JGLLOC2=IALS,IALF
    IF (KONL(KPTRFLOFF+JGLLOC2,KBSET) > 0) THEN
      ZMINA=MIN(ZMINA,ZLSA(JGLLOC2))
      ZMAXA=MAX(ZMAXA,ZLFA(JGLLOC2))
      LLHALO=.TRUE.
    ENDIF
  ENDDO

!       For DM-local latitude JGLLOC, loop -/+ KSLWIDE latitudes to find 
!       max angular separation due to overdimension of KDGSUR relative to
!       the number of northern latitudes actually necessary to do 
!       interpolations, and max angular separation for one grid point 
!       (for interpolation grid requirements).

  IF( LLHALO )THEN

    IF (LELAM) THEN

      Z1GPMAX=1.0_JPRB/REAL(KDLON,JPRB)
      ZDLMAX=ZDIST
      IALFGLO=1

    ELSE

      IALSGLO = MAX(KDGSAG,JGLLOC+KFRSTLOFF-KSLWIDE)
      IALFGLO = MIN(IDGENG,JGLLOC+KFRSTLOFF+KSLWIDE)

      Z1GPMAX=0.0_JPRB
      ZDLMAX=0.0_JPRB

      DO JGLGLO2=IALSGLO,IALFGLO
        Z1GP=1.0_JPRB/REAL(KLOENG(JGLGLO2),JPRB)
        Z1GPMAX=MAX(Z1GPMAX,Z1GP)
        ZNUM=COS(ZDIST)-(PMU(JGLGLO2)*PMU(JGLGLO2))
        ZDEN=PSQM2(JGLGLO2)*PSQM2(JGLGLO2)
        ZRAP=MIN(1.0_JPRB,MAX(0.0_JPRB, ZNUM/ZDEN ))
        ZDL=ACOS(ZRAP)/(2.0_JPRB*RPI)
        ZDLMAX=MAX(ZDLMAX,ZDL)
      ENDDO

    ENDIF

!       Add 1 grid point for west and east interpolation grid.

    ZANGLE=ZDLMAX+Z1GPMAX
    ZGPTS=ZANGLE*REAL(KLOENG(IALFGLO),JPRB)

    ZMINA=ZMINA-ZANGLE
    ZMAXA=ZMAXA+ZANGLE

!       Find latitude fraction and correct to ensure enough points present 
!       for interpolation requirements.

!       Add 1.0 as 1 was subtracted earlier as part of angular calc
!       note IPTS will truncate to nearest westerly grid point
!       for IPTF add further 1.0 to force to nearest easterly grid point.

    IBIG=1000000
    ZBIG=IBIG
    IGLGLO=JGLLOC+KFRSTLOFF
    ZDLSW=REAL(IDLSURWEST,JPRB)
    ZDLSE=REAL(IDLSUREAST,JPRB)
    IPTS=INT(ZMINA*REAL(KLOENG(IGLGLO),JPRB)+ZDLSW+ZBIG)-IBIG
    IPTF=INT(ZMAXA*REAL(KLOENG(IGLGLO),JPRB)+ZDLSE+ZBIG)-IBIG
!       In Fortran 90 we can replace above 4 lines by these 2.
!       IPTS=FLOOR  (ZMINA*REAL(KLOENG(IGLGLO))+ZDLSW)
!       IPTF=CEILING(ZMAXA*REAL(KLOENG(IGLGLO))+ZDLSE-1)

!       Rotate to other side if mimic lats (for ARPEGE only).

    IF( (.NOT.LELAM) .AND. (IGLGLO < 1.OR. IGLGLO > KDGLG) )THEN
      IF( IPTS > KLOENG(IGLGLO)/2 )THEN
        IPTS=IPTS-KLOENG(IGLGLO)/2
        IPTF=IPTF-KLOENG(IGLGLO)/2
      ELSE
        IPTS=IPTS+KLOENG(IGLGLO)/2
        IPTF=IPTF+KLOENG(IGLGLO)/2
      ENDIF
    ENDIF

!       Set KSLSTA and KONL to cover halo plus core area, but never more than
!       a whole latitude. Also force whole latitudes for polar latitudes. If
!       halo covers whole latitude then modify ZANGLE and ZGPTS to indicate
!       this on output.

    ISLPAD=NSLPAD

!       Leave ISLPAD space either side of start and end points, which
!       will be left initialised to a huge number to trap halo problems
!       should they occur in the future.

    IF (LELAM) THEN
      LLCOND=IPTF-IPTS+1 >= KLOENG(IGLGLO)
    ELSE
      LLCOND=IPTF-IPTS+1 >= KLOENG(IGLGLO) .OR.&
       & (IGLGLO <= 1+(KSLWIDE-1).OR.&
       & IGLGLO >= KDGLG-(KSLWIDE-1))  
    ENDIF
  
    IF (LLCOND) THEN
      KSLSTA(JGLLOC)=1
      KSLONL(JGLLOC)=KLOENG(IGLGLO)
      KSLOFF(JGLLOC)=IPTSET+ISLPAD+1
      IPTSET=IPTSET+KLOENG(IGLGLO)+IPERIOD+ISLPAD*2
      ZANGLE=1.0_JPRB
      ZGPTS=KLOENG(IGLGLO)
    ELSE
      KSLSTA(JGLLOC)=IPTS
      KSLONL(JGLLOC)=IPTF-IPTS+1
      KSLOFF(JGLLOC)=IPTSET+ISLPAD
      IPTSET=IPTSET+KSLONL(JGLLOC)+ISLPAD*2
    ENDIF

  ELSE

    KSLSTA(JGLLOC)=0
    KSLONL(JGLLOC)=0
    KSLOFF(JGLLOC)=0
    ZDLMAX=0.0_JPRB
    Z1GPMAX=0.0_JPRB
    ZANGLE=0.0_JPRB
    ZGPTS=0.0_JPRB

  ENDIF

!       optional diagnostic output

  IF( IGLGLO>=1.AND.IGLGLO<=KDGLG )THEN
    KMAPLEN=KMAPLEN+1
    IF( KMAPLEN > KDGLG ) CALL ABOR1('SLCSET: KMAPLEN > KDGLG')
    KMAP(1,KMAPLEN)=IGLGLO
    KMAP(2,KMAPLEN)=KSLSTA(JGLLOC)
    KMAP(3,KMAPLEN)=KSLONL(JGLLOC)
    KMAP(4,KMAPLEN)=KSLOFF(JGLLOC)
  ENDIF

!       optional diagnostic output

  IF( LOUTPUT.AND.LMPDIAG )THEN
    WRITE(NULOUT,'(" SLCSET INFO: DM-LOCAL LAT=",I3,&
     & " N",A2,"STA=",I5,&
     & " N",A2,"ONL=",I5,&
     & " N",A2,"OFF=",I8,&
     & " ZDLMAX=",F10.5,&
     & " Z1GPMAX=",F10.5," ZANGLE=",F10.5," ZGPTS=",F10.5)')&
     & IGLGLO,&
     & CDSL,KSLSTA(JGLLOC),CDSL,KSLONL(JGLLOC),CDSL,KSLOFF(JGLLOC),&
     & ZDLMAX,Z1GPMAX,ZANGLE,ZGPTS  
  ENDIF

ENDDO

IF( CDSL == 'OB' )THEN
  IF (LHOOK) CALL DR_HOOK('SLCSET',1,ZHOOK_HANDLE)
  RETURN
ENDIF

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

!*       2. COMPUTATION OF KSLCORE:
!           (position of core points in interpolation buffer).
!        -----------------------------------------------------

IROFINC=0
IGLLOC=1
IGPREM=KONL(KPTRFLOFF+IGLLOC,KBSET)

DO JROF=1,IGPTOT
  IF (IGPREM == 0) THEN
    IGLLOC=IGLLOC+1
    IGPREM=KONL(KPTRFLOFF+IGLLOC,KBSET)
    DO WHILE (IGPREM <= 0)
      IGLLOC=IGLLOC+1
      IGPREM=KONL(KPTRFLOFF+IGLLOC,KBSET)
    ENDDO
    IROFINC=IROFINC+IPERIOD
  ENDIF
  IGPREM=IGPREM-1
  IROFINC=KSLOFF(IGLLOC)+&
   & KONL(KPTRFLOFF+IGLLOC,KBSET)-IGPREM-1+&
   & KSTA(KPTRFLOFF+IGLLOC,KBSET)-KSLSTA(IGLLOC)-JROF  
  KSLCORE(JROF)=IROFINC+1+JROF
ENDDO

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

!*       3. COMPUTATION OF KSLEXT:
!           (data structure used by routines LASCAW, FPSCAW).
!        ----------------------------------------------------

DO JGLLOC= 1-KSLWIDE,KDGENL+KSLWIDE
  DO JLON=1-KDLON,KDLON+KDLON
    KSLEXT(JLON,JGLLOC)=-999999999
  ENDDO
ENDDO

DO JGLGLO=MAX(KDGSAG,KFRSTLAT(KASET)-KSLWIDE)&
   & ,MIN(IDGENG,KLSTLAT(KASET)+KSLWIDE)  
  IGLLOC=JGLGLO-KFRSTLAT(KASET)+1
  DO JLON=1-KDLON,KDLON+KDLON
    ILON=JLON
    IF( (.NOT.LELAM).AND.(JGLGLO < 1.OR. JGLGLO > KDGLG) )THEN
      ILON=ILON+KLOENG(JGLGLO)/2
    ENDIF
    ILON=MOD(ILON-KSLSTA(IGLLOC)+KLOENG(JGLGLO),KLOENG(JGLGLO))+1
    IF (KSLSTA(IGLLOC) == 1.AND.&
       & KSLONL(IGLLOC) == KLOENG(JGLGLO).AND.&
       & ILON == KLOENG(JGLGLO)) THEN  
      ILON=0
    ENDIF
    KSLEXT(JLON,IGLLOC)=ILON
!   IF (LOUTPUT.AND.LMPDIAG) THEN
!     WRITE(NULOUT,'(&
!      &" SLCSET: JLON,JGLGLO,IGLLOC,N",A2,"EXT(JLON,IGLLOC)=",&
!      &4(2X,I6))') CDSL,JLON,JGLGLO,IGLLOC,KSLEXT(JLON,IGLLOC)
!   ENDIF
  ENDDO
ENDDO
IF (LOUTPUT.AND.LMPDIAG) CALL FLUSH(NULOUT)

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

!*       4. COMPUTATION OF KASLB1:
!           THEN CALL SLRSET IF NPROC > 1.
!        ---------------------------------------------

KASLB1=IPTSET
!     Modify KASLB1 to avoid bad values for bank conflicts
!     choice of '27' is empirical(good for both vpp700 and vpp5000).
!     Similar tests repeated for NEC SX platform peaks for (1024,29).
!     Logically the original (512,27) is replaced by the new couple.
IF(MOD(KASLB1,1024) == 0) THEN
  KASLB1=KASLB1+29
ELSE
  KASLB1=((KASLB1-1)/1024 +1 ) * 1024 +29
ENDIF
WRITE(NULOUT,'(" NA",A2,"NASLB1 = ",I7)') CDSL,KASLB1

!     Allocate NSLMAP and RSASIGN (required for SL adjoint)

!     NSLMAP is initialised to values so that SL buffer points are unique

!     RSASIGN is initialised to handle symmetric and antisymmetric
!     properties of fields at polar latitudes
!       RSASIGN(:,1)= 1.0  (for fields where RPARSL1 = 1.0)
!       RSASIGN(:,2)= 1.0  (for non mirror latitudes)
!                   =-1.0  (for mirror latitudes)

IF ( CDSL == 'AD'.AND.LSLAG.AND.(NCONF == 131.OR.NCONF == 401.OR.NCONF == 801.OR.NCONF==601 ) ) THEN
  ALLOCATE(NSLMAP(KASLB1*(NFLEVG+2)))
  IF (LLP) WRITE(NULOUT,9) 'NSLMAP ',SIZE(NSLMAP),SHAPE(NSLMAP)
  ALLOCATE(RSASIGN(KASLB1,2))
  IF (LLP) WRITE(NULOUT,9) 'RSASIGN',SIZE(RSASIGN),SHAPE(RSASIGN)
  DO JROF=1,KASLB1*(NFLEVG+2)
    NSLMAP(JROF)=JROF
  ENDDO
  DO JFLD=1,KASLB1
    RSASIGN(JFLD,1)=1.0_JPRB
    RSASIGN(JFLD,2)=1.0_JPRB
  ENDDO
!     ** Search through all latitudes within halo region.
  DO JGLLOC=ILS,ILF
    IGLGLO=JGLLOC+KFRSTLOFF
    LLNOR=(IGLGLO >= KDGSAG).AND.(IGLGLO <= 0)
    LLSUD=(IGLGLO >= KDGLG+1).AND.(IGLGLO <= KDGENG)
    IF (LLNOR.OR.LLSUD) THEN
      IF (LLNOR) IGLSGLO=1-IGLGLO
      IF (LLSUD) IGLSGLO=2*KDGLG+1-IGLGLO
!         * Local view 
      IGLLOC=IGLGLO-KFRSTLOFF
      IGLSLOC=IGLSGLO-KFRSTLOFF
!         * Determine which mirror points come from this processors core region.
      DO JLP=KSLSTA(IGLLOC),KSLONL(IGLLOC)+KSLSTA(IGLLOC)-1
        ILPT=MOD(JLP-1+KLOENG(IGLGLO),KLOENG(IGLGLO))+1
        IPT =KSLOFF(IGLLOC)+&
         & MOD(ILPT-KSLSTA(IGLLOC)+KLOENG(IGLGLO),KLOENG(IGLGLO))  
        IPTF=KSLOFF(IGLSLOC)+&
         & MOD(ILPT-KSLSTA(IGLSLOC)+KLOENG(IGLSGLO),KLOENG(IGLSGLO))  
!           Mark which mirrored latitudes points close to the poles require 
!           correction for symmetric and antisymmetric properties
        RSASIGN(IPT+1,2)=-1.0_JPRB
!           Remap mirror points that are located on this processor
        IF ( (KSLOFF(IGLSLOC) <= IPTF).AND.&
           & (IPTF <= KSLOFF(IGLSLOC)+KSLONL(IGLSLOC)-1) ) THEN  
          DO JFLD=1,NFLEVG+2
            NSLMAP((JFLD-1)*KASLB1+IPT+1)=(JFLD-1)*KASLB1+IPTF+1
          ENDDO
        ENDIF
      ENDDO
    ENDIF
  ENDDO
  DO JGLLOC=ILS,ILF
    IF (KLOENG(JGLLOC+KFRSTLOFF) == KSLONL(JGLLOC)) THEN
      IST =KSLOFF(JGLLOC)-1
      IEND=KSLOFF(JGLLOC)+KLOENG(JGLLOC+KFRSTLOFF)
!         Remap 3 point latitudinal extensions
      DO JFLD=1,NFLEVG+2
        NSLMAP((JFLD-1)*KASLB1+IEND+2)=NSLMAP((JFLD-1)*KASLB1+IST+3)
        NSLMAP((JFLD-1)*KASLB1+IEND+1)=NSLMAP((JFLD-1)*KASLB1+IST+2)
        NSLMAP((JFLD-1)*KASLB1+IST +1)=NSLMAP((JFLD-1)*KASLB1+IEND )
      ENDDO
    ENDIF
  ENDDO
  DO JGLLOC=ILS,ILF
    IF (KLOENG(JGLLOC+KFRSTLOFF) == KSLONL(JGLLOC)) THEN
      IST =KSLOFF(JGLLOC)-1
      IEND=KSLOFF(JGLLOC)+KLOENG(JGLLOC+KFRSTLOFF)
!         Make 3 point latitudinal extensions consistent
      RSASIGN(IEND+2,2)=RSASIGN(IST+3,2)
      RSASIGN(IEND+1,2)=RSASIGN(IST+2,2)
      RSASIGN(IST +1,2)=RSASIGN(IEND ,2)
    ENDIF
  ENDDO
! DO JROF=1,KASLB1
!   WRITE(NULOUT,'("SLCSET: SLBUF POINT ",I10," IS REMAPPED TO ",I10)')&
!    &JROF,NSLMAP(JROF)
! ENDDO
! DO JROF=1,KASLB1
!   WRITE(NULOUT,'("SLCSET: RSASIGN(n,2) POINT ",I10," HAS SIGN ",E10.3)')&
!    &JROF,RSASIGN(JROF,2)
! ENDDO
ENDIF

IF (KSLWIDE > 0) THEN

  IF (NPROC > 1) THEN
    CALL SLRSET(CDSL,KSLWIDE,KASLB1,KSLRPTSUR,KSLSPTSUR,&
     & KSLSTA,KSLONL,KSLOFF,&
     & KDGLG,KDLON,KDGSAG,KDGENG,KDGUXL,KDGUXG,KDGSAL,KDGENL,&
     & KFRSTLOFF,KYFRSTACTLAT,KYLSTACTLAT,&
     & KSTA,KONL,KLOENG,KPTRFRSTLAT,KFRSTLAT,KLSTLAT,&
     & KSLPROCS,KSLRPT,KSLSPT,&
     & KSLSENDPOS,KSLRECVPOS,KSENDPTR,KRECVPTR,KSLCOMM)  
!         Check that KASLB1 is big enough to contain communication data
    DO JROC=1,KSLPROCS
      IF(KSENDPTR(JROC+1)-KSENDPTR(JROC) > KASLB1) THEN
        WRITE(NULOUT,*) ' SLCSET: KASLB1 too small',&
         & KSENDPTR(JROC+1)-KSENDPTR(JROC),&
         & ' required, but the value is ',KASLB1  
        CALL ABOR1('SLCSET: KASLB1 too small')
      ENDIF
    ENDDO
  ELSE
!         KSLSENDPOS,KSLRECVPOS,KSENDPTR,KRECVPTR,KSLCOMM are useless.
    KSLPROCS=0
    KSLRPT=0
    KSLSPT=0
    IF (LOUTPUT) THEN
      WRITE(IU,'(" SLCSET: N",A2,"PROCS=",I6)') CDSL,KSLPROCS
      WRITE(IU,'(" SLCSET: N",A2,"RPT=",I9)') CDSL,KSLRPT
      WRITE(IU,'(" SLCSET: N",A2,"SPT=",I9)') CDSL,KSLSPT
    ENDIF
  ENDIF

ENDIF

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

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

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

