SUBROUTINE GEMS_INIT( KIDIA, KFDIA, KLEV, KLON, KTRAC, PCO2O, PCO2B, PCO2A, &
   &  PCO2F, PCH4, PCH4F, PSF6, PGFLFLX, PGEMU, PLSM, KGRG, KTRACER, KAERO, PLRCH4, &
   &  PGFL, PTENGFL, PCEN, PTENC, PTENC_SKF, PCFLX, PSCAV, PGRGTEND)

!**   INTERFACE.
!     ----------
!          *GEMS_INIT* IS CALLED FROM *CALLPAR/TL/AD*.

! INPUTS:
!  -------

! INPUTS/OUTPUTS:

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

!     Externals.
!     ---------


!     Author
!    --------
!         2008-10-15, R. Engelen 

!     Modifications :
!    ----------------
!         2009-03-07, P. de Rosnay offline jacobians in SEKF surface analysis
!         2009-10-07, P. Bechtold:  Initialisation of scavenging coefficients
!                                   for wash out/ wet deposition    
!

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

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

USE YOM_YGFL , ONLY : LFIRE, NAERO, NGHG, NGRG, NGRG_CPLO4, YGRG,YGRGTEND, &
 & YGHG, YAERO, YTRAC , NTRAC, LGRGSFC, NACTAERO, LCH4SFC, YGFL, YLRCH4, YLRCH4_NL, LCO2SFC
