  SUBROUTINE CMIP6_PIAER_INTERP & 
 &( KIDIA , KFDIA , KLON , KLEV,&
 & KRINT , KSHIFT,&
 & PAPRS , PGELAM, PSINLAT  ,&
 & PIAOD , PIABS , PIASY )


    !--- 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 : TM5_NLON , TM5_NLAT, TM5_NLEV , TM5_NMON , NWVL, &
&                      TM5_LON, TM5_LAT, TM5_LEV, TM5_HYA, TM5_HYB, TM5_HYAI,  &
&                      TM5_HYBI, TM5_P0, TM5_PS, TM5_PPS, TM5_PPSF,         &
&                      TM5_NUM_KS, TM5_NUM_AS, TM5_NUM_CS, TM5_MSO4_KS,        &
&                      TM5_MSO4_AS, TM5_MSO4_CS, TM5_MBC_KS,TM5_MBC_AS, TM5_MBC_CS,     &
&                      TM5_MBC_KI, TM5_MOC_KS, TM5_MOC_AS, TM5_MOC_CS, TM5_MOC_KI,         &
&                      TM5_MSS_AS, TM5_MSS_CS, TM5_MDU_AS, TM5_MDU_CS,    &
&                      TM5_MDU_AI, TM5_MDU_CI,                                 &
&                      TM5_AOD, TM5_ABS, TM5_ASY

    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)   :: PIAOD(KLON,KLEV,NWVL)
     REAL(KIND=JPRB)   ,INTENT(OUT)   :: PIABS(KLON,KLEV,NWVL)
     REAL(KIND=JPRB)   ,INTENT(OUT)   :: PIASY(KLON,KLEV,NWVL)



     REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

     REAL(KIND=JPRB) :: ZIAOD(KLON,KLEV)
     REAL(KIND=JPRB) :: ZIABS(KLON,KLEV)
     REAL(KIND=JPRB) :: ZIASY(KLON,KLEV)

     REAL(KIND=JPRB) :: ZTM5_AOD(TM5_NLON, TM5_NLAT, TM5_NLEV)
     REAL(KIND=JPRB) :: ZTM5_ABS(TM5_NLON, TM5_NLAT, TM5_NLEV)
     REAL(KIND=JPRB) :: ZTM5_ASY(TM5_NLON, TM5_NLAT, TM5_NLEV)

     REAL(KIND=JPRB) :: ZLAT(KLON)
     REAL(KIND=JPRB) :: ZGLAT(KLON)
     REAL(KIND=JPRB) :: ZGLON(KLON)
     REAL(KIND=JPRB) :: ZRPI
     INTEGER(KIND=JPIM) :: ILAT, ILON, IMONTH, ILEV
     INTEGER(KIND=JPIM) :: IJ0, IM0, IA0, IDAY, IMON, IMODYR, ILMOIS(12)
     INTEGER(KIND=JPIM) :: JN, JL, JK
     INTEGER(KIND=JPIM) :: JLAT, JLON, JLEV , IGPBLKS
   

    !---included functions
