SUBROUTINE AVARCT(KEVENT)

!**** *AVARCT*  - reads in the inputs for AVARCT job , computes the
! the departure between the trajectory and reference correction of the avarc event.

!     Purpose.
!     --------
!     variational assimilation of corrections 

!**   Interface.
!     ----------
!        *CALL* *AVARCT(KEVENT)
!                KEVENT : the number of the correction event/slot

!        Implicit arguments :      The state variables of the model
!        --------------------

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

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

!     Reference.
!     ----------
!        Symposium II Project

!     Author.
!     -------
!        Radmila Brozkova  *RC LACE*

!     Modifications.
!     --------------
!        Original : 01-11-29
!        C. Fischer:03-09-30 introduce GFL in call to suspec
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMLUN   , ONLY : NULOUT
USE YOMDIM   , ONLY : NSPEC2   ,NFLSUR   , NFLEVL, NS2D, NS3D, NDLON
USE YOMSP    , ONLY : SPA3, SPA2, SPVOR    ,SPDIV    ,SPT     ,SPQ  ,SPSP
USE YOMMP    , ONLY : MYSETB   ,NBSETSP  ,NPSP
USE YOMJR    , ONLY : ATRASP   ,ATRAVOR  ,ATRADIV ,ATRAT, ATRAQ 
USE YOM_YGFL , ONLY : YGFL     ,YQ
USE YOMSP_PTRS , ONLY : MSPTR_VOR, MSPTR_DIV, MSPTR_T, &
 & MSPTR_GFL, MSPTR_SP, MSPTR_OR
USE YOMCST   , ONLY : RPI
USE YOMHCP   , ONLY : LAVALOC,AVAS, AVAN,AVAW,AVAE,AVASL,AVANL,&
&                     AVAWL,AVAEL

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KEVENT 
! arrays to read the reference file
REAL(KIND=JPRB),TARGET :: ZSPA3(NFLSUR,NSPEC2,NS3D)
REAL(KIND=JPRB),TARGET :: ZSPA2(NSPEC2,NS2D)
REAL(KIND=JPRB) :: ZSPA1(NFLEVL,2)
REAL(KIND=JPRB),POINTER :: ZCPOR(:)       , ZCSP (:)
REAL(KIND=JPRB),POINTER :: ZCVOR(:,:), ZCDIV(:,:)
REAL(KIND=JPRB),POINTER :: ZCT  (:,:)
REAL(KIND=JPRB),POINTER :: ZCGFL(:,:,: )
REAL(KIND=JPRB),ALLOCATABLE:: ZZSPA3(:,:,:)
REAL(KIND=JPRB),ALLOCATABLE:: ZZSPA2(:,:)




INTEGER(KIND=JPIM) ::    J, JK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB) :: ZDELA, ZDELLAT, ZDELLON

#include "spnorm.intfb.h"
#include "abor1.intfb.h"
#include "stepotl.intfb.h"
#include "suspec.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('AVARCT',0,ZHOOK_HANDLE)
WRITE(NULOUT,*) 'spectral norm of the trajectory arrays'
CALL SPNORM(0)

ZCT   => ZSPA3(:,:,MSPTR_T)
ZCVOR => ZSPA3(:,:,MSPTR_VOR)
ZCDIV => ZSPA3(:,:,MSPTR_DIV)
ZCGFL => ZSPA3(:,:,MSPTR_GFL:MSPTR_GFL+YGFL%NUMSPFLDS-1)
ZCPOR => ZSPA2(:,MSPTR_OR)
ZCSP  => ZSPA2(:,MSPTR_SP)
!*       1.    READ the correction file
!              ------------------------

CALL SUSPEC(ZSPA3,ZSPA2,ZSPA1,KFILE=11)

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

!*       2.    EVALUATE  difference trajectory - reference file
!              ----------------------------------------------------

IF(NPSP == 1) THEN
  IF (MYSETB  ==  NBSETSP) THEN
! result = trajectory - reference
    DO J=1,NSPEC2
      ATRASP(J,KEVENT)= SPSP(J) - ZCSP(J)
    ENDDO
  ENDIF
ENDIF

