SUBROUTINE PHCSET(CDSL,KSLWIDEN,KSLWIDES,KSLWIDEW,KSLWIDEE,&
 & KSLRPTSUR,KSLSPTSUR,&
 & 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)  

!**** *PHCSET * - Routine to initialize parallel environment
!                 necessary for horizontal interpolations - for Coarse Physics. 
!                 Based on SLCSET but with arguements for halo width in each of the
!                 coordinate directions to conserve memory.
!                 Works with a lateral band of KSLWIDE[N,S,W,E] 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.

!**   Interface.
!     ----------
!        *CALL* *PHCSET *

!        Explicit arguments :
!        --------------------
!         INPUT:
!          CDSL        - two letter code, ex:
!                        'RO': initialisation of environment based on NRIWIDE.
!                        'RI': initialisation of environment based on NROWIDE.
!          KSLWIDEN    - number of grid points required for halo (north)
!          KSLWIDES    - number of grid points required for halo (south)
!          KSLWIDEW    - number of grid points required for halo (west)
!          KSLWIDEE    - number of grid points required for halo (east)
!          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(MY_REGION_NS)-1
!          KYFRSTACTLAT- first actual lat on this PE in grid-point space,
!                        it is kfrstlat(MY_REGION_NS)
!          KYLSTACTLAT - last actual lat on this PE in grid-point space,
!                        it is klstlat(MY_REGION_NS)
!          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.
!     -------
!        After RDCSET

!     Externals.
!     ----------
!      Calls PHRSET if NPROC > 1.
!      Is called by SUECPHYPO.

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

!     Author.
!     -------
!        Deborah Salmond

!     Modifications.
!     --------------
!     ------------------------------------------------------------------

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

USE YOMCT0   , ONLY : NPROC    ,NPRINTLEV,LOUTPUT  ,LMPDIAG  ,LALLOPR  ,&
 & LELAM    ,N_REGIONS_NS    ,N_REGIONS_EW
USE YOMMP    , ONLY : MY_REGION_NS   ,MY_REGION_EW   ,NSLPAD
USE YOMLUN   , ONLY : NULOUT
USE YOMCST   , ONLY : RPI      ,RA
USE YEMGEO   , ONLY : EDELX    ,EDELY

IMPLICIT NONE

!     DUMMY:
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLWIDEN
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLWIDES
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLWIDEW
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLWIDEE
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLRPTSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSLSPTSUR 
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-KSLWIDEN:KDGENL+KSLWIDES) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLONL(KDGSAL-KSLWIDEN:KDGENL+KSLWIDES) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLOFF(KDGSAL-KSLWIDEN:KDGENL+KSLWIDES) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSLEXT(1-KDLON:KDLON+KDLON,1-KSLWIDEN:KDGENL+KSLWIDES) 
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, &
 & ISLWM2W, ISLWM2E, &
 & ISS, IU, JGLGLO, JGLGLO2, JGLLOC, JGLLOC2, &
 & JLON, JROC, JROF

LOGICAL :: LLCOND, LLP, LLHALO

REAL(KIND=JPRB) :: Z1GP, ZBIG, ZDEN, Z1GPMAX,&
 & ZANGLEW, ZANGLEE, &
 & ZDISTW, ZDISTE, &
 & ZDLSW, ZDLSE, &
 & ZGPTSW, ZGPTSE, &
 & ZDLW, ZDLE, &
 & ZISLWM2W, ZISLWM2E, &
 & ZDLMAXW, ZDLMAXE, &
 & ZNUMW, ZNUME, &
 & ZRAPW, ZRAPE, &
 & ZMAXA, ZMINA

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "phrset.intfb.h"

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

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

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

IF (LELAM .AND. CDSL == 'SL') THEN
  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(' PHCSET: IPERIOD AND KDLSUR ARE NOT CONSISTENT')
ENDIF

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

