SUBROUTINE COD_OPTL( KDLEN  , KLEN   , KMXCOUNT,& 
 &   PQF   , PTF   , PPRESH , PPRESF ,&
 &   PLWCF , PIWCF ,&
 &   PQF5  , PTF5  , PPRESH5, PPRESF5, PLSF5   ,&
 &   PLWCF5, PIWCF5,& 
 &   PCOD,PTAUC)

!*** *COD_OPTL* Tangent Linear Operator routine for aerosol optical depth 
!               observations.

!**   INTERFACE.
!     ----------
!          *COD_OPTL* IS CALLED FROM *HOPTL*.
!     CALL COD_OPTL(KDLEN,ILEN,IMXCOUNT,ZQF, ZTF, ZPRESH, ZPRESF,&
!      &  ZCLWF,ZCIWF, &
!      &  ZQF5, ZTF5, ZPRESH5, ZPRESF5, ZLS5, ZCLWF5, ZCIWF5, ZXPP)
!*
!    INPUT PARAMETERS (INTEGER):
!      KDLEN      = First dimension: Max number of observations, this set
!                       (INPUT)
!      KLEN       = Number of aerosol optical depth obs (INPUT)
!      IMXCOUNT   = Number of channels (INPUT)
!*
!    INPUT PARAMETERS (REAL):
!      Trajectory  Perturbation  Description
!      PQF5        PQF           Specific humidity at observation points,
!                                model levels 
!      PTF5        PTF           Temperature at obs points, model levels
!      PPRESH5     PPRESH        Half level pressure values at obs points
!      PPRESF5     PPRESF        Full level pressure values at obs points
!      PLS5        ---           Land-sea mask
!      PLWCF5      PLWCF         Liquid water content
!      PIWCF5      PIWCF         Ice water content
!*
!    OUTPUT PARAMETERS (REAL):
!      ---         PCOD          Aerosol optical depth at different 
!                                wavelengths 
!      ---         PTAUC         Cloud optical depth per layer

!     AUTHOR.
!     -------
!      Marta Janiskova       ECMWF     4 April 2006

!     MODIFICATIONS.
!     --------------
!      20090429  Antje Inness: Add default formulation NRADIP=3
!-----------------------------------------------------------------------

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

USE YOMCST    ,ONLY : RD, RG, RPI, RTT
USE YOECLOP550,ONLY : RSA55, RSB55, RFA55
USE YOERAD    ,ONLY : RCCNLND, RCCNSEA, RRe2De, RMINICE
USE YOERDU    ,ONLY : REPLOG, REPSCW
USE YOETHF   , ONLY : RTICE
USE YOMLUN    ,ONLY : NULERR
USE YOMDIM    ,ONLY : NFLEVG
!USE YOMVAR    ,ONLY : NSIM4D

IMPLICIT NONE

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

!*       0.1   ARGUMENTS
!              ---------

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN, KLEN, KMXCOUNT

REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRESH5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRESF5(KDLEN,NFLEVG)   
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF5(KDLEN,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQF5(KDLEN,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSF5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLWCF5(KDLEN,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIWCF5(KDLEN,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRESH(KDLEN,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRESF(KDLEN,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQF(KDLEN,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLWCF(KDLEN,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIWCF(KDLEN,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOD(KDLEN,KMXCOUNT)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTAUC(KDLEN,NFLEVG,KMXCOUNT) 

!*       0.5   LOCAL VARIABLES
!              ---------------

INTEGER(KIND=JPIM) :: JK, JL, JJ

REAL(KIND=JPRB) :: ZDESR(KDLEN), ZIWC(KDLEN), ZLWC(KDLEN)
REAL(KIND=JPRB) :: ZRADIP(KDLEN), ZRADLP(KDLEN)
REAL(KIND=JPRB) :: ZD(KDLEN), ZNTOT(KDLEN), ZDEN(KDLEN)
REAL(KIND=JPRB) :: ZTAUC(KDLEN,NFLEVG)
REAL(KIND=JPRB) :: ZTAUC5(KDLEN,NFLEVG)
REAL(KIND=JPRB) :: ZIWC5(KDLEN), ZLWC5(KDLEN), ZRADLP5(KDLEN)
REAL(KIND=JPRB) :: ZRADIP5(KDLEN), ZDESR5(KDLEN)
REAL(KIND=JPRB) :: ZCOD5(KDLEN,KMXCOUNT)

REAL(KIND=JPRB) :: Z1RADI, ZALND, ZASEA, ZBETAI, ZDefRe, &
                  & ZDPOG, ZNUM, &
                  & ZPODT, ZQIP, ZQLP, ZRefDe, ZTEMPC, ZTOI, ZTOL
REAL(KIND=JPRB) :: ZQIP1, ZQLP1
REAL(KIND=JPRB) :: ZDPOG5, ZPODT5, ZNUM5, ZTEMPC5, ZTOI5, ZTOL5
REAL(KIND=JPRB) :: Z1RADI5, ZBETAI5, ZQLP5, ZQIP5
REAL(KIND=JPRB) :: ZQIP15, ZQLP15
REAL(KIND=JPRB) :: ZRGI, ZRDI
REAL(KIND=JPRB) :: ZTCELS, ZAIWC, ZBIWC, ZFSR
REAL(KIND=JPRB) :: ZTCELS5,ZAIWC5, ZBIWC5, ZFSR5

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('COD_OPTL',0,ZHOOK_HANDLE)

!IF(NSIM4D == 1) THEN
!WRITE(NULERR,*) 'COD_OPTL: T Q LW IW'
!DO JL=1,KLEN/8
! DO JK=1,NFLEVG
!  WRITE(NULERR,100) 'TRAJ', JL, JK,  PPRESH5(JL,JK), PPRESF5(JL,JK), PTF5(JL,JK), PQF5(JL,JK), PLWCF5(JL,JK), PIWCF5(JL,JK) 
! ENDDO
! DO JK=1,NFLEVG
!  WRITE(NULERR,100) 'PERT', JL, JK,  PPRESH(JL,JK), PPRESF(JL,JK), &
! &   PTF(JL,JK), PQF(JL,JK), PLWCF(JL,JK), PIWCF(JL,JK)                                                       
! ENDDO
!ENDDO
! DO JL=1,KLEN/8
!  WRITE(NULERR,101) 'LSMK', JL, PLSF5(JL)
! ENDDO
!ENDIF
!100 FORMAT(A4,1X,I5,1X,I2,2X,6(E15.8,2X))
!101 FORMAT(A4,1X,I5,2X,E15.8)


!-- units:
!   ------
! PLWCF  is the liquid water mass mixing ratio      kg kg-1
! PIWCF  is the ice water ,ass mixing ratio         kg kg-1

ZASEA=RCCNSEA
ZALND=RCCNLND
ZRefDe = RRe2De
ZDefRe = 1.0_JPRB / ZRefDe
ZRGI = 1.0_JPRB/RG
ZRDI = 1.0_JPRB/RD

PCOD(:,:) = 0._JPRB
ZCOD5(:,:)= 0._JPRB

IF(KMXCOUNT /= 1) THEN
 WRITE(NULERR,*) 'COD_OPTL: ROUTINE CANNOT HANDLE MORE THAN WAVELENGHT'
 WRITE(NULERR,*) 'PROGRAM WILL STOP'
 CALL ABOR1('')
ENDIF

DO JL=1,KLEN
!  IF (PLSF5(JL) < 0.5_JPRB) THEN
    ZD(JL)=0.33_JPRB
    ZNTOT(JL)=-1.15E-03_JPRB*ZASEA*ZASEA+0.963_JPRB*ZASEA+5.30_JPRB
!  ELSE
!    ZD(JL)=0.43_JPRB
!    ZNTOT(JL)=-2.10E-04_JPRB*ZALND*ZALND+0.568_JPRB*ZALND-27.9_JPRB
!  ENDIF
  ZDEN(JL)=4.0_JPRB*RPI*ZNTOT(JL)*(1.0_JPRB+ZD(JL)*ZD(JL))**3
ENDDO

DO JJ=1,KMXCOUNT
  DO JK=1,NFLEVG
    DO JL=1,KLEN
      ZDPOG  = ZRGI*(PPRESH (JL,JK)-PPRESH (JL,JK-1))
      ZDPOG5 = ZRGI*(PPRESH5(JL,JK)-PPRESH5(JL,JK-1))

!-- cloud water path in g m-2
      ZQIP1  = 1.E+03_JPRB*(ZDPOG5*PIWCF(JL,JK)+PIWCF5(JL,JK)*ZDPOG)
      ZQIP15 = 1.E+03_JPRB*ZDPOG5*PIWCF5(JL,JK)
      IF (ZQIP15 > 0._JPRB) THEN
        ZQIP  = ZQIP1
        ZQIP5 = ZQIP15
      ELSE
        ZQIP  = 0._JPRB
        ZQIP5 = 0._JPRB
      ENDIF
      ZQLP1  = 1.E+03_JPRB*(ZDPOG5*PLWCF(JL,JK)+PLWCF5(JL,JK)*ZDPOG)
      ZQLP15 = 1.E+03_JPRB*ZDPOG5*PLWCF5(JL,JK)
      IF (ZQLP15 > 0._JPRB) THEN
        ZQLP  = ZQLP1
        ZQLP5 = ZQLP15
      ELSE
        ZQLP  = 0._JPRB
        ZQLP5 = 0._JPRB
      ENDIF
      ZPODT  = ZRDI*(PPRESF(JL,JK)/PTF5(JL,JK) &
       & -PPRESF5(JL,JK)*PTF(JL,JK)/PTF5(JL,JK)**2)
      ZPODT5 = ZRDI*PPRESF5(JL,JK)/PTF5(JL,JK)
     ZIWC (JL)=1.E+03_JPRB*(PIWCF5(JL,JK)*ZPODT+PIWCF(JL,JK)*ZPODT5)
     ZIWC5(JL)=1.E+03_JPRB*PIWCF5(JL,JK)*ZPODT5
     ZLWC (JL)=1.E+03_JPRB*(PLWCF5(JL,JK)*ZPODT+PLWCF(JL,JK)*ZPODT5)
     ZLWC5(JL)=1.E+03_JPRB*PLWCF5(JL,JK)*ZPODT5


!-- droplet effective radius

      ZNUM  = 3.0_JPRB*ZLWC (JL)*(1.0_JPRB+3.0_JPRB*ZD(JL)*ZD(JL))**2
      ZNUM5 = 3.0_JPRB*ZLWC5(JL)*(1.0_JPRB+3.0_JPRB*ZD(JL)*ZD(JL))**2
      IF ((ZNUM5/ZDEN(JL)) > REPLOG) THEN
        ZRADLP5(JL) = 100.0_JPRB*EXP(0.333_JPRB*LOG(ZNUM5/ZDEN(JL)))
        ZRADLP (JL) = 0.333_JPRB*ZRADLP5(JL)*ZNUM/ZNUM5
        IF (ZRADLP5(JL) < 4.0_JPRB) THEN
          ZRADLP (JL) = 0.0_JPRB
          ZRADLP5(JL) = 4.0_JPRB
        ENDIF
        IF (ZRADLP5(JL) > 16.0_JPRB) THEN
          ZRADLP (JL) = 0.0_JPRB
          ZRADLP5(JL) = 16.0_JPRB
        ENDIF
      ELSE
        ZRADLP (JL) = 0.0_JPRB
        ZRADLP5(JL) = 4.0_JPRB
      ENDIF

!-- ice particle effective size

      IF (PTF5(JL,JK) < RTICE) THEN
        ZTEMPC  = PTF(JL,JK)
        ZTEMPC5 = PTF5(JL,JK)-RTT
      ELSE
        ZTEMPC  = 0.0_JPRB
        ZTEMPC5 = RTICE-RTT
      ENDIF
      ZRADIP (JL) = ZTEMPC*(12.42_JPRB+ZTEMPC5 &
       & *(2*0.197_JPRB+3*0.0012_JPRB*ZTEMPC5))
      ZRADIP5(JL) = 326.3_JPRB+ZTEMPC5*(12.42_JPRB + ZTEMPC5 &
       & *(0.197_JPRB + ZTEMPC5*0.0012_JPRB))
      IF (ZRADIP5(JL) < 30.0_JPRB) THEN
        ZRADIP (JL) = 0.0_JPRB
        ZRADIP5(JL) = 30.0_JPRB
      ENDIF
      IF (ZRADIP5(JL) > 60.0_JPRB) THEN
        ZRADIP (JL) = 0.0_JPRB
        ZRADIP5(JL) = 60.0_JPRB
      ENDIF
      ZDESR (JL) = ZDefRe * ZRADIP (JL)
      ZDESR5(JL) = ZDefRe * ZRADIP5(JL)

!- default formulation NRADIP=3
      ZTEMPC=PTF(JL,JK)
      ZTEMPC5=PTF5(JL,JK)-83.15_JPRB
      ZTCELS=PTF(JL,JK)
      ZTCELS5=PTF5(JL,JK)-RTT
      ZFSR=0.0105_JPRB*ZTCELS
      ZFSR5=1.2351_JPRB+0.0105_JPRB*ZTCELS5
      ZAIWC=45.8966_JPRB*0.2214_JPRB*ZIWC(JL)*ZIWC5(JL)**(0.2214_JPRB-1.0_JPRB)
      ZAIWC5=45.8966_JPRB*ZIWC5(JL)**0.2214_JPRB
      ZBIWC=0.7957_JPRB *0.2535_JPRB*ZIWC(JL)*ZIWC5(JL)**(0.2535_JPRB-1.0_JPRB)
      ZBIWC5=0.7957_JPRB *ZIWC5(JL)**0.2535_JPRB
      ZDESR(JL)=ZFSR*(ZAIWC5+ZBIWC5*ZTEMPC5) + &
       &        ZFSR5*(ZAIWC+ZBIWC5*ZTEMPC+ZBIWC*ZTEMPC5)              
      ZDESR5(JL)=ZFSR5*(ZAIWC5+ZBIWC5*ZTEMPC5)
      IF(ZDESR5(JL) > RMINICE) THEN
        IF(ZDESR5(JL) < 155.0_JPRB) THEN
          ZDESR(JL)=ZDESR(JL)
          ZDESR5(JL)=ZDESR5(JL)
        ELSE
          ZDESR(JL)=0.0_JPRB
          ZDESR5(JL)=155.0_JPRB
        ENDIF
      ELSE
        IF(RMINICE < 155.0_JPRB) THEN
          ZDESR(JL)=0.0_JPRB
          ZDESR5(JL)=RMINICE
        ELSE
          ZDESR(JL)=0.0_JPRB
          ZDESR5(JL)=155.0_JPRB
        ENDIF
      ENDIF

!-- cloud optical properties

      ZTOL  = 0.0_JPRB
      ZTOL5 = 0.0_JPRB
      ZTOI  = 0.0_JPRB
      ZTOI5 = 0.0_JPRB

!-- for liquid water clouds (Slingo, 1989)

      IF (ZQLP5 > REPSCW) THEN
        ZTOL  = (RSA55 + RSB55 /ZRADLP5(JL))*ZQLP &
         & -RSB55*ZQLP5*ZRADLP(JL)/ZRADLP5(JL)**2
        ZTOL5 = ZQLP5 *(RSA55 + RSB55 /ZRADLP5(JL))
      ENDIF

!-- for ice water clouds (Fu, 1996)

      IF (ZQIP5 > REPSCW) THEN
        Z1RADI5 = 1.0_JPRB / ZDESR5(JL)
        Z1RADI  = -ZDESR(JL)*Z1RADI5*Z1RADI5
        ZBETAI  = Z1RADI * RFA55(2)
        ZBETAI5 = RFA55(1) + Z1RADI5 * RFA55(2)
        ZTOI  = ZQIP5*ZBETAI+ZBETAI5*ZQIP
        ZTOI5 = ZQIP5*ZBETAI5
      ENDIF

      ZTAUC(JL,JK) = ZTOI+ZTOL
      ZTAUC5(JL,JK) = ZTOI5+ZTOL5

      ZCOD5(JL,JJ) = ZCOD5(JL,JJ)+ZTAUC5(JL,JK)
      PCOD(JL,JJ) = PCOD(JL,JJ)+ZTAUC(JL,JK)

      PTAUC(JL,JK,JJ)=PCOD(JL,JJ)
    ENDDO
  ENDDO
ENDDO

! BEN - add check for optical depth above 100.
DO JJ=1,KMXCOUNT
  DO JL=1,KLEN
   IF(ZCOD5(JL,JJ) > 100._JPRB ) THEN
    PCOD(JL,JJ) = 0.0_JPRB
   ENDIF
  ENDDO
ENDDO

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