SUBROUTINE CA_PROFPERT(KSTEP,KLON,KLEV,KIDIA,KFDIA,PTP,PQP,PTP_CA,PQP_CA,PAPRSF,PCUCONVCA,PNLCONVCA,KMODE)

!**** *CA_PROFPERT* - Perturb T and q profiles where CA is active

!     Purpose.
!     --------
!        Perturb the T and q input profiles to the convection scheme 
!        and save the original profiles when the convective CA is 
!        active and KMODE==1.
!        Restore original profiles if KMODE==2.


!**   Interface.
!     ----------
!        *CALL* *CA_PROFPERT(KSTEP,KLON,KLEV,KIDIA,KFDIA,PTP,PQP,PTP_CA,PQP_CA,PAPRSF,KMODE)

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

!        KSTEP     : model timestep
!        KIDIA     : START OF HORIZONTAL LOOP
!        KFDIA     : END   OF HORIZONTAL LOOP
!        KLON      : HORIZONTAL DIMENSION
!        KLEV      : END OF VERTICAL LOOP AND VERTICAL DIMENSION
!        PTP       : model T profiles
!        PQP       : model q profiles
!        PTP_CA    : saved T profiles
!        PQP_CA    : saved q profiles
!        PAPRSF    : PRESSURE ON FULL LEVELS
!        PCUCONVCA : CA state
!        PNLCONVCA : indicates if CA was alive at a gridpoint before
!        KMODE     : 1 for perturbing
!                    2 for restoring

!        Implicit arguments :  none.
!        --------------------

!     Method.
!     -------
!        
!     Externals.
!     ----------
!      none

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

!     Author.
!     -------
!        Martin Steinheimer  *ECMWF*

!     Modifications.
!     --------------
!        Original : 30-04-2010
!     ------------------------------------------------------------------
  USE PARKIND1  ,ONLY : JPIM     ,JPRB
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK 
  USE YOMCST   , ONLY : RPI
  USE YOE_CUCONVCA, ONLY : CA_FORC
  IMPLICIT NONE

  INTEGER(KIND=JPIM),INTENT(IN)    :: KSTEP
  INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
  INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
  INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
  INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
  REAL(KIND=JPRB),INTENT(INOUT)    :: PTP(KLON,KLEV)
  REAL(KIND=JPRB),INTENT(INOUT)    :: PQP(KLON,KLEV)
  REAL(KIND=JPRB),INTENT(INOUT)    :: PTP_CA(KLON,KLEV)
  REAL(KIND=JPRB),INTENT(INOUT)    :: PQP_CA(KLON,KLEV)
  REAL(KIND=JPRB),INTENT(IN)       :: PAPRSF(KLON,KLEV)
  REAL(KIND=JPRB),INTENT(IN)       :: PCUCONVCA(KLON)
  REAL(KIND=JPRB),INTENT(IN)       :: PNLCONVCA(KLON)
  INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE

  INTEGER(KIND=JPIM)               :: JK, JL
  REAL(KIND=JPRB)                  :: ZHOOK_HANDLE

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

  IF (KSTEP > 1) THEN
    IF (KMODE == 1) THEN
      IF (CA_FORC == 'CONV_TQ' ) THEN
        !save T and Q profiles before changing them for convection input
        DO JK=1,KLEV
          DO JL=KIDIA,KFDIA
            PTP_CA(JL,JK) = PTP(JL,JK)
            PQP_CA(JL,JK) = PQP(JL,JK)
          ENDDO
        ENDDO
        !change T and Q profiles for convection
        DO JK=1,KLEV
          DO JL=KIDIA,KFDIA
            IF (PNLCONVCA(JL) == 1) THEN
              IF (PCUCONVCA(JL) > 2) THEN
                IF (PAPRSF(JL,JK) > 20000._JPRB) THEN
                  PTP(JL,JK) = PTP(JL,JK)-0.2_JPRB*SIN(2*RPI/(PAPRSF(JL,KLEV)-20000._JPRB)* &
                               & (PAPRSF(JL,JK)-20000._JPRB))
                  PQP(JL,JK) = PQP(JL,JK)*1.02_JPRB
                ENDIF
              ELSE
                IF (PAPRSF(JL,JK) > 20000._JPRB) THEN
                  PTP(JL,JK) = PTP(JL,JK)+0.2_JPRB*SIN(2*RPI/(PAPRSF(JL,KLEV)-20000._JPRB)* &
                               & (PAPRSF(JL,JK)-20000._JPRB))
                  PQP(JL,JK) = PQP(JL,JK)*0.98_JPRB
                ENDIF
              ENDIF
            ENDIF
          ENDDO
        ENDDO
      ENDIF
    ELSEIF (KMODE == 2) THEN
      IF (CA_FORC == 'CONV_TQ') THEN
        !restore T and Q profiles to pre-CA modification
        DO JK=1,KLEV
          DO JL=KIDIA,KFDIA
            PTP(JL,JK) = PTP_CA(JL,JK)
            PQP(JL,JK) = PQP_CA(JL,JK)
          ENDDO
        ENDDO
      ENDIF
    ENDIF
  ENDIF  
  IF (LHOOK) CALL DR_HOOK('CA_PROFPERT',1,ZHOOK_HANDLE)
END SUBROUTINE CA_PROFPERT
