SUBROUTINE SPECFITG

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE PARFPOS  , ONLY : JPOS3DF  ,JPOS2DF  ,JPOSPHY
USE YOMGRB   , ONLY : NGRBZ    ,&
 & NGRBT    ,NGRBU    ,NGRBV    ,NGRBQ    ,NGRBSP   ,&
 & NGRBVO   ,NGRBSTL1 ,NGRBSWVL1 ,NGRBSD   ,NGRBCHNK ,&
 & NGRBLNSP ,NGRBD    ,NGRBSDOR ,NGRBISOR ,NGRBANOR ,&
 & NGRBSLOR ,NGRBSTL2 ,NGRBSWVL2 ,NGRBLSM  ,NGRBSR   ,&
 & NGRBAL   ,NGRBSTL3 ,NGRBSWVL3 ,NGRBSRC  ,NGRBLSRH ,NGRBSKT  ,&
 & NGRBSTL4 ,NGRBSWVL4 ,NGRBCLWC ,NGRBCIWC ,NGRBCC   ,&
 & NGRBISTL1,NGRBISTL2,NGRBISTL3,NGRBISTL4,NGRBCI   ,&
 & NGRBSSTK  ,NGRBASN  ,NGRBRSN  ,NGRBTSN  ,&
 & NGRBCVL  ,NGRBCVH  ,NGRBTVL  ,NGRBTVH  ,&
 & NGRBLAIL ,NGRBLAIH ,NGRBSLT ,&
 & NGRBCO2NBF ,NGRBCO2OF ,NGRBCO2APF ,NGRBCO2FIRE ,NGRBSDFOR,NGRBSF6APF  ,&
 & NGRBCH4F ,NGRBCH4FIRE,NGRB118  ,NGRB119  ,NGRB120  ,NGRB080  ,&
 & NGRBALUVP,NGRBALUVD,NGRBALNIP,NGRBALNID,NGRBUCUR ,NGRBVCUR ,&
 & NGRBAERDEP,NGRBAERLTS,NGRBAERSCC,NGRBGRGSFC       ,&
 & NGRBAERLS01,NGRBAERLS02,NGRBAERLS10,NGRBAERLS03,NGRBAERLS04,NGRBAERLS11,&
 & NGRBAERLS05,NGRBAERLS06,NGRBAERLS12,NGRBAERLS07,NGRBAERLS08,NGRBAERLS09

USE YOMLUN   , ONLY : NULOUT
USE YOMDIM   , ONLY : NFLEVG   ,NFLEVL, NPROMA   ,NSPEC2  
USE YOMGEM   , ONLY : VBH      ,VAH      ,NGPTOT
USE YOMCST   , ONLY : RG       ,R        ,RETV     ,&
 & RLVTT    ,RLSTT    ,RTT  
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
 & R4IES    ,R5LES    ,R5IES    ,R5ALVCP  ,R5ALSCP  ,&
 & RALVDCP  ,RALSDCP  ,RTWAT    ,RTICE    ,RTICECU  ,&
 & RTWAT_RTICE_R      ,RTWAT_RTICECU_R    ,RHOH2O  
USE YOMCT0   , ONLY : NPRINTLEV,NPROC,LNHDYN
USE YOMCT3   , ONLY : NSTEP
USE YOMOP    , ONLY : CFNGG    ,CFNPL    ,LINC
USE YOMDYN   , ONLY : TSTEP
USE YOMSTA   , ONLY : RDTDZ1
USE YOMFPC   , ONLY : RFPCORR
USE YOEWCOU  , ONLY : LWCOU    ,LWCOU2W
USE YOMMP    , ONLY : NBSETLEV, MYSETV
USE YOM_YGFL , ONLY : YGFL     ,YGFLC, LCO2SFC, LSF6SFC, LAEROSFC, LCH4SFC, &
 & LGRGSFC, NGRG, LFIRE
USE YOMMCC   , ONLY : LMCC04
USE YOEPHY   , ONLY : LE4ALB, LECURR, LELAIV
USE MPL_MODULE, ONLY : MPL_BARRIER
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_PUT, IO_GET,&
 & CLOSE_IOSTREAM, TYPE_IOSTREAM , TYPE_IOREQUEST, CLOSE_IOREQUEST

!**** *SPECFITG*  - spectral fit of dynamic fields from FP-file.
!     and altitude correction on surface fields

!     Purpose.
!     --------
!     To spectrally fit the grid-point pre-processed dynamic data
!     and write them as spectral coefficients in a wrkfile, so that
!     SUSPEC can be used after.
!     Altitude correction is done on surface fields which need it.
!     Corrections are applied on upper air gridpoint fields 

!**   Interface.
!     ----------
!     *CALL* *SPECFITG*

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

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

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

!     Externals.
!     ----------
!     ABOR1
!
!     Reference.
!     ----------
!     ECMWF Research Department documentation of the IFS
!     Note de travail ARPEGE Nr 12 et 17

!     Author.
!     -------
!     Nils Wedi

!     Modifications.
!     --------------
!     ORIGINAL : 95-11-20 based on SUSPECG,WRMLPPG
!     Modified 98-08-10 by K. YESSAD:
!      - removal of LRPOLE option: removal of .FALSE. in 'CALL SPEREE'.
!      - correction of some false comments and false prints.
!     Modified 99-05-06 by D.Dent   : accept log surface pressure
!                                     as alternative to surface pressure field
!    R. El Khatib : 99-12-28 remove poles rows
!      D.Dent     : 00-09-01  MPE to MPL conversion
!        R. El Khatib : 01-08-07 Pruning options
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning
!        P. Viterbo    24-05-2004   Change surface units
!        R. El Khatib  05-03-01 Cleanups
!        M.Hamrud      01-Dec-2005 Generalized IO scheme
!        Nils Wedi    : 08-02-2006 nonhydrostatic 
!       S.Serrar        23-06-2005  CO2 surface fields added
!       R. Engelen      02-06-2006  CO2 replaced by GHG
!       JJMorcrette   20060625 MODIS albedo
!       JJMorcrette   20060925 DU, BC, OM, SO2, SOA climatological fields
!       G. Balsamo    20070115 Soil type
!       S. Serrar     20070717 methane surface fields
!       N. Wedi       26-Nov-2007: bug correction
!       H. Hersbach   20080403 Add ocean current
!       S. Boussetta/G.Balsamo     04-06-2009   Added variable LAI field

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

IMPLICIT NONE

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

#include "fcttre.h"

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