!!!!#include "updcal.intfb.h"
!!!!#include "fcttim.h"

    !---executable procedure
    IF (LHOOK) CALL DR_HOOK('CMIP6_PIAER_INTERP',0,ZHOOK_HANDLE)
    
    WRITE(NULOUT,*)'Entering Subroutine CMIP6_PIAER_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 TM5 PI aerosol optical properties'

       IF (TM5_NLEV /= KLEV) THEN
         CALL ABOR1('Number of levels of pre-industrial aerosol climatology unequal to model resolution!')
       ENDIF

       DO JN=1,NWVL

        IF (TM5_NLEV == KLEV) THEN
         ! No vertical regridding, therefore no conversion to intensive properties
         ZTM5_AOD(:,:,:)=TM5_AOD(:,:,:,JN)
         ZTM5_ABS(:,:,:)=TM5_ABS(:,:,:,JN)
         ZTM5_ASY(:,:,:)=TM5_ASY(:,:,:,JN)
        ELSE
         ! divide optical properties by layer pressure differences before interpolation,
         ! since intensive properties are assumed in the vertical interpolation routine
         DO JK=1,TM5_NLEV       
           ZTM5_AOD(:,:,JK)=TM5_AOD(:,:,JK,JN)/(TM5_PPSF(:,:,JK-1)-TM5_PPSF(:,:,JK))
           ZTM5_ABS(:,:,JK)=TM5_ABS(:,:,JK,JN)/(TM5_PPSF(:,:,JK-1)-TM5_PPSF(:,:,JK))
           ZTM5_ASY(:,:,JK)=TM5_ASY(:,:,JK,JN)/(TM5_PPSF(:,:,JK-1)-TM5_PPSF(:,:,JK))
         END DO
        ENDIF


         CALL INTERPOLATE_PITM5(KIDIA, KFDIA, KLON, KLEV, KRINT, KSHIFT, &
                             &  PGELAM, PSINLAT, &
                             &  TM5_LON,      TM5_LAT,      TM5_PPS, &
                             &  PAPRS, ZTM5_AOD, ZIAOD )


         CALL INTERPOLATE_PITM5(KIDIA, KFDIA, KLON, KLEV, KRINT, KSHIFT, &
                             &  PGELAM, PSINLAT, &
                             &  TM5_LON,      TM5_LAT,      TM5_PPS, &
                             &  PAPRS, ZTM5_ABS, ZIABS )

         CALL INTERPOLATE_PITM5(KIDIA, KFDIA, KLON, KLEV, KRINT, KSHIFT, &
                             &  PGELAM, PSINLAT, &
                             &  TM5_LON,      TM5_LAT,      TM5_PPS, &
                             &  PAPRS, ZTM5_ASY, ZIASY )

        ! convert back to extensive properties in original units


       IF (TM5_NLEV == KLEV) THEN
        ! No vertical regridding, therefore no conversion
        DO JL=KIDIA,KFDIA,KRINT
          PIAOD(JL,:,JN)=ZIAOD(JL,:)
          PIABS(JL,:,JN)=ZIABS(JL,:)
          PIASY(JL,:,JN)=ZIASY(JL,:)
        END DO
       ELSE 
        DO JK=1,KLEV
          DO JL=KIDIA,KFDIA,KRINT
            PIAOD(JL,JK,JN)=ZIAOD(JL,JK)*(PAPRS(JL,JK+1)-PAPRS(JL,JK))
            PIABS(JL,JK,JN)=ZIABS(JL,JK)*(PAPRS(JL,JK+1)-PAPRS(JL,JK))
            PIASY(JL,JK,JN)=ZIASY(JL,JK)*(PAPRS(JL,JK+1)-PAPRS(JL,JK))
          END DO
        END DO
       ENDIF


       END DO

!! DIAGNOSTIC OUTPUTS FOR DEBUGGING
!    DO JN=1,NWVL   
!     DO JK=1,KLEV
!       DO JL=KIDIA,KFDIA
!        IF (NSTEP == 0 .AND. JK == KLEV-5 .AND. JN == 4 ) THEN
!          WRITE(NULOUT,'(A,2(1X,F8.3),3(1X,E12.5))') 'BBBBBBBBB', ZGLON(JL), ZGLAT(JL), PIAOD(JL,KLEV-5,4), PIABS(JL,KLEV-5,4), PIASY(JL,KLEV-5,4)
!!          WRITE(NULOUT,'(A,2(1X,F8.3),3(1X,E12.5))') 'BBBBBBBBB', ZGLON(JL), ZGLAT(JL), PIAOD(JL,KLEV-5,4),PAPRS(JL,KLEV-5), (PAPRS(JL,KLEV-5)-PAPRS(JL,KLEV-6))
!        ENDIF
!!!         IF(ABS(ZGLAT(JL) - 87.0_JPRB) < 1.0_JPRB) THEN
!!!           WRITE(NULOUT,'(A,2(1X,F8.3),1(1X,E12.5))') 'YYYYYYYY', ZGLON(JL), ZGLAT(JL), PIAOD(JL,KLEV-5,4)
!!!         ENDIF
!!!        IF (NSTEP == 0 .and. ZGLON(JL) <= 22.5 .and. ZGLON(JL) > 22.4 .and. ZGLAT(JL) <= 45.7 .and. ZGLAT(JL) >= 45.6) THEN
!!!          WRITE(6,'(A,2(1X,F8.3),3(1X,E12.5))') 'VVVVVVVV', ZGLON(JL), ZGLAT(JL), PAPRS(JL, JK), PIAOD(JL, JK, 4), PIABS(JL, JK, 4), PIASY(JL, JK, 4)
!!!        ENDIF
!       END DO   
!     END DO
!    END DO
! END DIAGNOSTIC OUTPUTS FOR DEBUGGING

      

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