USE YOEAERSNK ,ONLY : RFRDD, RFRSS, RFROM, RFRBC, RFRSO4, RFRIF
USE YOEAERSRC ,ONLY : NINDAER
USE YOMGRB, ONLY : NGRBGHG
USE YOMPHY2  , ONLY : TSPHY

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2O(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2B(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2A(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2F(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCH4(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCH4F(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSF6(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFLFLX(KLON,NGRG+NTRAC)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEMU(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON)
REAL(KIND=JPRB), INTENT(IN)      :: PGFL(KLON,KLEV,YGFL%NDIM), PTENGFL(KLON,KLEV,YGFL%NDIM1)
REAL(KIND=JPRB), INTENT(INOUT)      :: PLRCH4(KLON,KLEV)

! In the declaration below the INTENT attribute has been removed to comply 
! strict f95 standards. The attribute INTENT(INOUT) should be put back after all 
! compiler (especially NEC) support this extension. - R. El Khatib 04-Jun-2009
REAL(KIND=JPRB), POINTER :: PCEN(:,:,:),PTENC(:,:,:),PCFLX(:,:) & 
        &, PGRGTEND(:,:,:), PSCAV(:), PTENC_SKF(:,:,:)

REAL(KIND=JPRB) :: ZABS_SINLAT, ZTDECAY
INTEGER(KIND=JPIM), INTENT(INOUT) :: KTRAC
INTEGER(KIND=JPIM) :: ITRC, ICO2, ICH4, ISF6, IRA
INTEGER(KIND=JPIM), INTENT(OUT) :: KGRG(NGRG), KAERO(NAERO), KTRACER(NTRAC)
INTEGER(KIND=JPIM) :: JL,JK, JEXT, ITRAC, JN, ITYP, IBIN

REAL(KIND=JPRB) :: ZHOOK_HANDLE


!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('GEMS_INIT',0,ZHOOK_HANDLE)

KTRAC=0
ICO2=0
ICH4=0
ISF6=0
IRA=0
KAERO(:)=0
KGRG(:)=0
KTRACER(:)=0
   
! Allocate general variables for tracer transport:
! IMPORTANT: Tracer order is : CO2 - -other tracers - react Gases - Aerosol - extra GFL

DO JEXT=1,NGHG
  KTRAC=KTRAC+1
  IF(YGHG(JEXT)%IGRBCODE == NGRBGHG(1)) ICO2=KTRAC
  IF(YGHG(JEXT)%IGRBCODE == NGRBGHG(2)) ICH4=KTRAC
ENDDO
DO JEXT=1,NTRAC
  KTRAC=KTRAC+1
  IF(YTRAC(JEXT)%IGRBCODE == 210181 ) IRA=KTRAC
  IF(YTRAC(JEXT)%IGRBCODE == 210182 ) ISF6=KTRAC
  KTRACER(JEXT)=KTRAC
ENDDO
DO JEXT=1,NGRG
 KTRAC=KTRAC+1
 KGRG(JEXT)=KTRAC
ENDDO
DO JEXT=1,NAERO
 KTRAC=KTRAC+1
 KAERO(JEXT)=KTRAC
ENDDO

ALLOCATE( PCEN(KLON,KLEV,KTRAC) )
ALLOCATE( PTENC(KLON,KLEV,KTRAC) )
ALLOCATE( PTENC_SKF(KLON,KLEV,KTRAC) )
ALLOCATE( PCFLX(KLON,KTRAC) )
ALLOCATE( PSCAV(KTRAC) )
PCFLX(KIDIA:KFDIA,1:KTRAC)=0.0_JPRB
PCEN (KIDIA:KFDIA,1:KLEV,1:KTRAC)=0.0_JPRB
PTENC(KIDIA:KFDIA,1:KLEV,1:KTRAC)=0.0_JPRB

! allocate GRG tendencies in coupled mode
IF (NGRG_CPLO4 > 0 ) THEN
 ALLOCATE( PGRGTEND(KLON,KLEV,NGRG_CPLO4) )
 PGRGTEND(KIDIA:KFDIA,1:KLEV,1:NGRG_CPLO4)=0.0_JPRB
ENDIF

IF(ICO2 > 0 .AND. LCO2SFC) THEN      ! CO2 surface fluxes
  DO JL=KIDIA,KFDIA
    IF(PCO2O(JL) > -9000._JPRB) PCFLX(JL,ICO2)=PCFLX(JL,ICO2)+PCO2O(JL)
    IF(PCO2B(JL) > -9000._JPRB) PCFLX(JL,ICO2)=PCFLX(JL,ICO2)+PCO2B(JL)
    IF(PCO2A(JL) > -9000._JPRB) PCFLX(JL,ICO2)=PCFLX(JL,ICO2)+PCO2A(JL)
    IF(LFIRE) THEN
      IF(PCO2F(JL) > -9000._JPRB) PCFLX(JL,ICO2)=PCFLX(JL,ICO2)-PCO2F(JL)
    ENDIF
  ENDDO
ENDIF

IF(ICH4 > 0 .AND. LCH4SFC) THEN      ! CH4 surface fluxes
  DO JL=KIDIA,KFDIA
    IF(PCH4(JL) > -9000._JPRB) PCFLX(JL,ICH4)=PCFLX(JL,ICH4)+PCH4(JL)
    IF(LFIRE) THEN
      IF(PCH4F(JL) > -9000._JPRB) PCFLX(JL,ICH4)=PCFLX(JL,ICH4)-PCH4F(JL)
    ENDIF
  ENDDO
ENDIF
IF(NGHG > 0 .AND. YLRCH4_NL%LGP) THEN
  PLRCH4(KIDIA:KFDIA,1:KLEV) = PGFL(KIDIA:KFDIA,1:KLEV,YLRCH4%MP9_PH)
ENDIF

IF(IRA > 0) THEN      ! Radon Surface Fluxes
  DO JL=KIDIA,KFDIA
    ZABS_SINLAT=ABS(PGEMU(JL))
    IF(ZABS_SINLAT >= 0.939692_JPRB .AND. ZABS_SINLAT <= 1._JPRB) THEN
      PCFLX(JL,IRA)=0._JPRB
    ELSEIF(ZABS_SINLAT >= 0.866025_JPRB .AND. ZABS_SINLAT < 0.939692_JPRB) THEN
      PCFLX(JL,IRA)=-1.8426E-23_JPRB 
    ELSEIF(ZABS_SINLAT < 0.866025_JPRB .AND. PLSM(JL) > 0.5_JPRB) THEN
      PCFLX(JL,IRA)=-0.36852E-20_JPRB 
    ELSEIF(ZABS_SINLAT < 0.866025_JPRB .AND. PLSM(JL) <= 0.5_JPRB) THEN
      PCFLX(JL,IRA)=-1.8426E-23_JPRB 
    ENDIF
  ENDDO
ENDIF

IF(ISF6 > 0) THEN     ! SF6 Surface Fluxes
  DO JL=KIDIA,KFDIA
    IF(PSF6(JL) > -9000._JPRB) PCFLX(JL,ISF6)=PCFLX(JL,ISF6)+PSF6(JL)
  ENDDO
ENDIF

IF (LGRGSFC )THEN     ! GRG Surface Fluxes
 DO JEXT=1,NGRG
   DO JL=KIDIA,KFDIA  
     IF(ABS(PGFLFLX(JL,JEXT)) <  9000._JPRB)  PCFLX(JL,KGRG(JEXT)) =  -1.0_JPRB * PGFLFLX(JL,JEXT)  
   ENDDO
 ENDDO
ENDIF

! flexible tracers 
 DO JEXT=1,NTRAC  
   DO JL=KIDIA,KFDIA  
     IF(ABS(PGFLFLX(JL,JEXT+NGRG)) <  9000._JPRB)  PCFLX(JL,KTRACER(JEXT)) =  -1.0_JPRB * PGFLFLX(JL,JEXT+NGRG)  
   ENDDO
 ENDDO


ITRC=0
DO JEXT=1,NGHG
  IF(YGHG(JEXT)%IGRBCODE == NGRBGHG(2)) THEN
    ITRC=ITRC+1
    PCEN(KIDIA:KFDIA,1:KLEV,ITRC) =PGFL(KIDIA:KFDIA,1:KLEV,YGHG(JEXT)%MP9_PH)- &
    &     PLRCH4(KIDIA:KFDIA,1:KLEV)*PGFL(KIDIA:KFDIA,1:KLEV,YGHG(JEXT)%MP9_PH)*TSPHY
    PTENC(KIDIA:KFDIA,1:KLEV,ITRC)=PTENGFL(KIDIA:KFDIA,1:KLEV,YGHG(JEXT)%MP1)- &
    &     PLRCH4(KIDIA:KFDIA,1:KLEV)*PGFL(KIDIA:KFDIA,1:KLEV,YGHG(JEXT)%MP9_PH)
  ELSE
    ITRC=ITRC+1
    PCEN(KIDIA:KFDIA,1:KLEV,ITRC) =PGFL(KIDIA:KFDIA,1:KLEV,YGHG(JEXT)%MP9_PH)
    PTENC(KIDIA:KFDIA,1:KLEV,ITRC)=PTENGFL(KIDIA:KFDIA,1:KLEV,YGHG(JEXT)%MP1)
  ENDIF
ENDDO
DO JEXT=1,NTRAC
  ITRC=KTRACER(JEXT)
  PCEN(KIDIA:KFDIA,1:KLEV,ITRC)=PGFL(KIDIA:KFDIA,1:KLEV,YTRAC(JEXT)%MP9_PH)
  PTENC(KIDIA:KFDIA,1:KLEV,ITRC)=PTENGFL(KIDIA:KFDIA,1:KLEV,YTRAC(JEXT)%MP1)
  IF(YTRAC(JEXT)%IGRBCODE == 210181 ) THEN   ! take into account Radon decays in the atmosphere
    PTENC(KIDIA:KFDIA,1:KLEV,ITRC)=PTENC(KIDIA:KFDIA,1:KLEV,ITRC)+ &
    &    PCEN(KIDIA:KFDIA,1:KLEV,ITRC)*(exp(-2.11E-6_JPRB*TSPHY)-1._JPRB)/TSPHY
    PCEN(KIDIA:KFDIA,1:KLEV,ITRC)=PCEN(KIDIA:KFDIA,1:KLEV,ITRC)*exp(-2.11E-6_JPRB*TSPHY)
  ELSEIF( YTRAC(JEXT)%IGRBCODE /= 210182 ) THEN 
!  CO lifetime of 50 days for 
   ZTDECAY=(EXP(-1.0_JPRB*TSPHY/(50.0_JPRB*86400.0_JPRB))-1.0_JPRB)/TSPHY
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        PTENC(JL,JK,ITRC) =  PTENC(JL,JK,ITRC) + &
     &    PCEN(JL,JK,ITRC)*ZTDECAY
      ENDDO
    ENDDO
  ENDIF
ENDDO
DO JEXT=1,NGRG
  ITRC=KGRG(JEXT)
  PCEN(KIDIA:KFDIA,1:KLEV,ITRC) =PGFL(KIDIA:KFDIA,1:KLEV,YGRG(JEXT)%MP9_PH)
  PTENC(KIDIA:KFDIA,1:KLEV,ITRC)=PTENGFL(KIDIA:KFDIA,1:KLEV,YGRG(JEXT)%MP1)
ENDDO
DO JEXT=1,NACTAERO
  ITRC=ITRC+1
  PCEN(KIDIA:KFDIA,1:KLEV,ITRC) =PGFL(KIDIA:KFDIA,1:KLEV,YAERO(JEXT)%MP9_PH)
  PTENC(KIDIA:KFDIA,1:KLEV,ITRC)=PTENGFL(KIDIA:KFDIA,1:KLEV,YAERO(JEXT)%MP1)
ENDDO
IF(NACTAERO > 0) THEN  ! total aerosol mass mixing ratio is treated as a pure tracer
  ITRC=ITRC+1
  PCEN(KIDIA:KFDIA,1:KLEV,ITRC)=PGFL(KIDIA:KFDIA,1:KLEV,YAERO(NAERO)%MP9_PH)
  PTENC(KIDIA:KFDIA,1:KLEV,ITRC)=PTENGFL(KIDIA:KFDIA,1:KLEV,YAERO(NAERO)%MP1)
ENDIF

! LOAD PGRGTEND
DO JEXT=1,NGRG_CPLO4
  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      PGRGTEND(JL,JK,JEXT)=PGFL(JL,JK,YGRGTEND(JEXT)%MP)
    ENDDO
  ENDDO
ENDDO

! Initialise scavenging coefficients
IF (KTRAC>0) THEN

  PSCAV(:)=0.0_JPRB

 ! Initialize here for other soluble tracers

  ITRAC=NGHG+NTRAC+NGRG
 ! Aerosol part
  DO JN=1,NAERO
    ITYP=NINDAER(JN)/10
    IBIN=NINDAER(JN)-ITYP*10
    JEXT=ITRAC+JN
    IF(ITYP==1) THEN
      PSCAV(JEXT)=RFRSS(IBIN)
    ELSEIF (ITYP==2) THEN
      PSCAV(JEXT)=RFRDD(IBIN)
    ELSEIF (ITYP==3) THEN
      PSCAV(JEXT)=RFROM(IBIN)
    ELSEIF (ITYP==4) THEN
      PSCAV(JEXT)=RFRBC(IBIN)
    ELSEIF (ITYP==5) THEN
      PSCAV(JEXT)=RFRSO4(IBIN)
    ELSEIF (ITYP==6) THEN
      PSCAV(JEXT)=RFRIF
    ENDIF
  ENDDO

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