REAL(KIND=JPRB) :: ZSPEC(1,NSPEC2)
REAL(KIND=JPRB) :: ZFISI(NGPTOT,1,1), ZFISO(NGPTOT,1,1)
REAL(KIND=JPRB) :: ZDIFINT(NGPTOT), ZDIFOUT(NGPTOT)
REAL(KIND=JPRB) :: ZSPOR(NSPEC2,1), ZSPORI(1,NSPEC2)
REAL(KIND=JPRB) :: ZSHSP(NSPEC2),ZSP(NGPTOT)
REAL(KIND=JPRB) :: ZSHLNSP(NSPEC2)
REAL(KIND=JPRB) :: ZGPT(NGPTOT,NFLEVG,1,1)
REAL(KIND=JPRB),ALLOCATABLE  :: ZW(:,:,:,:),ZPNH(:,:,:,:),ZREAL(:,:,:,:),ZWWS(:)
REAL(KIND=JPRB),ALLOCATABLE  :: ZSHWWS(:)
REAL(KIND=JPRB) :: ZREEL(NGPTOT),ZOROI(NGPTOT)
REAL(KIND=JPRB),ALLOCATABLE     :: ZFLD(:,:,:)
REAL(KIND=JPRB),ALLOCATABLE     :: ZSFOUT(:,:,:)
REAL(KIND=JPRB),ALLOCATABLE     :: ZGFL(:,:,:,:)
INTEGER(KIND=JPIM),ALLOCATABLE  :: IGRIBGFL(:),IGRIBOUT(:),ILEVOUT(:)
REAL(KIND=JPRB),ALLOCATABLE     :: ZSPEC3(:,:,:), ZPTRFLD(:,:)
REAL(KIND=JPRB),ALLOCATABLE     :: ZP(:,:)
INTEGER(KIND=JPIM),ALLOCATABLE  :: IGRIBIO(:,:)
LOGICAL,ALLOCATABLE  :: LLMISSING(:)
REAL(KIND=JPRB) :: ZUV(NGPTOT,NFLEVG,2,1),ZQS
REAL(KIND=JPRB) :: ZPRESH(NPROMA,0:NFLEVG),ZPRESF(NPROMA,NFLEVG)

INTEGER(KIND=JPIM) :: IVSETSC(3)
INTEGER(KIND=JPIM) :: IGRIB3D(3+YGFL%NUMFLDS)
INTEGER(KIND=JPIM),ALLOCATABLE  :: ILEVS2D(:),IBSET2D(:), IGRIBSH(:)

CHARACTER (LEN = 16) ::  CLFNIGG, CLFNIGC
CHARACTER (LEN = 16) ::  CLFPFN1, CLFPFN2
CHARACTER :: CLR1*5,CLR2*4,CLR3*5
CHARACTER (LEN = 1) ::   CLMODE

INTEGER(KIND=JPIM) :: JFLD, IGFL, ISF,I3D, ILEN,I2D, JGRG
INTEGER(KIND=JPIM) :: I, ICLIM, IEND, IFLD,&
 & IGGMAX, IGRIBCD, &
 & IINC, ILEVEL, &
 & IST, INUMGFL, J,  JF, &
 & JLEV, JSTGLO, JGFL, INHDYN, ICT, JNM, IMYLEV

LOGICAL :: LLSPOR, LLSP, LLLNSP ,LLABORT 

REAL(KIND=JPRB) :: ZCOR, ZDIFMAX, ZDTSGDZ, ZSCALE
REAL(KIND=JPRB) :: ZHOOK_HANDLE

TYPE(TYPE_IOSTREAM) :: YL_IO_IN_GG
TYPE(TYPE_IOSTREAM) :: YL_IO_IN_GC
TYPE(TYPE_IOSTREAM) :: YL_SPOROG
TYPE(TYPE_IOSTREAM) :: YL_IO_OUT_SH
TYPE(TYPE_IOSTREAM) :: YL_IO_OUT_SFC
TYPE(TYPE_IOSTREAM) :: YL_IO_OUT_UA

TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST1
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST2
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST3
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST4
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST5
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST6


!     different orographies used:

!     ZOROI   : interpolated unfitted orog
!     ZFISI   : fitted interpolated and back transformed orog
!     ZFISO   : fitted (climate) output and transformed orog
!     ZSPOR   : spectrally fitted (climate) output orog
!     ZSPORI  : spectrally fitted interpolated orog - reset to output if LLSPOR
!     ZDIFINT : fitted interpolated orog - unfitted interpolated orog
!     ZDIFOUT : fitted output       orog - unfitted interpolated orog

!     ------------------------------------------------------------------
#include "fcttim.h"

#include "abor1.intfb.h"
#include "gppre.intfb.h"

INTERFACE
#include "dir_trans.h"
#include "inv_trans.h"
END INTERFACE

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

IF (LHOOK) CALL DR_HOOK('SPECFITG',0,ZHOOK_HANDLE)

IVSETSC(:)=1

ALLOCATE(IGRIBIO(5,JPOS3DF*NFLEVG+JPOS2DF+JPOSPHY))

IGRIBIO(1,:) = -999
IGRIBIO(2,:) = -999
IGRIBIO(5,:) = 0

!     USED FOR TEMPERATURE CORRECTION
ZDTSGDZ=RDTDZ1/RG

!     2.           INPUT GRIDPOINT FILES

!     open horizontally pre-post-processed file for upper air fields

CLMODE = 'r'
CLFNIGG = ' '
CLR1 = 'ICMFP'
CLR2 = CFNGG(6:9)
CLR3 = 'ICMGC'
IF (LINC) THEN
  IINC = NINT(REAL(NSTEP,JPRB)*TSTEP/3600._JPRB)
ELSE
  IINC = NSTEP
ENDIF
IF (NSTEP < 0) THEN
  WRITE(CLFNIGG,'(A5,A4,I5.4)')CLR1,CLR2,NSTEP
  WRITE(CLFNIGC,'(A5,A4,I5.4)')CLR3,CLR2,NSTEP
ELSE
  WRITE(CLFNIGG,'(A5,A4,''+'',I6.6)')CLR1,CLR2,IINC
  WRITE(CLFNIGC,'(A5,A4,''+'',I6.6)')CLR3,CLR2,IINC
ENDIF

WRITE(NULOUT,'(A,A16)')' GRIDPOINT UA PRE-PROCESSED DATA TO BE READ FROM FILE  ', CLFNIGG  
WRITE(NULOUT,'(A,A16)')' GRIDPOINT SFC - CLIMATE    DATA TO BE READ FROM FILE  ', CLFNIGC    
CALL SETUP_IOSTREAM(YL_IO_IN_GG,'CIO',TRIM(CLFNIGG),CDMODE='r',KIOMASTER=1)
CALL SETUP_IOSTREAM(YL_IO_IN_GC,'CIO',TRIM(CLFNIGC),CDMODE='r',KIOMASTER=1)


!     *       2.1  Define scalings for grib reading and writing  

!     *       2.2  READ IN GRID-POINT FIELDS FROM GRIB DATA

! Initialise igribio data structure
!   1 - grib code
!   2 - level
!   3 - processor directed to perform grib input
!   4 - indicator to show field has been read

!    u wind component