DO JGLGLO=KFRSTLAT(MY_REGION_NS),KLSTLAT(MY_REGION_NS)
  IGLLOC=JGLGLO-KFRSTLOFF
  IF (KONL(KPTRFLOFF+IGLLOC,MY_REGION_EW) > 0) THEN
    ISS=KSTA(KPTRFLOFF+IGLLOC,MY_REGION_EW)
    IFF=ISS+KONL(KPTRFLOFF+IGLLOC,MY_REGION_EW)-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

ISLWM2W=KSLWIDEW-KDGSUR+1
ISLWM2E=KSLWIDEE-KDGSUR+1
ZISLWM2W=REAL(ISLWM2W,JPRB)
ZISLWM2E=REAL(ISLWM2E,JPRB)

!OCL  NOPREEX
IF (LELAM) THEN
  ZDISTW=(MIN(EDELX,EDELY)*ZISLWM2W)/RA
  ZDISTE=(MIN(EDELX,EDELY)*ZISLWM2E)/RA
ELSE
  ZDISTW=(RPI*ZISLWM2W)/(REAL(KDGLG,JPRB)+0.5_JPRB)
  ZDISTE=(RPI*ZISLWM2E)/(REAL(KDGLG,JPRB)+0.5_JPRB)
ENDIF

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

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

DO JGLLOC=ILS,ILF

  IALS=MAX(KYFRSTACTLAT,JGLLOC+KFRSTLOFF-MAX(KSLWIDEN,KSLWIDES))-KFRSTLOFF
  IALF=MIN(KYLSTACTLAT ,JGLLOC+KFRSTLOFF+MAX(KSLWIDEN,KSLWIDES))-KFRSTLOFF
! IF( IALF < IALS ) CYCLE
  IF( IALS < 1.OR. IALS > KDGENL )THEN
    CALL ABOR1(' PHCSET: INVALID STARTING LOCAL LATITUDE IALS')
  ENDIF
  IF( IALF < 1.OR. IALF > KDGENL )THEN
    CALL ABOR1(' PHCSET: 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,MY_REGION_EW) > 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)
      ZDLMAXW=ZDISTW
      ZDLMAXE=ZDISTE
      IALFGLO=1

    ELSE

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

      Z1GPMAX=0.0_JPRB
      ZDLMAXW=0.0_JPRB
      ZDLMAXE=0.0_JPRB

      DO JGLGLO2=IALSGLO,IALFGLO
        Z1GP=1.0_JPRB/REAL(KLOENG(JGLGLO2),JPRB)
        Z1GPMAX=MAX(Z1GPMAX,Z1GP)
        ZNUMW=COS(ZDISTW)-(PMU(JGLGLO2)*PMU(JGLGLO2))
        ZNUME=COS(ZDISTE)-(PMU(JGLGLO2)*PMU(JGLGLO2))
        ZDEN=PSQM2(JGLGLO2)*PSQM2(JGLGLO2)
        ZRAPW=MIN(1.0_JPRB,MAX(0.0_JPRB, ZNUMW/ZDEN ))
        ZRAPE=MIN(1.0_JPRB,MAX(0.0_JPRB, ZNUME/ZDEN ))
        ZDLW=ACOS(ZRAPW)/(2.0_JPRB*RPI)
        ZDLE=ACOS(ZRAPE)/(2.0_JPRB*RPI)
        ZDLMAXW=MAX(ZDLMAXW,ZDLW)
        ZDLMAXE=MAX(ZDLMAXE,ZDLE)
      ENDDO

    ENDIF

!       Add grid points for west and east interpolation

    ZANGLEW=ZDLMAXW+Z1GPMAX
    ZANGLEE=ZDLMAXE+Z1GPMAX
    ZGPTSW=ZANGLEW*REAL(KLOENG(IALFGLO),JPRB)
    ZGPTSE=ZANGLEE*REAL(KLOENG(IALFGLO),JPRB)

    ZMINA=ZMINA-ZANGLEW
    ZMAXA=ZMAXA+ZANGLEE

!       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+(MAX(KSLWIDEN,KSLWIDES)-1).OR.&
       & IGLGLO >= KDGLG-(MAX(KSLWIDEN,KSLWIDES)-1))
    ENDIF
  
    IF (LLCOND) THEN
      KSLSTA(JGLLOC)=1
      KSLONL(JGLLOC)=KLOENG(IGLGLO)
      KSLOFF(JGLLOC)=IPTSET+ISLPAD+1
      IPTSET=IPTSET+KLOENG(IGLGLO)+IPERIOD+ISLPAD*2
      ZANGLEW=1.0_JPRB
      ZANGLEE=1.0_JPRB
      ZGPTSW=KLOENG(IGLGLO)
      ZGPTSE=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
    ZDLMAXW=0.0_JPRB
    ZDLMAXE=0.0_JPRB
    Z1GPMAX=0.0_JPRB
    ZANGLEW=0.0_JPRB
    ZANGLEE=0.0_JPRB
    ZGPTSW=0.0_JPRB
    ZGPTSE=0.0_JPRB

  ENDIF

