MODULE YOE_CUCONVCA
  USE PARKIND1  ,ONLY : JPIM     ,JPRB
  USE RANDOM_NUMBERS_MIX, ONLY: randomNumberStream
  IMPLICIT NONE

  SAVE

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

!*    control parameters for cellular automaton for convection

!      yd_random_stream_CA: random number stream for CA update
!      NIJH         : Multiplicative for number of points in high resolution grid
!      NBmax        : maximum possible number of neighbours for every gridcell
!      RCUCONVCA    : Array for interaction with the physics
!      RNLCONVCA    : Array for interaction with the physics
!      RCAPECONVCA  : Array to store "good" CAPE between its calculation [MOD(KSTEP*TSPHY,3600._JPRB)]
!      NCELLCU      : Lat-lon grid for cellular automaton
!      NFERTCU      : Lat-lon grid for cellular automaton (fertile cell indicator)
!      NBLS         : neighbours for large scale grid (= model red gaussian grid)
!      NBSS         : neighbours for small scale grid (= NIJH*NIJH cells in every LS cell)
!      NRNBLS       : number of neighbours for large scale cells
!      NRNBSS       : number of neighbours for small scale cells
!      NBNS         : neighbour north/south or on same lat (1/-1/0)
!      NBEW         : neighbour east/west or on same long (1/-1/0)
!      RWASALIVE    : Array indicating grid-points where CA was alive before
!      RWGHTCU      : Weighted and smoothed CA pattern
!      LCUCONV_CA   : TRUE IF CELLULAR AUTOMATON USED IN CONVECTION
!      LCA_ADVECT   : switch for "kind of" semi-Lagrangian advection
!      LCA_GLOBAL   : switch for global CA instead ov "convective" CA
!      LCA_SMOOTH   : swith for smoothing CA on large scale grid
!      LCA_TEST     : switch for initialize CA at single point
!      LCA_RANTROP  : switch for random coupling of CA to deep convection (concerns initialization)
!      NTESTPROC    : set on which processor the single point should lie
!      NTESTGP      : set which gridpoint the single point is on
!      NSPINUP      : set number of spin-up cycles for global pattern
!      CA_FORC      : switch to choose convective forcing
!      CA_WIND      : switch to choose CA-wind (real/idealized)
!      CA_PROB      : switch to choose probabilities
!      NLIVES       : switch to choose number of lives (scaled by CAPE in callpar)
!      NFERTYRS     : switch to choose max number of steps a cell can be fertile
!      NFRCASEED    : Frequency of seeding CA where physics diagnoses deep convection
!      RCA_SEEDPROB : Probability of random seeding for global CA

!      RPROB_SURVIVE: probabilities for cell survival
!      RPROB_BIRTH: probabilities for cell birth
!      RPROB_FUN_FERT_S: function for specifying probabilities for survival as function of upwind(uw)+downwind(dw) neighbours
!      RPROB_FUN_UW_DW_S: function for specifying probabilities for survival as function of upwind(uw)-downwind(dw) neighbours
!      RPROB_FUN_FERT_B: function for specifying probabilities for birth as function of upwind(uw)+downwind(dw) neighbours
!      RPROB_FUN_UW_DW_B: function for specifying probabilities for birth as function of upwind(uw)-downwind(dw) neighbours
!
!      SLLONG(NASLB1)       : Array containing the longitude for each gridpoint in a semi/lagrangian buffer array
!      SLLAT(NASLB1)        : Array containing the latitude for each gridpoint in a semi/lagrangian buffer array
!      SLDLONG(NASLB1)      : Array containing the width of each gridbox in longitudinal direction 
!                             in a semi/lagrangian buffer array
!      SLDLAT(NASLB1)       : Array containing the width of each gridbox in latitudinal direction 
!                             in a semi/lagrangian buffer array
!      SLDDLAT(NASLB1)      : Array containing the difference of the gridbox's northern boundary latitude 
!                             and the latitude of the gp (necessary because latitudes are not uniformly distributed)

  TYPE (randomNumberStream)     :: yd_random_stream_CA
  INTEGER(KIND=JPIM), PARAMETER :: NIJH=4
  INTEGER(KIND=JPIM), PARAMETER :: NBmax=8
  INTEGER(KIND=JPIM)            :: NLIVES
  INTEGER(KIND=JPIM)            :: NFERTYRS
  INTEGER(KIND=JPIM)            :: NSPINUP

  INTEGER(KIND=JPIM),ALLOCATABLE:: NCELLCU(:,:)
  INTEGER(KIND=JPIM),ALLOCATABLE:: NFERTCU(:,:)
  INTEGER(KIND=JPIM),ALLOCATABLE:: NBLS(:,:)
  INTEGER(KIND=JPIM),ALLOCATABLE:: NBSS(:,:,:,:)
  INTEGER(KIND=JPIM),ALLOCATABLE:: NRNBLS(:)
  INTEGER(KIND=JPIM),ALLOCATABLE:: NRNBSS(:,:)
  INTEGER(KIND=JPIM),ALLOCATABLE:: NBEW(:,:,:)
  INTEGER(KIND=JPIM),ALLOCATABLE:: NBNS(:,:,:)
  REAL(KIND=JPRB)   ,ALLOCATABLE:: RCUCONVCA(:)
  REAL(KIND=JPRB)   ,ALLOCATABLE:: RNLCONVCA(:)
  REAL(KIND=JPRB)   ,ALLOCATABLE:: RCAPECONVCA(:)
  REAL(KIND=JPRB)   ,ALLOCATABLE:: RWASALIVE(:)
  REAL(KIND=JPRB)   ,ALLOCATABLE:: RWGHTCU(:)

  REAL(KIND=JPRB)               :: RPROB_SURVIVE(0:8,0:8)
  REAL(KIND=JPRB)               :: RPROB_BIRTH(0:8,0:8)
  REAL(KIND=JPRB)               :: RPROB_FUN_FERT_S(0:16)
  REAL(KIND=JPRB)               :: RPROB_FUN_UW_DW_S(0:16)
  REAL(KIND=JPRB)               :: RPROB_FUN_FERT_B(0:16)
  REAL(KIND=JPRB)               :: RPROB_FUN_UW_DW_B(0:16)

  REAL(KIND=JPRB)   ,ALLOCATABLE:: RLONDEP(:,:,:)
  REAL(KIND=JPRB)   ,ALLOCATABLE:: RLATDEP(:,:,:)

  REAL(KIND=JPRB)               :: RCA_SEEDPROB

  LOGICAL                       :: LCUCONV_CA
  LOGICAL                       :: LCA_ADVECT
  LOGICAL                       :: LCA_GLOBAL
  LOGICAL                       :: LCA_SMOOTH
  LOGICAL                       :: LCA_TEST
  LOGICAL                       :: LCA_RANTROP
  CHARACTER(len=10)             :: CA_FORC
  CHARACTER(len=10)             :: CA_WIND
  CHARACTER(len=10)             :: CA_PROB
  INTEGER(KIND=JPIM)            :: NFRCASEED
  INTEGER(KIND=JPIM)            :: NTESTPROC, NTESTGP
  INTEGER(KIND=JPIM)            :: NDXUNREAL, NDYUNREAL

  REAL(KIND=JPRB)   ,ALLOCATABLE:: SLLONG(:), SLLAT(:)
  REAL(KIND=JPRB)   ,ALLOCATABLE:: SLDLONG(:), SLDLAT(:), SLDDLAT(:)

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

  CONTAINS

!     ------------------------------------------------------
!     CA-initialization
!       - read NAMELIST
!       - if CA active initialize constants and allocate arrays
!     ------------------------------------------------------
SUBROUTINE INI_CUCONVCA
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  USE YOMCT0   , ONLY : LSLAG
  USE PARKIND1  ,ONLY : JPIM
  USE YOMGEM   , ONLY : NGPTOT
  USE YOMDIM   , ONLY : NDGLG,NPROMA,NFLEVG,NGPBLKS
  USE YOMCST   , ONLY : RPI
  use YOMLUN   , ONLY : NULOUT, NULNAM
  USE YOMMP    , ONLY : NASLB1
  USE YOMGRB   , ONLY : NENSFNB
!  USE RANDOM_NUMBERS_MIX
  IMPLICIT NONE
  INTEGER(KIND=JPIM) :: JI,JJ
  REAL(KIND=JPRB)    :: ZHOOK_HANDLE
#include "posnam.intfb.h"
#include "namca.h"
#include "setran.intfb.h"

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:INI_CUCONVCA',0,ZHOOK_HANDLE)
!     ----------------
!     Setup namelist variables
!     ----------------

 LCUCONV_CA=.false.! use Cellular Automaton 
 LCA_ADVECT=.false. ! use pseudo semi-lag advection of CA
 LCA_GLOBAL=.false.
 LCA_SMOOTH=.true.
 LCA_RANTROP=.false.
 CA_FORC="CONV_TQ"
 CA_WIND="REAL"
 CA_PROB="WIND"
 RCA_SEEDPROB=0.995
 NFRCASEED=1
 NLIVES=10
 NFERTYRS=3
 LCA_TEST=.false.
 NTESTPROC=8
 NTESTGP=1
 NDXUNREAL=-1
 NDYUNREAL=0
 NSPINUP=1000

!     ----------------
!     Read namelist
!     ----------------
 CALL POSNAM(NULNAM,'NAMCA')
 READ(NULNAM,NAMCA)

 IF (.NOT. LSLAG) LCUCONV_CA=.FALSE.

  IF (.NOT. LCUCONV_CA) THEN
    WRITE(NULOUT,*) 'convective CA not active!'
  ELSE
    WRITE(NULOUT,*) 'Initializing convective CA:'
    WRITE(NULOUT,*) 'CA settings are:'
    WRITE(NULOUT,*) 'Number of lives: ',NLIVES
    WRITE(NULOUT,*) 'Number of fertile Years: ',NFERTYRS
    WRITE(NULOUT,*) 'Frequency of seeding: ',NFRCASEED
    WRITE(NULOUT,*) '"semi-lagrangian" advection of CA: ',LCA_ADVECT
    WRITE(NULOUT,*) 'Wind used: ', CA_WIND
    WRITE(NULOUT,*) 'Forcing applied to convection: ', CA_FORC
    WRITE(NULOUT,*) 'Probabilities used: ', CA_PROB


!     ----------------
!     Setup CA grid and allocate arrays
!     ----------------