I=0
DO JLEV=1,NFLEVG
  CALL MKGRIBIO(NGRBU,JLEV,I,IGRIBIO)
ENDDO

!    v wind component

DO JLEV=1,NFLEVG
  CALL MKGRIBIO(NGRBV,JLEV,I,IGRIBIO)
ENDDO

!  vorticity and divergence (are derived from u/v)

!  Temperature

DO JLEV=1,NFLEVG
  CALL MKGRIBIO(NGRBT,JLEV,I,IGRIBIO)
ENDDO

!  surface pressure

CALL MKGRIBIO(NGRBSP,1,I,IGRIBIO)
LLSP = .TRUE.

!  log surface pressure

CALL MKGRIBIO(NGRBLNSP,1,I,IGRIBIO)
LLLNSP = .TRUE.

INHDYN=0

IF(LNHDYN)THEN

  INHDYN=2
!  surface vertical velocity

  ALLOCATE(ZWWS(NGPTOT))
  ZWWS=0.0_JPRB
  ALLOCATE(ZSHWWS(NSPEC2))
  CALL MKGRIBIO(NGRB080,1,I,IGRIBIO)

!  pressure departure

  ALLOCATE (ZPNH(NGPTOT,NFLEVG,1,1))
  DO JLEV=1,NFLEVG
    CALL MKGRIBIO(NGRB118,JLEV,I,IGRIBIO)
  ENDDO

! vertical velocity or pseudo divergence == g*delta_w

  ALLOCATE (ZW(NGPTOT,NFLEVG,1,1))
  ZW=0.0_JPRB
  ALLOCATE (ZREAL(NGPTOT,NFLEVG,1,1))
  DO JLEV=1,NFLEVG
    CALL MKGRIBIO(NGRB120,JLEV,I,IGRIBIO)
  ENDDO

ENDIF

!  GFL

INUMGFL=YGFL%NUMFLDS
ALLOCATE(IGRIBGFL(INUMGFL))
DO JGFL=1,INUMGFL
  DO JLEV=1,NFLEVG
    CALL MKGRIBIO(YGFLC(JGFL)%IGRBCODE,JLEV,I,IGRIBIO)
  ENDDO
  IGRIBGFL(JGFL) = YGFLC(JGFL)%IGRBCODE
ENDDO

!  Charnock parameter

IF(LWCOU.AND.LWCOU2W) THEN
  CALL MKGRIBIO(NGRBCHNK,0,I,IGRIBIO)
ENDIF

!  interpolated gridpoint orography

CALL MKGRIBIO(NGRBZ,1,I,IGRIBIO)

!  surface temperature lev 1/2/3/4

CALL MKGRIBIO(NGRBSTL1,0  ,I,IGRIBIO)
CALL MKGRIBIO(NGRBSTL2,7  ,I,IGRIBIO)
CALL MKGRIBIO(NGRBSTL3,28 ,I,IGRIBIO)
CALL MKGRIBIO(NGRBSTL4,100,I,IGRIBIO)

!  ice surface temperature 1/2/3/4     

CALL MKGRIBIO(NGRBISTL1,0  ,I,IGRIBIO)
CALL MKGRIBIO(NGRBISTL2,7  ,I,IGRIBIO)
CALL MKGRIBIO(NGRBISTL3,28 ,I,IGRIBIO)
CALL MKGRIBIO(NGRBISTL4,100,I,IGRIBIO)

!  soil wetness lev 1/2/3/4

CALL MKGRIBIO(NGRBSWVL1,0  ,I,IGRIBIO)
CALL MKGRIBIO(NGRBSWVL2,7  ,I,IGRIBIO)
CALL MKGRIBIO(NGRBSWVL3,28 ,I,IGRIBIO)
CALL MKGRIBIO(NGRBSWVL4,100,I,IGRIBIO)

! snow depth

CALL MKGRIBIO(NGRBSD,0,I,IGRIBIO)

! skin reservoir contents

CALL MKGRIBIO(NGRBSRC,0,I,IGRIBIO)

!  skin temperature

CALL MKGRIBIO(NGRBSKT,0,I,IGRIBIO)

!  sea surface temperature

CALL MKGRIBIO(NGRBSSTK,0,I,IGRIBIO)

!  ocean current

IF(LECURR.AND.(.NOT. LMCC04)) THEN
  CALL MKGRIBIO(NGRBUCUR,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBVCUR,0,I,IGRIBIO)
ENDIF

!  ice cover

CALL MKGRIBIO(NGRBCI,0,I,IGRIBIO)

!  snow temperature 

CALL MKGRIBIO(NGRBTSN,0,I,IGRIBIO)

!  snow albedo 

CALL MKGRIBIO(NGRBASN,0,I,IGRIBIO)

!  snow density

CALL MKGRIBIO(NGRBRSN,0,I,IGRIBIO)

! climate fields

ICLIM=I

CALL MKGRIBIO(NGRBLSM ,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBSDFOR  ,0,I,IGRIBIO)
IF(LCO2SFC) THEN
  CALL MKGRIBIO(NGRBCO2NBF ,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBCO2OF ,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBCO2APF ,0,I,IGRIBIO)
  IF(LFIRE) THEN
    CALL MKGRIBIO(NGRBCO2FIRE ,0,I,IGRIBIO)
  ENDIF
ENDIF
IF(LCH4SFC) THEN
  CALL MKGRIBIO(NGRBCH4F,0,I,IGRIBIO)
  IF(LFIRE) THEN
    CALL MKGRIBIO(NGRBCH4FIRE,0,I,IGRIBIO)
  ENDIF
ENDIF
IF(LSF6SFC) THEN
  CALL MKGRIBIO(NGRBSF6APF ,0,I,IGRIBIO)
ENDIF
IF(LAEROSFC) THEN
  CALL MKGRIBIO(NGRBAERDEP,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLTS,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERSCC,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLS01,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLS02,0,I,IGRIBIO)
  IF(LFIRE) CALL MKGRIBIO(NGRBAERLS10,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLS03,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLS04,0,I,IGRIBIO)
  IF(LFIRE) CALL MKGRIBIO(NGRBAERLS11,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLS05,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLS06,0,I,IGRIBIO)
  IF(LFIRE) CALL MKGRIBIO(NGRBAERLS12,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLS07,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLS08,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBAERLS09 ,0,I,IGRIBIO)
ENDIF
IF(LGRGSFC .AND. NGRG > 0 ) THEN
 DO JGRG=1,NGRG
   CALL MKGRIBIO(NGRBGRGSFC(JGRG) ,0,I,IGRIBIO)
 ENDDO
ENDIF
CALL MKGRIBIO(NGRBAL  ,0,I,IGRIBIO)
IF(LE4ALB) THEN
  CALL MKGRIBIO(NGRBALUVP,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBALUVD,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBALNIP,0,I,IGRIBIO)
  CALL MKGRIBIO(NGRBALNID,0,I,IGRIBIO)
