SUBROUTINE gpscalc_alphaTL(K_NOBS,K_NLEV,P_A,P_REFRAC,P_REFRAC_PRIME, &
                         & P_NR,P_NR_PRIME,P_ALPHA_PRIME)  
           
!**** *gpscalc_alphaTL* - part of the GPSRO observation operator.

!     S. Healy             ECMWF          2004/10/26
!     Based on a EUMETSAT GRAS-SAF routine that was Dr'd automatically by the CY27 merge.  

!     PURPOSE
!     -------
!     It evaluates the bending angle integral for each impact parameter

!**   INTERFACE
!     ---------

!     CALL gpscalc_alphaTL(K_NOBS,K_NLEV,P_A,P_REFRAC,P_REFRAC_PRIME, &
!                        & P_NR,P_NR_PRIME,P_ALPHA_PRIME)      

!     WHERE K_NOBS         =  number of observed bending angles 
!           K_NLEV         =  number of full model levels
!           P_A            =  impact parameter values
!           P_RERAC        =  refractivity on the full model levels
!           P_RERAC_PRIME  =  perturbed refractivity on the full model levels
!           P_NR           =  refractive index*radius on the full model levels
!           P_NR_PRIME     =  perturbed refractive index*radius on the full model levels
!           P_ALPHA_PRIME  =  bending angles


!     gpscalc_alphatl is called from gpsro_tl

!**   METHOD
!     ------
!     1) calculate the exponential decay of refractivity with nr between model levels
!     2) evaluates the bending angle integral for each impact parameter

!**   EXTERNALS
!     ---------
!     1) fcserf calculates the Gaussian error function

!**   MODIFICATIONS
!     -------------
!     Sean Healy      2004/10/26 : Original
!     Sean Healy      2009/03/03 : Bug-fix initialise "P_ALPHA_PRIME(:)  = RMDI" 
!     Sean Healy      2010/03/26 : Maximum kval introduced
!     -------------------------------------------------------------------------


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

USE YOMANCS  , ONLY : RMDI 

USE YOMCST   , ONLY : RPI

IMPLICIT NONE

! subroutine args. 

