SUBROUTINE UPDRLXREF

!**** *UPDRLXREF*

!     PURPOSE.
!     --------

!     Updates the reference fields for relaxation - distributed version

!**   INTERFACE.
!     ----------

!     CALL UPDRLXREF

!     METHOD.
!     -------
!     Reads the analyses for 2 6h-ranges and fills the spectral arrays

!     EXTERNALS.
!     ----------

!     AUTHORS.
!     --------
!         T. Jung  06-08-10.

!     MODIFICATIONS.
!     --------------
!         T Wilhelmsson 03-06-2011  Replace GRIBEX with GRIB_API
!         L Magnusson   05-07-2012  Gaussian fields and use IOSTREAM

USE PARKIND1 , ONLY : JPIM     ,JPIB     ,JPRB
USE YOMHOOK  , ONLY : LHOOK,   DR_HOOK
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMDIM   , ONLY : NFLEVG   ,NSPECG   ,NSPEC2G  ,NSPEC2   ,NSMAX, NPROMA, NGPBLKS
USE YOMRIP   , ONLY : NINDAT   ,NSSSSS   ,NSTADD   ,NSTASS   ,RSTATI
USE YOMCT0   , ONLY : NSTOP    ,NPRTRW   ,NPROC
USE YOMMP    , ONLY : MYPROC   ,NPRCIDS  ,NBSETLEV ,MYSETV   ,NPTRLL  ,NBSETSP
USE YOMMPG   , ONLY : NPOSSP   ,NDIM0G
USE YOMTAG   , ONLY : MTAGDISTSP
USE YOMRLX   , ONLY : NRLXAN,NFRLXG,NFRLXU,LRLXVO,LRLXDI,LRLXTE ,LRLXQ,LRLXLP, &
   & LRLXQL  ,LRLXQI  ,LRLXQC
USE YOMSRLX  , ONLY : TRLXVO   ,TRLXDI   ,TRLXTE,TRLXQ  ,TRLXLP, &
   & TRLXQL  ,TRLXQI  ,TRLXQC
USE MPL_MODULE
!USE GRIB_API


USE YOMCT0   , ONLY : LFPART2, NINTERPINCR
USE YOMGEM   , ONLY : NGPTOT
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_GET, &
 & CLOSE_IOSTREAM, TYPE_IOSTREAM , TYPE_IOREQUEST, CLOSE_IOREQUEST

IMPLICIT NONE

#include "abor1.intfb.h"
#include "updcalsec.intfb.h"
#include "set2pe.intfb.h"

REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTEGER(KIND=JPIM) :: IY0, IM0, ID0, IH0, IHOUR,IMIN,ISEC,IDAY,IMONTH,IYEAR
INTEGER(KIND=JPIM) :: IDATE0, IDATE1, IDATE(2), ITIME(2)
INTEGER(KIND=JPIM) :: IUPD, IUPDHH, IUPDDD, IUPDSS, ISTEP, ILMONTH(12)
INTEGER(KIND=JPIM) :: JN, JM, JNM, JA, JLEV,JLEV2, IRCV, ILOCLV, II, IAA,JK
INTEGER(KIND=JPIM) :: ILEN, ITAG, ISND, ILENSH, IRET, IUNITSH, IGRIB
INTEGER(KIND=JPIM), SAVE :: IDXSH
INTEGER(KIND=JPIM) :: JKGLO, ICEND, IBL, IOFF, JROF

! --- FIELDS 
REAL(KIND=JPRB) :: ZGG(NPROMA,NFLEVG,1,NGPBLKS)
REAL(KIND=JPRB) :: ZSP3(NFLEVG,NSPEC2G,1)
REAL(KIND=JPRB) :: ZSP2(NSPEC2G,1)
INTEGER(KIND=JPIM) :: IGRIB3D(1)
INTEGER(KIND=JPIM) :: ILEVS3D(NFLEVG)
INTEGER(KIND=JPIM) :: ILEVS2D(1)
CHARACTER*20 CLNAMFSH,CLDATETIME
CHARACTER*40 CLNAMRLX 
LOGICAL :: LLSCAN, LLOPEN

LOGICAL :: LLSPINT, LLINCR
TYPE(TYPE_IOSTREAM) :: YL_IOSTREAM
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST

#include "fcttim.h"

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

WRITE(NULOUT,'('' UPDRLXREF: Updating reference fields '')')

LLSCAN = .FALSE.
LLOPEN = .FALSE.