ENDIF
CALL MKGRIBIO(NGRBSR  ,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBLSRH,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBSDOR,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBANOR,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBISOR,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBSLOR,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBCVL ,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBCVH ,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBTVL ,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBTVH ,0,I,IGRIBIO)
IF(LELAIV) THEN
CALL MKGRIBIO(NGRBLAIH,0,I,IGRIBIO)
CALL MKGRIBIO(NGRBLAIL,0,I,IGRIBIO)
ENDIF
CALL MKGRIBIO(NGRBSLT,0,I,IGRIBIO)

IGGMAX = I
ALLOCATE(ZFLD(NGPTOT,IGGMAX,1))
ALLOCATE(LLMISSING(IGGMAX))

CALL SETUP_IOREQUEST(YL_IOREQUEST1,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
 & KGRIB2D=IGRIBIO(1,1:ICLIM),KLEVS2D=IGRIBIO(2,1:ICLIM),KPROMA=NGPTOT,&
 & LDREADALL=.TRUE.)
CALL IO_GET(YL_IO_IN_GG,YL_IOREQUEST1,PR3=ZFLD(:,1:ICLIM,:),&
 & LDMISSING_2D=LLMISSING(1:ICLIM))
CALL CLOSE_IOREQUEST(YL_IOREQUEST1)
CALL CLOSE_IOSTREAM(YL_IO_IN_GG)

CALL SETUP_IOREQUEST(YL_IOREQUEST2,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
 & KGRIB2D=IGRIBIO(1,ICLIM+1:IGGMAX),KLEVS2D=IGRIBIO(2,ICLIM+1:IGGMAX),&
 & KPROMA=NGPTOT,LDREADALL=.TRUE.)
CALL IO_GET(YL_IO_IN_GC,YL_IOREQUEST2,PR3=ZFLD(:,ICLIM+1:IGGMAX,:),&
 & LDMISSING_2D=LLMISSING(ICLIM+1:IGGMAX))
CALL CLOSE_IOREQUEST(YL_IOREQUEST2)
CALL CLOSE_IOSTREAM(YL_IO_IN_GC)

LLABORT = .FALSE.
DO J=1,IGGMAX
  IF( LLMISSING(J) )THEN
!         allow one of NGRBSP and NGRBLNSP to be missing
    WRITE(NULOUT,'("SPECFITG: MISSING FIELD ==",I6)') IGRIBIO(1,J)
    IF( IGRIBIO(1,J) == NGRBSP ) THEN
      LLSP = .FALSE.
    ELSEIF( IGRIBIO(1,J) == NGRBLNSP ) THEN
      LLLNSP = .FALSE.
    ELSE
      LLABORT = .TRUE.
    ENDIF
  ENDIF
ENDDO

IF(LLABORT .OR. .NOT. (LLSP .OR. LLLNSP)) THEN
  WRITE(NULOUT,*) 'ICLIM,IGGMAX,LLSP,LLLNSP,LLABORT ',ICLIM,IGGMAX,LLSP,LLLNSP,LLABORT
  DO J=1,IGGMAX
    WRITE(NULOUT,*) 'J,IGRIBIO(1,J),LLMISSING(J) ',J,IGRIBIO(1,J),LLMISSING(J)
  ENDDO
  CALL ABOR1(' SPECFITG: LESS INPUT FIELDS THAN EXPECTED ')
ENDIF

INUMGFL = YGFL%NUMFLDS
ALLOCATE(ZGFL(NGPTOT,NFLEVG,INUMGFL,1))

! apply scaling
DO JFLD=1,IGGMAX
  IGRIBCD = IGRIBIO(1,JFLD)
  ILEVEL  = IGRIBIO(2,JFLD) 
  IF    (IGRIBCD == NGRBSD  ) THEN
    ZSCALE = RHOH2O
  ELSEIF(IGRIBCD == NGRBSR  ) THEN
    ZSCALE = RG
  ELSEIF(IGRIBCD == NGRBSRC ) THEN
    ZSCALE = RHOH2O
  ELSEIF(IGRIBCD == NGRBSDOR) THEN
    ZSCALE = RG
  ELSE
    ZSCALE = 1.0_JPRB
  ENDIF

  IF(ZSCALE /= 1.0_JPRB) THEN
    ZFLD(:,JFLD,1)=ZFLD(:,JFLD,1)*ZSCALE
  ENDIF

! Now fill local arrays

  IF( IGRIBCD == NGRBT )THEN
    ZGPT(:,ILEVEL,1,1)=ZFLD(:,JFLD,1)
    IGRIBIO(2,JFLD)=1
    IGRIBIO(5,JFLD)=1
  ELSEIF( IGRIBCD == NGRBU )THEN
    ZUV(:,ILEVEL,1,1)=ZFLD(:,JFLD,1)
    IGRIBIO(2,JFLD)=1
    IGRIBIO(5,JFLD)=1
  ELSEIF( IGRIBCD == NGRBV )THEN
    ZUV(:,ILEVEL,2,1)=ZFLD(:,JFLD,1)
    IGRIBIO(2,JFLD)=1
    IGRIBIO(5,JFLD)=1
  ELSEIF( IGRIBCD == NGRB118 )THEN
    ZPNH(:,ILEVEL,1,1)=ZFLD(:,JFLD,1)
    IGRIBIO(2,JFLD)=1
    IGRIBIO(5,JFLD)=1
  ELSEIF( IGRIBCD == NGRB120 ) THEN
    ZW(:,ILEVEL,1,1)=ZFLD(:,JFLD,1)
    IGRIBIO(2,JFLD)=1
    IGRIBIO(5,JFLD)=1
  ELSEIF( IGRIBCD == NGRB080 )THEN
    DO J=1,NGPTOT
      ZWWS(J)=ZFLD(J,JFLD,1)
    ENDDO
    CALL DIR_TRANS(PSPSCALAR=ZSPEC(1:1,:),KPROMA=NGPTOT,KVSETSC=IVSETSC(1:1),&
     & PGP=ZFLD(:,JFLD:JFLD,1:1))
    IF( NPROC > 1 )THEN
      CALL MPL_BARRIER(CDSTRING='SPECFITG:')
    ENDIF
    I=0
    ZSHWWS(:)=ZSPEC(1,:)
    IGRIBIO(2,JFLD)=1
    IGRIBIO(5,JFLD)=1
  ELSEIF( IGRIBCD == NGRBSP .AND. LLSP)THEN
    DO J=1,NGPTOT
      ZSP(J)=ZFLD(J,JFLD,1)
    ENDDO
    CALL DIR_TRANS(PSPSCALAR=ZSPEC(1:1,:),KPROMA=NGPTOT,KVSETSC=IVSETSC(1:1),&
     & PGP=ZFLD(:,JFLD:JFLD,1:1))
    IF( NPROC > 1 )THEN
      CALL MPL_BARRIER(CDSTRING='SPECFITG:')
    ENDIF
    I=0
    ZSHSP(:)=ZSPEC(1,:)
    IGRIBIO(2,JFLD)=1
    IGRIBIO(5,JFLD)=1
  ELSEIF( IGRIBCD == NGRBLNSP .AND. LLLNSP)THEN
    DO J=1,NGPTOT
      ZSP(J)=EXP(ZFLD(J,JFLD,1))
    ENDDO
    CALL DIR_TRANS(PSPSCALAR=ZSPEC(1:1,:),KPROMA=NGPTOT,KVSETSC=IVSETSC(1:1),&
     & PGP=ZFLD(:,JFLD:JFLD,1:1))
    IF( NPROC > 1 )THEN
      CALL MPL_BARRIER(CDSTRING='SPECFITG:')
    ENDIF
    ZSHLNSP(:)=ZSPEC(1,:)
    IGRIBIO(2,JFLD)=1
    IGRIBIO(5,JFLD)=1
  ELSEIF(ANY(SPREAD(IGRIBCD,1,INUMGFL) == IGRIBGFL(:))) THEN
    DO JGFL=1,INUMGFL
      IF(IGRIBCD == IGRIBGFL(JGFL) ) THEN
        ZGFL(:,ILEVEL,JGFL,1)=ZFLD(:,JFLD,1)
        IF(YGFLC(JGFL)%LSP) THEN
          IGRIBIO(5,JFLD)=1
        ENDIF
      ENDIF
    ENDDO
  ELSEIF( IGRIBCD == NGRBZ   )THEN
    DO J=1,NGPTOT
      ZOROI(J)=ZFLD(J,JFLD,1)
    ENDDO
    CALL DIR_TRANS(PSPSCALAR=ZSPORI(1:1,:),KPROMA=NGPTOT,KVSETSC=IVSETSC(1:1),&
     & PGP=ZFLD(:,JFLD:JFLD,1:1))
    IF( NPROC > 1 )THEN
      CALL MPL_BARRIER(CDSTRING='SPECFITG:')
    ENDIF
    CALL INV_TRANS(PSPSCALAR=ZSPORI(1:1,:),KPROMA=NGPTOT,KVSETSC=IVSETSC(1:1),&
     & PGP=ZFISI(:,1:1,1:1))
    IF( NPROC > 1 )THEN
      CALL MPL_BARRIER(CDSTRING='SPECFITG:')
    ENDIF
  ENDIF