CONTAINS
 
  !--------------------------------------------------------------------------------------------------------------

  !--------------------------------------------------------------------------------------------------------------
  SUBROUTINE INTERPOLATE_PITM5(KIDIA, KFDIA, KLON, KLEV, KRINT, KSHIFT, &
                            &  PGELAM, PSINLAT, &
                            &  PTM5_LON,   PTM5_LAT,    PTM5_PRES, &
                            &  PAPRS, PTM5_FIELD, POUTFIELD )

    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) :: PTM5_LON(TM5_NLON)
    REAL(KIND=JPRB), INTENT(IN) :: PTM5_LAT(TM5_NLAT)
    REAL(KIND=JPRB), INTENT(IN) :: PTM5_PRES(TM5_NLON, TM5_NLAT, TM5_NLEV)
    REAL(KIND=JPRB), INTENT(IN) :: PTM5_FIELD(TM5_NLON, TM5_NLAT, TM5_NLEV)
    REAL(KIND=JPRB), INTENT(IN) :: PAPRS(KLON,KLEV+1) 


    REAL(KIND=JPRB), INTENT(OUT) :: POUTFIELD(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) :: ZSIN_TM5(TM5_NLAT)
    REAL(KIND=JPRB) :: ZSILAT(KLON)
    REAL(KIND=JPRB) :: ZLON(KLON)
    REAL(KIND=JPRB) :: ZNLO1(KLON)
    REAL(KIND=JPRB) :: ZNLO2(KLON)

    REAL(KIND=JPRB) :: ZTM5_LON(TM5_NLON)
    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(TM5_NLAT)
    REAL(KIND=JPRB) :: ZLONR(TM5_NLON)
    REAL(KIND=JPRB) :: ZGRIDR, ZLATR, ZDLONR


    !---local data
    REAL(KIND=JPRB) :: ZOUT_FIELD(KLON, TM5_NLEV)
    REAL(KIND=JPRB) :: ZTMP_TM5_LEV(KLON, TM5_NLEV)
    REAL(KIND=JPRB) :: ZP_TM5_LEV(KLON, TM5_NLEV)
    REAL(KIND=JPRB) :: ZINFIELD(KLON, TM5_NLEV)
    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_PITM5',0, ZHOOK_HANDLE)

!================================================================================================
!
       ZRPI=RPI/180.0_JPRB
       Z2PI=2._JPRB*RPI
       ZZRPI=180._JPRB/RPI
    ZSINR(:) = SIN(ZRPI*PTM5_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(TM5_NLAT)) THEN
        INLA=TM5_NLAT
        IINLA1(IL)=TM5_NLAT
        IINLA2(IL)=TM5_NLAT
        ZSILAT(IL)=0._JPRB
      ENDIF 

    DO JLR=1,TM5_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_piaer_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 
!================================================================================================

       !-- longitudinal interpolation

       IL=KSHIFT
       DO JLR=1,TM5_NLON
          ZTM5_LON(JLR)=PTM5_LON(JLR)*ZRPI
       END DO
       DO JL=KIDIA,KFDIA,KRINT
          IL=IL+1
          IINLO1(IL)=0
          IINLO2(IL)=0
          ZLON(IL)=-9999.
          IF (PGELAM(JL) > ZTM5_LON(TM5_NLON)) THEN
             IINLO1(IL)=TM5_NLON
             IINLO2(IL)=1
             ZNLO1(IL)=ZTM5_LON(TM5_NLON)
             ZNLO2(IL)=2.*ZTM5_LON(TM5_NLON)-ZTM5_LON(TM5_NLON-1)
          END IF
          IF (PGELAM(JL) < ZTM5_LON(1)) THEN
             IINLO1(IL)=TM5_NLON
             IINLO2(IL)=1
             ZNLO1(IL)=ZTM5_LON(TM5_NLON)-Z2PI
             ZNLO2(IL)=ZTM5_LON(1)
          END IF
          DO JLR=1,TM5_NLON-1
                IF (PGELAM(JL) <= ZTM5_LON(JLR+1) .AND. PGELAM(JL) >= ZTM5_LON(JLR)) THEN
                   IINLO1(IL)=JLR
                   IINLO2(IL)=JLR+1
                   ZNLO1(IL)=ZTM5_LON(JLR)
                   ZNLO2(IL)=ZTM5_LON(JLR+1)
                   EXIT
                END IF
          END DO

          IF (IINLO1(IL) == 0 .OR. IINLO2(IL) == 0) THEN

           WRITE(NULOUT,*)'XXXXXJL=',IL,JL,' PGELAM=',PGELAM(JL), &
                & ' TM5_LON=',ZTM5_LON(IINLO1(IL)),ZTM5_LON(IINLO2(IL))
           WRITE(NULOUT,*)'XXXXXJL=','TM5_LON(TM5_NLON)= ',ZTM5_LON(TM5_NLON),' TM5_LON(TM5_NLON-1)= ',ZTM5_LON(TM5_NLON-1),IINLO1(IL),IINLO2(IL)

             CALL ABOR1(' Problem with long. interpolation in cmip6_piaer_interp! ')

          END IF
          ZLON(IL)=(PGELAM(JL)-ZNLO1(IL))/(ZNLO2(IL)-ZNLO1(IL))
!           WRITE(NULOUT,*)'XXXXXJL=',JL,' PGELAM=',PGELAM(JL), &
!                & ' TM5_LON=',ZTM5_LON(IINLO1(IL)),ZTM5_LON(IINLO2(IL))
       END DO