!     NIJH         : Multiplicative for number of points in high resolution grid


    ALLOCATE(RCUCONVCA(NGPTOT))
    RCUCONVCA=0.0
    ALLOCATE(RNLCONVCA(NGPTOT))
    RNLCONVCA=0.0 !NLIVES
    ALLOCATE(RCAPECONVCA(NGPTOT))
    RCAPECONVCA=0.0
    ALLOCATE(RWASALIVE(NGPTOT))
    RWASALIVE=0.0
    ALLOCATE(NCELLCU(NIJH*NIJH,NGPTOT))
    ALLOCATE(NFERTCU(NIJH*NIJH,NGPTOT))
    ALLOCATE(NBLS(NBmax,NASLB1))
    ALLOCATE(NBSS(2,NBmax,NIJH*NIJH,NASLB1))
    ALLOCATE(NBNS(NBmax,NIJH*NIJH,NASLB1))
    ALLOCATE(NBEW(NBmax,NIJH*NIJH,NASLB1))
    ALLOCATE(NRNBLS(NASLB1))
    ALLOCATE(NRNBSS(NIJH*NIJH,NASLB1))
    ALLOCATE(RWGHTCU(NGPTOT))

    NCELLCU=0
    NFERTCU=0

    NBLS=0
    NBSS=0
    NRNBLS=0
    NRNBSS=0
    NBNS=0
    NBEW=0

!initialize random number stream (as function of ensemble member number and the date)
    CALL SETRAN (NENSFNB,YD_RANDOM_STREAM_CA)
!initialize probabilities for CA
    IF ( CA_PROB == 'WIND' ) THEN
      ! wind dominated probabilities
      !                           0      1      2      3      4      5      6      7      8      9
         RPROB_FUN_FERT_S  = (/ 0.000, 0.500, 0.950, 0.950, 0.950, 0.700, 0.550, 0.000, 0.000, 0.000, &
      !                          10     11     12     13     14     15     16
                              & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 /)
      !                           0      1      2      3      4      5      6      7      8      9
         RPROB_FUN_UW_DW_S = (/ 0.000, 0.000, 0.000, 0.000, 0.000, 0.005, 0.100, 0.250, 0.700, 0.950, &
      !                          10     11     12     13     14     15     16
                              & 0.950, 0.900, 0.850, 0.750, 0.700, 0.650, 0.650 /)
      !                           0      1      2      3      4      5      6      7      8      9
         RPROB_FUN_FERT_B  = (/ 0.000, 0.950, 0.950, 0.700, 0.600, 0.300, 0.150 , 0.000, 0.000, 0.000, &
      !                          10     11     12     13     14     15     16
                              & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 /)
      !                           0      1      2      3      4      5      6      7      8      9
         RPROB_FUN_UW_DW_B = (/ 0.000, 0.000, 0.000, 0.000, 0.000, 0.005, 0.100, 0.250, 0.700, 0.950, &
      !                          10     11     12     13     14     15     16
                              & 0.950, 0.900, 0.850, 0.750, 0.700, 0.650, 0.650 /)
    ELSEIF ( CA_PROB == 'NOWIND' ) THEN
      ! equal probabilities for UW/DW
      !                           0      1      2      3      4      5      6      7      8      9
         RPROB_FUN_FERT_S  = (/ 0.000, 0.250, 0.600, 0.950, 0.950, 0.950, 0.800, 0.650, 0.500, 0.000, &
      !                          10     11     12     13     14     15     16
                              & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 /)
      !                           0      1      2      3      4      5      6      7      8      9
         RPROB_FUN_UW_DW_S = (/ 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
      !                          10     11     12     13     14     15     16
                              & 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000 /)
      !                           0      1      2      3      4      5      6      7      8      9
         RPROB_FUN_FERT_B  = (/ 0.000, 0.250, 0.950, 0.950, 0.700, 0.600, 0.300, 0.150 , 0.000, 0.000, &
      !                          10     11     12     13     14     15     16
                              & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 /)
      !                           0      1      2      3      4      5      6      7      8      9
         RPROB_FUN_UW_DW_B = (/ 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
      !                          10     11     12     13     14     15     16
                              & 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000 /)
    ENDIF

    DO JI=0,8
      DO JJ=0,8
         RPROB_SURVIVE(JI,JJ)=RPROB_FUN_FERT_S(JI+JJ)*RPROB_FUN_UW_DW_S(JJ-JI+8)
         RPROB_BIRTH(JI,JJ)=RPROB_FUN_FERT_B(JI+JJ)*RPROB_FUN_UW_DW_B(JJ-JI+8)
      ENDDO
    ENDDO

    WRITE(NULOUT,*) '  Survive:'
    WRITE(NULOUT,'(9F7.3)') RPROB_SURVIVE
    WRITE(NULOUT,*) '  Birth:'
    WRITE(NULOUT,'(9F7.3)') RPROB_BIRTH

   !setup LAT/LONG, DLAT, DLONG arrays
    CALL SETUP_LATLONGHELP
   !caluclate neighbours for CA cells on reduced gaussian grid
    CALL CALCULATE_NEIGHBOURS

    IF (LCA_ADVECT) THEN
      ALLOCATE(RLONDEP(NPROMA,NFLEVG,NGPBLKS),RLATDEP(NPROMA,NFLEVG,NGPBLKS))
    ENDIF

  ENDIF
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:INI_CUCONVCA',1,ZHOOK_HANDLE)
END SUBROUTINE INI_CUCONVCA


!     ------------------------------------------------------
!     prepare arrays containing latitude, longitude and 
!     gridbox size for every gridbox in SL-buffer
!     ------------------------------------------------------
SUBROUTINE SETUP_LATLONGHELP
  USE YOMLUN, only : NULOUT, NULERR
  USE YOMGEM   , ONLY : NGPTOT, NLOENG
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  USE YOMGC    , ONLY : GELAM     , GELAT
  USE YOMDIM   , ONLY: NDGENL, NDGLG
  USE YOMCST   , ONLY : RPI
  USE YOMLEG   , ONLY : RLATIG

!stuff for SL-halo
  USE YOMMP , ONLY : NASLB1, NSLPROCS  ,&
                   & NSLRPT, NSLSPT, NSLSENDPOS,&
                   & NSLRECVPOS, NSENDPTR  ,NRECVPTR  ,NSLCOMM, &
                   & NSLCORE, MYLATS, &
                   & MY_REGION_NS, MY_REGION_EW, NONL, NPTRFRSTLAT
  IMPLICIT NONE
  REAL(KIND=JPRB)                 :: ZHOOK_HANDLE
  INTEGER(KIND=JPIM)              :: J,JLS, JLAT
  INTEGER(KIND=JPIM)              :: IGP, ILG
  INTEGER(KIND=JPIM)              :: INSTANLON, INRLON
  REAL(KIND=JPRB), ALLOCATABLE    :: ZDLONG(:),ZDLAT(:),ZDDLAT(:)
  REAL(KIND=JPRB)                 :: ZDLO, ZDLA, ZDDLA

!stuff for SL-halo
  LOGICAL                         :: LLINC
  INTEGER(KIND=JPIM)              :: IFIELDSLB1
  INTEGER(KIND=JPIM)              :: IDUMARR(2)
  INTEGER(KIND=JPIM)              :: IFIXSFLD(2)
  INTEGER(KIND=JPIM)              :: IFLDSLB1
  REAL(KIND=JPRB), ALLOCATABLE    :: ZPB1(:,:)

#include "slcomm.intfb.h"

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:SETUP_LATLONGHELP',0,ZHOOK_HANDLE)

!  WRITE(NULOUT,*) "yyyy latlong_help beginning"
!  CALL FLUSH(NULOUT)

  ALLOCATE(SLLONG(NASLB1),SLLAT(NASLB1),SLDLONG(NASLB1),SLDLAT(NASLB1),SLDDLAT(NASLB1))
  ALLOCATE(ZDLONG(NGPTOT),ZDLAT(NGPTOT),ZDDLAT(NGPTOT))

!calculate dlong, dlat
  IGP=1
  DO JLAT=1,NDGENL
    ILG=MYLATS(JLAT)
!    WRITE(NULOUT,*) "yyyy latlong_help JLAT, ILG, IGP",JLAT,ILG,IGP
!    CALL FLUSH(NULOUT) 
    ZDLO=2*RPI/REAL(NLOENG(ILG),JPRB)         !calculate delta longitude between gp on lat
    IF (ILG == 1) THEN
      ZDLA=0.5_JPRB*RPI-0.5_JPRB*(RLATIG(ILG)+RLATIG(ILG+1))
      ZDDLA=0.5_JPRB*RPI-RLATIG(ILG)
    ELSEIF (ILG == NDGLG) THEN
      ZDLA= 0.5_JPRB*(RLATIG(ILG)+RLATIG(ILG-1))+0.5_JPRB*RPI
      ZDDLA=0.5_JPRB*(RLATIG(ILG-1)-RLATIG(ILG))
    ELSE
      ZDLA=0.5_JPRB*(RLATIG(ILG-1)-RLATIG(ILG+1))
      ZDDLA=0.5_JPRB*(RLATIG(ILG-1)-RLATIG(ILG))
    ENDIF
    INSTANLON=NPTRFRSTLAT(MY_REGION_NS)+JLAT-1      !index for NSTA/NONL arrays
    INRLON=NONL(INSTANLON,MY_REGION_EW)             !number of gridpoints on this processor for current latitude
    IF (INRLON < 1 .OR. INRLON > NLOENG(ILG)) THEN
          CYCLE                    !go to next lat, if there are no points on this lat
    ENDIF
    DO J=1,INRLON                             !loop over gp on this latitude
      ZDLONG(IGP)=ZDLO
      ZDLAT(IGP)=ZDLA
      ZDDLAT(IGP)=ZDDLA
      IGP=IGP+1
    ENDDO
  ENDDO

!  WRITE(NULOUT,*) "yyyy latlong_help before SL-stuff"
!  CALL FLUSH(NULOUT)
!SL-stuff
  LLINC=.FALSE.
  IFIXSFLD(:)=0
  IFLDSLB1=5
  ALLOCATE(ZPB1(NASLB1,IFLDSLB1))
  ZPB1=0

!fill buffer
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS)
  DO JLS=1,NGPTOT
      ZPB1(NSLCORE(JLS),1)=GELAM(JLS)
      ZPB1(NSLCORE(JLS),2)=GELAT(JLS)
      ZPB1(NSLCORE(JLS),3)=ZDLONG(JLS)
      ZPB1(NSLCORE(JLS),4)=ZDLAT(JLS)
      ZPB1(NSLCORE(JLS),5)=ZDDLAT(JLS)
  ENDDO
!$OMP END PARALLEL DO

!get halo
  CALL SLCOMM(NASLB1,NSLPROCS,NSLRPT,&
       & NSLSPT,NSLSENDPOS,NSLRECVPOS,NSENDPTR,NRECVPTR,NSLCOMM,&
       & IDUMARR,&
       & IFLDSLB1,LLINC,0,ZPB1)

