SUBROUTINE REFLSIM(KDLEN,KDBDY,KLEN,KDCOUNT,KCOUNT,KPNLV,PTF5,PQF5,PCLWF5,&
 & PCIWF5,PCSWF5,PCRWF5,PCGWF5,PGEOPF5,KDPP,PXPP)

!SUBROUTINE REFLSIM will contain observator operator for
! radar reflectivity
! M.Jurasek & E. Wattrelot 04/05/27
! needs XRHOLW, PRHODREF ?, PCIT

USE PARKIND1,ONLY : JPIM,  JPRB
USE YOMCST  ,ONLY : RPI,RA,RG,RTT
USE YOMDIM  ,ONLY : NFLEVG
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE YOMANCS ,ONLY : RMDI, RDEGREES ! 180/PI
USE YOMCLMICST, ONLY : MOMG
USE YOMDB   
!USE YOMLUN  ,ONLY : NULOUT
IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN) :: KDLEN,KDBDY,KLEN,KDCOUNT
INTEGER(KIND=JPIM),INTENT(IN) :: KDPP
INTEGER(KIND=JPIM),INTENT(IN),DIMENSION(KLEN) :: KCOUNT
INTEGER(KIND=JPIM),INTENT(IN),DIMENSION(KDLEN,KDBDY) :: KPNLV

REAL(KIND=JPRB),INTENT(IN),   DIMENSION(KDLEN,0:NFLEVG)     :: PTF5,PQF5
! the following line should actually be INTENT(IN), but it is so for debugging purposes
REAL(KIND=JPRB),INTENT(INOUT),DIMENSION(KDLEN,0:NFLEVG)     :: PCLWF5,PCIWF5,&
                                                         &PCSWF5,PCRWF5,PCGWF5
REAL(KIND=JPRB),INTENT(OUT),  DIMENSION(KDLEN,KDCOUNT,KDPP) :: PXPP 
REAL(KIND=JPRB),INTENT(IN),   DIMENSION(KDLEN,NFLEVG)       :: PGEOPF5
REAL(KIND=JPRB),DIMENSION(:), ALLOCATABLE :: ZWKGEOPF5 ! working array for PGEOPF5
REAL(KIND=JPRB)               :: ZHOOK_HANDLE

REAL(KIND=JPRB),DIMENSION(KDLEN,0:NFLEVG) :: ZREFL,ZLBDA,ZREFL_MELT_CONV
REAL(KIND=JPRB),DIMENSION(:), ALLOCATABLE :: ZWKREFL ! working array for ZREFL
REAL(KIND=JPRB) :: ZDTHETA, fcintgtrap ! beamwidth
REAL(KIND=JPRB) :: ZINTEXP ! intermediate variable
REAL(KIND=JPRB),DIMENSION(0:NFLEVG) :: ZTHETA ! angle at each model level 
!(could have more dimensions for parallelization purposes) can be suppressed 
REAL(KIND=JPRB),DIMENSION(:),ALLOCATABLE :: ZWKTHETA ! working array for ZTHETA
INTEGER(KIND=JPIM) :: JLEN,JCOUNT,JLEV,JI ! loop dummy counters for column, 
!obs, level and working arrays
INTEGER(KIND=JPIM) :: ILEVTOP  ! maximum model vertical level for reflectivities
INTEGER(KIND=JPIM) :: IMIN,IMAX,IBODY ! min and max levels for vertical
! interpolation (grosso modo beam vertical extension at column)
!INTEGER(KIND=JPIM) :: ICON ! error code for TRAP

!!! constants
REAL(KIND=JPRB),PARAMETER :: XRHOLW=1000._JPRB ! density of liquid water (kg/m^3)
REAL(KIND=JPRB) :: ZCXR=-1.0_JPRB
REAL(KIND=JPRB) :: ZFRAC_WATER
REAL(KIND=JPRB) :: XAR,XBR,XCCR,     XALPHAR,XNUR,XLBEXR,XLBR,XRTMINCLW
REAL(KIND=JPRB) :: XAI,XBI,          XALPHAI,XNUI,XLBEXI,XLBI,XRTMINCIW
REAL(KIND=JPRB) :: XAS,XBS,XCCS,XCXS,XALPHAS,XNUS,XLBEXS,XLBS,XRTMINCSW
REAL(KIND=JPRB) :: XAG,XBG,XCCG,XCXG,XALPHAG,XNUG,XLBEXG,XLBG,XRTMINCGW
REAL(KIND=JPRB) :: ZEQICE=0.224_JPRB,ZDMELT_FACT,ZEXP