ENDDO
       
!     NOW READ FILE WITH SPECTRAL CLIMATE OROGRAPHY 

IGGMAX = IGGMAX+1
IFLD = IGGMAX

IGRIBIO(1,IFLD) = NGRBZ
IGRIBIO(2,IFLD) = 0
IGRIBIO(3,IFLD) = 1
IGRIBIO(4,IFLD) = 1
IGRIBIO(5,IFLD) = 1

INQUIRE(FILE='sporog',EXIST=LLSPOR)

IF( LLSPOR ) THEN
  WRITE(NULOUT,*)' SPECTRAL OROGRAPHY IN OUTPUT RESOLUTION FILE = sporog'
  CALL SETUP_IOSTREAM(YL_SPOROG,'CIO','sporog',CDMODE='r',KIOMASTER=1)
  CALL SETUP_IOREQUEST(YL_IOREQUEST3,'SPECTRAL_FIELDS',LDGRIB=.TRUE.,&
   & KGRIB2D=IGRIBIO(1,IFLD:IFLD),KBSET2D=IVSETSC(1:1),KLEVS2D=IGRIBIO(2,IFLD:IFLD),KPROMA=NGPTOT)
  CALL IO_GET(YL_SPOROG,YL_IOREQUEST3,PR2=ZSPOR)
  CALL CLOSE_IOREQUEST(YL_IOREQUEST3)
  CALL CLOSE_IOSTREAM(YL_SPOROG)
  
  IF( MYSETV == IVSETSC(1) ) THEN
    DO J=1,NSPEC2
      ZSPORI(1,J)=ZSPOR(J,1)
    ENDDO
  ELSE
    ZSPORI(1,:)=0.0_JPRB
  ENDIF

  IF( NPROC > 1 )THEN
    CALL MPL_BARRIER(CDSTRING='SPECFITG:')
  ENDIF
  
  CALL INV_TRANS(PSPSCALAR=ZSPORI(1:1,:),KPROMA=NGPTOT,KVSETSC=IVSETSC(1:1),&
   & PGP=ZFISO(:,1:1,1:1))

  IF( NPROC > 1 )THEN
    CALL MPL_BARRIER(CDSTRING='SPECFITG:')
  ENDIF
ENDIF



!     *   0.  OPEN SH OUTPUT FILE FOR SPECTRAL FIELDS
!     -----------------------------------------------

WRITE(NULOUT,'(A,A16)')' SPECTRAL DATA WRITTEN OUT TO FILE,FILE= ',CFNPL  
CALL SETUP_IOSTREAM(YL_IO_OUT_SH,'CIO',TRIM(CFNPL),CDMODE='w',KIOMASTER=1)

!     *   0.1  OPEN SFC OUTPUT FILE FOR CORRECTED SFC FIELDS 
!     ------------------------------------------------------

ILEN = INDEX(CFNPL,' ')-1
CLFPFN1 = 'PH'//CFNPL(3:ILEN)
WRITE(NULOUT,'(A,A16)')' SFC DATA WRITTEN OUT TO FILE ',CLFPFN1
CALL SETUP_IOSTREAM(YL_IO_OUT_SFC,'CIO',TRIM(CLFPFN1),CDMODE='w',KIOMASTER=1)

!     *   0.2  OPEN UA OUTPUT FILE FOR CORRECTED UPPER AIR FIELDS 
!     -----------------------------------------------------------

CLFPFN2 = 'UA'//CFNPL(3:ILEN)
WRITE(NULOUT,'(A,A16)')' UPPER AIR G.P. DATA WRITTEN OUT TO FILE ',CLFPFN2  
CALL SETUP_IOSTREAM(YL_IO_OUT_UA,'CIO',TRIM(CLFPFN2),CDMODE='w',KIOMASTER=1)



! create global arrays, spectrally fit (and/or) adjust and write them out 

! Send my part of each of the grid point fields to the respective
! output processor

! first compute orog. differences

IF( .NOT. LLSPOR ) THEN
  ZFISO(:,1,1) = ZFISI(:,1,1)
ENDIF

DO J=1,NGPTOT
  ZDIFOUT(J) = ZFISO(J,1,1)-ZOROI(J)
  ZDIFINT(J) = ZFISI(J,1,1)-ZOROI(J)
ENDDO