!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS)
  DO JLS=1,NASLB1
      SLLONG(JLS)=ZPB1(JLS,1)
      SLLAT(JLS)=ZPB1(JLS,2)
      SLDLONG(JLS)=ZPB1(JLS,3)
      SLDLAT(JLS)=ZPB1(JLS,4)
      SLDDLAT(JLS)=ZPB1(JLS,5)
  ENDDO
!$OMP END PARALLEL DO

  DEALLOCATE(ZPB1,ZDLONG,ZDLAT,ZDDLAT)

!  WRITE(NULOUT,*) "yyyy latlong_help done. IGP, NGPTOT",IGP,NGPTOT
!  CALL FLUSH(NULOUT)

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:SETUP_LATLONGHELP',1,ZHOOK_HANDLE)

END SUBROUTINE SETUP_LATLONGHELP


!     ------------------------------------------------------
!     calculate neighbours on reduced gaussian grid
!     for each gridcell on this processor
!       - neighbour given in terms of index in the SL-buffer
!     ------------------------------------------------------
SUBROUTINE CALCULATE_NEIGHBOURS
  USE YOMGEM   , ONLY : NGPTOT, NLOENG
  USE YOMLUN, only : NULOUT, NULERR
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 

  USE YOMMP,  ONLY: NSLSTA, NSLONL, NSLOFF, MYLATS, NSLCORE, &
                  & MY_REGION_NS, MY_REGION_EW, NSTA, NONL, NPTRFRSTLAT, NASLB1
  USE YOMSC2, ONLY: NSLWIDE
  USE YOMDIM, ONLY: NDGSAL,NDGENL,NDGSUR, NDGLG

  IMPLICIT NONE

  INTEGER(KIND=JPIM)                    :: JLAT, J, JLL,JI,JXSS,JYSS, JNB
  INTEGER(KIND=JPIM)                    :: ILG, ILATNB, ILGNB
  INTEGER(KIND=JPIM)                    :: INSTANLON
  INTEGER(KIND=JPIM)                    :: INRLON
  INTEGER(KIND=JPIM)                    :: INRNB
  INTEGER(KIND=JPIM)                    :: IGP, IGPNB, IGPSS
  INTEGER(KIND=JPIM)                    :: IINCR
  INTEGER(KIND=JPIM)                    :: ILON,ILONNB
  INTEGER(KIND=JPIM)                    :: IYNB, IXNB
  INTEGER(KIND=JPIM)                    :: IEW

  REAL(KIND=JPRB)                       :: ZDLONG, ZDLONGNB, ZDLONGMAX,ZDELTA
  REAL(KIND=JPRB)                       :: ZLONG(NASLB1)
  REAL(KIND=JPRB)                       :: ZLONGSSGP, ZLONGSSGPNB
  INTEGER(KIND=JPIM)                    :: ILATGP(NASLB1),ILONGP(NASLB1)
  REAL(KIND=JPRB)                       :: ZTMPNBLS(NBmax,NASLB1),ZTMPNBSS(2,NBmax,NIJH*NIJH,NASLB1)
  REAL(KIND=JPRB)                       :: ZTMPNRNBLS(NASLB1),ZTMPNRNBSS(NIJH*NIJH,NASLB1)

  LOGICAL                               :: LLCOMPLI

  REAL(KIND=JPRB)                       :: ZHOOK_HANDLE

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:CALCULATE_NEIGHBOURS',0,ZHOOK_HANDLE)

!   NBLS(NBmax,NGPTOT)
!   NBSS(2,NBmax,NIJH*NIJH,NGPTOT)
!   NRNBLS(NGPTOT)
!   NRNBSS(NIJH*NIJH,NGPTOT)

!  NBLS(1,:)=1
!  NBSS(:,1,:,:)=1
!  NRNBLS(:)=1
!  NRNBSS(:,:)=1

!  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:CALCULATE_NEIGHBOURS',1,ZHOOK_HANDLE)
!  RETURN

  WRITE(NULOUT,'("yyyy : ",4I8)') NSLWIDE,NDGSAL,NDGENL,NDGSUR
  WRITE(NULOUT,*) "yyyy NSLSTA: ", LBOUND(NSLSTA),NSLSTA(LBOUND(NSLSTA)),NSLSTA(LBOUND(NSLSTA)+1)
  WRITE(NULOUT,*) "yyyy NSLSTA: ", UBOUND(NSLSTA),NSLSTA(UBOUND(NSLSTA)),NSLSTA(UBOUND(NSLSTA)-1)
  WRITE(NULOUT,*) "yyyy NLOENG: ", LBOUND(NLOENG),NLOENG(LBOUND(NLOENG)),NLOENG(LBOUND(NLOENG)+1)
  WRITE(NULOUT,*) "yyyy NLOENG: ", UBOUND(NLOENG),NLOENG(UBOUND(NLOENG)),NLOENG(UBOUND(NLOENG)-1)
  WRITE(NULOUT,*) "yyyy NSLOFF: ", LBOUND(NSLOFF),NSLOFF(LBOUND(NSLOFF)),NSLOFF(LBOUND(NSLOFF)+1)
  WRITE(NULOUT,*) "yyyy NSLOFF: ", UBOUND(NSLOFF),NSLOFF(UBOUND(NSLOFF)),NSLOFF(UBOUND(NSLOFF)-1)
  WRITE(NULOUT,*) "yyyy NPTRFRSTLAT: ", LBOUND(NPTRFRSTLAT),NPTRFRSTLAT(LBOUND(NPTRFRSTLAT)),NPTRFRSTLAT(LBOUND(NPTRFRSTLAT)+1)
  WRITE(NULOUT,*) "yyyy NPTRFRSTLAT: ", UBOUND(NPTRFRSTLAT),NPTRFRSTLAT(UBOUND(NPTRFRSTLAT)),NPTRFRSTLAT(UBOUND(NPTRFRSTLAT)-1)
  WRITE(NULOUT,*) "yyyy MYLATS: ", LBOUND(MYLATS),MYLATS(LBOUND(MYLATS)),MYLATS(LBOUND(MYLATS)+1)
  WRITE(NULOUT,*) "yyyy MYLATS: ", UBOUND(MYLATS),MYLATS(UBOUND(MYLATS)),MYLATS(UBOUND(MYLATS)-1)
  CALL FLUSH(NULOUT)

ILATGP=-99
ILONGP=-99

!calculate longitude for every point in SL-array
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLAT,ILG,INRLON,ZDLONG,J,IGP,ILON)
  DO JLAT=0,NDGENL+1
    ILG=MYLATS(1)+JLAT-1           !global latitude number
    IF (ILG < 1) THEN
      ILG=1
    ELSEIF (ILG > NDGLG) THEN
      ILG=NDGLG
    ENDIF

    INRLON=NSLONL(JLAT)             !number of gridpoints on this processor for current latitude
    ZDLONG=360._JPRB/REAL(NLOENG(ILG),JPRB)         !calculate delta longitude between gp on lat
    DO J=1,INRLON
      IGP=NSLOFF(JLAT)+J
      ILON=NSLSTA(JLAT)+J-1-1       !second -1 because zero meridian = index one
      ZLONG(IGP)=REAL(ILON,JPRB)*ZDLONG
      ILONGP(IGP)=ILON
      ILATGP(IGP)=JLAT
    ENDDO
  ENDDO
!$OMP END PARALLEL DO

!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLAT,ILG,INSTANLON,INRLON,J,INRNB,IGP,JLL,ILATNB,IINCR,ILGNB)&
!$OMP& PRIVATE(LLCOMPLI,JI,IGPNB,ZDLONG,ZDLONGNB,ZDLONGMAX,ILON,ILONNB,ZDELTA)&
!$OMP& PRIVATE(JYSS,JXSS,IGPSS,IYNB,IXNB,JNB,ZLONGSSGP,ZLONGSSGPNB,IEW)
  DO JLAT=1,NDGENL                            !loop over latitudes on this processor
    ILG=MYLATS(JLAT)                          !global latitude number
    INSTANLON=NPTRFRSTLAT(MY_REGION_NS)+JLAT-1      !index for NSTA/NONL arrays
    INRLON=NONL(INSTANLON,MY_REGION_EW)             !number of gridpoints on this processor for current latitude
    IF (INRLON < 1 .OR. INRLON > NLOENG(ILG)) THEN
!          WRITE(NULERR,'("yyyy INFO: JLAT,INRLON: ",2I12)') JLAT,INRLON
          CYCLE                    !go to next lat, if there are no points on this lat (why <= 1 and not <1 ????)
    ENDIF
    DO J=1,INRLON                             !loop over gp on this latitude
       INRNB=0                                !reset number of neighbours found
       IGP=NSLOFF(JLAT)+NSTA(INSTANLON,MY_REGION_EW)-NSLSTA(JLAT)+J     !index of current gp in SL-buffer !
                                                                  !(!!!! potentially false-> inconsistent with IFS DOCU)
       DO JLL=-1,1                            !loop over lat above, own, below
          ILATNB=JLAT+JLL                     !local lat index of neighbour
          IINCR=1                             !east-west gridpoint increment
          IF (JLL == 0) IINCR=2               !on own latitude JI=0 is the point itself

          ILGNB=ILG+JLL                        !global lat index of neighbour