REAL(KIND=JPRB) :: RAE ! Earth's effective radius (4a/3)
REAL(KIND=JPRB),PARAMETER :: ZCOEF=1. ! width for vertical interpolation

!!!! REMPLISSAGE DES VARIABLES (TEMPORAIRE)
!REAL(KIND=JPRB),PARAMETER :: STALT=150._JPRB
!REAL(KIND=JPRB),PARAMETER :: ANTENHT=29._JPRB
REAL(KIND=JPRB), DIMENSION(KDLEN) :: STALT,ANTENHT ! radar station altitude 
!and antena height
!REAL(KIND=JPRB),PARAMETER :: DISTANCE=30000._JPRB
REAL(KIND=JPRB), DIMENSION(KDLEN,KDCOUNT) :: DISTANCE,ELEVATION ! elevation 
!en degres 
! a convertir
!REAL(KIND=JPRB),PARAMETER :: ELEVATION=1.2_JPRB
!!!! FIN REMPLISSAGE DES VARIABLES (TEMPORAIRE)

#include "openmp_obs.h"

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

!*********************************************************
! 0. Initialization of constants (should be done outside)*
!*********************************************************
RAE=4._JPRB/3._JPRB*RA

ZREFL(:,:)=0._JPRB
PXPP(:,:,:)=RMDI
ILEVTOP = 15
!*       0.1     CHARACTERISTICS OF THE SPECIES
!                ------------------------------


!*       0.1.1    Raindrops characteristics

XAR = (RPI/6.0_JPRB)*XRHOLW
XBR = 3.0_JPRB

XCCR = 1.E7_JPRB    ! N0_r with XCXR = -1, implicitly


!*       0.1.2    Ice crystal characteristics


XAI = 0.82_JPRB      ! Plates
XBI = 2.5_JPRB       ! Plates 

!  Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly

!*       0.1.3    Snowflakes/aggregates characteristics


XAS = 0.02_JPRB
XBS = 1.9_JPRB

XCCS = 5.0_JPRB
XCXS = 1.0_JPRB

!*       0.1.4    Heavily rimed crystals characteristics


XAG = 19.6_JPRB  ! Lump graupel case
XBG = 2.8_JPRB   ! Lump graupel case

XCCG = 5.E5_JPRB
XCXG = -0.5_JPRB
! XCCG = 4.E4 ! Test of Ziegler (1988)
! XCXG = -1.0 ! Test of Ziegler (1988)

!!*       0.2     DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
!                 ----------------------------------------

!*       0.2.1    Raindrops distribution

XALPHAR = 1.0_JPRB  ! Exponential law
XNUR    = 1.0_JPRB  ! Exponential law

!*       0.2.2    Ice crystal distribution

XALPHAI = 3.0_JPRB  ! Gamma law for the ice crystal volume
XNUI    = 3.0_JPRB  ! Gamma law with little dispersion

XALPHAS = 1.0_JPRB  ! Exponential law
XNUS    = 1.0_JPRB  ! Exponential law

XALPHAG = 1.0_JPRB  ! Exponential law
XNUG    = 1.0_JPRB  ! Exponential law

!*       0.2.3    Constants for shape parameter

XLBEXR = 1.0_JPRB/(-1.0_JPRB-XBR)
XLBR   = ( XAR*XCCR*MOMG(XALPHAR,XNUR,XBR) )**(-XLBEXR)

XLBEXI = 1.0_JPRB/(-XBI)
XLBI   = ( XAI*MOMG(XALPHAI,XNUI,XBI) )**(-XLBEXI)

XLBEXS = 1.0_JPRB/(XCXS-XBS)
XLBS   = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)

XLBEXG = 1.0_JPRB/(XCXG-XBG)
XLBG   = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG)

!*       0.2.4    Minimal values allowed for the mixing ratios

!ALLOCATE( XRTMIN(6) )

!XRTMIN(1) = 1.0E-20
!XRTMIN(2) = 1.0E-20
XRTMINCLW = 1.0E-10_JPRB
XRTMINCIW = 1.0E-10_JPRB
XRTMINCSW = 1.0E-10_JPRB
XRTMINCGW = 1.0E-10_JPRB