IF (NPRINTLEV >= 0) THEN
  
  ZDIFMAX = 0.0_JPRB
  DO J=1,NGPTOT
    ZDIFMAX = MAX(ZDIFMAX,ABS(ZFISO(J,1,1)-ZFISI(J,1,1)))
  ENDDO
  
  WRITE (NULOUT,FMT='(&
   & '' MAX. DIFFERENCE BETWEEN FITTED OUTPUT'',&
     & '' AND FITTED INTERPOLATED OROGRAPHIES :  '',&
     & F9.2, '' J/kg '')') ZDIFMAX  
  WRITE (NULOUT,FMT='('' ALLOWED DIFFERENCE : '',F9.2,'' J/kg '')') RFPCORR
  IF (ZDIFMAX > RFPCORR) THEN
    WRITE (NULOUT,FMT='(&
     & '' TOO MUH DIFFERENCE >> '',&
     & ''INCREASE RFPCORR IN NAMELIST NAMFPC '')')  
    CALL ABOR1('SPECFITG:')
  ENDIF
  
  ZDIFMAX = 0.0_JPRB
  DO J=1,NGPTOT
    ZDIFMAX = MAX(ZDIFMAX,ABS(ZDIFOUT(J)))
  ENDDO
  WRITE (NULOUT,FMT='(&
   & '' MAX. DIFFERENCE BETWEEN FITTED OUTPUT'',&
   & '' AND UNFITTED INTERPOLATED OROGRAPHIES :  '',&
   & F9.2, '' J/kg '')') ZDIFMAX  
  WRITE (NULOUT,FMT='('' ALLOWED DIFFERENCE : '',F9.2,'' J/kg '')') RFPCORR
  IF (ZDIFMAX > RFPCORR) THEN
    WRITE (NULOUT,FMT='(&
     & '' TOO MUCH DIFFERENCE >> '',&
     & ''INCREASE RFPCORR IN NAMELIST NAMFPC '')')  
    CALL ABOR1('SPECFITG:')
  ENDIF
  
  ZDIFMAX = 0.0_JPRB
  DO J=1,NGPTOT
    ZDIFMAX = MAX(ZDIFMAX,ABS(ZDIFINT(J)))
  ENDDO
  WRITE (NULOUT,FMT='(&
   & '' MAX. DIFFERENCE BETWEEN FITTED'',&
   & '' AND UNFITTED INTERPOLATED OROGRAPHIES :  '',&
   & F9.2, '' J/kg '')') ZDIFMAX  
  WRITE (NULOUT,FMT='('' ALLOWED DIFFERENCE : '',F9.2,'' J/kg '')') RFPCORR
  
  IF (ZDIFMAX > RFPCORR) THEN
    WRITE (NULOUT,FMT='(&
     & '' TOO MUCH DIFFERENCE >> '',&
     & ''INCREASE RFPCORR IN NAMELIST NAMFPC '')')  
    CALL ABOR1('SPECFITG:')
  ENDIF
  
ENDIF

ALLOCATE(ZP(NGPTOT,NFLEVG))

DO JSTGLO=1,NGPTOT,NPROMA
  IST = 1
  IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
  DO J=IST,IEND
    ZPRESH(J,NFLEVG) = ZSP(JSTGLO+J-1)
  ENDDO

  CALL GPPRE(NPROMA,IST,IEND,NFLEVG,VAH,VBH,ZPRESH,ZPRESF)
  DO JLEV=1,NFLEVG
    DO J=IST,IEND
      ZP(JSTGLO+J-1,JLEV) = ZPRESF(J,JLEV)
    ENDDO
  ENDDO
ENDDO

DO JF=1,IGGMAX

  IGRIBCD = IGRIBIO(1,JF)
  ILEVEL  = IGRIBIO(2,JF)

  IF( IGRIBIO(5,JF) /= 1 ) THEN

    IF(ANY(SPREAD(IGRIBCD,1,INUMGFL) == IGRIBGFL(:))) THEN
      DO JGFL=1,INUMGFL
        IF(IGRIBCD ==IGRIBGFL(JGFL) ) THEN
          IGFL = JGFL
        ENDIF
      ENDDO
      IF( IGRIBCD == NGRBQ ) THEN
        DO J=1,NGPTOT
!     Compute saturation humidity at level ILEVEL
          ZQS=FOEEWMCU(ZGPT(J,ILEVEL,1,1))/ZP(J,ILEVEL)
          ZQS=MIN(0.5_JPRB,ZQS)
          ZCOR=1.0_JPRB/(1.0_JPRB-RETV  *ZQS)
          ZQS=ZQS*ZCOR
          ZGFL(J,ILEVEL,IGFL,1)=MAX(0.0_JPRB,MIN(ZQS,ZGFL(J,ILEVEL,IGFL,1)))
        ENDDO
      ELSEIF( IGRIBCD == NGRBCLWC )THEN
! make sure CLWC is a above 0.
        DO J=1,NGPTOT
          ZGFL(J,ILEVEL,IGFL,1)=MAX(0.0_JPRB,ZGFL(J,ILEVEL,IGFL,1))
        ENDDO
      ELSEIF( IGRIBCD == NGRBCIWC )THEN
! make sure CIWC is a above 0.
        DO J=1,NGPTOT
          ZGFL(J,ILEVEL,IGFL,1)=MAX(0.0_JPRB,ZGFL(J,ILEVEL,IGFL,1))
        ENDDO
      ELSEIF( IGRIBCD == NGRBCC   )THEN
! make sure CC is a above 0. and below 1.
        DO J=1,NGPTOT
          ZGFL(J,ILEVEL,IGFL,1)=MIN(1.0_JPRB,MAX(0.0_JPRB,ZGFL(J,ILEVEL,IGFL,1)))
        ENDDO
      ENDIF
    ENDIF
  ENDIF
ENDDO

CALL SETUP_IOREQUEST(YL_IOREQUEST4,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
 & KGRIB3D=IGRIBGFL(1:YGFL%NUMGPFLDS),KPROMA=NGPTOT,CDLEVTYPE='ML')
CALL IO_PUT(YL_IO_OUT_UA,YL_IOREQUEST4,PR4=ZGFL(:,:,1:YGFL%NUMGPFLDS,:))
CALL CLOSE_IOREQUEST(YL_IOREQUEST4)
CALL CLOSE_IOSTREAM(YL_IO_OUT_UA)

ISF = 0
ALLOCATE(ZSFOUT(NGPTOT,IGGMAX,1))
ALLOCATE(IGRIBOUT(IGGMAX))
ALLOCATE(ILEVOUT(IGGMAX))
DO JF=1,IGGMAX

  IGRIBCD = IGRIBIO(1,JF)
  ILEVEL  = IGRIBIO(2,JF)

  IF( IGRIBIO(5,JF) /= 1 ) THEN

    IF(ANY(SPREAD(IGRIBCD,1,INUMGFL) == IGRIBGFL(:))) THEN
