SUBROUTINE NOX2NO2TL(KDLEN,KLEN,KDCOUNT,KCOUNT,PRESO,&
 & PXP,PXPD,&
 & PTF,PSOE,PAL,PCOD5,PTAUC5,PCCF5,YDGEMSPROF,&
 & PNO2, &
 & PRESH5,PRESF5,PXP5,PXPD5,PTF5,YDGEMSPROF5)

!**** NOX2NO2TL - POST-PROCESSING

!     D. VASILJEVIC          ECMWF           91-01-03
!     (TANGENT LINEAR VERSION - MIKE FISHER ECMWF)

!     PURPOSE
!     -------

!        FIND OUT AN EQUIVALENT MODEL PARAMETER FOR A GIVEN OBSERVED.

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

!        CALL NOX2NO2TL(KDLEN,KLEN,KDCOUNT,KCOUNT,PRESO,
!    I                 PXP,PXPD,
!    I                 PCLWF,PCIWF,PCCF,PTSTAR,PT0,PLNPR,PALPH,
!    O                 KDPP,PXPP,
!    R                 PRESH5,PRESF5,PXP5,PXPD5,PUF5,PVF5,PTF5,PQF5,PO3F5,
!    R                 PCLWF5,PCIWF5,PCCF5,PTSTAR5,PT05,PLNPR5,PALPH5,
!                      YDGEMSPROF,YDGEMSPROF5)

!     WHERE KDLEN   : FIRST DIMENSION (Observations)
!           KLEN    : ACTUAL NUMBER OF OBSERVATIONS
!           KDCOUNT : SECOND DIMENSION (Data)
!           KCOUNT  : COUNTER FOR THE PARTICULAR OBS. PARAMETER
!           PRESO   : OBSERVED PRESSURES
!           PRESH   : HALF LEVEL PRESSURES
!           PRESF   : FULL LEVEL PRESSURES
!           PXP     : INTERMEDIATE ARRAY
!           PXPD    : ..................
!           PUF     : U AT MODEL FULL LEVELS
!           PVF     : V AT MODEL FULL LEVELS
!           PTF     : T AT MODEL FULL LEVELS
!           PQF     : Q AT MODEL FULL LEVELS
!           PO3F    : O3 AT MODEL FULL LEVELS
!           PCLWF   : CLOUD LIQUID WATER AT MODEL FULL LEVELS
!           PCIWF   : CLOUD ICE AT MODEL FULL LEVELS
!           PCCF    : CLOUD COVER AT MODEL FULL LEVELS
!           PTSTAR  : T*
!           PT0     : T0
!           PLNPR   : LOG. OF THE RATIO OF PRESSURE
!           PALPH   : COEFFICIENTS OF THE HYDROSTATICS
!           KDPP    : Number of fields, dimension of PXPP.
!           PXPP    : POST-PROCESSED VARIABLES
!           YDGEMSPROF   : GEMS PROFILES 
!           YDGEMSPROF5   : GEMS PROFILES 

!        NOX2NO2TL IS CALLED FROM HOPTL

!**   METHOD
!     ------

!        CALL TO AN APPROPIRIATE POST-PROCESSING ROUTINE

!**   EXTERNALS
!     ---------

!        PPFLEV   - FIND PRESSURE LEVEL UNDER SPECIFIED PRESSURES
!        PPUVTL   - U,V POST-PROCESSING
!        PPTTL    - T         "
!        PPRHTL   - RH        "
!        PPRQTL   - Q         "
!        PPPWCTL  - PWC       "
!        PPGEOPTL - Z         "
!        GPRCPTL  - COMPUTE R, CP AND KAPPA

!**   MODIFICATIONS
!     -------------
!     E.Andersson 92-06-22 : Introduce PWC
!     E.Andersson 96-02-07 : Remove 'V'-option
!     FV971113 - Correct PXPD,PXPD5 dimensions
!     FV          97-04-27 :  Call to PPRHTL corrected
!     E.Andersson 97-11-14 : GOM-variables more flexible
!     E.Holm      98-05-08 : Introduce intrgrated ozone option (TO3)
!     E.Andersson 98-06-11 : Pass dimension as argument
!     E.Andersson 99-07-02 : Incorporate clouds
!     M.Hamrud    15-Jan-2006  Revised GPRCP
!     D.Tan       02-Mar-2007  Introduce HLoS (horizontal line-of-sight wind component)

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

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

