!ocl list_copy(32,IADDR)
!ocl list_copy(32,PLSDEPI)
!ocl list_copy(32,PLATI)
!ocl list_copy(32,PIPI0)
!ocl list_copy(32,PIPI1)
!ocl list_copy(32,PIPI2)
SUBROUTINE RDSCAW(KPROMB,KSTART,KPROF,KGLN,KGLX,&
 & KSTABUF,KWIS,KFRSTLOFF,KEXT,K1,K2,K3,K4,&
 & P4JP,PIS2,PLSDEPI,PLATI,&
 & PIPI0,PIPI1,PIPI2,PLON,PLAT,&
 & PDLAT,PCLA,PDLO,PCLO,KL0,&
 & KARXB1,KMASK2)  

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

USE YOMPRAD  , ONLY : LRADONDEM,LRADONDEM_ACTIVE
USE YOMLASCAW, ONLY : KPDUP

!**** *RDSCAW  -  Interpolator for radiation scheme:
!                 Storage of Coordinates And Weights.

!     Purpose.
!     --------
!       Same kind of action as LASCAW but for the interpolator used
!        in the radiation scheme.
!       Determines the interpolation grid:
!       - computation of the latitude and the longitude of the
!         point situated at the upper left corner of the 16 points
!         square, and of the interpolation point.
!       - computation of weights.
!       Storage of coordinates and weights.

!**   Interface.
!     ----------
!        *CALL* *RDSCAW( ... )

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

!        INPUT:
!          KPROMB  - horizontal dimension for interpolation point quantities.
!          KSTART  - first element of arrays where computations are performed.
!          KPROF   - depth of work.
!          KGLN    - lower dimension for latitude.
!          KGLX    - upper dimension for latitude.
!          KSTABUF - for a latitude IGL, KSTABUF(IGL) is the
!                    address of the element corresponding to
!                    (ILON=0,IGL) in the KPROMB arrays.
!          KWIS    - kind of interpolation.
!          KFRSTLOFF   - offset for first lat of own a-set in grid-point space,
!                        see NFRSTLOFF
!          KEXT    - latitude extension mapping array (see NSLEXT)
!          K1,K2,K3,K4 - for dimensioning KEXT
!          KARXB1  - leading dimension of radiation buffer
!          P4JP    - Approximative inverse of the differences of latitudes.
!          PIS2    - PI / 2
!          PLSDEPI - (Number of points by latitude) / (2 * PI) .
!          PLATI   - latitude on the computational sphere.
!          PIPI0   - coefficients for the bicubic interpolations.
!          PIPI1   - coefficients for the bicubic interpolations.
!          PIPI2   - coefficients for the bicubic interpolations.
!          PLON    - Interpolation point longitude on the computational sphere.
!          PLAT    - Interpolation point latitude on the computational sphere.

!        OUTPUT:
!          PDLAT   - distance for horizontal linear interpolations
!                    in latitude
!          PCLA    - weights for horizontal cubic interpolations
!                    in latitude
!          PDLO    - distances for horizontal linear interpolations
!                    in longitude (latitude rows 0, 1, 2, 3)
!          PCLO    - weights for horizontal cubic interpolations in
!                    longitude (latitude rows 1, 2)
!          KL0     - index of the four western points
!                    of the 16 points interpolation grid.
!          KMASK2  - mask for on-demand comms

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

!     Method.
!     -------
!      See documentation about ECMWF physics, and semi-Lagrangian interpolator.

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

!        No external.
!        Called by RADINTG

!     Reference.
!     ----------

!     Author.
!     -------
!        G.Mozdzynski (based on lascaw)