!      Already done
    ELSEIF( IGRIBCD == NGRBCHNK   )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBZ )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZOROI,ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSTL1 .OR. IGRIBCD == NGRBSTL2 &
    &  .OR. IGRIBCD == NGRBSTL3 .OR. IGRIBCD == NGRBSTL4 &
    &  .OR. IGRIBCD == NGRBISTL1.OR. IGRIBCD == NGRBISTL2&
    &  .OR. IGRIBCD == NGRBISTL3.OR. IGRIBCD == NGRBISTL4)THEN
      DO J=1,NGPTOT
        ZREEL(J)=ZFLD(J,JF,1)+ZDTSGDZ*ZDIFOUT(J)
      ENDDO
      CALL OUTSFC(IGRIBCD,ILEVEL,ZREEL,ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSWVL1 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSWVL2 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSWVL3 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSWVL4 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSD )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSRC )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSKT )THEN
      DO J=1,NGPTOT
        ZREEL(J)=ZFLD(J,JF,1)+ZDTSGDZ*ZDIFOUT(J)
      ENDDO
      CALL OUTSFC(IGRIBCD,ILEVEL,ZREEL,ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSSTK )THEN
      DO J=1,NGPTOT
        ZREEL(J)=ZFLD(J,JF,1)+ZDTSGDZ*ZDIFOUT(J)
      ENDDO
      CALL OUTSFC(IGRIBCD,ILEVEL,ZREEL,ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBCI )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBTSN )THEN
      DO J=1,NGPTOT
        ZREEL(J)=ZFLD(J,JF,1)+ZDTSGDZ*ZDIFOUT(J)
      ENDDO
      CALL OUTSFC(IGRIBCD,ILEVEL,ZREEL,ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBASN )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBRSN )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
! climate fields
    ELSEIF( IGRIBCD == NGRBLSM )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSDFOR )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBCO2NBF )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBCO2OF )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBCO2APF )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBCO2FIRE )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSF6APF )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBCH4F )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBCH4FIRE )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAL )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
!-- MODIS albedo
    ELSEIF( IGRIBCD == NGRBALUVP )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBALUVD )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBALNIP )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBALNID )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
! aerosol climatological fields
    ELSEIF( IGRIBCD == NGRBAERDEP )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLTS )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERSCC )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)

    ELSEIF( IGRIBCD == NGRBAERLS01 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS02 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS10 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS03 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS04 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS11 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS05 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS06 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS12 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS07 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS08 )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBAERLS09  )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF(ANY(IGRIBCD == NGRBGRGSFC(1:NGRG))  )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
!--
    ELSEIF( IGRIBCD == NGRBSR )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBLSRH )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSDOR )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBISOR )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBANOR )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSLOR )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBCVL )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBCVH )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBTVL )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBTVH )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBLAIL )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBLAIH )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSEIF( IGRIBCD == NGRBSLT )THEN
      CALL OUTSFC(IGRIBCD,ILEVEL,ZFLD(:,JF,1),ISF,IGRIBOUT,ILEVOUT,ZSFOUT)
    ELSE
      CYCLE
    ENDIF
! apply scaling

    IF    (IGRIBCD == NGRBSD  ) THEN
      ZSCALE =  1.0_JPRB/RHOH2O
    ELSEIF(IGRIBCD == NGRBSR  ) THEN
      ZSCALE = 1.0_JPRB/RG
    ELSEIF(IGRIBCD == NGRBSRC ) THEN
      ZSCALE = 1.0_JPRB/RHOH2O
    ELSEIF(IGRIBCD == NGRBSDOR) THEN
      ZSCALE = 1.0_JPRB/RG
    ELSE
      ZSCALE = 1.0_JPRB
    ENDIF
      
    IF(ZSCALE /= 1.0_JPRB) THEN
      ZSFOUT(:,ISF,1) = ZSFOUT(:,ISF,1)*ZSCALE
    ENDIF
  ENDIF
ENDDO

CALL SETUP_IOREQUEST(YL_IOREQUEST5,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
 & KGRIB2D=IGRIBOUT(1:ISF),KLEVS2D=ILEVOUT(1:ISF),KPROMA=NGPTOT,CDLEVTYPE='SFC')
CALL IO_PUT(YL_IO_OUT_SFC,YL_IOREQUEST5,PR3=ZSFOUT(:,1:ISF,:))
CALL CLOSE_IOREQUEST(YL_IOREQUEST5)
CALL CLOSE_IOSTREAM(YL_IO_OUT_SFC)

! deal with spectral arrays
ALLOCATE(ZSPEC3(NFLEVL,NSPEC2,3+INHDYN+YGFL%NUMSPFLDS))

CALL DIR_TRANS(PSPVOR=ZSPEC3(:,:,1),PSPDIV=ZSPEC3(:,:,2),PGPUV=ZUV,&
 & KVSETUV=NBSETLEV,KPROMA=NGPTOT)
CALL DIR_TRANS(PSPSC3A=ZSPEC3(:,:,3:3),PGP3A=ZGPT,&
 & KVSETSC3A=NBSETLEV,KPROMA=NGPTOT)
IF(LNHDYN)THEN
! trick to create g*delta_w == pseudo-vertical divergence
! Convert NH half level vertical velocity into pseudo-vertical divergence
! Note, on file there is always g*delta_w (on full levels) and p-pi
! Note, in model there is d3, d4, or other
! Note, in full-pos there is p-pi (on full levels) and w (on half levels)
! Only correct for LVERTFE=.FALSE.
  DO ILEVEL=1,NFLEVG
    IF( ILEVEL <= NFLEVG-1 ) THEN
      ZREAL(:,ILEVEL,1,1)=-RG*(ZW(:,ILEVEL+1,1,1)-ZW(:,ILEVEL,1,1))
    ELSE
! surface vertical velocity ZWWS used here, Nils
      ZREAL(:,ILEVEL,1,1)=-RG*(ZWWS(:)-ZW(:,ILEVEL,1,1))
    ENDIF
  ENDDO
  CALL DIR_TRANS(PSPSC3A=ZSPEC3(:,:,4:4),PGP3A=ZPNH,&
   & KVSETSC3A=NBSETLEV,KPROMA=NGPTOT)
  CALL DIR_TRANS(PSPSC3A=ZSPEC3(:,:,5:5),PGP3A=ZREAL,&
   & KVSETSC3A=NBSETLEV,KPROMA=NGPTOT)
ENDIF

IF(YGFL%NUMSPFLDS>0) THEN
  CALL DIR_TRANS(PSPSC3A=ZSPEC3(:,:,(4+INHDYN):(4+INHDYN)+YGFL%NUMSPFLDS-1),&
   & PGP3A=ZGFL(:,:,YGFL%NUMGPFLDS+1:INUMGFL,:),&
   & KVSETSC3A=NBSETLEV,KPROMA=NGPTOT)
ENDIF

! 3d fields
IGRIB3D(1) = NGRBVO
IGRIB3D(2) = NGRBD
IGRIB3D(3) = NGRBT
I3D = 3
IF(LNHDYN)THEN
  IGRIB3D(4) = NGRB118
  IGRIB3D(5) = NGRB119 