!**********************************************************************
! 1. Compute reflectivities on each model vertical level (0D operator)*
!**********************************************************************
! we can think of restricting computations to those actually needed.
! 1.1. Rain

DO JLEN=1,KLEN
   DO JLEV=1,NFLEVG
     IF (PQF5(JLEN,JLEV)<=0.9_JPRB) THEN
     PCRWF5(JLEN,JLEV)=PCRWF5(JLEN,JLEV)/(1.0_JPRB-PQF5(JLEN,JLEV))*1.2_JPRB
     ENDIF
   ENDDO
ENDDO
DO JLEN=1,KLEN
  DO JLEV=1,NFLEVG
    IF (PCRWF5(JLEN,JLEV) > XRTMINCLW) THEN
      ZLBDA(JLEN,JLEV) = XLBR*( PCRWF5(JLEN,JLEV) )**XLBEXR
      IF (ZLBDA(JLEN,JLEV) < 1.0E120_JPRB) THEN
     ZREFL(JLEN,JLEV) = XCCR*(ZLBDA(JLEN,JLEV)**(ZCXR-6.0_JPRB))*MOMG(XALPHAR &
    &  ,XNUR,6.0_JPRB)
      ENDIF
    ENDIF
  ENDDO
ENDDO
! 1.2. Pristine ice (problematic because of PCIT)
!!$WHERE(PCIWF5(:,:) > XRTMINCIW)
!!$   ZDMELT_FACT = ( XBI/3.0 )*( (6.0*XAI)/(RPI*XRHOLW) )**(7.0/3.0)
!!$   ZEXP = 7.0*XBI/3.0-1.0
!!$   ZLBDA(:,:) = XLBI*( PCLWF5(:,:)/PCIT(:,:) )**XLBEXI
!!$   ZREFL(:,:) = ZREFL(:,:)+ZEQICE*ZDMELT_FACT                 &
!!$      &  *PCIT(:,:)*(ZLBDA(:,:)**(-ZEXP))*MOMG(XALPHAI,XNUI,ZEXP)
!!$END WHERE

! 1.3. Snow ! ajout eric wattrelot pour rapports de melange

DO JLEN=1,KLEN
  DO JLEV=1,NFLEVG
   IF (PQF5(JLEN,JLEV)<=0.9_JPRB) THEN
   PCSWF5(JLEN,JLEV)=PCSWF5(JLEN,JLEV)/(1.0_JPRB-PQF5(JLEN,JLEV))*1.2_JPRB
   ENDIF
  ENDDO
ENDDO
ZDMELT_FACT = ( XBS/3.0_JPRB )*( (6.0_JPRB*XAS)/(RPI*XRHOLW) )**&
&(7.0_JPRB/3.0_JPRB)
ZEXP = 7.0_JPRB*XBS/3.0_JPRB-1.0_JPRB

DO JLEN=1,KLEN
  DO JLEV=1,NFLEVG
    IF (PCSWF5(JLEN,JLEV) > XRTMINCSW) THEN
       ZLBDA(JLEN,JLEV) = XLBS*( PCSWF5(JLEN,JLEV) )**XLBEXS
       IF (ZLBDA(JLEN,JLEV) < 1.0E120_JPRB) THEN
          ZREFL(JLEN,JLEV) = ZREFL(JLEN,JLEV)+ZEQICE*ZDMELT_FACT      &
        &    *XCCS*(ZLBDA(JLEN,JLEV)**(XCXS-ZEXP))*MOMG(XALPHAS,XNUS,ZEXP)
       ENDIF
    ENDIF
  ENDDO
ENDDO

! 1.4. Graupel

DO JLEN=1,KLEN
    DO JLEV=1,NFLEVG
      IF (PQF5(JLEN,JLEV)<=0.9_JPRB) THEN
      PCGWF5(JLEN,JLEV)=PCGWF5(JLEN,JLEV)/(1.0_JPRB-PQF5(JLEN,JLEV))*1.2_JPRB
      ENDIF
    ENDDO
ENDDO

ZFRAC_WATER = 0.14
ZDMELT_FACT = ( XBG/3.0_JPRB )*( (6.0_JPRB*XAG)/(RPI*XRHOLW) )**(7.0_JPRB/3.0_JPRB)

 DO JLEN=1,KLEN
      DO JLEV=1,NFLEVG
        IF (PTF5(JLEN,JLEV) > RTT ) THEN
        ZREFL_MELT_CONV(JLEN,JLEV) = ((1.0-ZFRAC_WATER)*ZEQICE+ZFRAC_WATER)*ZDMELT_FACT
        ELSE
        ZREFL_MELT_CONV(JLEN,JLEV) = ZEQICE*ZDMELT_FACT
        ENDIF
       ENDDO
 ENDDO