!          IF (ILGNB < 1) ILGNB=1              !check if at one of the poles
!          IF (ILGNB > NDGLG) ILGNB=NDGLG
          !because there is no SL buffer in EW direction on lats containing all gp's there has to be done
          !this complicated logical
          LLCOMPLI=.FALSE.
          IF (NLOENG(ILGNB) == NSLONL(ILATNB) .AND. (J == 1 .OR. J == INRLON)) THEN
            LLCOMPLI=.TRUE.
          ENDIF

          IF (NLOENG(ILG) == NLOENG(ILGNB) .AND. .NOT.LLCOMPLI) THEN !easy case: same number of longitudes on both lats 
                                                 !(problematic at poles becuase NLOENG outside of array range??)
            DO JI=-1,1,IINCR
              IGPNB=NSLOFF(ILATNB)+NSTA(INSTANLON,MY_REGION_EW)+J-NSLSTA(ILATNB)+JI    !index of neighbour in SL-buffer
              INRNB=INRNB+1
              NBLS(INRNB,IGP)=IGPNB
            ENDDO
          ELSE                                !complicated case, different number of longs on lats
            ZDLONG=360._JPRB/REAL(NLOENG(ILG),JPRB)       !calculate delta longitude between gp on lat
            ZDLONGNB=360._JPRB/REAL(NLOENG(ILGNB),JPRB)
            ZDLONGMAX=0.5_JPRB*ZDLONG+0.5_JPRB*ZDLONGNB   !max delta in long for a gp to be a neighbour
            ILON=NSTA(INSTANLON,MY_REGION_EW)+J-1-1       !nr of gp's long; second -1 because zero meridian = index one
            DO JI=1,NSLONL(ILATNB)
              IGPNB=NSLOFF(ILATNB)+JI                     !index of neighbour in SL-buffer
              ILONNB=NSLSTA(ILATNB)+JI-1-1                !nr of neighbour's long; second -1 because zero meridian = index one

              ZDELTA=ABS(ILON*ZDLONG-ILONNB*ZDLONGNB)
              DO WHILE (ZDELTA >= 360._JPRB)
                ZDELTA=ZDELTA-360._JPRB
              ENDDO
              IF (ZDELTA > 180) ZDELTA=360._JPRB-ZDELTA
              IF (ZDELTA <= ZDLONGMAX .AND. IGPNB /= IGP) THEN
                INRNB=INRNB+1
                NBLS(INRNB,IGP)=IGPNB
              ENDIF
            ENDDO
          ENDIF
       ENDDO
       NRNBLS(IGP)=INRNB
 
    !find neighbours for small scale grid
       DO JYSS=1,NIJH
         DO JXSS=1,NIJH
           IGPSS=(JYSS-1)*NIJH+JXSS             !index of small scale cell in large scale cell
           INRNB=0                              !reset number of neighbours found
           DO JLL=-1,1                          !loop over lat above, own, below
             IYNB=JYSS+JLL                      !Y ob neibouring row
             ILATNB=JLAT                          !large scale latitude of neighbour
             ILGNB=ILG
             IF (IYNB < 1) THEN                 !if SS nb-row is outside of LS cell (to the north)
               ILATNB=JLAT-1
               ILGNB=ILG-1
               IYNB=NIJH
             ENDIF
             IF (IYNB > NIJH) THEN                 !if SS nb-row is outside of LS cell (to the south)
               ILATNB=JLAT+1
               ILGNB=ILG+1
               IYNB=1
             ENDIF

             !because there is no SL buffer in EW direction on lats containing all gp's there has to be done
             !this complicated logical
             LLCOMPLI=.FALSE.
             IF (NLOENG(ILGNB) == NSLONL(ILATNB) .AND. (J == 1 .OR. J == INRLON)) THEN
               LLCOMPLI=.TRUE.
             ENDIF

             IINCR=1                             !east-west gridpoint increment
             IF (JLL == 0) IINCR=2               !on own latitude JI=0 is the point itself
             IF (ILATNB == JLAT) THEN            !easy case: NB and GP on same LS Lat
                DO JI=-1,1,IINCR
                  IXNB=JXSS+JI
                  IGPNB=IGP
                  IF (IXNB < 1) THEN                 !if SS nb-column is outside of LS cell (to the west)
                    IGPNB=IGP-1
                    IXNB=NIJH
                    IF (LLCOMPLI .AND. J == 1) IGPNB=IGPNB+NSLONL(ILATNB)
                  ENDIF
                  IF (IXNB > NIJH) THEN              !if SS nb-column is outside of LS cell (to the east)
                    IGPNB=IGP+1
                    IXNB=1
                    IF (LLCOMPLI .AND. J == INRLON) IGPNB=IGPNB-NSLONL(ILATNB)
                  ENDIF
                  INRNB=INRNB+1
                  NBSS(1,INRNB,IGPSS,IGP)=IGPNB
                  NBSS(2,INRNB,IGPSS,IGP)=(IYNB-1)*NIJH+IXNB
                  NBNS(INRNB,IGPSS,IGP)=-JLL
                  NBEW(INRNB,IGPSS,IGP)=JI
                ENDDO
             ELSEIF (NLOENG(ILG) == NLOENG(ILGNB)) THEN      !NB and GP on different LS Lat, but same number of LS gp on lat
                                                              !necessarry because below's complicated case doesn't reliable detect
                                                              !neighbours for NLOENG(ILG) == NLOENG(ILGNB) (roundoff errors)
                ILON=NSTA(INSTANLON,MY_REGION_EW)+J-1-1
                DO JI=-1,1,IINCR
                  IXNB=JXSS+JI
                  ILONNB=ILON
                  IF (IXNB < 1) THEN                 !if SS nb-column is outside of LS cell (to the west)
                    ILONNB=ILON-1
                    IXNB=NIJH
                    IF (LLCOMPLI .AND. J == 1) ILONNB=ILONNB+NSLONL(ILATNB)
                  ENDIF
                  IF (IXNB > NIJH) THEN              !if SS nb-column is outside of LS cell (to the east)
                    ILONNB=ILON+1
                    IXNB=1
                    IF (LLCOMPLI .AND. J == INRLON) ILONNB=ILONNB-NSLONL(ILATNB)
                  ENDIF
                  DO JNB=1,NRNBLS(IGP)                 !loop over LS neighbours
                    IGPNB=NBLS(JNB,IGP)
                    IF (ILATNB == ILATGP(IGPNB) .AND. ILONNB == ILONGP(IGPNB)) THEN
                      INRNB=INRNB+1
                      NBSS(1,INRNB,IGPSS,IGP)=IGPNB
                      NBSS(2,INRNB,IGPSS,IGP)=(IYNB-1)*NIJH+IXNB
                      NBNS(INRNB,IGPSS,IGP)=-JLL
                      NBEW(INRNB,IGPSS,IGP)=JI
                    ENDIF
                  ENDDO
                ENDDO
             ELSE                                !complicated case: NB and GP on different LS Lat
                ZDLONG=360._JPRB/REAL(NLOENG(ILG),JPRB)            !calculate delta longitude between LS gp on lat
                ZDLONGNB=360._JPRB/REAL(NLOENG(ILGNB),JPRB)
                ZDLONGMAX=0.5_JPRB*ZDLONG/REAL(NIJH,JPRB)+0.5_JPRB*ZDLONGNB/REAL(NIJH,JPRB) !max delta in long for a gp to be a nbr
                DO JNB=1,NRNBLS(IGP)                 !loop over LS neighbours
                  IGPNB=NBLS(JNB,IGP)
                  IF (ILATNB == ILATGP(IGPNB)) THEN
                    DO JI=1,NIJH                       !E-W loop over SS cells in LS cell
                      ZLONGSSGP=ZLONG(IGP)-(0.5_JPRB-0.5_JPRB/REAL(NIJH,JPRB)-REAL(JXSS-1,JPRB)/REAL(NIJH,JPRB))*ZDLONG
                      ZLONGSSGPNB=ZLONG(IGPNB)-(0.5_JPRB-0.5_JPRB/REAL(NIJH,JPRB)-REAL(JI-1,JPRB)/REAL(NIJH,JPRB))*ZDLONGNB
                      ZDELTA=ABS(ZLONGSSGP-ZLONGSSGPNB)
                      DO WHILE (ZDELTA >= 360._JPRB)
                        ZDELTA=ZDELTA-360._JPRB
                      ENDDO
                      IF (ZDELTA > 180) ZDELTA=360._JPRB-ZDELTA
!                      IF (IGP == NSLCORE(500)) THEN
!                        WRITE(NULERR,*) "yyyy INFO: IGP,ZDELTA,ZDLONGMAX: ",IGP,ZDELTA,ZDLONGMAX
!                        CALL FLUSH(NULERR)
!                      ENDIF
                      IF (ZDELTA <= ZDLONGMAX) THEN
                        INRNB=INRNB+1
                        NBSS(1,INRNB,IGPSS,IGP)=IGPNB
                        NBSS(2,INRNB,IGPSS,IGP)=(IYNB-1)*NIJH+JI

                        IF (ZLONGSSGP >= 360._JPRB) ZLONGSSGP=ZLONGSSGP-360._JPRB
                        IF (ZLONGSSGP <    0._JPRB) ZLONGSSGP=ZLONGSSGP+360._JPRB
                        IF (ZLONGSSGPNB >= 360._JPRB) ZLONGSSGPNB=ZLONGSSGPNB-360._JPRB
                        IF (ZLONGSSGPNB <    0._JPRB) ZLONGSSGPNB=ZLONGSSGPNB+360._JPRB
                        ZDELTA=ZLONGSSGPNB-ZLONGSSGP
                        IEW=NINT(SIGN(1._JPRB,ZDELTA))
                        IF (ABS(ZDELTA) > 180) THEN
                          IEW=-1*IEW
                        ENDIF

                        NBNS(INRNB,IGPSS,IGP)=-JLL
                        NBEW(INRNB,IGPSS,IGP)=IEW
                      ENDIF
                    ENDDO
                  ENDIF
                ENDDO
             ENDIF
           ENDDO !JLL
           NRNBSS(IGPSS,IGP)=INRNB
         ENDDO   !JXSS
       ENDDO     !JYSS
     !end of finding small scale grid
    ENDDO
  ENDDO
!$OMP END PARALLEL DO

!temporary until ss-neighbour count is activated
!  DO JI=1,NIJH*NIJH
!    NBSS(1,:,JI,:)=NBLS(:,:)
!  ENDDO
!  NBSS(2,:,:,:)=1
!  NRNBSS(1,:)=NRNBLS(:)

  ZTMPNBLS=NBLS
  ZTMPNBSS=NBSS
  ZTMPNRNBLS=NRNBLS
  ZTMPNRNBSS=NRNBSS

  WRITE(NULOUT,*) "yyyy neighbour calculation done"
  CALL FLUSH(NULOUT)
  WRITE(NULERR,*) "yyyy neighbour calculation done"
  CALL FLUSH(NULERR)
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:CALCULATE_NEIGHBOURS',1,ZHOOK_HANDLE)

END SUBROUTINE CALCULATE_NEIGHBOURS


!     ------------------------------------------------------
!     initialize CA state
!       - set KCELL=KLIVES and KFERT=NFERTYRS where KINI == 1
!       - used for initialization at first timestep and for
!         seeding the CA with "new" cells later on
!     ------------------------------------------------------
SUBROUTINE INITIALIZE_CELLS(KINI,KLIVES,KCELL,KFERT)
  USE YOMGEM   , ONLY : NGPTOT
  USE YOMLUN, only : NULOUT
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 

  IMPLICIT NONE

  INTEGER(KIND=JPIM),INTENT(IN)    :: KLIVES(NGPTOT)
  INTEGER(KIND=JPIM),INTENT(IN)    :: KINI(NGPTOT)
  INTEGER(KIND=JPIM),INTENT(INOUT) :: KCELL(NIJH*NIJH,NGPTOT)
  INTEGER(KIND=JPIM),INTENT(INOUT) :: KFERT(NIJH*NIJH,NGPTOT)

  INTEGER(KIND=JPIM)               :: JLS,JSS
  INTEGER(KIND=JPIM)               :: INIJH2
  REAL(KIND=JPRB)                  :: ZHOOK_HANDLE

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:INITIALIZE_CELLS',0,ZHOOK_HANDLE)

  INIJH2=NIJH*NIJH