USE YOMDIM   , ONLY : NFLEVG   ,NPPM
USE YOMLUN   , ONLY : NULERR
USE TYPE_GEMS_PROFILES
USE YOM_YGFL , ONLY : NGRG,YGRG_NL
USE YOECLD   , ONLY : REPSEC
USE YOERDI   , ONLY : REPCLC
IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDCOUNT
INTEGER(KIND=JPIM),INTENT(IN)    :: KCOUNT(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESO(KDLEN,KDCOUNT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXP(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXPD(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSOE(KDLEN)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAL(KDLEN)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOD5(KDLEN)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUC5(KDLEN,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCF5(KDLEN,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PNO2(KDLEN,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESH5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXP5(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXPD5(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF5(KDLEN,0:NFLEVG) 

TYPE (TYPE_GEMSPROF), INTENT(IN), OPTIONAL :: YDGEMSPROF(KDLEN,NGEMS)
TYPE (TYPE_GEMSPROF), INTENT(IN), OPTIONAL :: YDGEMSPROF5(KDLEN,NGEMS)
!     ------------------------------------------------------------------

REAL(KIND=JPRB)  :: ZNOX(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)  :: ZGO3(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)  :: ZNOX5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)  :: ZGO35(KDLEN,0:NFLEVG) 
INTEGER(KIND=JPIM), ALLOCATABLE :: ILEVB (:,:,:)
LOGICAL, ALLOCATABLE :: LLBELO(:,:),LLBLOW(:),LLBELS(:,:),LLBLES(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZLNPRESO(:,:)
INTEGER(KIND=JPIM) :: ILEN,IMXCNT,JLEN
INTEGER(KIND=JPIM) :: JLEVP,JLEV,JGRG
REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB), ALLOCATABLE :: ZCCINT5(:,:)
INTEGER(KIND=JPIM) :: JGEMS,IND_GO3,IND_NOX,ind_go3_gems,ind_nox_gems
REAL(KIND=JPRB) :: ZCOL5(KDLEN,0:NFLEVG),ZCOL(KDLEN,0:NFLEVG)
REAL(KIND=JPRB) :: ZJNO25(KDLEN,NFLEVG),ZJNO2(KDLEN,NFLEVG)


#include "abor1.intfb.h"
#include "ppflev.intfb.h"
#include "gpnoxtl.intfb.h"
#include "gppwc.intfb.h"
#include "gppwctl.intfb.h"
#include "grg_jno2_cloud.intfb.h"
#include "grg_jno2_cloudtl.intfb.h"


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

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

!     ------------------------------------------------------------------
!*    1.  PREPARATION
!*    1.1 MAX. NO. OF LEVELS

ILEN   = KLEN
IMXCNT = MAXVAL(KCOUNT(1:ILEN))
IF(IMXCNT == 0) GOTO 9
IF(IMXCNT > 1) THEN
  WRITE(NULERR,*) 'NOX2NO2TL: ROUTINE DOES NOT WORK FOR IMXCNT>1. IMXCNT=',IMXCNT
  CALL ABOR1('NOX2NO2TL: ROUTINE DOES NOT WORK FOR IMXCNT>1.')
ENDIF

!*    1.2 FIND OUT PRESSURE LEVEL BELOW SPECIFIED (OBSERVED) PRESSURES

ALLOCATE(ILEVB(KDLEN,IMXCNT,NPPM))
ALLOCATE(LLBELO(KDLEN,IMXCNT))
ALLOCATE(LLBELS(KDLEN,IMXCNT))
ALLOCATE(LLBLOW(IMXCNT))
ALLOCATE(LLBLES(IMXCNT))
CALL PPFLEV(KDLEN,1,ILEN,NFLEVG,IMXCNT,&
 & PRESO,PRESH5,PRESF5,&
 & ILEVB,&
 & LLBELO,LLBELS,LLBLOW,LLBLES)  

!*    1.3 LN(P)

ALLOCATE(ZLNPRESO(KDLEN,IMXCNT))
DO JLEVP=1,IMXCNT
  ZLNPRESO(1:ILEN,JLEVP) = LOG(PRESO(1:ILEN,JLEVP))
ENDDO

!*    1.4 TOTAL CLOUD COVER

!*    1.4.1 Locate NOx and GO3 in GRG array
IND_NOX=-1
DO JGRG=1,NGRG
  IF(TRIM(YGRG_NL(JGRG)%cname) =='NOX') IND_NOX=JGRG
ENDDO
IF (IND_NOX==-1) THEN
  WRITE(NULERR,*) 'NOX2NO2TL: PROBLEM WITH NOX OPERATOR. NOX FIELD NEEDED BUT DOES NOT EXIST.'
  CALL ABOR1('NOX2NO2TL: PROBLEM WITH NOX OPERATOR. NOX FIELD DOES NOT EXIST')
ENDIF
IND_GO3=-1
DO JGRG=1,NGRG
  IF(TRIM(YGRG_NL(JGRG)%cname) =='GO3') IND_GO3=JGRG
ENDDO
IF (IND_GO3==-1) THEN
  WRITE(NULERR,*) 'NOX2NO2TL: PROBLEM WITH NOX OPERATOR. GO3 FIELD NEEDED BUT DOES NOT EXIST.'
  CALL ABOR1('NOX2NO2TL: PROBLEM WITH NOX OPERATOR. GO3 FIELD DOES NOT EXIST')
ENDIF

JGRG=0
DO JGEMS=1,NGEMS
  IF(YDGEMSPROF5(1,JGEMS)%CSPECIES=='GRG') THEN
    JGRG=JGRG+1
    IF(JGRG==IND_NOX) THEN
      IND_NOX_GEMS=JGEMS
      DO JLEN=1,ILEN
        ZNOX(JLEN,0)=0.0_JPRB
        ZNOX(JLEN,1:NFLEVG)=YDGEMSPROF(JLEN,JGEMS)%MODELPROF(:)
        ZNOX5(JLEN,0)=YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(1)
        ZNOX5(JLEN,1:NFLEVG)=YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(:)
      ENDDO
    ENDIF
    IF(JGRG==IND_GO3) THEN
      DO JLEN=1,ILEN
      IND_GO3_GEMS=JGEMS
        ZGO3(JLEN,0)=0.0_JPRB
        ZGO3(JLEN,1:NFLEVG)= YDGEMSPROF(JLEN,JGEMS)%MODELPROF(:)
        ZGO35(JLEN,0)= YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(1)
        ZGO35(JLEN,1:NFLEVG)= YDGEMSPROF5(JLEN,JGEMS)%MODELPROF(:)
      ENDDO
    ENDIF
  ENDIF
ENDDO

!*    1.4.2 Calculate integrated cloud cover above level - adapted from cldpp.f90
ALLOCATE(ZCCINT5(KDLEN,NFLEVG))
DO JLEN=1,ILEN
  ZCCINT5(JLEN,1)=1.0_JPRB-MIN(MAX(PCCF5(JLEN,1),REPCLC),1.0_JPRB-REPCLC)
ENDDO

DO JLEV=2,NFLEVG
  DO JLEN=1,ILEN
    IF(PCCF5(JLEN,JLEV-1) < 1.0_JPRB-REPSEC) THEN
      ZCCINT5(JLEN,JLEV)=ZCCINT5(JLEN,JLEV-1)* &
       & (1.0_JPRB-MAX(PCCF5(JLEN,JLEV),PCCF5(JLEN,JLEV-1)))&
       & /(1.0_JPRB-PCCF5(JLEN,JLEV-1))
    ENDIF
  ENDDO
ENDDO

DO JLEV=1,NFLEVG
 DO JLEN=1,ILEN
  ZCCINT5(JLEN,JLEV)=1.0_JPRB-ZCCINT5(JLEN,JLEV)
 ENDDO
ENDDO

!*    2. Convert model level NOx to NO2

!*    2.1 Compute layer O3 ON MODEL HALF LEVELS for use in GRG_JNO2. ZCOL5=0 AT TOP OF MODEL.

ZCOL5(:,:)=0._JPRB
ZCOL(:,:)=0._JPRB
CALL GPPWC(KDLEN,1,ILEN,NFLEVG,ZCOL5,ZGO35(1,1),PXP5)
CALL GPPWCTL(KDLEN,1,ILEN,NFLEVG,ZCOL,ZGO3(1,1),PXP,ZGO35(1,1),PXP5)

!*    2.2   Compute photolysis frequency for NO2

ZJNO25(:,:)=0._JPRB
ZJNO2(:,:)=0._JPRB
CALL GRG_JNO2_CLOUD(KDLEN,1,ILEN,NFLEVG,ZCOL5(1,1),PTF5(1,1),PSOE,PAL,&
 & ZCCINT5,PTAUC5,PCOD5,ZJNO25,PXP5)

CALL GRG_JNO2_CLOUDTL(KDLEN,1,ILEN,NFLEVG,ZCOL(1,1),PTF(1,1),PSOE,PAL,&
 & ZJNO2,PXP,&
 & ZCOL5(1,1),PTF5(1,1),ZCCINT5,PTAUC5,PCOD5,PXP5)

!*    2.3 Convert model level NOX to NO2
CALL GPNOXTL(KDLEN,1,ILEN,NFLEVG,PNO2,&
 & PTF(1,1),ZGO3(1,1),ZNOX(1,1),PSOE,ZJNO2,PXP,&
 & PTF5(1,1),ZGO35(1,1),ZNOX5(1,1),ZJNO25,PXP5)

DO JLEN=1,ILEN
  PNO2(JLEN,0)=PNO2(JLEN,1)
ENDDO

!*    3.  FINALLY, DEALLOCATE AND RETURN

DEALLOCATE(ILEVB,LLBELO,LLBELS,LLBLOW,LLBLES)
IF(ALLOCATED(ZLNPRESO)) DEALLOCATE(ZLNPRESO)

9 CONTINUE

IF (LHOOK) CALL DR_HOOK('NOX2NO2TL',1,ZHOOK_HANDLE)
END SUBROUTINE NOX2NO2TL
