#ifdef VPP
!OCL SCALAR
#endif
SUBROUTINE SUCOAPHY

USE PARKIND1 , ONLY : JPIM     ,JPRB
USE PARKIND2 , ONLY : JPRH
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOM_PHYS_GRID ,ONLY : PHYS_GRID,DYN_GRID,DYN_SL,PHYS_SL, &
 & YPHYPOI, YDYNPOI, JPMXNEI

USE YOMGEM   , ONLY : NGPTOT, NLOENG
USE YOMDIM   , ONLY : NDGLG, NDGENL, NDGSAL, NDGENG, NDGSAG, NDLON, NSMAX
USE YOMGC    , ONLY : GELAM, GELAT, GEMU
USE YOMLEG   , ONLY : RMU, RLATI
USE YOMCST   , ONLY : RPI
USE YOMMP    , ONLY : NFRSTLOFF, NSLOFF
USE YOMLUN   , ONLY : NULERR

!**** *SUCOAPHY*  - Initialize the coarse grid for the physics

!     Purpose.
!     --------
!           Initialize the coarse grid for the physics

!**   Interface.
!     ----------
!        *CALL* *SUCOAPHY

!        Explicit arguments :
!        --------------------
!        None

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

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

!     Externals.
!     ----------
!        None

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

!     Author.
!     -------
!        Mariano Hortal  *ECMWF*

!     Modifications.
!     --------------
!        Original : 2005-03-01
!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JP, JR, ICOUNT, JPF, IPOI
INTEGER(KIND=JPIM) :: ILBRLATI,IUBRLATI
INTEGER(KIND=JPIM) :: INL0(JPMXNEI)
INTEGER(KIND=JPIM) :: IGPTOTC, IGPTOTF, IDGLGC, IDGLGF
INTEGER(KIND=JPIM) :: IFRSTLOFFF, IFRSTLOFFC
INTEGER(KIND=JPIM) :: ISLWIDEFN, ISLWIDECN
INTEGER(KIND=JPIM) :: ISLWIDEFS, ISLWIDECS
INTEGER(KIND=JPIM) :: IASLB1F, IASLB1C, IDGENLC, IDGENLF, IDGENGC, IDGENGF