!  WRITE(NULOUT,*) 'initializing KCELLs'

!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS,JSS)
    DO JLS=1,NGPTOT
      IF(KINI(JLS)==1) THEN
        DO JSS=1,INIJH2
          KCELL(JSS,JLS)=KLIVES(JLS)
          KFERT(JSS,JLS)=NFERTYRS
        ENDDO
      ENDIF
    ENDDO
!$OMP END PARALLEL DO

  CALL FLUSH(NULOUT)

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:INITIALIZE_CELLS',1,ZHOOK_HANDLE)
END SUBROUTINE INITIALIZE_CELLS


!     ------------------------------------------------------
!     update CA
!       - evolve CA according to the probabilities set in the
!         initial setup
!       - advect CA if LD_ADVECT is set
!       - average to coarse CA grid
!     ------------------------------------------------------
SUBROUTINE UPDCELAUT_RGG(KLIVE,KDX,KDY,KFERT,KCELL,PFERTIN,PCELLIN,PWGHT,PRAND1D,LD_ADVECT)
!  USE YOMCT3   , ONLY : NSTEP
  USE YOMGEM   , ONLY : NGPTOT
  USE YOMMP    , ONLY : NASLB1, NSLCORE
  USE PARKIND1  ,ONLY : JPIM     ,JPRB
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  IMPLICIT NONE

  INTEGER(KIND=JPIM),INTENT(IN)    :: KLIVE(NGPTOT)                !max number of lives for GP
  INTEGER(KIND=JPIM),INTENT(IN) :: KDX(NGPTOT),KDY(NGPTOT)   !wind increments
  REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAND1D(NIJH*NIJH*NGPTOT)    !random numbers
  REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PFERTIN(NIJH*NIJH,NASLB1)    !fertile status of CA including SL halo
  REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PCELLIN(NIJH*NIJH,NASLB1)    !status of CA including SL halo

  INTEGER(KIND=JPIM),INTENT(OUT) :: KFERT(NIJH*NIJH,NGPTOT)      !fertile status of CA
  INTEGER(KIND=JPIM),INTENT(OUT) :: KCELL(NIJH*NIJH,NGPTOT)      !status of CA
  REAL(KIND=JPRB)   ,INTENT(OUT) :: PWGHT(NGPTOT)                !CA smoothed to LS

  LOGICAL,INTENT(IN)             :: LD_ADVECT

  REAL(KIND=JPRB)                  :: ZHOOK_HANDLE

  INTEGER(KIND=JPIM)               :: INIJH2
  INTEGER(KIND=JPIM)               :: JLS,JSS,JNB,ICOUNT
  INTEGER(KIND=JPIM)               :: IFERT_UW, IFERT_DW, IAVRG

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:UPDCELAUT_RGG',0,ZHOOK_HANDLE)

  INIJH2=NIJH*NIJH

  ! advect cells
  !IF (LD_ADVECT) CALL ADVECT_CA(KCELL,KFERT,PFERTIN,PCELLIN)
  IF (LD_ADVECT) CALL ADVECT_CA_SOPH(KCELL,KFERT,PFERTIN,PCELLIN)

!following lines for testing advection
!  IF (LD_ADVECT .AND. NSTEP > 5) CALL ADVECT_CA_SOPH(KCELL,KFERT,PFERTIN,PCELLIN)
!  IF (NSTEP == 6) THEN
!    RPROB_SURVIVE(:,:)=1
!    RPROB_BIRTH(:,:)=-1
!  ENDIF

! evolve CA
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS,JSS,IFERT_UW,IFERT_DW,IAVRG)
  DO JLS= 1,NGPTOT
    DO JSS= 1,INIJH2
      !count fertile neighbours (upwind and downwind)
      CALL FERTILE_NEIGHBOUR_COUNT(IFERT_UW,IFERT_DW,IAVRG,JLS,JSS,PCELLIN,PFERTIN,KDX,KDY)

      ! check for living cell
      IF (KCELL(JSS,JLS)/=0) THEN
        IF (PRAND1D((JLS-1)*INIJH2+JSS)<=RPROB_SURVIVE(IFERT_DW,IFERT_UW)) THEN ! survival test
           KCELL(JSS,JLS)=  KCELL(JSS,JLS)
           KFERT(JSS,JLS)= MAX(KFERT(JSS,JLS)-1,0)        !if cell survives reduce the number of fertile years it has left by one
        ELSE  !  cells failing the survival test -> lose a life
           KCELL(JSS,JLS)=  KCELL(JSS,JLS) - 1
           KFERT(JSS,JLS)=  0
        ENDIF
      ELSE        ! dead cell
        IF (PRAND1D((JLS-1)*INIJH2+JSS)<=RPROB_BIRTH(IFERT_DW,IFERT_UW)) THEN  ! check for birth condition
           KCELL(JSS,JLS)= KLIVE(JLS)
           IF (KLIVE(JLS) > 0) THEN
              KFERT(JSS,JLS)=  NFERTYRS
           ELSE
              KFERT(JSS,JLS)=  0
           ENDIF
        ELSE                    !  cells failing the birth condition
           KCELL(JSS,JLS)=  0
           KFERT(JSS,JLS)=  0
        ENDIF
      ENDIF
    ENDDO
  ENDDO
!$OMP END PARALLEL DO



  ! average blocks of cells to a coarser grid
  CALL WEIGHTING_FIELD(KCELL,PWGHT)
  !      
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:UPDCELAUT_RGG',1,ZHOOK_HANDLE)
END SUBROUTINE UPDCELAUT_RGG


!     ------------------------------------------------------
!     - average over NIJHxNIJH cell blocks, smooth and weight
!     ------------------------------------------------------
SUBROUTINE WEIGHTING_FIELD(KCELL,PWGHT)
!     ------------------------------------------------------

!     square the KCELL values (on range 0->31); average over
!     4x4 KCELL blocks, and then normalize  
  USE YOMGEM   , ONLY : NGPTOT, NGPTOTG
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  USE MPL_MODULE , ONLY : MPL_ALLGATHERV
  USE YOMCT0   , ONLY : NPROC
  use YOMLUN   , ONLY : NULERR

  IMPLICIT NONE

  INTEGER(KIND=JPIM),INTENT(IN) :: KCELL(NIJH*NIJH,NGPTOT)
  REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWGHT(NGPTOT)
  INTEGER(KIND=JPIM)               :: JLS,JSS, INIJH2,ICOUNT(NPROC)
  REAL(KIND=JPRB)                  :: ZDIV!, ZSUM, ZSUMA(NPROC)
  REAL(KIND=JPRB)                  :: ZHOOK_HANDLE
  REAL(KIND=JPRB)   ,ALLOCATABLE:: ZSUM(:), ZSUMA(:)

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:WEIGHTING_FIELD',0,ZHOOK_HANDLE)

  ALLOCATE(ZSUM(1),ZSUMA(NPROC))

  INIJH2=NIJH*NIJH
  ZDIV=1._JPRB/REAL(INIJH2,JPRB)

!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS,JSS)
  DO JLS=1,NGPTOT
    PWGHT(JLS)=0.
    DO JSS=1,INIJH2
      PWGHT(JLS)= PWGHT(JLS)+ZDIV*KCELL(JSS,JLS)
    ENDDO
  ENDDO
!$OMP END PARALLEL DO

  IF (LCA_SMOOTH) CALL SMOOTH_CA(PWGHT)

  IF (LCA_GLOBAL) THEN    !scale global field to zero mean
    ZSUM(1)=0._JPRB
    !calculate sum over GP on this processor
    DO JLS=1,NGPTOT
       ZSUM(1)=ZSUM(1)+PWGHT(JLS)
    ENDDO
    !exchange sums between all processors
    ICOUNT(:)=1
    CALL MPL_ALLGATHERV(ZSUM,ZSUMA,ICOUNT,CDSTRING='YOE_CUCONVCA:WEIGHTING_FIELD')

    !calculate global sum
    ZSUM(1)=0
    DO JLS=1,NPROC
       ZSUM(1)=ZSUM(1)+ZSUMA(JLS)
    ENDDO

    ZSUM(1)=ZSUM(1)/NGPTOTG

!    WRITE(NULERR,*) 'ZSUM= ',ZSUMA

    IF (ZSUM(1) /= 0._JPRB ) THEN
     !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS)
      DO JLS=1,NGPTOT
        PWGHT(JLS)=PWGHT(JLS)/ZSUM(1) - 1._JPRB
      ENDDO
     !$OMP END PARALLEL DO
    ENDIF
  ENDIF

  DEALLOCATE(ZSUM,ZSUMA)

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:WEIGHTING_FIELD',1,ZHOOK_HANDLE)
END SUBROUTINE WEIGHTING_FIELD


!     ------------------------------------------------------
!       apply smoothing
!     ------------------------------------------------------
SUBROUTINE SMOOTH_CA(PFLD)
  USE YOMGEM   , ONLY : NGPTOT
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 

!stuff for SL-halo
  USE YOMMP , ONLY : NASLB1, NSLPROCS  ,&
                   & NSLRPT, NSLSPT, NSLSENDPOS,&
                   & NSLRECVPOS, NSENDPTR  ,NRECVPTR  ,NSLCOMM, &
                   & NSLCORE

  IMPLICIT NONE
  REAL(KIND=JPRB)   ,INTENT(INOUT)      :: PFLD(NGPTOT)
  INTEGER(KIND=JPIM)                    :: JLS,JNB,INB
  REAL(KIND=JPRB), DIMENSION(NGPTOT)    :: ZFLD_SMOOTH
  REAL(KIND=JPRB)                       :: ZHOOK_HANDLE

!stuff for SL-halo
  LOGICAL                         :: LLINC
  INTEGER(KIND=JPIM)              :: IFIELDSLB1
  INTEGER(KIND=JPIM)              :: IDUMARR(2)
  INTEGER(KIND=JPIM)              :: IFIXSFLD(2)
  INTEGER(KIND=JPIM)              :: IFLDSLB1
  REAL(KIND=JPRB), ALLOCATABLE    :: ZPB1(:,:)

#include "slcomm.intfb.h"

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:SMOOTH_CA',0,ZHOOK_HANDLE)

!*       3.2  get halo for CA
!     ------------------------------------------------------

  LLINC=.FALSE.
  IFIXSFLD(:)=0
  IFLDSLB1=1
  ALLOCATE(ZPB1(NASLB1,IFLDSLB1))
  ZPB1=0


!fill buffer
 !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS)
  DO JLS=1,NGPTOT
      ZPB1(NSLCORE(JLS),1)=PFLD(JLS)
  ENDDO
 !$OMP END PARALLEL DO
