SUBROUTINE CMIP6_STRATO_AERO_INTERP & 
&( KIDIA, KFDIA, KLON ,KLEV,        &
& KRINT, KSHIFT,                    &
& PAPRS, PGELAM, PSINLAT,           &
& STRATAOD, STRATAAOD, STRATREFAOD, &
& STRATAAOD_LW)

!     PURPOSE.
!     --------

!     INTERFACE.
!     ----------
!     CALL *CMIP6_STRATO_AERO_INTERP* FROM *RADLSWR*

!     AUTHOR.
!     -------
!     M.Ménégoz for EC-EARTH 2017
!
!     Horizontal interpolation of the stratospheric aerosol CMIP6
!     dataset. The data need to have the correct vertical resolution.
!     The vertical interpolation is done off-line.
!     The horizontal interpolation id done on-line.
!     In the SW, the triplet (AOD, AAOD, REFAOD) is used
!     In the LW, only AAOD is used, since only the aerosol absorption
!     is taken into account in IFS (aerosol scattering neglected in
!     the LW in IFS)

!     MODIFICATIONS.
!     --------------

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

!--- inherited types, functions and data
USE PARKIND1,ONLY : JPIM     ,JPRB
USE YOMHOOK, ONLY : LHOOK, DR_HOOK
USE YOMLUN,  ONLY : NULOUT
USE YOMRIP,  ONLY : NINDAT, NSTADD

USE YOMCST,  ONLY : RPI    
USE YOMMP,   ONLY : MYPROC

USE YOMDIM,  ONLY : NPROMA, NFLEVG, NGPBLKS
USE YOMGEM,  ONLY : NGPTOT
USE YOERAD,  ONLY : NRPROMA

USE YOERAD,  ONLY : STRATO_CMIP6_NLAT,STRATO_CMIP6_NALT,STRATO_CMIP6_NTIME, &
                & STRATO_CMIP6_ALT,STRATO_CMIP6_LAT,STRATO_CMIP6_SB,STRATO_CMIP6_TB,          &
                & STRATO_CMIP6_NSB,STRATO_CMIP6_NTB,STRATO_CMIP6_NMONTH,                      &
                & AOD_SUN, AAOD_SUN,REFAOD_SUN,                                               &
                & AAOD_EARTH