ZEXP = 7.0_JPRB*XBG/3.0_JPRB-1.0_JPRB
!WHERE(PCGWF5(:,:) > XRTMINCGW)
!   ZLBDA(:,:) = XLBG*( PCGWF5(:,:) )**XLBEXG
!   ZREFL(:,:) = ZREFL(:,:)+ZREFL_MELT_CONV(:,:) &
!   &     *XCCG*(ZLBDA(:,:)**(XCXG-ZEXP))*MOMG(XALPHAG,XNUG,ZEXP)
!ENDWHERE
DO JLEN=1,KLEN
  DO JLEV=1,NFLEVG
    IF (PCGWF5(JLEN,JLEV) > XRTMINCGW) THEN 
     ZLBDA(JLEN,JLEV) = XLBG*( PCGWF5(JLEN,JLEV) )**XLBEXG
      IF (ZLBDA(JLEN,JLEV) < 1.0E120_JPRB) THEN
          ZREFL(JLEN,JLEV) = ZREFL(JLEN,JLEV)+ZREFL_MELT_CONV(JLEN,JLEV) &
        &     *XCCG*(ZLBDA(JLEN,JLEV)**(XCXG-ZEXP))*MOMG(XALPHAG,XNUG,ZEXP)
      ELSE 
      ENDIF
    ENDIF 
 ENDDO
ENDDO

! 1.5. Unit conversion
!ZREFL(:,:) = 10.0*LOG10( 1.E18_JPRB*ZREFL(:,:) ) ! Z_e in dBZ


!*******************************************************
! 2. Weight reflectivities over the vertical (Gaussian)*
!*******************************************************
!2.1 
DO JLEN=1,KLEN ! loop over model columns of observations
   DO JCOUNT=1,KCOUNT(JLEN) ! loop over each observation data
      STALT(JLEN)=SATHDR(JLEN,MDB_STALT_AT_RADAR_STATION)
      ANTENHT(JLEN)=SATHDR(JLEN,MDB_ANTENHT_AT_RADAR_STATION)
      IBODY = MLNKH2B(JLEN) + KPNLV(JLEN,JCOUNT)-1
      DISTANCE(JLEN, JCOUNT)=SATBODY(IBODY,MDB_DISTANCE_AT_RADAR_BODY) 
      ELEVATION(JLEN,JCOUNT)=SATBODY(IBODY,MDB_ELEVATION_AT_RADAR_BODY)
      IMIN=1
      IMAX=1
      ZDTHETA=0.8_JPRB ! en degres a convertir directly from ODB (BEAMWIDTH)
      DO JLEV=ILEVTOP,NFLEVG
! ajout de la conversion si refl non nulle
!         IF (ZREFL(JLEN,JLEV) > 0) THEN 
!            ZREFL(JLEN,JLEV)=&
!           &10.0*LOG10( 1.E18_JPRB*ZREFL(JLEN,JLEV) ) ! Z_e in dBZ
        IF (DISTANCE(JLEN,JCOUNT) > 0.) THEN
         ZTHETA(JLEV)=((PGEOPF5(JLEN,JLEV)/RG-STALT(JLEN)-ANTENHT(JLEN)+RAE)**2&
           &-DISTANCE(JLEN,JCOUNT)**2-RAE**2)/2._JPRB/DISTANCE(JLEN,JCOUNT)/RAE &
             & -ELEVATION(JLEN,JCOUNT)/RDEGREES ! directly from ODB
        ELSE 
         ZTHETA(JLEV) = 0.
        ENDIF
         IF((ZTHETA(JLEV)*RDEGREES) >= .5_JPRB*ZCOEF*ZDTHETA) IMIN=JLEV
         IF((ZTHETA(JLEV)*RDEGREES) >= (-0.5_JPRB)*ZCOEF*ZDTHETA) IMAX=JLEV
      ENDDO
! next 2 lines to be removed
!IMIN=5
!IMAX=10
! we have to reshape arrays because of intrinsic TRAP - perhaps there exists a better method
      IF (IMIN < IMAX) THEN 
      ALLOCATE(ZWKGEOPF5(IMIN:IMAX),ZWKREFL(IMIN:IMAX),ZWKTHETA(IMIN:IMAX))
      DO JI=IMIN,IMAX
         ZWKGEOPF5(JI)=PGEOPF5(JLEN,IMAX+IMIN-JI)