!get halo
  CALL SLCOMM(NASLB1,NSLPROCS,NSLRPT,&
       & NSLSPT,NSLSENDPOS,NSLRECVPOS,NSENDPTR,NRECVPTR,NSLCOMM,&
       & IDUMARR,&
       & IFLDSLB1,LLINC,0,ZPB1)

 !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS,INB,JNB)
  DO JLS=1,NGPTOT
    ZFLD_SMOOTH(JLS)=4.*PFLD(JLS)
    INB=4
    DO JNB=1,NRNBLS(NSLCORE(JLS))
      ZFLD_SMOOTH(JLS)=ZFLD_SMOOTH(JLS)+2*ZPB1(NBLS(JNB,NSLCORE(JLS)),1)
      INB=INB+2
    ENDDO
    ZFLD_SMOOTH(JLS)=ZFLD_SMOOTH(JLS)/(1.*INB)
    PFLD(JLS)= ZFLD_SMOOTH(JLS)
  ENDDO
 !$OMP END PARALLEL DO


  DEALLOCATE(ZPB1)
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:SMOOTH_CA',1,ZHOOK_HANDLE)
END SUBROUTINE SMOOTH_CA

!     ------------------------------------------------------
!     perform advection (using departure points from SL-advection)
!     ------------------------------------------------------
SUBROUTINE ADVECT_CA(KCELL,KFERT,PFERTIN,PCELLIN)
  USE YOMGEM   , ONLY : NGPTOT, NLOENG
  USE YOMMP    , ONLY : NASLB1, NSLCORE, MYLATS, NSLOFF, NSLSTA, NSLONL, &
                   & NSLPROCS  ,&
                   & NSLRPT, NSLSPT, NSLSENDPOS,&
                   & NSLRECVPOS, NSENDPTR  ,NRECVPTR  ,NSLCOMM
  USE YOMDIM   , ONLY : NPROMA,NFLEVG,NGPBLKS,NDGENL,NDGLG
  USE YOECUMF  , ONLY : NJKT4, NJKT5
  USE YOMLEG   , ONLY : RLATIG
  USE YOMCST   , ONLY : RPI

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

  REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PFERTIN(NIJH*NIJH,NASLB1)    !fertile status of CA including SL halo
  REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PCELLIN(NIJH*NIJH,NASLB1)    !status of CA including SL halo
  INTEGER(KIND=JPIM),INTENT(INOUT)    :: KFERT(NIJH*NIJH,NGPTOT)      !fertile status of CA
  INTEGER(KIND=JPIM),INTENT(INOUT)    :: KCELL(NIJH*NIJH,NGPTOT)

  INTEGER(KIND=JPIM)                  :: IDEPPOINT(NGPTOT)
  INTEGER(KIND=JPIM)                  :: ICEND,IBL, IOFF
  INTEGER(KIND=JPIM)                  :: IGP, IJKT, IGPDEP
  INTEGER(KIND=JPIM)                  :: JK, JI, JLAT, JLS, JSS
  REAL(KIND=JPRB)                     :: ZLATDEP, ZLONDEP
  INTEGER(KIND=JPIM)                  :: ILATDEP, ILATDEPG

!  INTEGER(KIND=JPIM)                  :: ILATG(1-NSLWIDE:NDGENL+NSLWIDE)
  INTEGER(KIND=JPIM)                  :: ILG, ILONG, ILON
  REAL(KIND=JPRB)                     :: ZLATBOUND(1:NDGLG-1)
  REAL(KIND=JPRB)                     :: ZDLONG, ZRADDEG

  REAL(KIND=JPRB)                     :: ZHOOK_HANDLE

!stuff for SL-halo
  LOGICAL                         :: LLINC
  INTEGER(KIND=JPIM)              :: IDUMARR(2)
  INTEGER(KIND=JPIM)              :: IFIXSFLD(2)
  INTEGER(KIND=JPIM)              :: IFLDSLB1, IFLD
  REAL(KIND=JPRB), ALLOCATABLE    :: ZPB1(:,:)

#include "slcomm.intfb.h"

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:ADVECT_CA',0,ZHOOK_HANDLE)

  IJKT=(NJKT4+NJKT5)/2    !get level in the middle of 850 and 500 hPa


  DO JLAT=1,NDGLG-1
    ZLATBOUND(JLAT)=0.5_JPRB*(RLATIG(JLAT)+RLATIG(JLAT+1))
  ENDDO

  ZRADDEG=180._JPRB/RPI

! work out departure GP in SL-halo array from lon/lat of departure point
  DO JK=1,NGPTOT,NPROMA
    ICEND=MIN(NPROMA,NGPTOT-JK+1)
    IBL=(JK-1)/NPROMA+1
    IOFF=JK
    DO JI=1,ICEND
      IGP=IOFF+JI-1
      ZLATDEP=RLATDEP(JI,IJKT,IBL)
      ZLONDEP=ZRADDEG*RLONDEP(JI,IJKT,IBL)
      !find global lat-index of dep point
      ILATDEPG=1
      DO WHILE (ZLATDEP < ZLATBOUND(ILATDEPG) .AND. ILATDEPG < NDGLG)!can this be replaced by something similar to ilon calc below?
        ILATDEPG=ILATDEPG+1
      ENDDO
      !find local lat-index of dep point
      ILATDEP=ILATDEPG-MYLATS(1)+1
      ZDLONG=360._JPRB/REAL(NLOENG(ILATDEPG),JPRB)         !calculate delta longitude between gp on lat
      ILONG=NINT(ZLONDEP/ZDLONG)
      ILON=ILONG-NSLSTA(ILATDEP)+2
      IF (ILON > NSLONL(ILATDEP)) ILON=ILON-NLOENG(ILATDEPG)

      IGPDEP=NSLOFF(ILATDEP)+ILON

      IDEPPOINT(IGP)=IGPDEP
    ENDDO
  ENDDO
! do the advection
  DO JLS=1,NGPTOT
    DO JSS=1,NIJH*NIJH
      KFERT(JSS,JLS)=PFERTIN(JSS,IDEPPOINT(JLS))
      KCELL(JSS,JLS)=PCELLIN(JSS,IDEPPOINT(JLS))
    ENDDO
  ENDDO
! get the updated halo

  LLINC=.FALSE.
  IFIXSFLD(:)=0
  IFLDSLB1=2*NIJH*NIJH
  ALLOCATE(ZPB1(NASLB1,IFLDSLB1))
  ZPB1=0


!fill buffer
  DO JLS=1,NGPTOT
    IFLD=1
    DO JSS=1,NIJH*NIJH
      ZPB1(NSLCORE(JLS),IFLD)=KCELL(JSS,JLS)
      ZPB1(NSLCORE(JLS),IFLD+NIJH*NIJH)=KFERT(JSS,JLS)
      IFLD=IFLD+1
    ENDDO
  ENDDO

!get halo
  CALL SLCOMM(NASLB1,NSLPROCS,NSLRPT,&
       & NSLSPT,NSLSENDPOS,NSLRECVPOS,NSENDPTR,NRECVPTR,NSLCOMM,&
       & IDUMARR,&
       & IFLDSLB1,LLINC,0,ZPB1)

!extract from buffer
  DO JLS=1,NASLB1
    IFLD=1
    DO JSS=1,NIJH*NIJH
      PCELLIN(JSS,JLS)=ZPB1(JLS,IFLD)
      PFERTIN(JSS,JLS)=ZPB1(JLS,IFLD+NIJH*NIJH)
      IFLD=IFLD+1
    ENDDO
  ENDDO

  DEALLOCATE(ZPB1)

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:ADVECT_CA',1,ZHOOK_HANDLE)
END SUBROUTINE ADVECT_CA

!     ------------------------------------------------------
!     perform advection (using departure points from SL-advection)
!     ------------------------------------------------------
SUBROUTINE ADVECT_CA_SOPH(KCELL,KFERT,PFERTIN,PCELLIN)
  USE YOMLUN, only : NULOUT, NULERR
  USE YOMGEM   , ONLY : NGPTOT, NLOENG
  USE YOMMP    , ONLY : NASLB1, NSLCORE, MYLATS, NSLOFF, NSLSTA, NSLONL, &
                   & NSLPROCS  ,&
                   & NSLRPT, NSLSPT, NSLSENDPOS,&
                   & NSLRECVPOS, NSENDPTR  ,NRECVPTR  ,NSLCOMM !,MYPROC
  USE YOMDIM   , ONLY : NPROMA,NFLEVG,NGPBLKS,NDGENL,NDGLG
  USE YOECUMF  , ONLY : NJKT4, NJKT5
  USE YOMLEG   , ONLY : RLATIG
  USE YOMCST   , ONLY : RPI

  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  USE PARKIND1  ,ONLY : JPIM     ,JPRB
  USE YOMGC    , ONLY : GELAM     , GELAT
  IMPLICIT NONE

  REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PFERTIN(NIJH*NIJH,NASLB1)    !fertile status of CA including SL halo
  REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PCELLIN(NIJH*NIJH,NASLB1)    !status of CA including SL halo
  INTEGER(KIND=JPIM),INTENT(INOUT)    :: KFERT(NIJH*NIJH,NGPTOT)      !fertile status of CA
  INTEGER(KIND=JPIM),INTENT(INOUT)    :: KCELL(NIJH*NIJH,NGPTOT)

  INTEGER(KIND=JPIM)                  :: IDEPLS(NIJH*NIJH,NGPTOT)
  INTEGER(KIND=JPIM)                  :: IDEPSS(NIJH*NIJH,NGPTOT)

  INTEGER(KIND=JPIM)                  :: ICEND,IBL, IOFF
  INTEGER(KIND=JPIM)                  :: IGP, IJKT, IGPDEP
  INTEGER(KIND=JPIM)                  :: IXSS,IYSS,IDEPPOINT
  INTEGER(KIND=JPIM)                  :: JK, JI, JLAT, JLS, JSS
  INTEGER(KIND=JPIM)                  :: J,JXSS,JYSS
  REAL(KIND=JPRB)                     :: ZLATDEP, ZLONDEP
  INTEGER(KIND=JPIM)                  :: ILATDEP, ILATDEPG

  INTEGER(KIND=JPIM)                  :: ILG, ILONG, ILON
  REAL(KIND=JPRB)                     :: ZLATBOUND(1:NDGLG-1) !,ZDLATG(1:NDGLG)
  REAL(KIND=JPRB)                     :: ZDLONG, ZRADDEG
  REAL(KIND=JPRB)                     :: ZDLONGDEP, ZDLATDEP

  REAL(KIND=JPRB)   ,ALLOCATABLE:: ZLONDEPC(:,:,:),ZLDLAT(:),ZLDLONG(:)
  REAL(KIND=JPRB)   ,ALLOCATABLE:: ZLATDEPC(:,:,:)

  REAL(KIND=JPRB)                     :: ZHOOK_HANDLE