!*    1.1 Calendar

ID0=NDD(NINDAT)
IM0=NMM(NINDAT)
IY0=NCCAA(NINDAT)
IH0=NSSSSS/3600_JPIM
CALL UPDCALSEC(IH0,ID0,IM0,IY0,NSTADD,NSTASS,IHOUR,IMIN,ISEC,IDAY,IMONTH,IYEAR,ILMONTH,NULOUT)

IDATE0=IY0*1000000+IM0*10000+ID0*100+IH0 
IDATE1=IYEAR*1000000+IMONTH*10000+IDAY*100+IHOUR
IUPD=RSTATI/(3600_JPIM*NFRLXU) 
ISTEP=IUPD+1
!ISTEP=IUPD+1-1  !New Change

IUPDHH=IUPD*NFRLXU
IUPDDD=IUPDHH/24
IUPDSS=(IUPDHH - IUPDDD*24)*3600
CALL UPDCALSEC(IH0,ID0,IM0,IY0,IUPDDD,IUPDSS,IHOUR,IMIN,ISEC,IDAY,IMONTH,IYEAR,ILMONTH,NULOUT)
IDATE(1) = IYEAR*10000+IMONTH*100+IDAY
ITIME(1) = IHOUR*100

IUPDHH=(IUPD+1)*NFRLXU
IUPDDD=IUPDHH/24
IUPDSS=(IUPDHH - IUPDDD*24)*3600
CALL UPDCALSEC(IH0,ID0,IM0,IY0,IUPDDD,IUPDSS,IHOUR,IMIN,ISEC,IDAY,IMONTH,IYEAR,ILMONTH,NULOUT)
IDATE(2) = IYEAR*10000+IMONTH*100+IDAY
ITIME(2) = IHOUR*100

WRITE(NULOUT,*)'   NSSSSS                          ',NSSSSS
WRITE(NULOUT,*)'   Number of reference step        ',IUPD
WRITE(NULOUT,*)'   Initial date                    ',IDATE0
WRITE(NULOUT,*)'   Current reference date          ',IDATE1
WRITE(NULOUT,*)'   First reference field           ',IDATE(1)*100 + ITIME(1)/100
WRITE(NULOUT,*)'   Second reference field          ',IDATE(2)*100 + ITIME(2)/100

!* 1.3 Here we compute some variables for later use

ILENSH=NSPEC2G

IF(ISTEP == 1) THEN
  LLSCAN=.TRUE.
ELSE
  LLSCAN=.FALSE.
ENDIF

! --- allocating relaxation arrays if necessary
IF (.not.ALLOCATED (TRLXTE)) ALLOCATE(TRLXTE(NFLEVG,NSPEC2,NFRLXG))
IF (.not.ALLOCATED (TRLXDI)) ALLOCATE(TRLXDI(NFLEVG,NSPEC2,NFRLXG))
IF (.not.ALLOCATED (TRLXVO)) ALLOCATE(TRLXVO(NFLEVG,NSPEC2,NFRLXG))
IF (.not.ALLOCATED (TRLXLP)) ALLOCATE(TRLXLP(NSPEC2,NFRLXG))
IF (.not.ALLOCATED (TRLXQ)) ALLOCATE(TRLXQ(NPROMA,NFLEVG,NFRLXG,NGPBLKS))
IF (.not.ALLOCATED (TRLXQL)) ALLOCATE(TRLXQL(NPROMA,NFLEVG,NFRLXG,NGPBLKS))
IF (.not.ALLOCATED (TRLXQI)) ALLOCATE(TRLXQI(NPROMA,NFLEVG,NFRLXG,NGPBLKS))
IF (.not.ALLOCATED (TRLXQC)) ALLOCATE(TRLXQC(NPROMA,NFLEVG,NFRLXG,NGPBLKS))

!New read
!--------

DO JLEV=1,NFLEVG                                                                                                    
  ILEVS3D(JLEV)=JLEV                                                                                           
ENDDO