!     Modifications.
!     --------------
!        Original : November 2001
!        Modified 02-10-01 GMozdzynski support on-demand radiation comms
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        R. El Khatib 28-Jul-2006 Porting to NEC
!        F. Vana  21-Aug-2008 - precomputation of longitudal interpolation 
!                             - generalized support for memory conflicts
!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGLN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGLX 
INTEGER(KIND=JPIM),INTENT(IN)    :: K1 
INTEGER(KIND=JPIM),INTENT(IN)    :: K2 
INTEGER(KIND=JPIM),INTENT(IN)    :: K3 
INTEGER(KIND=JPIM),INTENT(IN)    :: K4 
INTEGER(KIND=JPIM),INTENT(IN)    :: KARXB1 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTABUF(KGLN:KGLX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KWIS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFRSTLOFF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEXT(K1:K2,K3:K4) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P4JP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIS2 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSDEPI(KGLN:KGLX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLATI(KGLN:KGLX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIPI0(KGLN:KGLX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIPI1(KGLN:KGLX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIPI2(KGLN:KGLX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLON(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAT(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDLAT(KPROMB) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCLA(KPROMB,3) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDLO(KPROMB,0:3) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCLO(KPROMB,3,2)
INTEGER(KIND=JPIM),INTENT(OUT)   :: KL0(KPROMB,0:3) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KMASK2(KARXB1+4) 

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

INTEGER(KIND=JPIM) :: IADDR(KGLN:KGLX)

INTEGER(KIND=JPIM) :: ILA, ILO, ILO1, ILO2, ILO3, IZLAT, JLAT, JROF

REAL(KIND=JPRB) :: PD, ZDA, ZDB, ZDC, ZDD, ZLO, ZLO1, ZLO2, ZLO3

REAL(KIND=JPRB),PARAMETER :: Z6_R=1.0_JPRB/6.0_JPRB

REAL(KIND=JPRB) :: FLAG1, FLAG2, FLAG3

REAL(KIND=JPRB) :: ZHOOK_HANDLE

! Duplicata of some dummy or local arrays for optimisation on NEC platform.
INTEGER(KIND=JPIM) :: J_, JK_
INTEGER(KIND=JPIM) :: IADDR_(KPDUP,KGLN:KGLX)
REAL(KIND=JPRB) :: ZLSDEPI_(KPDUP,KGLN:KGLX)
REAL(KIND=JPRB) :: ZRLATI_(KPDUP,KGLN:KGLX)
REAL(KIND=JPRB) :: ZRIPI0_(KPDUP,KGLN:KGLX)
REAL(KIND=JPRB) :: ZRIPI1_(KPDUP,KGLN:KGLX)
REAL(KIND=JPRB) :: ZRIPI2_(KPDUP,KGLN:KGLX)

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

!     FUNCTIONS:
! weights for cubic Lagrange interpolation (regular nodes)
FLAG1(PD)= 0.5_JPRB*(PD+1.0_JPRB)   *(PD-1.0_JPRB)*(PD-2.0_JPRB)
FLAG2(PD)=-0.5_JPRB*(PD+1.0_JPRB)*PD              *(PD-2.0_JPRB)
FLAG3(PD)= Z6_R    *(PD+1.0_JPRB)*PD*(PD-1.0_JPRB)

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

IF (LHOOK) CALL DR_HOOK('RDSCAW',0,ZHOOK_HANDLE)

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

!*       0.    PRELIMINARY INITIALISATIONS.
!              ----------------------------

DO JLAT=KGLN,KGLX
  IADDR(JLAT)=KSTABUF(JLAT)
ENDDO
DO J_ = 1, KPDUP
  DO JK_ = KGLN, KGLX
    IADDR_(J_,JK_)=IADDR(JK_)
  ENDDO
ENDDO
!CDIR SHORTLOOP
DO J_ = 1, KPDUP
  ZLSDEPI_(J_,KGLN:KGLX)=PLSDEPI(KGLN:KGLX)
  ZRLATI_(J_,KGLN:KGLX)=PLATI(KGLN:KGLX)
  ZRIPI0_(J_,KGLN:KGLX)=PIPI0(KGLN:KGLX)
  ZRIPI1_(J_,KGLN:KGLX)=PIPI1(KGLN:KGLX)
  ZRIPI2_(J_,KGLN:KGLX)=PIPI2(KGLN:KGLX)
ENDDO


!        Coordinates and weights for bilinear interpolations.

IF (KWIS == 201) THEN

!CDIR NODEP
  DO JROF=KSTART,KPROF

    J_ = MOD(JROF+1-KSTART,KPDUP)+1

    IZLAT =INT(P4JP*(PIS2-PLAT(JROF))+0.75_JPRB)-KFRSTLOFF
    ILA   =IZLAT+NINT(SIGN(0.5_JPRB,ZRLATI_(J_,IZLAT)-PLAT(JROF))-1.5_JPRB)

    PDLAT(JROF)=(PLAT(JROF)-ZRLATI_(J_,ILA+1))&
     & /(ZRLATI_(J_,ILA+2)-ZRLATI_(J_,ILA+1))  

    ZLO1  =PLON(JROF)*ZLSDEPI_(J_,ILA+1)
    ILO1  =INT(ZLO1)
    PDLO(JROF,1)=ZLO1-REAL(ILO1,JPRB)
    ZLO2  =PLON(JROF)*ZLSDEPI_(J_,ILA+2)
    ILO2  =INT(ZLO2)
    PDLO(JROF,2)=ZLO2-REAL(ILO2,JPRB)

    KL0(JROF,1)=IADDR_(J_,ILA+1)+KEXT(ILO1,ILA+1)
    KL0(JROF,2)=IADDR_(J_,ILA+2)+KEXT(ILO2,ILA+2)

    IF( LRADONDEM.AND..NOT.LRADONDEM_ACTIVE )THEN
      KMASK2(KL0(JROF,1))=4
      KMASK2(KL0(JROF,2))=4
    ENDIF

  ENDDO

ENDIF

!        Coordinates and weights for 12 points interpolations.

IF (KWIS == 203) THEN

!CDIR NODEP
  DO JROF=KSTART,KPROF

    J_ = MOD(JROF+1-KSTART,KPDUP)+1

    IZLAT =INT(P4JP*(PIS2-PLAT(JROF))+0.75_JPRB)-KFRSTLOFF
    ILA   =IZLAT+NINT(SIGN(0.5_JPRB,ZRLATI_(J_,IZLAT)-PLAT(JROF))-1.5_JPRB)

    PDLAT(JROF)=(PLAT(JROF)-ZRLATI_(J_,ILA+1))&
     & /(ZRLATI_(J_,ILA+2)-ZRLATI_(J_,ILA+1))  

    ZDA   =PLAT(JROF)-ZRLATI_(J_,ILA)
    ZDB   =PLAT(JROF)-ZRLATI_(J_,ILA+1)
    ZDC   =PLAT(JROF)-ZRLATI_(J_,ILA+2)
    ZDD   =PLAT(JROF)-ZRLATI_(J_,ILA+3)
    
    PCLA(JROF,1)=(ZDA*ZDC)*ZDD*ZRIPI0_(J_,ILA+1)
    PCLA(JROF,2)=(ZDA*ZDB)*ZDD*ZRIPI1_(J_,ILA+1)
    PCLA(JROF,3)=(ZDA*ZDB)*ZDC*ZRIPI2_(J_,ILA+1)

    ZLO   =PLON(JROF)*ZLSDEPI_(J_,ILA  )
    ILO   =INT(ZLO )
    PDLO(JROF,0)=ZLO -REAL(ILO ,JPRB)
    ZLO1  =PLON(JROF)*ZLSDEPI_(J_,ILA+1)
    ILO1  =INT(ZLO1)
    PDLO(JROF,1)=ZLO1-REAL(ILO1,JPRB)
    ZLO2  =PLON(JROF)*ZLSDEPI_(J_,ILA+2)
    ILO2  =INT(ZLO2)
    PDLO(JROF,2)=ZLO2-REAL(ILO2,JPRB)
    ZLO3  =PLON(JROF)*ZLSDEPI_(J_,ILA+3)
    ILO3  =INT(ZLO3)
    PDLO(JROF,3)=ZLO3-REAL(ILO3,JPRB)

    PCLO(JROF,1,1)= FLAG1(PDLO(JROF,1))
    PCLO(JROF,2,1)= FLAG2(PDLO(JROF,1))
    PCLO(JROF,3,1)= FLAG3(PDLO(JROF,1))
    PCLO(JROF,1,2)= FLAG1(PDLO(JROF,2))
    PCLO(JROF,2,2)= FLAG2(PDLO(JROF,2))
    PCLO(JROF,3,2)= FLAG3(PDLO(JROF,2))

    KL0(JROF,0)=IADDR_(J_,ILA  )+KEXT(ILO ,ILA  )
    KL0(JROF,1)=IADDR_(J_,ILA+1)+KEXT(ILO1,ILA+1)
    KL0(JROF,2)=IADDR_(J_,ILA+2)+KEXT(ILO2,ILA+2)
    KL0(JROF,3)=IADDR_(J_,ILA+3)+KEXT(ILO3,ILA+3)

    IF( LRADONDEM.AND..NOT.LRADONDEM_ACTIVE )THEN
      KMASK2(KL0(JROF,0))=4
      KMASK2(KL0(JROF,1))=4
      KMASK2(KL0(JROF,2))=4
      KMASK2(KL0(JROF,3))=4
    ENDIF

  ENDDO

ENDIF

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

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