USE YOMCT3   , ONLY : NSTEP

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KRINT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSHIFT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGELAM(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSINLAT(KLON)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: STRATAOD(KLON,KLEV,STRATO_CMIP6_NSB,STRATO_CMIP6_NMONTH)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: STRATAAOD(KLON,KLEV,STRATO_CMIP6_NSB,STRATO_CMIP6_NMONTH)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: STRATREFAOD(KLON,KLEV,STRATO_CMIP6_NSB,STRATO_CMIP6_NMONTH)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: STRATAAOD_LW(KLON,KLEV,STRATO_CMIP6_NTB,STRATO_CMIP6_NMONTH)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTEGER(KIND=JPIM), PARAMETER :: RPRC = 1

REAL(KIND=JPRB) :: ZSTRATAOD(KLON,KLEV)
REAL(KIND=JPRB) :: ZSTRATAAOD(KLON,KLEV)
REAL(KIND=JPRB) :: ZSTRATREFAOD(KLON,KLEV)
REAL(KIND=JPRB) :: ZSTRATAAOD_LW(KLON,KLEV)

REAL(KIND=JPRB) :: ZAOD_SUN(STRATO_CMIP6_NALT, STRATO_CMIP6_NLAT)
REAL(KIND=JPRB) :: ZAAOD_SUN(STRATO_CMIP6_NALT, STRATO_CMIP6_NLAT)
REAL(KIND=JPRB) :: ZREFAOD_SUN(STRATO_CMIP6_NALT, STRATO_CMIP6_NLAT)
REAL(KIND=JPRB) :: ZAAOD_EARTH(STRATO_CMIP6_NALT, STRATO_CMIP6_NLAT)

REAL(KIND=JPRB) :: ZLAT(KLON)
REAL(KIND=JPRB) :: ZGLAT(KLON)
REAL(KIND=JPRB) :: ZGLON(KLON)
REAL(KIND=JPRB) :: ZRPI
INTEGER(KIND=JPIM) :: IMONTH, ILEV
INTEGER(KIND=JPIM) :: JN, JL, JK
   

!---executable procedure
IF (LHOOK) CALL DR_HOOK('CMIP6_STRATO_AERO_INTERP',0,ZHOOK_HANDLE)

WRITE(NULOUT,*)'Entering Subroutine CMIP6_STRATO_AERO_INTERP'

ZRPI=1.0_JPRB/RPI
DO JL=KIDIA,KFDIA
  ZLAT(JL) = ASIN(PSINLAT(JL))
  ZGLAT(JL)= ZLAT(JL) * 180._JPRB*ZRPI
  ZGLON(JL)= PGELAM(JL) * 180._JPRB*ZRPI  
END DO

IF (MYPROC==RPRC) WRITE(NULOUT,*) 'Interpolating stratospheric aerosol optical properties'

DO JN=1,STRATO_CMIP6_NSB
  DO IMONTH=1,STRATO_CMIP6_NMONTH
     IF (STRATO_CMIP6_NALT == KLEV) THEN
       ! No vertical regridding, therefore no conversion to intensive properties
       ZAOD_SUN(:,:)=AOD_SUN(:,:,JN,IMONTH)
       ZAAOD_SUN(:,:)=AAOD_SUN(:,:,JN,IMONTH)
       ZREFAOD_SUN(:,:)=REFAOD_SUN(:,:,JN,IMONTH)
      ELSE
       CALL ABOR1('Number of levels of stratospheric aerosol CMIP6 forcing unequal to model resolution!')
     ENDIF

     CALL INTERPOLATE_STRATAERO(KIDIA, KFDIA, KLON, KLEV, KRINT, KSHIFT, &
                         &  PGELAM, PSINLAT, STRATO_CMIP6_LAT, &
                         &  PAPRS, ZAOD_SUN, ZSTRATAOD )

     CALL INTERPOLATE_STRATAERO(KIDIA, KFDIA, KLON, KLEV, KRINT, KSHIFT, &
                         &  PGELAM, PSINLAT, STRATO_CMIP6_LAT, &
                         &  PAPRS, ZAAOD_SUN, ZSTRATAAOD )

     CALL INTERPOLATE_STRATAERO(KIDIA, KFDIA, KLON, KLEV, KRINT, KSHIFT, &
                         &  PGELAM, PSINLAT, STRATO_CMIP6_LAT, &
                         &  PAPRS, ZREFAOD_SUN, ZSTRATREFAOD )

     DO JL=KIDIA,KFDIA,KRINT
       STRATAOD(JL,:,JN,IMONTH)=ZSTRATAOD(JL,:)
       STRATAAOD(JL,:,JN,IMONTH)=ZSTRATAAOD(JL,:)
       STRATREFAOD(JL,:,JN,IMONTH)=ZSTRATREFAOD(JL,:)
     END DO

  END DO
END DO

DO JN=1,STRATO_CMIP6_NTB
  DO IMONTH=1,STRATO_CMIP6_NMONTH
     IF (STRATO_CMIP6_NALT == KLEV) THEN
       ! No vertical regridding, therefore no conversion to intensive properties
       ZAAOD_EARTH(:,:)=AAOD_EARTH(:,:,JN,IMONTH)
      ELSE
       CALL ABOR1('Number of levels of stratospheric aerosol CMIP6 forcing unequal to model resolution!')
     ENDIF

     CALL INTERPOLATE_STRATAERO(KIDIA, KFDIA, KLON, KLEV, KRINT, KSHIFT, &
                         &  PGELAM, PSINLAT, STRATO_CMIP6_LAT, &
                         &  PAPRS, ZAAOD_EARTH, ZSTRATAAOD_LW )

     DO JL=KIDIA,KFDIA,KRINT
       STRATAAOD_LW(JL,:,JN,IMONTH)=ZSTRATAAOD_LW(JL,:)
     END DO

  END DO
END DO

WRITE(NULOUT,*)'Leaving Subroutine CMIP6_STRATO_AERO_INTERP'
  
IF (LHOOK) CALL DR_HOOK('CMIP6_STRATO_AERO_INTERP',1,ZHOOK_HANDLE)


CONTAINS
 
  !--------------------------------------------------------------------------------------------------------------
  SUBROUTINE INTERPOLATE_STRATAERO(KIDIA, KFDIA, KLON, KLEV, KRINT, KSHIFT, &
                        &  PGELAM, PSINLAT, PSTRATO_CMIP6_LAT, &
                        &  PAPRS, PIN_FIELD, POUT_FIELD )

USE YOMHOOK, ONLY    : LHOOK, DR_HOOK
USE YOMLUN,  ONLY    : NULOUT
USE YOMCST,  ONLY : RPI 
!---subroutine interface
INTEGER(KIND=JPIM), INTENT(IN) :: KIDIA
INTEGER(KIND=JPIM), INTENT(IN) :: KFDIA
INTEGER(KIND=JPIM), INTENT(IN) :: KLON
INTEGER(KIND=JPIM), INTENT(IN) :: KLEV
INTEGER(KIND=JPIM),INTENT(IN)  :: KRINT 
INTEGER(KIND=JPIM),INTENT(IN)  :: KSHIFT 
REAL(KIND=JPRB), INTENT(IN) :: PGELAM(KLON)
REAL(KIND=JPRB), INTENT(IN) :: PSINLAT(KLON)
REAL(KIND=JPRB), INTENT(IN) :: PSTRATO_CMIP6_LAT(STRATO_CMIP6_NLAT)
REAL(KIND=JPRB), INTENT(IN) :: PIN_FIELD(STRATO_CMIP6_NALT,STRATO_CMIP6_NLAT)
REAL(KIND=JPRB), INTENT(IN) :: PAPRS(KLON,KLEV+1) 

REAL(KIND=JPRB), INTENT(OUT) :: POUT_FIELD(KLON,KLEV)
!---local data
INTEGER(KIND=JPIM) :: IINLA1(KLON), IINLA2(KLON)
INTEGER(KIND=JPIM) :: IINLO1(KLON), IINLO2(KLON)
INTEGER(KIND=JPIM) :: IL, JL, JLR, JK 
INTEGER(KIND=JPIM) :: INLA1, INLA2, INLO1, INLO2, ILEV, INLA

REAL(KIND=JPRB) :: ZSILAT(KLON)
REAL(KIND=JPRB) :: ZLON(KLON)
REAL(KIND=JPRB) :: ZNLO1(KLON)
REAL(KIND=JPRB) :: ZNLO2(KLON)

REAL(KIND=JPRB) :: ZGELAM(KLON)
REAL(KIND=JPRB) :: ZAER1, ZAER2,ZRPI, Z2PI, ZZRPI
REAL(KIND=JPRB) :: ZAERLEV1, ZAERLEV2 

REAL(KIND=JPRB) :: ZSIN

REAL(KIND=JPRB) :: ZSINR(STRATO_CMIP6_NLAT)
REAL(KIND=JPRB) :: ZGRIDR, ZLATR, ZDLONR

!---local data
REAL(KIND=JPRB) :: ZOUT_FIELD(KLON, STRATO_CMIP6_NALT)
REAL(KIND=JPRB) :: ZP_STR_LEV(KLON, STRATO_CMIP6_NALT)
REAL(KIND=JPRB) :: ZINFIELD(KLON, STRATO_CMIP6_NALT)
REAL(KIND=JPRB) :: ZPRE(KLON)

REAL(KIND=JPRB) :: ZRRR
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

!---executable procedure
IF (LHOOK) CALL DR_HOOK('INTERPOLATE_STRATAERO',0, ZHOOK_HANDLE)

!================================================================================================
!
   ZRPI=RPI/180.0_JPRB
   Z2PI=2._JPRB*RPI
   ZZRPI=180._JPRB/RPI
ZSINR(:) = SIN(ZRPI*PSTRATO_CMIP6_LAT(:))

   !-- latitudinal interpolation
  IL=KSHIFT
  DO JL=KIDIA,KFDIA,KRINT 
IL=IL+1
IINLA1(IL)=0
IINLA2(IL)=0
ZSILAT(IL)=-9999._JPRB
ZSIN=PSINLAT(JL)
  IF (ZSIN <= ZSINR(1)) THEN
    INLA=1
    IINLA1(IL)=1
    IINLA2(IL)=1
    ZSILAT(IL)=0._JPRB
  ENDIF
  IF (ZSIN >= ZSINR(STRATO_CMIP6_NLAT)) THEN
    INLA=STRATO_CMIP6_NLAT
    IINLA1(IL)=STRATO_CMIP6_NLAT
    IINLA2(IL)=STRATO_CMIP6_NLAT
    ZSILAT(IL)=0._JPRB
  ENDIF 

DO JLR=1,STRATO_CMIP6_NLAT-1

  IF (ZSIN >= ZSINR(JLR) .AND. ZSIN < ZSINR(JLR+1)) THEN
    INLA=JLR
    IINLA1(IL)=JLR
    IINLA2(IL)=JLR+1
    ZSILAT(IL)=(ZSIN-ZSINR(INLA))/(ZSINR(INLA+1)-ZSINR(INLA))
  ENDIF

ENDDO


!IF (INLA == 0) THEN 
IF (IINLA1(IL) == 0 .OR. IINLA2(IL) == 0) THEN
  CALL ABOR1(' Problem with lat. interpolation in in cmip6_strato_aero_interp!')
ENDIF
   !  print 9123,JL,IL,PSIN(JL),INLA,ZSINR(INLA),ZSILAT(IL)
9123     format(1x,'Interp.Latit.',2I4,F10.7,I4,2F10.7)          
   ENDDO 

DO JK=1,STRATO_CMIP6_NALT
   !-- compute interpolated field
   IL=KSHIFT
   DO JL=KIDIA,KFDIA, KRINT
      IL=IL+1
      INLA1=IINLA1(IL)
      INLA2=IINLA2(IL)
      
      ZAER1=PIN_FIELD(JK,INLA1) &
           & +ZSILAT(IL)*(PIN_FIELD(JK,INLA2)-PIN_FIELD(JK,INLA1))

      ZOUT_FIELD(IL,JK)=ZAER1

   END DO                    
END DO         ! JK (vertical loop)
     
!================================================================================================
 DO JL=KIDIA,KFDIA, KRINT
   POUT_FIELD(JL,:) = ZOUT_FIELD(JL,:)
 END DO

!================================================================================================ 
IF (LHOOK) CALL DR_HOOK('INTERPOLATE_STRATAERO',1,ZHOOK_HANDLE)
 END SUBROUTINE INTERPOLATE_STRATAERO
  !--------------------------------------------------------------------------------------------------------------

END   SUBROUTINE cmip6_strato_aero_interp