!----------Spectral fields
!------------------------
!Temperature 130
!---------------
TRLXTE(:,:,:)=0.0_JPRB
IF ( LRLXTE ) THEN
  DO IAA=1,2
    WRITE(CLDATETIME,*) IDATE(IAA)*100+ITIME(IAA)/100
    CLDATETIME = adjustl(CLDATETIME)
    CLNAMRLX='rlxmlsh'//trim(CLDATETIME)//'00130'
    WRITE(NULOUT,*)'RELAX FILENAME ', CLNAMRLX
    IGRIB3D(1)=130                                                                                  
    LLINCR=.FALSE.  
    CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLNAMRLX),CDMODE='r',KIOMASTER=1)
    CALL SETUP_IOREQUEST(YL_IOREQUEST,'SPECTRAL_FIELDS',LDGRIB=.TRUE.,&
      & KGRIB3D=IGRIB3D,KLEVS3D=ILEVS3D,LDINTERP=LLINCR)
    CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR3=ZSP3)
    CALL CLOSE_IOREQUEST(YL_IOREQUEST)                                                              
    CALL CLOSE_IOSTREAM(YL_IOSTREAM)
    DO JLEV2=1,NFLEVG
      DO JNM=1,NSPEC2
        TRLXTE(JLEV2,JNM,IAA)=ZSP3(JLEV2,JNM,1)
      ENDDO
    ENDDO
  ENDDO
  WRITE(NULOUT,*)' SPECTRAl FIELDS TRLXTE HAVE BEEN RECEIVED ',TRLXTE(1,1,1),TRLXTE(1,1,2)
ENDIF

!Divergence 155
!--------------
TRLXDI(:,:,:)=0.0_JPRB
IF ( LRLXVO ) THEN
  DO IAA=1,2
    WRITE(CLDATETIME,*) IDATE(IAA)*100+ITIME(IAA)/100
    CLDATETIME = adjustl(CLDATETIME)
    CLNAMRLX='rlxmlsh'//trim(CLDATETIME)//'00155'
    WRITE(NULOUT,*)'RELAX FILENAME ', CLNAMRLX
    IGRIB3D(1)=155                                                                                  
    LLINCR=.FALSE.  
    CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLNAMRLX),CDMODE='r',KIOMASTER=1)
    CALL SETUP_IOREQUEST(YL_IOREQUEST,'SPECTRAL_FIELDS',LDGRIB=.TRUE.,&
      & KGRIB3D=IGRIB3D,KLEVS3D=ILEVS3D,LDINTERP=LLINCR)
    CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR3=ZSP3)
    CALL CLOSE_IOREQUEST(YL_IOREQUEST)                                                              
    CALL CLOSE_IOSTREAM(YL_IOSTREAM)
    DO JLEV2=1,NFLEVG
      DO JNM=1,NSPEC2
        TRLXDI(JLEV2,JNM,IAA)=ZSP3(JLEV2,JNM,1)
      ENDDO
    ENDDO
  ENDDO
  WRITE(NULOUT,*)' SPECTRAl FIELDS TRLXDI HAVE BEEN RECEIVED ',TRLXDI(1,1,1),TRLXDI(1,1,2)
ENDIF

!Vorticity 138
!-------------
TRLXVO(:,:,:)=0.0_JPRB
IF ( LRLXVO ) THEN
  DO IAA=1,2
    WRITE(CLDATETIME,*) IDATE(IAA)*100+ITIME(IAA)/100
    CLDATETIME = adjustl(CLDATETIME)
    CLNAMRLX='rlxmlsh'//trim(CLDATETIME)//'00138'
    WRITE(NULOUT,*)'RELAX FILENAME ', CLNAMRLX
    IGRIB3D(1)=138                                                    
    LLINCR=.FALSE.  
    CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLNAMRLX),CDMODE='r',KIOMASTER=1)
    CALL SETUP_IOREQUEST(YL_IOREQUEST,'SPECTRAL_FIELDS',LDGRIB=.TRUE.,&
      & KGRIB3D=IGRIB3D,KLEVS3D=ILEVS3D,LDINTERP=LLINCR)
    CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR3=ZSP3)
    CALL CLOSE_IOREQUEST(YL_IOREQUEST)                                                              
    CALL CLOSE_IOSTREAM(YL_IOSTREAM)
    DO JLEV2=1,NFLEVG
      DO JNM=1,NSPEC2
        TRLXVO(JLEV2,JNM,IAA)=ZSP3(JLEV2,JNM,1)
      ENDDO
    ENDDO
  ENDDO
  WRITE(NULOUT,*)' SPECTRAl FIELDS TRLXVO HAVE BEEN RECEIVED ',TRLXVO(1,1,1),TRLXVO(1,1,2)
ENDIF