!       optional diagnostic output

  IF( IGLGLO>=1.AND.IGLGLO<=KDGLG )THEN
    KMAPLEN=KMAPLEN+1
    IF( KMAPLEN > KDGLG ) CALL ABOR1('PHCSET: 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,'(" PHCSET INFO: DM-LOCAL LAT=",I3,&
     & " N",A2,"STA=",I5,&
     & " N",A2,"ONL=",I5,&
     & " N",A2,"OFF=",I8,&
     & " ZDLMAXW=",F10.5," ZDLMAXE=",F10.5,&
     & " Z1GPMAX=",F10.5,&
     & " ZANGLEW=",F10.5," ZANGLEE=",F10.5,&
     & " ZGPTSW=",F10.5," ZGPTSE=",F10.5)')&
     & IGLGLO,&
     & CDSL,KSLSTA(JGLLOC),CDSL,KSLONL(JGLLOC),CDSL,KSLOFF(JGLLOC),&
     & ZDLMAXW,ZDLMAXE,Z1GPMAX,ZANGLEW,ZANGLEE,ZGPTSW,ZGPTSE
    CALL FLUSH(NULOUT)
  ENDIF

ENDDO

IF( CDSL == 'OB' )THEN
  WRITE(NULOUT,'("PHCSET: INITIALISATION COMPLETE FOR CDSL=OB")')
  IF (LHOOK) CALL DR_HOOK('PHCSET',1,ZHOOK_HANDLE)
  RETURN
ENDIF

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

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

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

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

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

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

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

DO JGLGLO=MAX(KDGSAG,KFRSTLAT(MY_REGION_NS)-KSLWIDEN)&
   & ,MIN(IDGENG,KLSTLAT(MY_REGION_NS)+KSLWIDES)  
  IGLLOC=JGLGLO-KFRSTLAT(MY_REGION_NS)+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,'(&
!      &" PHCSET: 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 RDRSET IF NPROC > 1.
!        ---------------------------------------------

KASLB1=IPTSET
IF(LLP) WRITE(NULOUT,'(" NA",A2,"B1 = ",I7)') CDSL,KASLB1

IF (NPROC > 1) THEN
  CALL PHRSET(CDSL,KSLWIDEN,KSLWIDES,&
   & 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,*) ' PHCSET: KASLB1 too small',&
       & KSENDPTR(JROC+1)-KSENDPTR(JROC),&
       & ' required, but the value is ',KASLB1  
      CALL ABOR1('PHCSET: KASLB1 too small')
    ENDIF
  ENDDO
ELSE
!         KSLSENDPOS,KSLRECVPOS,KSENDPTR,KRECVPTR,KSLCOMM are useless.
  KSLPROCS=0
  KSLRPT=0
  KSLSPT=0
  IF (LOUTPUT) THEN
    WRITE(IU,'(" PHCSET: N",A2,"PROCS=",I6)') CDSL,KSLPROCS
    WRITE(IU,'(" PHCSET: N",A2,"RPT=",I9)') CDSL,KSLRPT
    WRITE(IU,'(" PHCSET: N",A2,"SPT=",I9)') CDSL,KSLSPT
  ENDIF
ENDIF


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

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

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