INTEGER(KIND=JPIM),INTENT(IN)    :: K_NOBS! size of ob. vector 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_NLEV! no. of refractivity levels 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_A(K_NOBS) ! impact parameter
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_REFRAC(K_NLEV) ! refractivity values on levels
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_REFRAC_PRIME(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_NR(K_NLEV) ! index * radius product
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_NR_PRIME(K_NLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_ALPHA_PRIME(K_NOBS) ! bending angle 
! local variables

INTEGER(KIND=JPIM) :: i,I_N,ibot,jbot,I_KBOT    ! counters
REAL(KIND=JPRB) :: Z_KVAL(K_NLEV-1)             ! refractivity decay rates 
REAL(KIND=JPRB) :: Z_KVAL_PRIME(K_NLEV-1)       ! perturbed "
REAL(KIND=JPRB) :: Z_ROOT_2PIA                  ! sqrt(2*pi*a) 
REAL(KIND=JPRB) :: Z_REF_LOW                    ! lower refractivity value
REAL(KIND=JPRB) :: Z_REF_LOW_PRIME              ! perturbed "
REAL(KIND=JPRB) :: Z_NR_LOW                     ! lower nr value
REAL(KIND=JPRB) :: Z_NR_LOW_PRIME               ! perturbed "
REAL(KIND=JPRB) :: Z_TUP,Z_TLOW                 ! upper/lower limits
REAL(KIND=JPRB) :: Z_TUP_PRIME,Z_TLOW_PRIME     ! perturbed "
REAL(KIND=JPRB) :: Z_DALPHA                     ! change in bending angle
REAL(KIND=JPRB) :: Z_DALPHA_PRIME               ! perturbed "
REAL(KIND=JPRB) :: Z_DIFF_ERF                   ! difference in error function values
REAL(KIND=JPRB) :: Z_DIFF_ERF_PRIME             ! perturbed "
REAL(KIND=JPRB) :: ZERF_UP,ZERF_LOW,ZT          ! new variables to remove eff func.call
REAL(KIND=JPRB) :: ZERF_UP_PRIME,ZERF_LOW_PRIME,ZT_PRIME                      

REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('GPSCALC_ALPHATL',0,ZHOOK_HANDLE)
!!P_ALPHA_PRIME(:)  = 0.0_JPRB

P_ALPHA_PRIME(:)  = RMDI  
Z_KVAL_PRIME(:)   = 0.0_JPRB 

jbot = 1

DO

  IF (P_REFRAC(jbot) > 0.0_JPRB .AND. P_NR(jbot) > 0.0_JPRB) EXIT
  
  jbot = jbot + 1

ENDDO

! cannot integrate through super refracting layer

I_KBOT = K_NLEV

DO i=K_NLEV,jbot+1,-1


  IF ((P_NR(I_KBOT) - P_NR(I_KBOT-1)) < 10.0_JPRB) EXIT 

  I_KBOT = I_KBOT - 1

ENDDO

jbot = MAX(jbot,I_KBOT)

! calculate the exponential decay rate between levels

DO i=jbot,K_NLEV-1

  Z_KVAL(i) = LOG(P_REFRAC(i)/P_REFRAC(i+1)) / &
   & MAX(1.0_JPRB,(P_NR(i+1)-P_NR(i)))  

! limit the kval   
   
  IF (Z_KVAL(i) > 1.0E-6_JPRB) THEN

    Z_KVAL_PRIME(i) = &
     & ((Z_KVAL(i)*(P_NR_PRIME(i)-P_NR_PRIME(i+1))) + &
     & (P_REFRAC_PRIME(i)/P_REFRAC(i)-              &
     & P_REFRAC_PRIME(i+1)/P_REFRAC(i+1)))/        &
     & MAX(1.0_JPRB,(P_NR(i+1)-P_NR(i)))  
            
  ELSE 

! ensure positive kval

    Z_KVAL(i) = 1.0E-6_JPRB 
   
    Z_KVAL_PRIME(i) = 0.0_JPRB         
            
  ENDIF  
  
!
! introduce maximum kval SBH
!  
  
  IF (Z_KVAL(i) > (0.157_JPRB/P_REFRAC(i))) THEN
       
     Z_KVAL(i) = 0.157_JPRB/P_REFRAC(i)

! tl 

     Z_KVAL_PRIME(i) = - 0.157_JPRB/P_REFRAC(i)**2*P_REFRAC_PRIME(i)
     
  ENDIF  


            
ENDDO

! now calculate the bending angle values

DO I_N=1,K_NOBS

  IF (P_A(I_N) < P_NR(jbot) .OR. P_A(I_N) > P_NR(K_NLEV) .OR. P_A(I_N) == RMDI) CYCLE  

  Z_ROOT_2PIA = SQRT(2.0_JPRB*RPI*P_A(I_N))

  ibot = jbot

  DO 

    IF ((P_NR(ibot+1) - P_A(I_N)) > 1.0_JPRB .OR. ibot == K_NLEV-1) EXIT 

    ibot=ibot+1

  ENDDO
   
!  set bending angle value  

  P_ALPHA_PRIME(I_N) = 0.0_JPRB
      
  DO i = ibot, K_NLEV-1
   
    IF ( i == ibot) THEN 
      
      Z_REF_LOW = P_REFRAC(i)*EXP(-Z_KVAL(i)*(P_A(I_N)-P_NR(i)))
     
      Z_REF_LOW_PRIME = Z_REF_LOW*               &
       & (P_REFRAC_PRIME(i)/P_REFRAC(i) -  &
       & Z_KVAL_PRIME(i)*(P_A(I_N)-P_NR(i)) + &
       & Z_KVAL(i)*P_NR_PRIME(i))    
     
      Z_NR_LOW = P_A(I_N)
     
      Z_NR_LOW_PRIME = 0.0_JPRB

    ELSE 
      
      Z_REF_LOW = P_REFRAC(i) 
     
      Z_REF_LOW_PRIME = P_REFRAC_PRIME(i)
     
      Z_NR_LOW  = P_NR(i) 
     
      Z_NR_LOW_PRIME = P_NR_PRIME(i)
     
    ENDIF
         
    Z_TUP = SQRT(Z_KVAL(i)*(P_NR(i+1)-P_A(I_N)))

    Z_TUP_PRIME = 0.5_JPRB*(Z_KVAL_PRIME(i)*(P_NR(i+1)-P_A(I_N)) + &
       & Z_KVAL(i)*P_NR_PRIME(i+1))/Z_TUP  

    Z_TLOW = 0.0_JPRB                         
      
    Z_TLOW_PRIME = 0.0_JPRB

    IF (i > ibot) THEN
      
      Z_TLOW = SQRT(Z_KVAL(i)*(P_NR(i)  -P_A(I_N)))
            
      Z_TLOW_PRIME = 0.5_JPRB*(Z_KVAL_PRIME(i)*(P_NR(i)-P_A(I_N)) + &
       & Z_KVAL(i)*P_NR_PRIME(i))/Z_TLOW       
      
    ENDIF 
    
! re-written to remove error function calls. 
    
    IF (i == ibot) THEN
 
       ZERF_LOW = 0.0_JPRB
       
       ZERF_LOW_PRIME = 0.0_JPRB 
 
       zt = 1.0_JPRB/(1.0_JPRB+0.47047_JPRB*Z_TUP)
       
       zt_prime = - zt/(1.0_JPRB+0.47047_JPRB*Z_TUP)*0.47047_JPRB*Z_TUP_PRIME
    
       ZERF_UP= &
      &1.0_JPRB-(0.3480242_JPRB-(0.0958798_JPRB-0.7478556_JPRB*zt)*zt)*zt*EXP(-(Z_TUP*Z_TUP))    

       ZERF_UP_PRIME = &
      &-(0.3480242_JPRB-(0.1917596_JPRB-2.2435668_JPRB*zt)*zt)*EXP(-(Z_TUP*Z_TUP))*zt_prime + & 
      &(0.3480242_JPRB-(0.0958798_JPRB-0.7478556_JPRB*zt)*zt)*zt*EXP(-(Z_TUP*Z_TUP))* &
      &2.0_JPRB*Z_TUP*Z_TUP_PRIME
 
    ELSEIF (i > ibot .AND. i < K_NLEV-1) THEN
    
   
! lower

       zt = 1.0_JPRB/(1.0_JPRB+0.47047_JPRB*Z_TLOW) 
       zt_prime = - zt/(1.0_JPRB+0.47047_JPRB*Z_TLOW)*0.47047_JPRB*Z_TLOW_PRIME

    
       ZERF_LOW = -(0.3480242_JPRB-(0.0958798_JPRB-0.7478556_JPRB*zt)*zt)*zt*EXP(-(Z_TLOW*Z_TLOW)) 

       ZERF_LOW_PRIME = &
      &-(0.3480242_JPRB-(0.1917596_JPRB-2.2435668_JPRB*zt)*zt)*EXP(-(Z_TLOW*Z_TLOW))*zt_prime + &
      &(0.3480242_JPRB-(0.0958798_JPRB-0.7478556_JPRB*zt)*zt)*zt*EXP(-(Z_TLOW*Z_TLOW))* &
      &2.0_JPRB*Z_TLOW*Z_TLOW_PRIME


! upper

       zt = 1.0_JPRB/(1.0_JPRB+0.47047_JPRB*Z_TUP)
       zt_prime = - zt/(1.0_JPRB+0.47047_JPRB*Z_TUP)*0.47047_JPRB*Z_TUP_PRIME
    
       ZERF_UP  = -(0.3480242_JPRB-(0.0958798_JPRB-0.7478556_JPRB*zt)*zt)*zt*EXP(-(Z_TUP*Z_TUP))    

       ZERF_UP_PRIME = &
      &-(0.3480242_JPRB-(0.1917596_JPRB-2.2435668_JPRB*zt)*zt)*EXP(-(Z_TUP*Z_TUP))*zt_prime + & 
      &(0.3480242_JPRB-(0.0958798_JPRB-0.7478556_JPRB*zt)*zt)*zt*EXP(-(Z_TUP*Z_TUP))* &
      &2.0_JPRB*Z_TUP*Z_TUP_PRIME
        
    ELSE

! includes extrapolation
 
       ZERF_UP = 0.0_JPRB
       
       ZERF_UP_PRIME = 0.0_JPRB
        
       zt = 1.0_JPRB/(1.0_JPRB+0.47047_JPRB*Z_TLOW) 
       zt_prime = - zt/(1.0_JPRB+0.47047_JPRB*Z_TLOW)*0.47047_JPRB*Z_TLOW_PRIME
    
       ZERF_LOW = -(0.3480242_JPRB-(0.0958798_JPRB-0.7478556_JPRB*zt)*zt)*zt*EXP(-(Z_TLOW*Z_TLOW)) 

       ZERF_LOW_PRIME = &
      &-(0.3480242_JPRB-(0.1917596_JPRB-2.2435668_JPRB*zt)*zt)*EXP(-(Z_TLOW*Z_TLOW))*zt_prime + &
      &(0.3480242_JPRB-(0.0958798_JPRB-0.7478556_JPRB*zt)*zt)*zt*EXP(-(Z_TLOW*Z_TLOW))* &
      &2.0_JPRB*Z_TLOW*Z_TLOW_PRIME

    
    ENDIF     
     
    Z_DIFF_ERF = ZERF_UP - ZERF_LOW
 
    Z_DIFF_ERF_PRIME = ZERF_UP_PRIME - ZERF_LOW_PRIME  
      
    Z_DALPHA    = &
     & + 1.0E-6_JPRB * Z_ROOT_2PIA * SQRT(Z_KVAL(i))  &
     & * Z_REF_LOW*EXP(Z_KVAL(i)*(Z_NR_LOW-P_A(I_N)))*Z_DIFF_ERF   
                           
    Z_DALPHA_PRIME = Z_DALPHA * (  &
     & Z_REF_LOW_PRIME/MAX(1.0E-10_JPRB,Z_REF_LOW) + &
     & Z_DIFF_ERF_PRIME/MAX(1.0E-10_JPRB,Z_DIFF_ERF) + &
     & Z_KVAL(i)*Z_NR_LOW_PRIME + &
     & (Z_NR_LOW-P_A(I_N) + 0.5_JPRB/Z_KVAL(i))* Z_KVAL_PRIME(i))                
     
    P_ALPHA_PRIME(I_N) = P_ALPHA_PRIME(I_N) + Z_DALPHA_PRIME
      
                  
  ENDDO


ENDDO

IF (LHOOK) CALL DR_HOOK('GPSCALC_ALPHATL',1,ZHOOK_HANDLE)

END SUBROUTINE gpscalc_alphaTL