!          ZWKGEOPF5(JI)=PGEOPF5(JLEN,JI)
         ZWKREFL(JI)=ZREFL(JLEN,IMAX+IMIN-JI)
!          ZWKREFL(JI)=ZREFL(JLEN,JI)
         ZWKTHETA(JI)=ZTHETA(IMAX+IMIN-JI)
!          ZWKTHETA(JI)=ZTHETA(JI)
      ENDDO

!      CALL DTRAP(ZWKGEOPF5(:)/RG,ZWKREFL(:)* &
!         &  EXP(-8._JPRB*LOG(2._JPRB)*(ZWKTHETA(:)/ZDTHETA*RDEGREES)**2),&
!         &  IMAX-IMIN+1,PXPP(JLEN,JCOUNT,1),ICON)
!**********
! use new function from module YOMINTGT
!*
       PXPP(JLEN,JCOUNT,1) = fcintgtrap(ZWKGEOPF5(:)/RG,ZWKREFL(:)* &
          &  EXP(-8._JPRB*LOG(2._JPRB)*(ZWKTHETA(:)/ZDTHETA*RDEGREES)**2),&
          &  IMAX-IMIN+1)
!*
!      IF(ICON/=0) THEN
!         WRITE(NULOUT,*)"ERROR IN TRAP (MODULE REFLSIM.F90) 1"
!         print*,"N, theta, jlen, ILEN, jcount",IMAX-IMIN+1,ZDTHETA,jlen,KLEN,jcount
!          WRITE(NULOUT,*)"N, theta, jlen, ILEN, jcount",IMAX-IMIN+1,ZDTHETA,jlen,KLEN,jcount
!         print*,"GEOP",ZWKGEOPF5(IMIN:IMAX)/RG
!          WRITE(NULOUT,*)"GEOP",ZWKGEOPF5(IMIN:IMAX)/RG
!         WRITE(NULOUT,*)"REFL",ZWKREFL(IMIN:IMAX)* &
!            &  EXP(-8._JPRB*LOG(2._JPRB)*(ZWKTHETA(IMIN:IMAX)/ZDTHETA*RDEGREES)**2)
!         WRITE(NULOUT,*)"THET",&
!          &EXP(-8._JPRB*LOG(2._JPRB)*(ZWKTHETA(IMIN:IMAX)/ZDTHETA*RDEGREES)**2)
!      ENDIF
!      CALL DTRAP(ZWKGEOPF5(:)/RG,                       &
!        &   EXP(-8._JPRB*LOG(2._JPRB)*(ZWKTHETA(:)/ZDTHETA*RDEGREES)**2),&
!        &   IMAX-IMIN+1,ZINTEXP            ,ICON) ! there are more efficient methods to integrate this, but we want to keep consistency
!      IF(ICON/=0) PRINT*,"ERROR IN TRAP (MODULE REFLSIM.F90) 2"
!************
! use new function from module YOMINTGT
!*
            ZINTEXP = fcintgtrap(ZWKGEOPF5(:)/RG,                       &
               &   EXP(-8._JPRB*LOG(2._JPRB)*(ZWKTHETA(:)/ZDTHETA*RDEGREES)**2),&
               &   IMAX-IMIN+1)
!*
!************
      DEALLOCATE(ZWKGEOPF5,ZWKREFL,ZWKTHETA)
      PXPP(JLEN,JCOUNT,1)=PXPP(JLEN,JCOUNT,1)/ZINTEXP
! conversion des unites des reflectivites si sup a 1 mm6/m2
         IF (PXPP(JLEN,JCOUNT,1)>=1.E-18_JPRB) THEN 
              PXPP(JLEN,JCOUNT,1)=10.0*LOG10( 1.E18_JPRB*PXPP(JLEN,JCOUNT,1))
         ELSE
         PXPP(JLEN,JCOUNT,1)=0._JPRB ! refl nulle si negative
         ENDIF      
      ENDIF ! end condition on imin, imax else refl is rmdi
   ENDDO
ENDDO

! other method: interpolation of Z on the column and analytic integration of Z*exp(...).

!PXPP(:,:,:)=0_JPRB

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


END SUBROUTINE  REFLSIM
