SUBROUTINE CSEKF2

!**** *CSEKF2*  -  Controls integration job for SEKF at level 2.

!     Purpose.
!     --------
!        Controls integration job for SEKF at level 2.

!**   Interface.
!     ----------
!        *CALL* *CSEKF2

!        Explicit arguments :
!        --------------------
!        None

!        Implicit arguments :
!        --------------------
!        None

!     Method.
!     -------
!        See documentation

!     Externals.    SU2YOM - initialize level 2 commons
!     ----------    CNT3

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        M. Drusch and M. Hamrud *ECMWF*

!     Modifications.
!     --------------
!        Original : 17-01-07
!         2007-11-28 - K. Scipal - Added call to SEKF_PREP_ASCAT
!         2009-02-13 - P. de Rosnay - Offline Jacobians - preliminary dvpt
!         2009-12-15 - P. de Rosnay - Offline Jacobians completed
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPRB, JPIM
USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
USE YOMCT0    ,ONLY : NSTART, NSTOP
USE YOMSEKF   ,ONLY : N_SEKF_CV, N_SEKF_PT, NSEKFQ, VSM_ANAL_INC,&
 & SEKF_INC, SEKF_Q, VSM_INC_L1, VSM_INC_L2, NANAL, &
 & VSM_INC_L3, SEKF_DEBUG, SEKF_DEBUG_3D, NREF_BLOCK, NREF_GP,&
 & NOBS_SEKF_MAX, SEKF_G, SEKF_J, SEKF_B, SEKF_A, SEKF_F,&
 & LUSEKF_REF, LUSE_ASCAT, LUSE_T2M, LUSE_RH2M, LUSE_JATM


USE YOMLUN    ,ONLY : NULOUT

USE YOMFPG    ,ONLY : RFPGM, RFPNORX, RFPNORY, RFPLA, RFPLO
USE YOMFPEZO  ,ONLY : EFPGM, EFPNORX, EFPNORY

USE YOEWCOU   ,ONLY : LWFRSTIME, NADV_WAVE

USE SURFACE_FIELDS_MIX, ONLY : SP_SB, YSP_SB

! Debug
USE YOMDIM    ,ONLY : NPROMA
USE YOMGEM    ,ONLY : NGPTOT

IMPLICIT NONE

REAL(KIND=JPRB) :: ZHOOK_HANDLE

REAL(KIND=JPRB),ALLOCATABLE   :: ZGAIN_O(:,:)
REAL(KIND=JPRB),ALLOCATABLE   :: ZOCGR_O(:,:)
REAL(KIND=JPRB),ALLOCATABLE   :: ZBACK_O(:,:)
REAL(KIND=JPRB),ALLOCATABLE   :: ZANER_O(:,:)
REAL(KIND=JPRB),ALLOCATABLE   :: ZANA_O(:,:)

INTEGER(KIND=JPIM) :: JLENG, JBLOCK, JL, JKGLO
INTEGER(KIND=JPIM) :: J1, J2, J3
CHARACTER (LEN=5) :: CLWR

#include "cnt3.intfb.h"
#include "dealsekf.intfb.h"
#include "su2yom.intfb.h"
#include "susekf.intfb.h"
#include "sm_ekf_main.intfb.h"
#include "obsgen.intfb.h"
#include "sekf_write.intfb.h"
#include "sekf_prep_ascat.intfb.h"

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

!*       1.    Initialization.
!              ---------------

!*       1.1   Initialize YOMCT2.

IF (LHOOK) CALL DR_HOOK('CSEKF2',0,ZHOOK_HANDLE)
CALL SU2YOM

!*       1.2   Initialize YOMSEKF

WRITE(NULOUT,*) ' CSEKF2: Initialize surface analysis and EKF'

CALL SUSEKF

!        1.3.  Initialize output fields

IF (LUSEKF_REF) THEN
  SEKF_INC(:,:,:) = 0._JPRB
  SEKF_Q(:,:,:) = 0._JPRB
  SEKF_DEBUG_3D(:,:,:) = 0._JPRB
  SEKF_G(:,:,:) = 0._JPRB
  SEKF_J(:,:,:) = 0._JPRB
  SEKF_B(:,:,:) = 0._JPRB
  SEKF_A(:,:,:) = 0._JPRB
  SEKF_F(:,:,:) = 0._JPRB

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