!================================================================================================

!================================================================================================

    
    DO JK=1,TM5_NLEV
       !-- compute interpolated field
       IL=KSHIFT
       DO JL=KIDIA,KFDIA, KRINT
          IL=IL+1
          INLO1=IINLO1(IL)
          INLO2=IINLO2(IL)
          INLA1=IINLA1(IL)
          INLA2=IINLA2(IL)
          
          ZAER1=PTM5_FIELD(INLO1,INLA1,JK) &
               & +ZSILAT(IL)*(PTM5_FIELD(INLO1,INLA2,JK)-PTM5_FIELD(INLO1,INLA1,JK))
          ZAER2=PTM5_FIELD(INLO2,INLA1,JK) &
               & +ZSILAT(IL)*(PTM5_FIELD(INLO2,INLA2,JK)-PTM5_FIELD(INLO2,INLA1,JK))
          ZOUT_FIELD(IL,JK)=ZAER1+ZLON(IL)*(ZAER2-ZAER1)
       END DO                    
    END DO         ! JK (vertical loop)
         
    DO JK=1,TM5_NLEV
       !-- compute interpolated field
       IL=KSHIFT
       DO JL=KIDIA,KFDIA, KRINT
          IL=IL+1
          INLO1=IINLO1(IL)
          INLO2=IINLO2(IL)
          INLA1=IINLA1(IL)
          INLA2=IINLA2(IL)

          ZAERLEV1=PTM5_PRES(INLO1,INLA1,JK) &
               & +ZSILAT(IL)*(PTM5_PRES(INLO1,INLA2,JK)-PTM5_PRES(INLO1,INLA1,JK))
          ZAERLEV2=PTM5_PRES(INLO2,INLA1,JK) &
               & +ZSILAT(IL)*(PTM5_PRES(INLO2,INLA2,JK)-PTM5_PRES(INLO2,INLA1,JK))
          ZTMP_TM5_LEV(IL,JK)=ZAERLEV1+ZLON(IL)*(ZAERLEV2-ZAERLEV1)
       END DO
       
    END DO         ! JK (vertical loop)


     !-- put TM5 field in the same vertical order as IFS 
      DO ILEV=1,TM5_NLEV
       IL=KSHIFT
        DO JL=KIDIA,KFDIA, KRINT
            IL=IL+1
            ZP_TM5_LEV(JL,ILEV)= ZTMP_TM5_LEV(JL,TM5_NLEV-ILEV+1)
            ZINFIELD(JL,ILEV)  = ZOUT_FIELD(JL,TM5_NLEV-ILEV+1)
         END DO           
      END DO 

!================================================================================================    
   IF (TM5_NLEV == KLEV) THEN
     DO JL=KIDIA,KFDIA, KRINT
       POUTFIELD(JL,:) = ZINFIELD(JL,:)
     END DO
   ELSE
    !-- main loop over levels
    DO JK=KLEV,1,-1

      IL=KSHIFT
      DO JL=KIDIA,KFDIA, KRINT
            IL=IL+1
        ZPRE(JL)=0.5_JPRB*(PAPRS(JL,JK)+PAPRS(JL,JK+1))
      END DO
      ! ENDIF
!   ZRH(:)=0.0_JPRB ! for dry aerosols

      !-- vertical interpolation
         IL=KSHIFT
      DO JL=KIDIA,KFDIA, KRINT
            IL=IL+1

            IF(ZPRE(JL) <= ZP_TM5_LEV(JL,1)) THEN
               POUTFIELD(JL,JK)= 0.0_JPRB
            END IF

            IF(ZPRE(JL) > ZP_TM5_LEV(JL,TM5_NLEV)) THEN
               POUTFIELD(JL,JK)= ZINFIELD(JL,TM5_NLEV)
            END IF

         DO ILEV=TM5_NLEV,2,-1
            IF(ZPRE(JL) > ZP_TM5_LEV(JL,ILEV-1) .AND. ZPRE(JL) <= ZP_TM5_LEV(JL,ILEV)) THEN
               ZRRR=1.0_JPRB/(ZP_TM5_LEV(JL,ILEV)-ZP_TM5_LEV(JL,ILEV-1))

               POUTFIELD(JL,JK) = ZINFIELD(JL,ILEV) + & 
                                & (ZPRE(JL)-ZP_TM5_LEV(JL,ILEV)) * ZRRR * &
                                & (ZINFIELD(JL,ILEV) - ZINFIELD(JL,ILEV-1))

            END IF
         END DO           
      END DO

    END DO      ! JK (vertical loop)           
   ENDIF

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

END   SUBROUTINE CMIP6_PIAER_INTERP