INTEGER(KIND=JPIM),ALLOCATABLE :: ILOENGC(:), ILOENGF(:), ISLOFFC(:), ISLOFFF(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: ISLEXTC(:,:), ISLEXTF(:,:)

REAL(KIND=JPRB) :: ZWGT(JPMXNEI)
REAL(KIND=JPRH) :: ZTEMP
INTEGER(KIND=JPIM) :: IDGSALF, IDGSALC,  IDGSAGF, IDGSAGC
REAL(KIND=JPRB) :: ZBNC, ZBSC, ZBNF, ZBSF, ZBEC, ZBWC, ZBEF, ZBWF
REAL(KIND=JPRB) :: ZNSWT, ZEWWT, ZLATWT, ZTWT
REAL(KIND=JPRH) :: ZDLAM, ZDLOEN,  ZDLONN, ZDLONS
REAL(KIND=JPRB) :: ZLONWT, Z2PI
REAL(KIND=JPRB) :: ZLATIC,ZLATICM1,ZEPS
REAL(KIND=JPRH) :: ZLON,ZGELAM_DP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

REAL(KIND=JPRB),ALLOCATABLE :: ZGEMUC(:), ZGEMUF(:), ZRMUC(:), ZRMUF(:)
REAL(KIND=JPRB),ALLOCATABLE :: ZGELAMC(:),  ZGELAMF(:)
REAL(KIND=JPRB),ALLOCATABLE :: ZGELATC(:),  ZGELATF(:)
LOGICAL :: LLIWN, LLAWN
INTEGER(KIND=JPIM) :: IROWC, IPOIC, IROWF(JPMXNEI), IPOIF(JPMXNEI)

#include "abor1.intfb.h"
#include "suecphypo.intfb.h"

IF (LHOOK) CALL DR_HOOK('SUCOAPHY',0,ZHOOK_HANDLE)
!     ------------------------------------------------------------------

!*       0.5 SET BASIC CONSTANTS
!            --- ----- ---------
Z2PI=2.0_JPRB*RPI
ZEPS=1.0E-12_JPRB
!     ------------------------------------------------------------------

!*       1. SELECT POINTS
!           ------ ------

CALL SUECPHYPO

IF(PHYS_GRID%NSMAX < NSMAX) THEN
  IGPTOTC=PHYS_GRID%NGPTOT
  IGPTOTF=DYN_GRID%NGPTOT
  IDGLGC=PHYS_GRID%NDGLG
  IDGLGF=DYN_GRID%NDGLG
  IDGENLC=PHYS_GRID%NDGENL
  IDGENLF=DYN_GRID%NDGENL
  IDGENGC=PHYS_GRID%NDGENG
  IDGENGF=DYN_GRID%NDGENG
  ALLOCATE(ZGEMUC(PHYS_GRID%NGPTOT))
  ZGEMUC(:)=PHYS_GRID%GEMU(:)
  ALLOCATE(ZGEMUF(DYN_GRID%NGPTOT))
  ZGEMUF(:)=GEMU(:)
  ALLOCATE(ZRMUC(PHYS_GRID%NDGSAG:PHYS_GRID%NDGENG))
  ZRMUC(:)=PHYS_GRID%RMU(:)
  ALLOCATE(ZRMUF(DYN_GRID%NDGSAG:DYN_GRID%NDGENG))
  ZRMUF(:)=DYN_GRID%RMU(:)
  ALLOCATE(ILOENGC(PHYS_GRID%NDGSAG:PHYS_GRID%NDGENG))
  ILOENGC(:)=PHYS_GRID%NLOENG(:)
  ALLOCATE(ILOENGF(DYN_GRID%NDGSAG:DYN_GRID%NDGENG))
  ILOENGF(:)=DYN_GRID%NLOENG(:)
  ALLOCATE(ZGELAMC(PHYS_GRID%NGPTOT))
  ZGELAMC(:)=PHYS_GRID%GELAM(:)
  ALLOCATE(ZGELAMF(DYN_GRID%NGPTOT))
  ZGELAMF(:)=GELAM(:)
  ALLOCATE(ZGELATC(PHYS_GRID%NGPTOT))
  ZGELATC(:)=PHYS_GRID%GELAT(:)
  ALLOCATE(ZGELATF(DYN_GRID%NGPTOT))
  ZGELATF(:)=GELAT(:)
  IDGSAGC=PHYS_GRID%NDGSAG
  IDGSAGF=DYN_GRID%NDGSAG
  IDGSALC=PHYS_GRID%NDGSAL
  IDGSALF=DYN_GRID%NDGSAL
  IFRSTLOFFC=PHYS_GRID%NFRSTLOFF
  IFRSTLOFFF=DYN_GRID%NFRSTLOFF
  ISLWIDECN=PHYS_SL%NSLWIDEN
  ISLWIDEFN=DYN_SL%NSLWIDEN
  ISLWIDECS=PHYS_SL%NSLWIDES
  ISLWIDEFS=DYN_SL%NSLWIDES
  ALLOCATE(ISLOFFC(PHYS_GRID%NDGSAL-PHYS_SL%NSLWIDEN:PHYS_GRID%NDGENL+PHYS_SL%NSLWIDES))
  ISLOFFC(:)=PHYS_SL%NSLOFF(:)
  ALLOCATE(ISLOFFF(DYN_GRID%NDGSAL-DYN_SL%NSLWIDEN:DYN_GRID%NDGENL+DYN_SL%NSLWIDES))
  ISLOFFF(:)=DYN_SL%NSLOFF(:)
  ALLOCATE(ISLEXTC(1-PHYS_GRID%NDLON:PHYS_GRID%NDLON+PHYS_GRID%NDLON,&
       & 1-PHYS_SL%NSLWIDEN:PHYS_GRID%NDGENL+PHYS_SL%NSLWIDES))
  ISLEXTC(:,:)=PHYS_SL%NSLEXT(:,:)
  ALLOCATE(ISLEXTF(1-DYN_GRID%NDLON:DYN_GRID%NDLON+DYN_GRID%NDLON,&
       &1-DYN_SL%NSLWIDEN:DYN_GRID%NDGENL+DYN_SL%NSLWIDES))
  ISLEXTF(:,:)=DYN_SL%NSLEXT(:,:)
  IASLB1C=PHYS_SL%NASLB1
  IASLB1F=DYN_SL%NASLB1
ELSE
  IGPTOTC=DYN_GRID%NGPTOT
  IGPTOTF=PHYS_GRID%NGPTOT
  IDGLGC=DYN_GRID%NDGLG
  IDGLGF=PHYS_GRID%NDGLG
  IDGENLC=DYN_GRID%NDGENL
  IDGENLF=PHYS_GRID%NDGENL
  IDGENGC=DYN_GRID%NDGENG
  IDGENGF=PHYS_GRID%NDGENG
  ALLOCATE(ZGEMUC(DYN_GRID%NGPTOT))
  ZGEMUC(:)=GEMU(:)
  ALLOCATE(ZGEMUF(PHYS_GRID%NGPTOT))
  ZGEMUF(:)=PHYS_GRID%GEMU(:)
  ALLOCATE(ZRMUC(DYN_GRID%NDGSAG:DYN_GRID%NDGENG))
  ZRMUC(:)=DYN_GRID%RMU(:)
  ALLOCATE(ZRMUF(PHYS_GRID%NDGSAG:PHYS_GRID%NDGENG))
  ZRMUF(:)=PHYS_GRID%RMU(:)
  ALLOCATE(ILOENGC(DYN_GRID%NDGSAG:DYN_GRID%NDGENG))
  ILOENGC(:)=DYN_GRID%NLOENG(:)
  ALLOCATE(ILOENGF(PHYS_GRID%NDGSAG:PHYS_GRID%NDGENG))
  ILOENGF(:)=PHYS_GRID%NLOENG(:)
  ALLOCATE(ZGELAMC(DYN_GRID%NGPTOT))
  ZGELAMC(:)=GELAM(:)
  ALLOCATE(ZGELAMF(PHYS_GRID%NGPTOT))
  ZGELAMF(:)=PHYS_GRID%GELAM(:)
  ALLOCATE(ZGELATC(DYN_GRID%NGPTOT))
  ZGELATC(:)=GELAT(:)
  ALLOCATE(ZGELATF(PHYS_GRID%NGPTOT))
  ZGELATF(:)=PHYS_GRID%GELAT(:)
  IDGSAGC=DYN_GRID%NDGSAG
  IDGSAGF=PHYS_GRID%NDGSAG
  IDGSALC=DYN_GRID%NDGSAL
  IDGSALF=PHYS_GRID%NDGSAL
  IFRSTLOFFC=DYN_GRID%NFRSTLOFF
  IFRSTLOFFF=PHYS_GRID%NFRSTLOFF
  ISLWIDECN=DYN_SL%NSLWIDEN
  ISLWIDEFN=PHYS_SL%NSLWIDEN
  ISLWIDECS=DYN_SL%NSLWIDES
  ISLWIDEFS=PHYS_SL%NSLWIDES
  ALLOCATE(ISLOFFC(DYN_GRID%NDGSAL-DYN_SL%NSLWIDEN:DYN_GRID%NDGENL+DYN_SL%NSLWIDES))
  ISLOFFC(:)=DYN_SL%NSLOFF(:)
  ALLOCATE(ISLOFFF(PHYS_GRID%NDGSAL-PHYS_SL%NSLWIDEN:PHYS_GRID%NDGENL+PHYS_SL%NSLWIDES))
  ISLOFFF(:)=PHYS_SL%NSLOFF(:)
  ALLOCATE(ISLEXTC(1-DYN_GRID%NDLON:DYN_GRID%NDLON+DYN_GRID%NDLON,&
       &1-DYN_SL%NSLWIDEN:DYN_GRID%NDGENL+DYN_SL%NSLWIDES))
  ISLEXTC(:,:)=DYN_SL%NSLEXT(:,:)
  ALLOCATE(ISLEXTF(1-PHYS_GRID%NDLON:PHYS_GRID%NDLON+PHYS_GRID%NDLON,&
       & 1-PHYS_SL%NSLWIDEN:PHYS_GRID%NDGENL+PHYS_SL%NSLWIDES))
  ISLEXTF(:,:)=PHYS_SL%NSLEXT(:,:)
! WRITE(0,*) ' PHYS_SL%NSLEXT(96)=',(PHYS_SL%NSLEXT(JR,96),JR=1,PHYS_GRID%NLOENG(96))
  IASLB1C=DYN_SL%NASLB1
  IASLB1F=PHYS_SL%NASLB1
ENDIF

!*       2. COMPUTE WEIGHTS FOR AVERAGING
!           ------- ------- --- ---------
DO JP=1,IGPTOTC
  DO JR=1,IDGLGC
    IF(ZGEMUC(JP) ==  ZRMUC(JR)) THEN
      IF(JR == 1) THEN
        ZBNC=1.0_JPRB
      ELSE
        ZBNC=(ZRMUC(JR)+ZRMUC(JR-1))*0.5_JPRB
      ENDIF
      IF(JR ==  IDGLGC) THEN
        ZBSC=-1.0_JPRB
      ELSE
        ZBSC=(ZRMUC(JR)+ZRMUC(JR+1))*0.5_JPRB
      ENDIF
      ZDLAM=2.0_JPRH*REAL(RPI,JPRH)/REAL(ILOENGC(JR),JPRH)
      IPOI=NINT(ZGELAMC(JP)/ZDLAM)+1
      ZGELAM_DP=REAL(IPOI-1,JPRH)*ZDLAM
      ZTEMP=ZGELAM_DP+ZDLAM*0.5_JPRH
      ZBEC=ZTEMP
      ZTEMP=ZGELAM_DP-ZDLAM*0.5_JPRH
      ZBWC=ZTEMP
      EXIT
    ENDIF
  ENDDO
  IROWC=JR
  IPOIC=NINT(ZGELAMC(JP)/ZDLAM)+1
  ICOUNT=0

  ILBRLATI = MAX(IDGSAGF,IDGSALF+IFRSTLOFFF-ISLWIDEFN)-IFRSTLOFFF
  IUBRLATI = MIN(IDGENGF,IDGENLF+IFRSTLOFFF+ISLWIDEFS)-IFRSTLOFFF

  DO JR=ILBRLATI+1,IUBRLATI
    IF(JR+IFRSTLOFFF >= 1 .AND. JR+IFRSTLOFFF < IDGLGF) THEN
      ZBSF=(ZRMUF(JR+IFRSTLOFFF)+ZRMUF(JR+1+IFRSTLOFFF))*0.5_JPRB
    ELSEIF(JR+IFRSTLOFFF < 1) THEN
      ZBSF=1._JPRB
    ELSE
      ZBSF=-1._JPRB
    ENDIF
    IF(JR+IFRSTLOFFF > 1 .AND. JR+IFRSTLOFFF <= IDGLGF) THEN
      ZBNF=(ZRMUF(JR+IFRSTLOFFF)+ZRMUF(JR-1+IFRSTLOFFF))*0.5_JPRB
    ELSEIF(JR+IFRSTLOFFF > IDGLGF) THEN
      ZBNF=-1._JPRB
    ELSE
      ZBNF=1._JPRB
    ENDIF

    IF(ZBNF <= ZBSC) THEN
      EXIT
    ELSEIF(ZBSF < ZBNC .AND. ZBNF > ZBSC) THEN
      ZDLOEN=2.0_JPRH*REAL(RPI,JPRH)/REAL(ILOENGF(JR+IFRSTLOFFF),JPRH)
      DO JPF=-1,ILOENGF(JR+IFRSTLOFFF)+2
        ZLON=REAL(JPF-1,JPRH)*ZDLOEN
        ZBEF=ZLON+ZDLOEN*0.5_JPRH
        ZBWF=ZLON-ZDLOEN*0.5_JPRH
        IF(ZBEF > ZBWC .AND. ZBWF < ZBEC) THEN
          ICOUNT=ICOUNT + 1
          IROWF(ICOUNT)=JR
          IPOIF(ICOUNT)=JPF
          INL0(ICOUNT)=ISLOFFF(JR)+ISLEXTF(JPF,JR)
          IF(INL0(ICOUNT) < 1 .OR. INL0(ICOUNT) > IASLB1F) THEN
            CALL ABOR1('SUCOAPHY: INDEX OUTSIDE SL BUFFER')
          ENDIF
          ZNSWT=(MAX(ZBSC,MIN(ZBNC,ZBNF))-MIN(ZBNC,MAX(ZBSC,ZBSF)))/(ZBNC-ZBSC)
          ZEWWT=(MAX(ZBWC,MIN(ZBEC,ZBEF))-MIN(ZBEC,MAX(ZBWC,ZBWF)))/(ZBEC-ZBWC)
          ZWGT(ICOUNT)=ZNSWT*ZEWWT
          IF(PHYS_GRID%NSMAX == NSMAX .AND. (ZWGT(ICOUNT) /= 1.0_JPRB &
               &.AND. ZWGT(ICOUNT) /= 0.0_JPRB)) THEN
            WRITE(NULERR,*) ' Weight=',ZWGT(ICOUNT),' ZNSWT=',ZNSWT,&
               &' ZEWWT=',ZEWWT,' for averaging, ZBWC=',ZBWC,' ZBEC=',ZBEC,&
               &' ZBWF=',ZBWF,' ZBEF=',ZBEF,' ZGELAMC=',ZGELAMC(JP),&
               &' ZLON=',ZLON,' ZBSC=',ZBSC,' ZBSF=',ZBSF
          ENDIF
        ELSEIF(ZBWF >= ZBEC) THEN
          EXIT
        ENDIF
      ENDDO
    ENDIF
  ENDDO
! WRITE(0,'("SUCOAPHY: ICOUNT=",I6)')ICOUNT
  IF(ICOUNT > JPMXNEI)CALL ABOR1('SUCOAPHY: TOO MANY NEIGHBOURS FOR AVERAGING')
  IF(PHYS_GRID%NSMAX < NSMAX) THEN
    YPHYPOI(JP)%NEIGH=ICOUNT
    ALLOCATE(YPHYPOI(JP)%NL0(ICOUNT))
    ALLOCATE(YPHYPOI(JP)%WGT(ICOUNT))
    ZTWT=0.0_JPRB
    LLAWN=.FALSE.
    DO JPF=1,ICOUNT
      IF(ZWGT(JPF) < 0.0_JPRB) LLAWN=.TRUE.
      ZTWT=ZTWT+ZWGT(JPF)
      YPHYPOI(JP)%NL0(JPF)=INL0(JPF)
      YPHYPOI(JP)%WGT(JPF)=ZWGT(JPF)
    ENDDO
  ELSE
    YDYNPOI(JP)%NEIGH=ICOUNT
    ALLOCATE(YDYNPOI(JP)%NL0(ICOUNT))
    ALLOCATE(YDYNPOI(JP)%WGT(ICOUNT))
    ZTWT=0.0_JPRB
    LLAWN=.FALSE.
    DO JPF=1,ICOUNT
      IF(ZWGT(JPF) < 0.0_JPRB) LLAWN=.TRUE.
      ZTWT=ZTWT+ZWGT(JPF)
      YDYNPOI(JP)%NL0(JPF)=INL0(JPF)
      YDYNPOI(JP)%WGT(JPF)=ZWGT(JPF)
    ENDDO
  ENDIF
  IF(ABS(ZTWT-1.0_JPRB) > ZEPS)THEN
    WRITE(NULERR,*)' JP=',JP,' IGPTOTC=',IGPTOTC, &
      &'ZTWT = ',ZTWT,(ZWGT(JPF),JPF=1,ICOUNT)
    CALL ABOR1('SUCOAPHY: AVERAGE WEIGHT WRONG')
  ENDIF
  IF(LLAWN) CALL ABOR1(' SUCOAPHY: Negative average weight')
ENDDO

!*       3. COMPUTE WEIGHTS FOR INTERPOLATION
!           ------- ------- --- -------------

ILBRLATI = MAX(IDGSAGC, IDGSALC+IFRSTLOFFC-ISLWIDECN)-IFRSTLOFFC
IUBRLATI = MIN(IDGENGC, IDGENLC+IFRSTLOFFC+ISLWIDECN)-IFRSTLOFFC
DO JP=1,IGPTOTF
  ICOUNT=0
  DO JR=ILBRLATI+1,IUBRLATI
    IF(PHYS_GRID%NSMAX < NSMAX) THEN
      ZLATICM1=PHYS_GRID%RLATI(JR-1)
      ZLATIC=PHYS_GRID%RLATI(JR)
    ELSE
      ZLATICM1=DYN_GRID%RLATI(JR-1)
      ZLATIC=DYN_GRID%RLATI(JR)
    ENDIF
    IF(ZLATIC < ZGELATF(JP)) THEN
      ZLATWT=(ZGELATF(JP)-ZLATICM1)/&
               & (ZLATIC-ZLATICM1)
      ZDLONS=2.0_JPRH*REAL(RPI,JPRH)/REAL(ILOENGC(JR+IFRSTLOFFC),JPRH)
      DO JPF=-1,ILOENGC(JR+IFRSTLOFFC)+2
        ZLON=REAL(JPF-1,JPRH)*ZDLONS
        IPOI=NINT(ZGELAMF(JP)/ZDLONS)+1
        ZGELAM_DP=REAL(IPOI-1,JPRH)*ZDLONS
        IF(ZLON >= ZGELAM_DP) THEN
          ZLONWT=1._JPRH-(ZLON-ZGELAM_DP)/ZDLONS
          ICOUNT=ICOUNT+1
          INL0(ICOUNT)=ISLOFFC(JR)+ISLEXTC(JPF,JR)
          ZWGT(ICOUNT)=ZLONWT*ZLATWT
          ICOUNT=ICOUNT+1
          INL0(ICOUNT)=ISLOFFC(JR)+ISLEXTC(JPF-1,JR)
          ZWGT(ICOUNT)=(1._JPRB-ZLONWT)*ZLATWT
          IF(PHYS_GRID%NSMAX == NSMAX .AND. (ZWGT(ICOUNT) /= 1.0_JPRB &
               &.AND. ZWGT(ICOUNT) /= 0.0_JPRB)) THEN
            WRITE(NULERR,*) ' Weight=',ZWGT(ICOUNT),' ZLONWT=',ZLONWT,&
               &' ZLATWT=',ZLATWT,' row south'
          ENDIF
          EXIT
        ENDIF
      ENDDO
      ZDLONN=2.0_JPRH*REAL(RPI,JPRH)/REAL(ILOENGC(JR-1+IFRSTLOFFC),JPRH)
      DO JPF=-1,ILOENGC(JR-1+IFRSTLOFFC)+2
        ZLON=REAL(JPF-1,JPRH)*ZDLONN
        IPOI=NINT(ZGELAMF(JP)/ZDLONN)+1
        ZGELAM_DP=REAL(IPOI-1,JPRH)*ZDLONN
        IF(ZLON >= ZGELAM_DP) THEN
          ZLONWT=1._JPRH-(ZLON-ZGELAM_DP)/ZDLONN
          ICOUNT=ICOUNT+1
          INL0(ICOUNT)=ISLOFFC(JR-1)+ISLEXTC(JPF,JR-1)
          ZWGT(ICOUNT)=ZLONWT*(1._JPRB-ZLATWT)
          ICOUNT=ICOUNT+1
          INL0(ICOUNT)=ISLOFFC(JR-1)+ISLEXTC(JPF-1,JR-1)
          ZWGT(ICOUNT)=(1._JPRB-ZLONWT)*(1._JPRB-ZLATWT)
          IF(PHYS_GRID%NSMAX == NSMAX .AND. (ZWGT(ICOUNT) /= 1.0_JPRB &
               &.AND. ZWGT(ICOUNT) /= 0.0_JPRB)) THEN
            WRITE(NULERR,*) ' Weight=',ZWGT(ICOUNT),' ZLONWT=',ZLONWT,&
               &' ZLATWT=',ZLATWT,' row north'
          ENDIF
          EXIT
        ENDIF
      ENDDO
      EXIT
    ENDIF
  ENDDO
  IF(ICOUNT > JPMXNEI)CALL ABOR1&
    &('SUCOAPHY: TOO MANY NEIGHBOURS FOR INTERPOLATION')
  IF(PHYS_GRID%NSMAX < NSMAX) THEN
    YDYNPOI(JP)%NEIGH=ICOUNT
    ALLOCATE(YDYNPOI(JP)%NL0(ICOUNT))
    ALLOCATE(YDYNPOI(JP)%WGT(ICOUNT))
    ZTWT=0.0_JPRB
    LLIWN=.FALSE.
    DO JPF=1,ICOUNT
      IF(ZWGT(JPF) < -ZEPS) LLIWN=.TRUE.
      ZTWT=ZTWT+ZWGT(JPF)
      YDYNPOI(JP)%NL0(JPF)=INL0(JPF)
      YDYNPOI(JP)%WGT(JPF)=ZWGT(JPF)
    ENDDO
  ELSE
    YPHYPOI(JP)%NEIGH=ICOUNT
    ALLOCATE(YPHYPOI(JP)%NL0(ICOUNT))
    ALLOCATE(YPHYPOI(JP)%WGT(ICOUNT))
    ZTWT=0.0_JPRB
    LLIWN=.FALSE.
    DO JPF=1,ICOUNT
      IF(ZWGT(JPF) < -ZEPS) LLIWN=.TRUE.
      ZTWT=ZTWT+ZWGT(JPF)
      YPHYPOI(JP)%NL0(JPF)=INL0(JPF)
      YPHYPOI(JP)%WGT(JPF)=ZWGT(JPF)
    ENDDO
  ENDIF
  IF(ABS(ZTWT-1.0_JPRB) > ZEPS)THEN
    WRITE(NULERR,*)'ZTWT = ',ZTWT,(ZWGT(JPF),JPF=1,ICOUNT),JP
    CALL ABOR1('SUCOAPHY: INTERPOLATION WEIGHT WRONG')
  ENDIF
  IF(LLIWN) CALL ABOR1(' SUCOAPHY: Negative interpolation weight')
ENDDO

DEALLOCATE(ZGEMUC)
DEALLOCATE(ZGEMUF)
DEALLOCATE(ZRMUC)
DEALLOCATE(ZRMUF)
DEALLOCATE(ILOENGC)
DEALLOCATE(ILOENGF)
DEALLOCATE(ZGELAMC)
DEALLOCATE(ZGELAMF)
DEALLOCATE(ZGELATC)
DEALLOCATE(ZGELATF)
DEALLOCATE(ISLOFFC)
DEALLOCATE(ISLOFFF)
DEALLOCATE(ISLEXTC)
DEALLOCATE(ISLEXTF)


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