!*       2.    Call level 3 control routine.
!              -----------------------------
! J1 = 1 (N_SEKF_PT = 0) is the fg run with unperturbed initial conditions.
! The following runs use perturbed soil moisture values.
! At the end of this step, the soil moisture and screen level parameter data
! sets are availbale for each time step (in NPROMA chunks ...)

  WRITE(NULOUT,*) ' CSEKF2: Perform fg and perturbation runs'

 IF(LUSE_JATM) Then

    DO J1 = 1,N_SEKF_CV + 1
      N_SEKF_PT = J1-1
      LWFRSTIME=.TRUE.
      NADV_WAVE=0_JPIM
      WRITE(NULOUT,*) 'Coupled Jacobians',N_SEKF_PT,LWFRSTIME,NADV_WAVE
      CALL CNT3
      CALL DEALSEKF
    ENDDO

 ELSE ! Offline Jacobians
    J1 = 1             ! no pert in pertsekf_v2.F90
     N_SEKF_PT = J1-1
     LWFRSTIME=.TRUE.
     NADV_WAVE=0_JPIM
     WRITE(NULOUT,*) 'Off line Jacobians',N_SEKF_PT,LWFRSTIME,NADV_WAVE
     CALL CNT3
     CALL DEALSEKF

 ENDIF


  IF (ALLOCATED(RFPGM)) DEALLOCATE(RFPGM)
  IF (ALLOCATED(RFPNORX)) DEALLOCATE(RFPNORX)
  IF (ALLOCATED(RFPNORY)) DEALLOCATE(RFPNORY)
  IF (ALLOCATED(RFPLA)) DEALLOCATE(RFPLA)
  IF (ALLOCATED(RFPLO)) DEALLOCATE(RFPLO)
  IF (ALLOCATED(EFPGM)) DEALLOCATE(EFPGM)
  IF (ALLOCATED(EFPNORX)) DEALLOCATE(EFPNORX)
  IF (ALLOCATED(EFPNORY)) DEALLOCATE(EFPNORY)

  WRITE(NULOUT,*) ' CSEKF2: Finished fg and perturbation runs'

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

!*       3.    Observation screening and observation operator(s).
!              -----------------------------

  WRITE(NULOUT,*) ' CSEKF2: Observation processing and matching'

! Prepare screen level analyses
  IF (LUSE_T2M .OR. LUSE_RH2M) CALL OBSGEN
  WRITE(NULOUT,*) ' CSEKF2: T2M, RH2M observations processed'

! Prepare ASCAT soil water index
  IF (LUSE_ASCAT) CALL SEKF_PREP_ASCAT
  WRITE(NULOUT,*) ' CSEKF2: ASCAT observations processed'

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

!*       4.    SEKF
!              -----------------------------
! Kalman Filtering, loop over individual grid boxes, 
! compute analysis increments at time t0.

!        4.0      Allocate output fields
!            -----------------------------

  ALLOCATE(ZGAIN_O(N_SEKF_CV,NOBS_SEKF_MAX))
  ALLOCATE(ZOCGR_O(NOBS_SEKF_MAX,N_SEKF_CV))
  ALLOCATE(ZBACK_O(N_SEKF_CV,N_SEKF_CV))
  ALLOCATE(ZANER_O(N_SEKF_CV,N_SEKF_CV))
  ALLOCATE(ZANA_O(NANAL,N_SEKF_CV))

  WRITE(NULOUT,*) 'CSEKF2 Call EKF MAIN'


  DO JKGLO=1,NGPTOT,NPROMA
    JBLOCK=(JKGLO-1)/NPROMA + 1
    JLENG=MIN(NPROMA,NGPTOT-JKGLO+1)
    DO JL=1,JLENG

      IF ((JL == NREF_GP) .AND. (JBLOCK == NREF_BLOCK)) WRITE(NULOUT,*) SP_SB(JL,1,YSP_SB%YQ%MP0,JBLOCK)