!Surface pressure 152
!--------------------
TRLXLP(:,:)=0.0_JPRB
IF ( LRLXLP ) THEN
  DO IAA=1,2
    WRITE(CLDATETIME,*) IDATE(IAA)*100+ITIME(IAA)/100
    CLDATETIME = adjustl(CLDATETIME)
    CLNAMRLX='rlxmlsh'//trim(CLDATETIME)//'00152'
    WRITE(NULOUT,*)'RELAX FILENAME ', CLNAMRLX
    IGRIB3D(1)=152
    ILEVS2D(1)=1                       
    LLINCR=.FALSE.  
    CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLNAMRLX),CDMODE='r',KIOMASTER=1)
    CALL SETUP_IOREQUEST(YL_IOREQUEST,'SPECTRAL_FIELDS',LDGRIB=.TRUE.,&
      & KGRIB2D=IGRIB3D,KLEVS2D=ILEVS2D,LDINTERP=LLINCR)
    CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR2=ZSP2)
    CALL CLOSE_IOREQUEST(YL_IOREQUEST)                                                              
    CALL CLOSE_IOSTREAM(YL_IOSTREAM)
    DO JNM=1,NSPEC2
      TRLXLP(JNM,IAA)=ZSP2(JNM,1)
    ENDDO
  ENDDO
  WRITE(NULOUT,*)' SPECTRAl FIELDS TRLXLP HAVE BEEN RECEIVED ',TRLXLP(1,1),TRLXLP(1,2)
ENDIF

  CALL FLUSH(NULOUT)
!------------ Guassian grid data
! Specific humidity 133
!----------------------

TRLXQ(:,:,:,:)=0.0_JPRB
IF ( LRLXQ ) THEN
  DO IAA=1,2
    WRITE(CLDATETIME,*) IDATE(IAA)*100+ITIME(IAA)/100
    CLDATETIME = adjustl(CLDATETIME)
    CLNAMRLX='rlxmlgg'//trim(CLDATETIME)//'00133'
    WRITE(NULOUT,*)'RELAX FILENAME ', CLNAMRLX
    IGRIB3D(1)=133                                                                                  
    LLINCR=.FALSE.                                                                                                                               
    CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLNAMRLX),CDMODE='r',KIOMASTER=1)
    CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
      & KGRIB3D=IGRIB3D,KLEVS3D=ILEVS3D,KPROMA=NPROMA,LDINTERP=LLINCR,&
      & KTYPE_INTERP=NINTERPINCR,CDLEVTYPE='ML')                                                             
    CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR4=ZGG)
    CALL CLOSE_IOREQUEST(YL_IOREQUEST)                                                              
    CALL CLOSE_IOSTREAM(YL_IOSTREAM)
  
    DO JKGLO=1,NGPTOT,NPROMA
      IBL=(JKGLO-1)/NPROMA+1
      ICEND=MIN(NPROMA,NGPTOT-JKGLO+1)
      DO JLEV2=1,NFLEVG
        DO JROF=1,ICEND
          TRLXQ(JROF,JLEV2,IAA,IBL)=ZGG(JROF,JLEV2,1,IBL)
        ENDDO
      ENDDO
    ENDDO                                                    
  ENDDO
  WRITE(NULOUT,*)' GAUSSIAN FIELDS TRLXQ HAVE BEEN RECEIVED ',TRLXQ(1,1,1,1),TRLXQ(1,1,2,1)
ENDIF

! Specific cloud liquid water content 246
!----------------------------------------
TRLXQL(:,:,:,:)=0.0_JPRB
IF ( LRLXQL ) THEN
  DO IAA=1,2
    WRITE(CLDATETIME,*) IDATE(IAA)*100+ITIME(IAA)/100
    CLDATETIME = adjustl(CLDATETIME)
    CLNAMRLX='rlxmlgg'//trim(CLDATETIME)//'00246'
    WRITE(NULOUT,*)'RELAX FILENAME ', CLNAMRLX
    IGRIB3D(1)=246                                                                                  
    LLINCR=.FALSE.                                                                                                                               
    CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLNAMRLX),CDMODE='r',KIOMASTER=1)
    CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
      & KGRIB3D=IGRIB3D,KLEVS3D=ILEVS3D,KPROMA=NPROMA,LDINTERP=LLINCR,&
      & KTYPE_INTERP=NINTERPINCR,CDLEVTYPE='ML')                                                             
    CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR4=ZGG)
    CALL CLOSE_IOREQUEST(YL_IOREQUEST)                                                              
    CALL CLOSE_IOSTREAM(YL_IOSTREAM)
  
    DO JKGLO=1,NGPTOT,NPROMA
      IBL=(JKGLO-1)/NPROMA+1
      ICEND=MIN(NPROMA,NGPTOT-JKGLO+1)
      DO JLEV2=1,NFLEVG
        DO JROF=1,ICEND
          TRLXQL(JROF,JLEV2,IAA,IBL)=ZGG(JROF,JLEV2,1,IBL)
        ENDDO
      ENDDO
    ENDDO                                                    
  ENDDO
  WRITE(NULOUT,*)' GAUSSIAN FIELDS TRLXQL HAVE BEEN RECEIVED ',TRLXQL(1,1,1,1),TRLXQL(1,1,2,1)
