SUBROUTINE SUFORCE

!**** *SUFORCE*   - Routine to initialize forcing SV arrays 

!     Purpose.
!     --------
!           Initialize forcing SV arrays 
!**   Interface.
!     ----------
!        *CALL* *SUFORCE

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

!        Implicit arguments :
!        --------------------
!        COMMON YOMLCZ

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

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

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

!     Authors.
!     -------
!        Jan Barkmeijer  *ECMWF*

!     Modifications.
!     --------------
!        Original : 2000.10.01
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!     -----------------------------------------------------------------

USE PARKIND1  ,ONLY : JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA  ,NGPBLKS
USE YOMLUN   , ONLY : NULOUT   
USE YOMCT0   , ONLY : NSTART
USE YOMLCZ   , ONLY : GPFORCEU ,GPFORCEV ,GPFORCET  ,&
 & GPFORCEQ ,GPFORCESP,YSPFORCE ,LFORCEWR  
USE YOMNMIA  , ONLY : NITNMI
USE STOPH_MIX , ONLY : LFORCENL 
USE YOMSKF   , ONLY : LSKF
USE CONTROL_VECTORS

IMPLICIT NONE

CHARACTER (LEN = 16) ::  CLFILE
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "readvec.intfb.h"
#include "stepo.intfb.h"
#include "sualspa.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('SUFORCE',0,ZHOOK_HANDLE)
ALLOCATE(GPFORCEU(NPROMA,NFLEVG,NGPBLKS,(NSTART-NITNMI):1))
ALLOCATE(GPFORCEV(NPROMA,NFLEVG,NGPBLKS,(NSTART-NITNMI):1))
ALLOCATE(GPFORCET(NPROMA,NFLEVG,NGPBLKS,(NSTART-NITNMI):1))
ALLOCATE(GPFORCEQ(NPROMA,NFLEVG,NGPBLKS,(NSTART-NITNMI):1))
ALLOCATE(GPFORCESP(NPROMA,NGPBLKS,(NSTART-NITNMI):1))

GPFORCEU(:,:,:,:)=0.0_JPRB
GPFORCEV(:,:,:,:)=0.0_JPRB
GPFORCET(:,:,:,:)=0.0_JPRB
GPFORCEQ(:,:,:,:)=0.0_JPRB
GPFORCESP(:,:,:) =0.0_JPRB

WRITE(NULOUT,9990) 'GPFORCEU ',SIZE(GPFORCEU),SHAPE(GPFORCEU)
WRITE(NULOUT,9990) 'GPFORCEV ',SIZE(GPFORCEV),SHAPE(GPFORCEV)
WRITE(NULOUT,9990) 'GPFORCET ',SIZE(GPFORCET),SHAPE(GPFORCET)
WRITE(NULOUT,9990) 'GPFORCEQ ',SIZE(GPFORCEQ),SHAPE(GPFORCEQ)  
WRITE(NULOUT,9990) 'GPFORCESP ',SIZE(GPFORCESP),SHAPE(GPFORCESP)

! spectral array used in adjoint integration
IF(.NOT.LFORCENL) THEN
  CALL ALLOCATE_CTLVEC(YSPFORCE)
  YSPFORCE=0.0_JPRB

  WRITE(NULOUT,9990) 'YSPFORCE  ',YSPFORCE%nsizel
ENDIF

IF (LFORCENL) THEN
  WRITE(NULOUT,*) 'APPLY FORCING'
  LSKF=.TRUE.
  CLFILE = 'perturb'
  CALL READVEC (CLFILE,LDJB=.FALSE.)
  LSKF=.FALSE.
  LFORCEWR=.TRUE.
  CALL STEPO('0AA000000')
  LFORCEWR=.FALSE.
  CALL SUALSPA
ENDIF
IF (LHOOK) CALL DR_HOOK('SUFORCE',1,ZHOOK_HANDLE)
  
9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
END SUBROUTINE SUFORCE