!  change to land sea mask ... (M. Drusch)
      IF (SP_SB(JL,1,YSP_SB%YQ%MP0,JBLOCK)>0.01) THEN

        ZGAIN_O(:,:) = 0._JPRB
        ZOCGR_O(:,:) = 0._JPRB
        ZBACK_O(:,:) = 0._JPRB
        ZANER_O(:,:) = 0._JPRB
        ZANA_O(:,:) = 0._JPRB

        VSM_ANAL_INC(:) = 0._JPRB
        SEKF_DEBUG(:) = 0._JPRB

!     4.1      Run the Kalman filter
!              -----------------------------

!        WRITE(NULOUT,*) 'CSEKF2 Call EKF MAIN: JL, JBLOCK:', JL, JBLOCK

        CALL SM_EKF_MAIN(JL,JBLOCK,N_SEKF_CV,NSTART,NSTOP,&
       &               NSEKFQ,VSM_ANAL_INC,SEKF_DEBUG,&
       &               ZGAIN_O,ZBACK_O,ZANER_O,ZOCGR_O, ZANA_O)

!     4.2      Write internal global fields for the final traj
!              -----------------------------------------------

!     Not needed right now, the final trajectory is approximated in 
!     SM_EKF_MAIN ... this is somthing for the future.

        VSM_INC_L1(JL,JBLOCK) = VSM_ANAL_INC(1)
        VSM_INC_L2(JL,JBLOCK) = VSM_ANAL_INC(2)
        VSM_INC_L3(JL,JBLOCK) = VSM_ANAL_INC(3)

!     4.3      Prepare global fields for grib output
!              -----------------------------------------------

        SEKF_Q(JKGLO+JL-1,1,1) = NSEKFQ * 1.0

        DO J1 = 1, 3
          SEKF_INC(JKGLO+JL-1,J1,1) = VSM_ANAL_INC(J1)
        ENDDO

        DO J1 = 1, 20
          SEKF_DEBUG_3D(JKGLO+JL-1,J1,1) = SEKF_DEBUG(J1)
        ENDDO

        DO J1 = 1, N_SEKF_CV
          DO J2 = 1, N_SEKF_CV
            J3 = N_SEKF_CV * (J1-1) + J2
            SEKF_A(JKGLO+JL-1,J3,1) = ZANER_O(J1,J2)
            SEKF_B(JKGLO+JL-1,J3,1) = ZBACK_O(J1,J2)
          ENDDO
        ENDDO
      
        DO J1 = 1, N_SEKF_CV
          DO J2 = 1, NOBS_SEKF_MAX
            J3 = NOBS_SEKF_MAX * (J1-1) + J2
            SEKF_G(JKGLO+JL-1,J3,1) = ZGAIN_O(J1,J2)
          ENDDO
        ENDDO
        
        DO J1 = 1, NOBS_SEKF_MAX
          DO J2 = 1, N_SEKF_CV
            J3 = N_SEKF_CV * (J1-1) + J2
            SEKF_J(JKGLO+JL-1,J3,1) = ZOCGR_O(J1,J2)
          ENDDO
        ENDDO
        
        DO J1 = 1, NANAL
          DO J2 = 1, N_SEKF_CV
            J3 = N_SEKF_CV * (J1-1) + J2
            SEKF_F(JKGLO+JL-1,J3,1) = ZANA_O(J1,J2)
          ENDDO
        ENDDO

      ENDIF
    ENDDO
  ENDDO

  WRITE(NULOUT,*) 'CSEKF2 Finished EKF'

!     4.4      Deallocate output fields
!              -----------------------------

  DEALLOCATE(ZANER_O)
  DEALLOCATE(ZBACK_O)
  DEALLOCATE(ZGAIN_O)
  DEALLOCATE(ZOCGR_O)
  DEALLOCATE(ZANA_O)



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

!*       5.    Create grib output for diagnostics and B-cycling
!              ---------------------------------------------------------
! Write output to grib files

  CLWR = 'SEKF1'

  CALL SEKF_WRITE(TRIM(CLWR))


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

!*       6.    Final trajectory with analysed soil moisture at t=0
!              ---------------------------------------------------------
! Something for the future ... currently the update is done within 
! SM_EKF_MAIN

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

!*       7.    Create grib output for the analyses
!              -----------------------------------
! Produce analysis at times t.

  CLWR = 'SEKF2'

  CALL SEKF_WRITE(TRIM(CLWR))


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

ENDIF

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