ENDIF

! Specific cloud ice water content 247
!-------------------------------------
TRLXQL(:,:,:,:)=0.0_JPRB
IF ( LRLXQI ) THEN
  DO IAA=1,2
    WRITE(CLDATETIME,*) IDATE(IAA)*100+ITIME(IAA)/100
    CLDATETIME = adjustl(CLDATETIME)
    CLNAMRLX='rlxmlgg'//trim(CLDATETIME)//'00247'
    WRITE(NULOUT,*)'RELAX FILENAME ', CLNAMRLX
    IGRIB3D(1)=247                                                                                  
    LLINCR=.FALSE.                                                                                                                               
    CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLNAMRLX),CDMODE='r',KIOMASTER=1)
    CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
      & KGRIB3D=IGRIB3D,KLEVS3D=ILEVS3D,KPROMA=NPROMA,LDINTERP=LLINCR,&
      & KTYPE_INTERP=NINTERPINCR,CDLEVTYPE='ML')                                                             
    CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR4=ZGG)
    CALL CLOSE_IOREQUEST(YL_IOREQUEST)                                                              
    CALL CLOSE_IOSTREAM(YL_IOSTREAM)
  
    DO JKGLO=1,NGPTOT,NPROMA
      IBL=(JKGLO-1)/NPROMA+1
      ICEND=MIN(NPROMA,NGPTOT-JKGLO+1)
      DO JLEV2=1,NFLEVG
        DO JROF=1,ICEND
          TRLXQI(JROF,JLEV2,IAA,IBL)=ZGG(JROF,JLEV2,1,IBL)
        ENDDO
      ENDDO
    ENDDO                                                     
  ENDDO
  WRITE(NULOUT,*)' GAUSSIAN FIELDS TRLXQI HAVE BEEN RECEIVED ',TRLXQI(1,1,1,1),TRLXQI(1,1,2,1)
ENDIF

! Cloud cover 248
!-----------------
TRLXQL(:,:,:,:)=0.0_JPRB
IF ( LRLXQC ) THEN
  DO IAA=1,2
    WRITE(CLDATETIME,*) IDATE(IAA)*100+ITIME(IAA)/100
    CLDATETIME = adjustl(CLDATETIME)
    CLNAMRLX='rlxmlgg'//trim(CLDATETIME)//'00248'
    WRITE(NULOUT,*)'RELAX FILENAME ', CLNAMRLX
    IGRIB3D(1)=248                                                                                  
    LLINCR=.FALSE.                                                                                                                               
    CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLNAMRLX),CDMODE='r',KIOMASTER=1)
    CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
      & KGRIB3D=IGRIB3D,KLEVS3D=ILEVS3D,KPROMA=NPROMA,LDINTERP=LLINCR,&
      & KTYPE_INTERP=NINTERPINCR,CDLEVTYPE='ML')                                                             
    CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR4=ZGG)
    CALL CLOSE_IOREQUEST(YL_IOREQUEST)                                                              
    CALL CLOSE_IOSTREAM(YL_IOSTREAM)
  
    DO JKGLO=1,NGPTOT,NPROMA
      IBL=(JKGLO-1)/NPROMA+1
      ICEND=MIN(NPROMA,NGPTOT-JKGLO+1)
      DO JLEV2=1,NFLEVG
        DO JROF=1,ICEND
          TRLXQC(JROF,JLEV2,IAA,IBL)=ZGG(JROF,JLEV2,1,IBL)
        ENDDO
      ENDDO
    ENDDO                                                  
  ENDDO
  WRITE(NULOUT,*)' GAUSSIAN FIELDS TRLXQC HAVE BEEN RECEIVED ',TRLXQC(1,1,1,1),TRLXQC(1,1,2,1)
ENDIF

CALL FLUSH(NULOUT)

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