DO J=1,NSPEC2
  DO JK=1,NFLEVL
    ATRAVOR(JK,J,KEVENT) = SPVOR(JK,J) - ZCVOR(JK,J)
    ATRADIV(JK,J,KEVENT) = SPDIV(JK,J) - ZCDIV(JK,J)
    ATRAT  (JK,J,KEVENT) = SPT(JK,J) - ZCT  (JK,J)
    IF (YQ%LSP) THEN
      ATRAQ  (JK,J,KEVENT) = SPQ(JK,J) - ZCGFL(JK,J,YQ%MPSP)
    ENDIF
  ENDDO
ENDDO

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

!*       3.    apply mask to the correction if required
!              ----------------------------------------------------

IF(LAVALOC) THEN
  AVASL = AVAS(KEVENT)
  AVANL = AVAN(KEVENT)
  AVAWL = AVAW(KEVENT)
  AVAEL = AVAE(KEVENT)

  AVASL=AVASL*RPI/180._JPRB
  AVANL=AVANL*RPI/180._JPRB
  AVAWL=AVAWL*RPI/180._JPRB
  AVAEL=AVAEL*RPI/180._JPRB
! set-up the interval to smooth the mask at the length of 10 grid-points
  ZDELA=20._JPRB*RPI/(FLOAT(NDLON))
WRITE(NULOUT,*) ' ZDELA =  ',ZDELA
! do some checks
  IF(AVASL < -0.5_JPRB*RPI.OR.AVASL > 0.5_JPRB*RPI.OR.&
    &AVANL < -0.5_JPRB*RPI.OR.AVANL > 0.5_JPRB*RPI.OR.&
    &AVAEL <  0._JPRB.OR.AVAEL > 2._JPRB*RPI.OR.&
    &AVAWL <  0._JPRB.OR.AVAWL > 2._JPRB*RPI) THEN
    WRITE(NULOUT,*) 'AVARC correction target area borders out of range'
    WRITE(NULOUT,*) 'S= ',AVASL,' N= ',AVANL,' E= ',AVAEL,' W= ',AVAWL
    CALL ABOR1 ('AVARC abort: target area borders out of range')
  ENDIF
  ZDELLAT= AVANL - AVASL + 2._JPRB*ZDELA
  ZDELLON= AVAEL - AVAWL + 2._JPRB*ZDELA
  IF (AVAEL < AVAWL) THEN
    ZDELLON = ZDELLON + 2._JPRB*RPI
  ENDIF
  IF (ZDELLAT >= RPI.OR.ZDELLON >= 2._JPRB*RPI) THEN
    WRITE(NULOUT,*) 'AVARC correction target area is too big:'
    WRITE(NULOUT,*) 'change it or run with LAVALOC=F'
    CALL ABOR1 ('AVARC abort: too big target area ')
  ENDIF

  IF(NPSP == 1) THEN
    IF (MYSETB  ==  NBSETSP) THEN
      ALLOCATE(ZZSPA2(NSPEC2,NS2D))
      ZZSPA2(:,:) = SPA2(:,:)
      SPSP(:) = ATRASP(:,KEVENT)
    ENDIF
  ENDIF
  ALLOCATE(ZZSPA3(NFLSUR,NSPEC2,NS3D))
  ZZSPA3(:,:,:)=SPA3(:,:,:)
  SPVOR(:,:)=ATRAVOR(:,:,KEVENT)
  SPDIV(:,:)=ATRADIV(:,:,KEVENT)
  SPT(:,:)=  ATRAT(:,:,KEVENT)
  IF (YQ%LSP) THEN
    SPQ(:,:)=ATRAQ  (:,:,KEVENT)
  ENDIF

  CALL STEPOTL('0GB0L0AA0')

  IF(NPSP == 1) THEN
    IF (MYSETB ==  NBSETSP) THEN
      ATRASP(:,KEVENT) = SPSP(:)
      SPA2(:,:) = ZZSPA2(:,:)
      DEALLOCATE(ZZSPA2)
    ENDIF
  ENDIF
  ATRAVOR(:,:,KEVENT) = SPVOR(:,:)
  ATRADIV(:,:,KEVENT) = SPDIV(:,:)
  ATRAT(:,:,KEVENT)   = SPT(:,:)
  IF (YQ%LSP) THEN
    ATRAQ  (:,:,KEVENT)= SPQ(:,:)
  ENDIF
  SPA3(:,:,:)=ZZSPA3(:,:,:)
  DEALLOCATE(ZZSPA3)

ENDIF

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