SUBROUTINE WRTLLCZ (YD_IOSTREAM,YD_PCV)

!**** *WRTLLCZ*

!     Purpose.
!     --------
!           Write a file in a mars format.

!**   Interface.
!     ----------
!        *CALL* *WRTLLCZ*

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

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

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

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

!     Author.
!     -------
!        Roberto Buizza :                   *ECMWF*

!     Modifications.
!     --------------
!        Original   : 92-10-15
!        R Buizza   : 93-10-25
!        L. Isaksen : 95-06-06  Reordering of spectral arrays
!        L. Isaksen : 96-05-05  Adapted for Message Passing
!        R. Buizza  : 96-06-05  Output in GRIB format
!        M. Hamrud  : 02-01-10  Change from obsolete MODNSEC to PREGRBENC
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        M.Hamrud      01-May-2006 Generalized IO scheme
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVL   ,NSPEC2  ,NS3D
USE YOMLUN   , ONLY : NULOUT
USE YOMCVA   , ONLY : NVA3D    ,NVA2D
USE YOMMP    , ONLY : NPSP
USE YOMGRB   , ONLY : NGRBLNSP ,NGRBSP3
USE CONTROL_VECTORS
USE CONTROL_VECTORS_COMM_MOD
USE IOSTREAM_MIX , ONLY :  SETUP_IOREQUEST, IO_PUT, &
 &  TYPE_IOSTREAM , TYPE_IOREQUEST, CLOSE_IOREQUEST

IMPLICIT NONE

TYPE(TYPE_IOSTREAM) ,INTENT(INOUT) :: YD_IOSTREAM
TYPE(CONTROL_VECTOR),INTENT(IN)    :: YD_PCV 
!     ------------------------------------------------------------------

REAL(KIND=JPRB) :: ZSPA3(NFLEVL,NSPEC2,NS3D), ZSPA2(NSPEC2,NVA2D)
INTEGER(KIND=JPIM) :: IGRIB3D(NS3D),IGRIB2D(1),ILEVS2D(1)
INTEGER(KIND=JPIM) :: II, JF,JS,JL,I2D,I3D
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

!     1. Control
!     ----------

IF (LHOOK) CALL DR_HOOK('WRTLLCZ',0,ZHOOK_HANDLE)
WRITE(NULOUT,'('' >> Sub WRTLLCZ <<'')')

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

!     2. From IFS format to mars format
!     ---------------------------------

IF (YD_PCV%LINITCV) THEN
  II=0
  IF (NPSP==1) THEN
    DO JF=1,NVA2D
      DO JS=1,NSPEC2
        II=II+1
        ZSPA2(JS,JF)=YD_PCV%INITCV(II)
      ENDDO
    ENDDO
  ENDIF
  IF (NS3D > NVA3D) THEN
    CALL ABOR1('CAIN: UNEXPECTED INCONSITENCY NS3D > NVA3D ')
  ENDIF
  DO JF=1,NS3D
    DO JS=1,NSPEC2
      DO JL=1,NFLEVL
        II=II+1
        ZSPA3(JL,JS,JF)=YD_PCV%INITCV(II)
      ENDDO
    ENDDO
  ENDDO
ELSE
  CALL ABOR1('WRTLLCZ:LINITCV FALSE')
ENDIF

I2D = 1
IGRIB2D(I2D) = NGRBLNSP
ILEVS2D(I2D) = 1
I3D = NS3D
IGRIB3D(1:I3D) = NGRBSP3(1:I3D)

CALL SETUP_IOREQUEST(YL_IOREQUEST,'SPECTRAL_FIELDS',LDGRIB=.TRUE.,&
 & KGRIB3D=IGRIB3D(1:I3D),KGRIB2D=IGRIB2D(1:I2D),KLEVS2D=ILEVS2D(1:I2D),&
 & CDLEVTYPE='ML')
CALL IO_PUT(YD_IOSTREAM,YL_IOREQUEST,PR2=ZSPA2,PR3=ZSPA3)
CALL CLOSE_IOREQUEST(YL_IOREQUEST)

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