!stuff for SL-halo
  LOGICAL                         :: LLINC
  INTEGER(KIND=JPIM)              :: IDUMARR(2)
  INTEGER(KIND=JPIM)              :: IFIXSFLD(2)
  INTEGER(KIND=JPIM)              :: IFLDSLB1, IFLD
  REAL(KIND=JPRB), ALLOCATABLE    :: ZPB1(:,:)

#include "slcomm.intfb.h"

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:ADVECT_CA_SOPH',0,ZHOOK_HANDLE)

!  WRITE(NULOUT,*) "yyyy ADVECT_CA_SOPH"
!  CALL FLUSH(NULOUT)

  ZRADDEG=180._JPRB/RPI

  IJKT=(NJKT4+NJKT5)/2    !get level in the middle of 850 and 500 hPa

  ALLOCATE(ZLONDEPC(NPROMA,NFLEVG,NGPBLKS),ZLATDEPC(NPROMA,NFLEVG,NGPBLKS))
  ALLOCATE(ZLDLAT(NASLB1),ZLDLONG(NASLB1))

  ZLONDEPC=RLONDEP
  ZLATDEPC=RLATDEP

  ZLDLAT=SLDLAT
  ZLDLONG=SLDLONG

  !calculate latitude boundaries
 !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLAT)
  DO JLAT=1,NDGLG-1
    ZLATBOUND(JLAT)=0.5_JPRB*(RLATIG(JLAT)+RLATIG(JLAT+1))
  ENDDO
 !$OMP END PARALLEL DO
!  ZDLATG(1)=RPI-ZLATBOUND(1)
!  ZDLATG(NDGLG)=ZLATBOUND(NDGLG-1)-RPI
!  DO JLAT=2,NDGLG-1
!    ZDLATG(JLAT)=ZLATBOUND(JLAT-1)-ZLATBOUND(JLAT)
!  ENDDO

!  ZRADDEG=180._JPRB/RPI

! work out departure GP in SL-halo array from lon/lat of departure point and do advection
 !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JK,ICEND,IBL,IOFF,JI,IGP,JYSS,JXSS,JSS,ZLATDEP,ZLONDEP)&
 !$OMP& PRIVATE(ILATDEPG,ILATDEP,ZDLONG,ILONG,ILON,IGPDEP,ZDLONGDEP,ZDLATDEP,IXSS,IYSS)
  DO JK=1,NGPTOT,NPROMA                           !
    ICEND=MIN(NPROMA,NGPTOT-JK+1)                 !
    IBL=(JK-1)/NPROMA+1                           ! loop over large scale gridpoints
    IOFF=JK                                       !
    DO JI=1,ICEND                                 !
      IGP=IOFF+JI-1

      DO JYSS=1,NIJH                          ! loop over small scale gridpoints
        DO JXSS=1,NIJH
          JSS=(JYSS-1)*NIJH+JXSS

          ZLATDEP=RLATDEP(JI,IJKT,IBL)+(-JYSS+0.5)*SLDLAT(NSLCORE(IGP))/REAL(NIJH,JPRB)+SLDDLAT(NSLCORE(IGP))
          ZLONDEP=RLONDEP(JI,IJKT,IBL)+(JXSS-0.5*NIJH-0.5)*SLDLONG(NSLCORE(IGP))/REAL(NIJH,JPRB)

       !ZLATDEP=GELAT(IGP)+(JYSS-0.5*NIJH-0.5)*SLDLAT(NSLCORE(IGP))/REAL(NIJH,JPRB)-SLDLAT(NSLCORE(IGP)) !temporary for testing
       !ZLONDEP=GELAM(IGP)+(JXSS-0.5*NIJH-0.5)*SLDLONG(NSLCORE(IGP))/REAL(NIJH,JPRB) !-SLDLONG(NSLCORE(IGP)) !temporary for testing

          IF (ZLONDEP >= 2*RPI) ZLONDEP=ZLONDEP-2*RPI
          IF (ZLONDEP < 0) ZLONDEP=ZLONDEP+2*RPI
          IF (ZLATDEP > 0.5*RPI) ZLATDEP=RPI-ZLATDEP
          IF (ZLATDEP < -0.5*RPI) ZLATDEP=-RPI-ZLATDEP


          !find global lat-index of dep point
          ILATDEPG=1
          DO WHILE (ZLATDEP < ZLATBOUND(ILATDEPG) .AND. ILATDEPG < NDGLG)!can this be replaced by something similar 
                                                                         !to ilon calc below?
            ILATDEPG=ILATDEPG+1
          ENDDO
          !find local lat-index of dep point
          ILATDEP=ILATDEPG-MYLATS(1)+1
          ZDLONG=2*RPI/REAL(NLOENG(ILATDEPG),JPRB)         !calculate delta longitude between gp on lat
          ILONG=NINT(ZLONDEP/ZDLONG)
          ILON=ILONG-NSLSTA(ILATDEP)+2
          IF (ILON > NSLONL(ILATDEP)) ILON=ILON-NLOENG(ILATDEPG)         !???? correct ??????

          IGPDEP=NSLOFF(ILATDEP)+ILON

          IDEPLS(JSS,IGP)=IGPDEP

          ZDLONGDEP=ZLONDEP-(SLLONG(IGPDEP)-0.5*SLDLONG(IGPDEP))
          ZDLATDEP=(SLLAT(IGPDEP)+SLDDLAT(IGPDEP))-ZLATDEP

          IF (ZDLONGDEP >= 2*RPI) ZDLONGDEP=ZDLONGDEP-2*RPI

          IF (ZDLONGDEP>=SLDLONG(IGPDEP) .OR. ZDLONGDEP<0 .OR. ZDLATDEP>=SLDLAT(IGPDEP) .OR. ZDLATDEP<0) THEN
             WRITE(NULERR,'(A,4I6,6F9.3)') "dddd INCONSISTENCY: ",IGP,NSLCORE(IGP),JSS,IGPDEP,ZLONDEP*ZRADDEG, &
                                   & ZLATDEP*ZRADDEG,ZDLONGDEP*ZRADDEG,ZDLATDEP*ZRADDEG,&
                                   & SLDLONG(IGPDEP)*ZRADDEG,SLDLAT(IGPDEP)*ZRADDEG
          ENDIF

          IXSS=1
          DO WHILE (ZDLONGDEP > IXSS*ZDLONG/REAL(NIJH,JPRB))
            IXSS=IXSS+1
          ENDDO
          IYSS=1
          DO WHILE (ZDLATDEP > IYSS*SLDLAT(IGPDEP)/REAL(NIJH,JPRB))
            IYSS=IYSS+1
          ENDDO
          IDEPSS(JSS,IGP)=(IYSS-1)*NIJH+IXSS

!          IF (PCELLIN(IDEPSS(JSS,IGP),IDEPLS(JSS,IGP)) /= 0 .OR. (MYPROC == 2 .AND. NSLCORE(IGP) == 3610)) THEN
!            WRITE(NULERR,'(A,5I6,8F9.3)') "dddd ",IGP,NSLCORE(IGP),JSS,IGPDEP,(IYSS-1)*NIJH+IXSS,ZLONDEP*ZRADDEG, &
!                                    & ZLATDEP*ZRADDEG,ZDLONGDEP*ZRADDEG,ZDLATDEP*ZRADDEG,SLLONG(NSLCORE(IGP))*ZRADDEG,&
!                                    & SLLAT(NSLCORE(IGP))*ZRADDEG,SLLONG(IGPDEP)*ZRADDEG,SLLAT(IGPDEP)*ZRADDEG
!          ENDIF

          ! do the advection (arrays IDEPSS and IDEPLS could be saved)
          KFERT(JSS,IGP)=PFERTIN(IDEPSS(JSS,IGP),IDEPLS(JSS,IGP))
          KCELL(JSS,IGP)=PCELLIN(IDEPSS(JSS,IGP),IDEPLS(JSS,IGP))

        ENDDO
      ENDDO
    ENDDO
  ENDDO
 !$OMP END PARALLEL DO

!  WRITE(NULOUT,*) "yyyy before doing advection"
!  CALL FLUSH(NULOUT)

!  IF (MYPROC == 2) THEN
!     JLS=1023
!     DO JSS=1,NIJH*NIJH
!       WRITE(NULERR,'(A,4I6,8F9.3)') "debug ",JLS,NSLCORE(JLS),JSS,IDEPLS(JSS,JLS),IDEPSS(JSS,JLS)
!     ENDDO
!  ENDIF

! do the advection
!  DO JLS=1,NGPTOT
!    DO JSS=1,NIJH*NIJH
!      KFERT(JSS,JLS)=PFERTIN(IDEPSS(JSS,JLS),IDEPLS(JSS,JLS))
!      KCELL(JSS,JLS)=PCELLIN(IDEPSS(JSS,JLS),IDEPLS(JSS,JLS))
!    ENDDO
!  ENDDO

!  WRITE(NULOUT,*) "yyyy before SL-stuff"
!  CALL FLUSH(NULOUT)

! get the updated halo

  LLINC=.FALSE.
  IFIXSFLD(:)=0
  IFLDSLB1=2*NIJH*NIJH
  ALLOCATE(ZPB1(NASLB1,IFLDSLB1))
  ZPB1=0


!fill buffer
 !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS,JSS)
  DO JLS=1,NGPTOT
    DO JSS=1,NIJH*NIJH
      ZPB1(NSLCORE(JLS),JSS)=KCELL(JSS,JLS)
      ZPB1(NSLCORE(JLS),JSS+NIJH*NIJH)=KFERT(JSS,JLS)
    ENDDO
  ENDDO
 !$OMP END PARALLEL DO

!get halo
  CALL SLCOMM(NASLB1,NSLPROCS,NSLRPT,&
       & NSLSPT,NSLSENDPOS,NSLRECVPOS,NSENDPTR,NRECVPTR,NSLCOMM,&
       & IDUMARR,&
       & IFLDSLB1,LLINC,0,ZPB1)

!extract from buffer
 !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLS,JSS)
  DO JLS=1,NASLB1
    DO JSS=1,NIJH*NIJH
      PCELLIN(JSS,JLS)=ZPB1(JLS,JSS)
      PFERTIN(JSS,JLS)=ZPB1(JLS,JSS+NIJH*NIJH)
    ENDDO
  ENDDO
 !$OMP END PARALLEL DO
  DEALLOCATE(ZPB1)
  DEALLOCATE(ZLONDEPC,ZLATDEPC)
  DEALLOCATE(ZLDLAT,ZLDLONG)