! Switched from 120 for compatibility with SUINIF
  I3D = I3D+INHDYN
ENDIF
DO JGFL=1,INUMGFL
  IF(YGFLC(JGFL)%LSP) THEN
    I3D = I3D+1
    IGRIB3D(I3D) = IGRIBGFL(JGFL)
  ENDIF
ENDDO

ALLOCATE(ILEVS2D(I3D*NFLEVG))
ALLOCATE(IBSET2D(I3D*NFLEVG))
ALLOCATE(IGRIBSH(I3D*NFLEVG))

ICT=0
DO JF=1,I3D
  DO JFLD=1,NFLEVG
    ICT=ICT+1
    ILEVS2D(ICT)=JFLD
    IBSET2D(ICT)=NBSETLEV(JFLD)
    IGRIBSH(ICT)=IGRIB3D(JF)
  ENDDO
ENDDO

ALLOCATE(ZPTRFLD(NSPEC2,I3D*NFLEVL))

ICT=0
DO JF=1,I3D
  IMYLEV=0
  DO JFLD=1,NFLEVG
    IF( MYSETV == NBSETLEV(JFLD) ) THEN
      ICT=ICT+1
      IMYLEV=IMYLEV+1
      DO JNM=1,NSPEC2
        ZPTRFLD(JNM,ICT)=ZSPEC3(IMYLEV,JNM,JF)
      ENDDO
    ENDIF
  ENDDO
ENDDO

CALL SETUP_IOREQUEST(YL_IOREQUEST6,'SPECTRAL_FIELDS',LDGRIB=.TRUE.,CDLEVTYPE='ML',&
 & KGRIB2D=IGRIBSH,KBSET2D=IBSET2D,KLEVS2D=ILEVS2D)
CALL IO_PUT(YL_IO_OUT_SH,YL_IOREQUEST6,PR2=ZPTRFLD)
CALL CLOSE_IOREQUEST(YL_IOREQUEST6)


! 2d fields

ZPTRFLD(1:NSPEC2,1:3)=0.0_JPRB
ICT=1
IF( MYSETV == IVSETSC(1) ) ZPTRFLD(1:NSPEC2,ICT) = ZSHLNSP(1:NSPEC2)
IGRIBSH(ICT)=NGRBLNSP
ICT=ICT+1
IF( MYSETV == IVSETSC(1) ) ZPTRFLD(1:NSPEC2,ICT) = ZSPORI(1,1:NSPEC2)
IGRIBSH(ICT)=NGRBZ
IF(LNHDYN)THEN
  ICT=ICT+1
  IF( MYSETV == IVSETSC(1) ) ZPTRFLD(1:NSPEC2,ICT) = ZSHWWS(1:NSPEC2)
  IGRIBSH(ICT)=NGRB080
ENDIF
I2D=ICT
ILEVS2D(1:I2D)=0

CALL SETUP_IOREQUEST(YL_IOREQUEST6,'SPECTRAL_FIELDS',LDGRIB=.TRUE.,&
 & KGRIB2D=IGRIBSH(1:I2D),KBSET2D=IVSETSC(1:I2D),KLEVS2D=ILEVS2D(1:I2D))
CALL IO_PUT(YL_IO_OUT_SH,YL_IOREQUEST6,PR2=ZPTRFLD(1:NSPEC2,1:I2D))
CALL CLOSE_IOREQUEST(YL_IOREQUEST6)

CALL CLOSE_IOSTREAM(YL_IO_OUT_SH)

DEALLOCATE(ZPTRFLD)
DEALLOCATE(IBSET2D)
DEALLOCATE(ILEVS2D)
DEALLOCATE(IGRIBSH)

IF(ALLOCATED(LLMISSING)) DEALLOCATE(LLMISSING)
IF(ALLOCATED(ZSFOUT))    DEALLOCATE(ZSFOUT)
IF(ALLOCATED(ZFLD))      DEALLOCATE(ZFLD)
IF(ALLOCATED(ZSPEC3))    DEALLOCATE(ZSPEC3)
IF(ALLOCATED(IGRIBIO))   DEALLOCATE(IGRIBIO)
IF(ALLOCATED(IGRIBOUT))  DEALLOCATE(IGRIBOUT)
IF(ALLOCATED(ILEVOUT))   DEALLOCATE(ILEVOUT)
IF(ALLOCATED(IGRIBGFL))  DEALLOCATE(IGRIBGFL)
IF(ALLOCATED(ZGFL))      DEALLOCATE(ZGFL)
IF(ALLOCATED(ZP))        DEALLOCATE(ZP)
IF(ALLOCATED(ZW))        DEALLOCATE(ZW)
IF(ALLOCATED(ZREAL))     DEALLOCATE(ZREAL)
IF(ALLOCATED(ZPNH))      DEALLOCATE(ZPNH)
IF(ALLOCATED(ZSHWWS))    DEALLOCATE(ZSHWWS)
IF(ALLOCATED(ZWWS))      DEALLOCATE(ZWWS)


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

IF (LHOOK) CALL DR_HOOK('SPECFITG',1,ZHOOK_HANDLE)
CONTAINS

SUBROUTINE MKGRIBIO(KGRIB,KLEV,KPT,KGRIBIO)
INTEGER(KIND=JPIM),INTENT(IN)    :: KGRIB
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
INTEGER(KIND=JPIM),INTENT(INOUT) :: KPT
INTEGER(KIND=JPIM),INTENT(INOUT) :: KGRIBIO(:,:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('SPECFITG:MKGRIBIO',0,ZHOOK_HANDLE)
KPT = KPT+1
KGRIBIO(1,KPT) = KGRIB
KGRIBIO(2,KPT) = KLEV
IF (LHOOK) CALL DR_HOOK('SPECFITG:MKGRIBIO',1,ZHOOK_HANDLE)
END SUBROUTINE MKGRIBIO

SUBROUTINE OUTSFC(KGRIB,KLEV,PFLD,KSF,KGRIBOUT,KLEVOUT,PSFOUT)
INTEGER(KIND=JPIM),INTENT(IN)    :: KGRIB
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFLD(:)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSF
INTEGER(KIND=JPIM),INTENT(OUT)   :: KGRIBOUT(:)
INTEGER(KIND=JPIM),INTENT(OUT)   :: KLEVOUT(:)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFOUT(:,:,:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('SPECFITG:OUTSFC',0,ZHOOK_HANDLE)
KSF = KSF+1
KGRIBOUT(KSF) = KGRIB
KLEVOUT(KSF)  = KLEV
PSFOUT(:,KSF,1) = PFLD(:)
IF (LHOOK) CALL DR_HOOK('SPECFITG:OUTSFC',1,ZHOOK_HANDLE)

END SUBROUTINE OUTSFC
END SUBROUTINE SPECFITG
