SUBROUTINE STORE (KN,KFLAG,KREC,PFIELD)

!***  *STORE* - store/retrieve state vector for Lanczos routines

!**   Purpose.
!     --------

!**   Interface.
!     *CALL* *STORE(..)*

!        Explicit arguments :
!        --------------------
!        KN     : length of state vector
!        KFLAG  : mode flag
!               : KFLAG=1 - store Q
!               : KFLAG=2 - retrieve Q
!               : KFLAG=3 - store P
!               : KFLAG=4 - retrieve P
!        KREC   : record number                                  
!        PFIELD : state vector

!        Implicit arguments :
!        --------------------
!        none.

!     Method.
!     -------
!        See Lanczos code

!     Externals.
!     ----------
!      MIO routines

!     Reference.
!     ----------
!        ECMWF research department documentation of the IFS

!     Author.
!     -------
!        Roberto Buizza  and Mats Hamrud *ECMWF*

!     Modifications.
!     --------------
!        Original : 94-08-24
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

USE YOMLUN   , ONLY : NULOUT
USE YOMLCZ   , ONLY : RLANBUF  ,NITERL, RLANBUF_OBSCOR, NITERL_OBSCOR, NLANTYPE

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLAG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KREC 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFIELD(KN) 
INTEGER(KIND=JPIM) :: JPMAXLL

PARAMETER (JPMAXLL=2)
INTEGER(KIND=JPIM) ::   IREC, ITER

LOGICAL :: LLSTORE
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"


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

!*    1.  PREPARE IO BUFFERS.
!     -----------------------

IF (LHOOK) CALL DR_HOOK('STORE',0,ZHOOK_HANDLE)
IF (NLANTYPE<99) THEN
  ITER=NITERL
ELSE
  ITER=NITERL_OBSCOR
ENDIF
IF(KFLAG <= 2) THEN
  IREC=JPMAXLL+KREC
ELSE
  IF(KREC > JPMAXLL) THEN
    WRITE(NULOUT,*) 'STORE: KREC > JPMAXLL',KREC,JPMAXLL
    CALL ABOR1 ('STORE: KREC > JPMAXLL')
  ENDIF
  IREC=KREC
ENDIF
IF(IREC > ITER+2) THEN
  WRITE(NULOUT,*) 'STORE: IREC > ITER+2 ',IREC,ITER+2
  CALL ABOR1('STORE: IREC > ITER+2')
ENDIF

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

!*    2.  ACTUAL STORE/RESTORE OF THE PAIR OF VECTORS.
!     ------------------------------------------------

LLSTORE=KFLAG == 1.OR.KFLAG == 3
IF (LLSTORE) THEN
  IF (NLANTYPE < 99) THEN
    RLANBUF(1:KN,IREC)=PFIELD(1:KN)
  ELSE
    RLANBUF_OBSCOR(1:KN,IREC)=PFIELD(1:KN)
  ENDIF
ELSE
  IF (NLANTYPE < 99) THEN
    PFIELD(1:KN)=RLANBUF(1:KN,IREC)
  ELSE
    PFIELD(1:KN)=RLANBUF_OBSCOR(1:KN,IREC)
  ENDIF 
ENDIF

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

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