!  WRITE(NULOUT,*) "yyyy ADVECT_CA_SOPH done"
!  CALL FLUSH(NULOUT)

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:ADVECT_CA_SOPH',1,ZHOOK_HANDLE)
END SUBROUTINE ADVECT_CA_SOPH




!     ------------------------------------------------------
!     count those neighbours that haven't lost a life and 
!     are younger than NFERTYRS (separate counts for upwind and downwind -> not yet implemented for redGG CA)
!     ------------------------------------------------------
SUBROUTINE FERTILE_NEIGHBOUR_COUNT(KN_UW,KN_DW,KAVRGLFS,KLS,KSS,PCELLS,PFERTS,KDX,KDY)
  USE YOMGEM   , ONLY : NGPTOT
  USE YOMMP    , ONLY : NASLB1, NSLCORE
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  USE YOMLUN, only : NULOUT, NULERR
  IMPLICIT NONE

  INTEGER(KIND=JPIM),INTENT(OUT)   :: KN_UW,KN_DW, KAVRGLFS
  INTEGER(KIND=JPIM),INTENT(IN)    :: KLS
  INTEGER(KIND=JPIM),INTENT(IN)    :: KSS
  REAL(KIND=JPRB),INTENT(IN)       :: PFERTS(NIJH*NIJH,NASLB1)
  REAL(KIND=JPRB),INTENT(IN)       :: PCELLS(NIJH*NIJH,NASLB1)
  INTEGER(KIND=JPIM),INTENT(IN)    :: KDX(NGPTOT)
  INTEGER(KIND=JPIM),INTENT(IN)    :: KDY(NGPTOT)

  INTEGER(KIND=JPIM)               :: ICOUNT,ISUM,JNB
  INTEGER(KIND=JPIM)               :: INBLS, INBSS
  INTEGER(KIND=JPIM)               :: IDX, IDY
  INTEGER(KIND=JPIM)               :: IEW, INS
  INTEGER(KIND=JPIM)               :: ILSSL
  REAL(KIND=JPRB)                  :: ZHOOK_HANDLE
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:FERTILE_NEIGHBOUR_COUNT',0,ZHOOK_HANDLE)

  KN_UW= 0
  KN_DW= 0
  ISUM= 0
  ILSSL=NSLCORE(KLS)
  DO JNB= 1,NRNBSS(KSS,ILSSL)
    INBLS=NBSS(1,JNB,KSS,ILSSL)
    INBSS=NBSS(2,JNB,KSS,ILSSL)
    IEW=NBEW(JNB,KSS,ILSSL)
    INS=NBNS(JNB,KSS,ILSSL)


    IF (PFERTS(INBSS,INBLS)>0) THEN
      IDX=KDX(KLS)
      IDY=KDY(KLS)
      IF ( &
           & (IEW == 0 .AND. IDY /= 0 .AND. INS == SIGN(1,IDY)) &
           & .OR. (INS == 0 .AND. IDX /= 0 .AND. IEW /= SIGN(1,IDX)) &
           & .OR. (INS /= 0 .AND. IEW /= 0 .AND. &
           &  ((IDX /= 0 .AND. IDY /= 0 .AND. IEW /= SIGN(1,IDX) .AND. INS == SIGN(1,IDY)) &
           & .OR. (IDX /= 0 .AND. IDY == 0 .AND. IEW /= SIGN(1,IDX) ) &
           & .OR. (IDX == 0 .AND. IDY /= 0 .AND. INS == SIGN(1,IDY)))) &
           & ) THEN                       !check if neighbour is upwind
        KN_UW= KN_UW+1
      ELSE
        KN_DW= KN_DW+1
      ENDIF
      ISUM=ISUM+PCELLS(INBSS,INBLS)
    ENDIF
  ENDDO

  ICOUNT=KN_UW+KN_DW
  IF (ICOUNT > 0) THEN
    KAVRGLFS=NINT((1._JPRB*ISUM)/(1._JPRB*ICOUNT))
  ELSE
    KAVRGLFS=0
  ENDIF

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:FERTILE_NEIGHBOUR_COUNT',1,ZHOOK_HANDLE)
END SUBROUTINE FERTILE_NEIGHBOUR_COUNT


!     ------------------------------------------------------
!     set output to check if neighbour calculation works 
!     ------------------------------------------------------
SUBROUTINE VISUALIZE_NEIGHBOURS(KLS,KSS,POUT)
  USE YOMGEM   , ONLY : NGPTOT
  USE YOMMP    , ONLY : NASLB1, NSLCORE
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  IMPLICIT NONE

  INTEGER(KIND=JPIM),INTENT(IN)    :: KLS
  INTEGER(KIND=JPIM),INTENT(IN)    :: KSS

  REAL(KIND=JPRB),INTENT(OUT)      :: POUT(NGPTOT,NIJH*NIJH)

  REAL(KIND=JPRB)                  :: ZTMP(NIJH*NIJH,NASLB1)
  INTEGER(KIND=JPIM)               :: JNB
  INTEGER(KIND=JPIM)               :: INBLS, INBSS
  REAL(KIND=JPRB)                  :: ZHOOK_HANDLE
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:VISUALIZE_NEIGHBOURS',0,ZHOOK_HANDLE)

  ZTMP(:,:)=0._JPRB

  DO JNB= 1,NRNBSS(KSS,NSLCORE(KLS))
    INBLS=NBSS(1,JNB,KSS,NSLCORE(KLS))
    INBSS=NBSS(2,JNB,KSS,NSLCORE(KLS))

    ZTMP(INBSS,INBLS)=100._JPRB
  ENDDO

  DO JNB=1,NGPTOT
    POUT(JNB,:)=ZTMP(:,NSLCORE(JNB))
  ENDDO
  POUT(KLS,KSS)=10._JPRB

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:VISUALIZE_NEIGHBOURS',1,ZHOOK_HANDLE)
END SUBROUTINE VISUALIZE_NEIGHBOURS

!     ------------------------------------------------------
!     set output to check if neighbour calculation works 
!     ------------------------------------------------------
SUBROUTINE VISUALIZE_NEIGHBOURS_LS(KLS,POUT)
  USE YOMGEM   , ONLY : NGPTOT
  USE YOMMP    , ONLY : NASLB1, NSLCORE
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  IMPLICIT NONE

  INTEGER(KIND=JPIM),INTENT(IN)    :: KLS
  REAL(KIND=JPRB),INTENT(OUT)      :: POUT(NGPTOT)

  REAL(KIND=JPRB)                  :: ZTMP(NASLB1)
  INTEGER(KIND=JPIM)               :: JNB
  INTEGER(KIND=JPIM)               :: INBLS
  REAL(KIND=JPRB)                  :: ZHOOK_HANDLE
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:VISUALIZE_NEIGHBOURS_LS',0,ZHOOK_HANDLE)

  ZTMP(:)=0._JPRB

  DO JNB= 1,NRNBLS(NSLCORE(KLS))
    INBLS=NBLS(JNB,NSLCORE(KLS))
    ZTMP(INBLS)=100._JPRB
  ENDDO

  DO JNB=1,NGPTOT
    POUT(JNB)=ZTMP(NSLCORE(JNB))
  ENDDO
  POUT(KLS)=10._JPRB

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:VISUALIZE_NEIGHBOURS_LS',1,ZHOOK_HANDLE)
END SUBROUTINE VISUALIZE_NEIGHBOURS_LS


!     ------------------------------------------------------
!     set output to check if neighbour calculation works 
!     ------------------------------------------------------
SUBROUTINE VISUALIZE_NRNEIGHBOURS(POUT)
  USE YOMGEM   , ONLY : NGPTOT
  USE YOMMP    , ONLY : NASLB1, NSLCORE
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  IMPLICIT NONE

  REAL(KIND=JPRB),INTENT(OUT)      :: POUT(NGPTOT,NIJH*NIJH)

  REAL(KIND=JPRB)                  :: ZTMP(NIJH*NIJH,NASLB1)
  INTEGER(KIND=JPIM)               :: JLS,JSS
  INTEGER(KIND=JPIM)               :: INBLS, INBSS
  REAL(KIND=JPRB)                  :: ZHOOK_HANDLE
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:VISUALIZE_NRNEIGHBOURS',0,ZHOOK_HANDLE)

  ZTMP(:,:)=0._JPRB

  DO JSS= 1,NIJH*NIJH
    DO JLS=1,NGPTOT
      POUT(JLS,JSS)=NRNBSS(JSS,NSLCORE(JLS))
    ENDDO 
 ENDDO


  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:VISUALIZE_NRNEIGHBOURS',1,ZHOOK_HANDLE)
END SUBROUTINE VISUALIZE_NRNEIGHBOURS

!     ------------------------------------------------------
!     set output to check if neighbour calculation works 
!     ------------------------------------------------------
SUBROUTINE VISUALIZE_NRNEIGHBOURS_LS(POUT)
  USE YOMGEM   , ONLY : NGPTOT
  USE YOMMP    , ONLY : NASLB1, NSLCORE
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  IMPLICIT NONE

  REAL(KIND=JPRB),INTENT(OUT)      :: POUT(NGPTOT)

  INTEGER(KIND=JPIM)               :: JLS
  INTEGER(KIND=JPIM)               :: INBLS, INBSS
  REAL(KIND=JPRB)                  :: ZHOOK_HANDLE
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:VISUALIZE_NRNEIGHBOURS_LS',0,ZHOOK_HANDLE)


  DO JLS=1,NGPTOT
     POUT(JLS)=NRNBLS(NSLCORE(JLS))
 ENDDO


  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:VISUALIZE_NRNEIGHBOURS_LS',1,ZHOOK_HANDLE)
END SUBROUTINE VISUALIZE_NRNEIGHBOURS_LS


!     ------------------------------------------------------
!     binary 2D output for debuging
!     ------------------------------------------------------
subroutine write_field(cdfilename, pfield, kpoints, klevs)
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  implicit none
  integer(KIND=JPIM),INTENT(IN)      :: kpoints, klevs
  character(len=*),INTENT(IN)        :: cdfilename
  real(KIND=JPRB),INTENT(IN)         :: pfield(kpoints,klevs)
  REAL(KIND=JPRB)                       :: ZHOOK_HANDLE

  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:WRITE_FIELD',0,ZHOOK_HANDLE)
  print *,'Writing file ',cdfilename

  OPEN(1142, FILE=cdfilename, FORM="unformatted", STATUS="REPLACE") 

  WRITE(1142) kpoints
  WRITE(1142) klevs
  WRITE(1142) pfield

  CLOSE(1142)
  IF (LHOOK) CALL DR_HOOK('YOE_CUCONVCA:WRITE_FIELD',1,ZHOOK_HANDLE)
end subroutine write_field



END MODULE YOE_CUCONVCA
