MODULE TRAJ_MAIN_MOD

!     Purpose.
!     --------
!       Manage main trajectory

!     Author.
!     -------
!        Y. Tremolet *ECMWF*

!     Modifications.
!     --------------
!        Original : 09-10-01
!        Modified : 02-09-16 G. Desroziers - also treat Aladin mean wind trajectory
!        O.Spaniel    : 03-04-15 cleaning-ordering of declaration
!        Modified : 03-03-31 C. Fischer - readapted Aladin mean wind to control_vectors
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        G. Desroziers & C. Fischer: 04-06-08 Secure gridpoint copy to/from TRAJ_grids
!        Y.Tremolet    18-Mar-2004 Add lprttraj option for diagnostics
!        J.Haseler     11-Oct-2005 Generalise gridpoint trajectory contents
!        M.Hamrud  15-Jan-2006  Revised GPRCP
!        G. Desroziers and K. Yessad (sept 2005):
!         - split option LTRAJHR into LTRAJHR_ALTI and LTRAJHR_SURF.
!         - adapt option LTRAJHR to METEO-FRANCE configurations.
!        J.Haseler     27-Feb-2007 Simplify logic
!        Y.Tremolet    27-Nov-2008 Long window 4D-Var
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMLUN, ONLY: NULOUT, NULERR
USE YOMCT0, ONLY: NSTART, LIFSTRAJ, LIFSMIN, LSPRT, NINTERPTRAJ, &
 & LARPEGEF_TRAJHR,LARPEGEF_TRAJBG,NSTOP
USE YOMVAR, ONLY: NUPTRA, MUPTRA, FILTERFACTOR, FILTEREXPO, FILTERRESOL
USE YOMMODEL_ERROR, ONLY: N_COUPLED_WINDOWS
USE YOMDIM, ONLY: NFLEVG, NFLEVL, NSPEC2, NS3D, NPROMA, NGPBLKS, &
 & LVOR, LUVDER,NFTHER, &
 & NMSMAX, NS1D  
USE YOMMP , ONLY: NBSETLEV, NBSETSP, MYSETV
USE YOMGRB, ONLY: NGRBVO, NGRBD, NGRBT, NGRBQ, NGRBO3, &
 & NGRBLNSP
USE SPECTRAL_FIELDS_MOD
USE YOMTRAJ, ONLY: TRAJ_SPEC, TRAJ_BUF, NSMAX_TRAJ, &
 & NSMAX_BACKGR00, NSMAX_BACKGR01, NSMAX_BACKGR02, NSMAX_BACKGR03, &
 & BCKG_SPEC, BCKG_GMV, BCKG_GMVS, BCKG_GFL, LPRTTRAJ,  &
 & TRAJ_GMV, TRAJ_GMVS, TRAJ_GFL, &
 & LTRAJHR, LTRAJGP, LREADGPTRAJ, NSTEPTRAJ, MSTART, NSPTRAJ, NGPTRAJ, &
 & LTRAJHR_ALTI, &
 & MSTEPTRAJW, MSTEPTRAJR,MIOTRAJMAIN,TRAJ_SPEC_TMP0, LTRAJRESET, &
 & MTYPE_MAIN3_TRAJ, MTYPE_MAIN2_TRAJ, MAIN_GRIB, MBACKGR_GRIB 
USE GRIB_HEADER_MIX
USE YOM_YGFL , ONLY : YGFL, YGFLC, YQ, YO3
USE YOMGMV, ONLY : YT5,YT0
USE YOMGEM   , ONLY : NGPTOT
USE YOMCST   , ONLY : RD
USE YOMOP    , ONLY : CFNTRAJHRGRID,CFNTRAJHRSPEC,CFNTRAJBGGRID,CFNTRAJBGSPEC

IMPLICIT NONE

PRIVATE
PUBLIC ALLOCATE_TRAJ_MAIN, DEALLOCATE_TRAJ_MAIN, &
 & STORE_TRAJ_MAIN, READ_TRAJ_SPEC,READ_TRAJ_GRID, &
 & GET_TRAJ_SPEC, GET_TRAJ_GRID  

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

#include "abor1.intfb.h"
#include "copy_spa2spec.intfb.h"
#include "copy_spec2spa.intfb.h"
#include "read_spec.intfb.h"
#include "read_spec_fromfa.intfb.h"
#include "write_spec.intfb.h"
#include "read_grid_traj.intfb.h"
#include "write_grid_traj.intfb.h"

!-----------------------------------------------------------------------
CONTAINS
!-----------------------------------------------------------------------

SUBROUTINE ALLOCATE_TRAJ_MAIN

INTEGER(KIND=JPIM) :: ii, jstep, ifirst, ilast
INTEGER(KIND=JPIM) :: j1,j2,j3,j4
INTEGER(KIND=JPIM), ALLOCATABLE :: igrib(:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM) :: INSMAX_BACKGR

! Spectral trajectory
! -------------------
IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:ALLOCATE_TRAJ_MAIN',0,ZHOOK_HANDLE)

IF (LTRAJHR.AND.LTRAJHR_ALTI) THEN
  IF (LREADGPTRAJ) THEN
    NSPTRAJ=3  ! Vor, Div, Tem
  ELSE
    NSPTRAJ=4  ! Vor, Div, Tem, Hum
    IF (YO3%LACTIVE) NSPTRAJ=NSPTRAJ+1
  ENDIF
ELSE
  NSPTRAJ=NS3D
ENDIF

ALLOCATE(igrib(NSPTRAJ+1))
igrib(1)=NGRBVO
igrib(2)=NGRBD
igrib(3)=NGRBT
IF (.NOT.LREADGPTRAJ) THEN
  igrib(4)=NGRBQ
  IF (YO3%LACTIVE) igrib(NSPTRAJ)=NGRBO3
ENDIF
igrib(NSPTRAJ+1)=NGRBLNSP

IF (LTRAJGP.OR.LIFSTRAJ) THEN
  ALLOCATE(TRAJ_SPEC(mstart:mstart))
  CALL ALLOCATE_SPEC(TRAJ_SPEC(mstart),NSMAX_TRAJ,NMSMAX,NSPTRAJ,1,NS1D,igrib)
  CALL ALLOCATE_SPEC(TRAJ_SPEC_TMP0   ,NSMAX_TRAJ,NMSMAX,NSPTRAJ,1,NS1D,igrib)
ELSE
  ALLOCATE(TRAJ_SPEC(NSTEPTRAJ))
  DO ii=1,NSTEPTRAJ
    CALL ALLOCATE_SPEC(TRAJ_SPEC(ii),NSMAX_TRAJ,NMSMAX,NSPTRAJ,1,NS1D,igrib)  
  ENDDO
ENDIF
WRITE(NULOUT,9)'TRAJ_SPEC ',SIZE(TRAJ_SPEC)

IF ((LIFSTRAJ .AND. NUPTRA==0) .OR. (LIFSMIN.AND. NUPTRA>=0 .AND. NUPTRA<=3)) THEN
  ! ML: INSMAX_BACKGR only defined if NUPTRA<4, 
  !     NUPTRA=99999 in SV computation
  IF (LIFSTRAJ) THEN
    IFIRST=0
    ILAST=MUPTRA-1
  ELSE
    IFIRST=NUPTRA
    ILAST=NUPTRA
  ENDIF
  ALLOCATE(BCKG_SPEC(IFIRST:ILAST))
  DO II=IFIRST,ILAST
    SELECT CASE (II)
    CASE(0)
      INSMAX_BACKGR=NSMAX_BACKGR00
    CASE(1)
      INSMAX_BACKGR=NSMAX_BACKGR01
    CASE(2)
      INSMAX_BACKGR=NSMAX_BACKGR02
    CASE(3)
      INSMAX_BACKGR=NSMAX_BACKGR03
    CASE DEFAULT
      WRITE(NULERR,*)'NSMAX_BACKGRxx only available for MUPTRA<=3',MUPTRA
      CALL ABOR1('ALLOCATE_TRAJ_MAIN: Error NSMAX_BACKGRxx undefined')
    END SELECT
    CALL ALLOCATE_SPEC(BCKG_SPEC(ii),INSMAX_BACKGR,NMSMAX,NSPTRAJ,1,NS1D,igrib)
  ENDDO
  WRITE(NULOUT,9)'BCKG_SPEC ',SIZE(BCKG_SPEC)
ENDIF

ALLOCATE(MIOTRAJMAIN(NSTEPTRAJ))
MIOTRAJMAIN(:) = -1
WRITE(NULOUT,9)'MIOTRAJMAIN',SIZE(MIOTRAJMAIN),SHAPE(MIOTRAJMAIN)
! Grid point trajectory
! ---------------------
NGPTRAJ=NFLEVG*YT5%NDIM+YT5%NDIMS+NFLEVG*YGFL%NDIM5
IF (LTRAJGP) THEN
  ALLOCATE(TRAJ_GMV(NPROMA,NFLEVG,YT5%NDIM,NGPBLKS,NSTEPTRAJ))
  ALLOCATE(TRAJ_GMVS(NPROMA,YT5%NDIMS,NGPBLKS,NSTEPTRAJ))
  ALLOCATE(TRAJ_GFL(NPROMA,NFLEVG,YGFL%NDIM5,NGPBLKS,NSTEPTRAJ))
  ALLOCATE(BCKG_GMV(NPROMA,NFLEVG,YT5%NDIM,NGPBLKS))
  ALLOCATE(BCKG_GMVS(NPROMA,YT5%NDIMS,NGPBLKS))
  ALLOCATE(BCKG_GFL(NPROMA,NFLEVG,YGFL%NDIM5,NGPBLKS))
  CALL GSTATS(1050,0)

!!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JSTEP)
!  do jstep=1,NSTEPTRAJ
!    TRAJ_GMV(:,:,:,:,jstep) = HUGE(TRAJ_GMV)
!    TRAJ_GMVS(:,:,:,jstep) = HUGE(TRAJ_GMVS)
!    TRAJ_GFL(:,:,:,:,jstep) = HUGE(TRAJ_GFL)
!  enddo
!!$OMP END PARALLEL DO
!  BCKG_GMV(:,:,:,:) = HUGE(BCKG_GMV)
!  BCKG_GMVS(:,:,:) = HUGE(BCKG_GMVS)
!  BCKG_GFL(:,:,:,:) = HUGE(BCKG_GFL)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J4,JSTEP,J3,J2,J1)
  DO J4=1,NGPBLKS
    DO JSTEP=1,NSTEPTRAJ
      DO J3=1,YT5%NDIM
        DO J2=1,NFLEVG
          DO J1=1,NPROMA
            TRAJ_GMV(J1,J2,J3,J4,jstep) = HUGE(TRAJ_GMV)
          ENDDO
        ENDDO
      ENDDO
    ENDDO
    DO JSTEP=1,NSTEPTRAJ
      DO J3=1,YT5%NDIMS
        DO J1=1,NPROMA
          TRAJ_GMVS(J1,J3,J4,jstep) = HUGE(TRAJ_GMVS)
        ENDDO
      ENDDO
    ENDDO
    DO JSTEP=1,NSTEPTRAJ
      DO J3=1,YGFL%NDIM5
        DO J2=1,NFLEVG
          DO J1=1,NPROMA
            TRAJ_GFL(J1,J2,J3,J4,jstep) = HUGE(TRAJ_GFL)
          ENDDO
        ENDDO
      ENDDO
    ENDDO
    DO J3=1,YT5%NDIM
      DO J2=1,NFLEVG
        DO J1=1,NPROMA
          BCKG_GMV(J1,J3,J3,J4) = HUGE(BCKG_GMV)
        ENDDO
      ENDDO
    ENDDO
    DO J3=1,YT5%NDIMS
      DO J1=1,NPROMA
        BCKG_GMVS(J1,J3,J4) = HUGE(BCKG_GMVS)
      ENDDO
    ENDDO
    DO J3=1,YGFL%NDIM5
      DO J2=1,NFLEVG
        DO J1=1,NPROMA
          BCKG_GFL(J1,J2,J3,J4) = HUGE(BCKG_GFL)
        ENDDO
      ENDDO
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1050,1)
  WRITE(NULOUT,9)'TRAJ_GMV  ',SIZE(TRAJ_GMV),SHAPE(TRAJ_GMV)
  WRITE(NULOUT,9)'TRAJ_GMVS ',SIZE(TRAJ_GMVS),SHAPE(TRAJ_GMVS)
  WRITE(NULOUT,9)'TRAJ_GFL  ',SIZE(TRAJ_GFL),SHAPE(TRAJ_GFL)
  WRITE(NULOUT,9)'BCKG_GMV  ',SIZE(BCKG_GMV),SHAPE(BCKG_GMV)
  WRITE(NULOUT,9)'BCKG_GMVS ',SIZE(BCKG_GMVS),SHAPE(BCKG_GMVS)
  WRITE(NULOUT,9)'BCKG_GFL  ',SIZE(BCKG_GFL),SHAPE(BCKG_GFL)
ENDIF
DEALLOCATE(igrib)

9 FORMAT(1X,'GREPTRAJ ARRAY ',A11,' ALLOCATED ',8I8)

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:ALLOCATE_TRAJ_MAIN',1,ZHOOK_HANDLE)
END SUBROUTINE ALLOCATE_TRAJ_MAIN

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

SUBROUTINE DEALLOCATE_TRAJ_MAIN
INTEGER(KIND=JPIM) :: jj, IFIRST, ILAST
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:DEALLOCATE_TRAJ_MAIN',0,ZHOOK_HANDLE)
IF (LTRAJGP.OR.LIFSTRAJ) THEN
  CALL DEALLOCATE_SPEC(TRAJ_SPEC(mstart))
  CALL DEALLOCATE_SPEC(TRAJ_SPEC_TMP0)
ELSE
  DO jj=1,NSTEPTRAJ
    CALL DEALLOCATE_SPEC(TRAJ_SPEC(jj))
  ENDDO
ENDIF
IF (ALLOCATED(BCKG_SPEC)) THEN
  IF (LIFSTRAJ) THEN
    IFIRST=0
    ILAST=MUPTRA-1
  ELSE
    IFIRST=NUPTRA
    ILAST=NUPTRA
  ENDIF
  DO jj=IFIRST,ILAST
    CALL DEALLOCATE_SPEC(BCKG_SPEC(jj))
  ENDDO
  DEALLOCATE(BCKG_SPEC)
ENDIF
DEALLOCATE(TRAJ_SPEC)
DEALLOCATE(MIOTRAJMAIN)
WRITE(NULOUT,*)'GREPTRAJ TRAJ_SPEC DEALLOCATED'
IF (ALLOCATED(TRAJ_GMV)) DEALLOCATE (TRAJ_GMV)
IF (ALLOCATED(TRAJ_GMVS)) DEALLOCATE (TRAJ_GMVS)
IF (ALLOCATED(TRAJ_GFL)) DEALLOCATE (TRAJ_GFL)
IF (ALLOCATED(BCKG_GMV)) DEALLOCATE (BCKG_GMV)
IF (ALLOCATED(BCKG_GMVS)) DEALLOCATE (BCKG_GMVS)
IF (ALLOCATED(BCKG_GFL)) DEALLOCATE (BCKG_GFL)
WRITE(NULOUT,*)'GREPTRAJ TRAJ_GMV,TRAJ_GMVS,TRAJ_GFL AND BCKG_xxx DEALLOCATED'

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:DEALLOCATE_TRAJ_MAIN',1,ZHOOK_HANDLE)
END SUBROUTINE DEALLOCATE_TRAJ_MAIN

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

SUBROUTINE STORE_TRAJ_MAIN(PSP3D,PSPSP,PSP1D,PGMV,PGMVS,PGFL,KSTEP,LDREADGPTRAJ)

REAL(KIND=JPRB),INTENT(IN):: PSP3D(:,:,:),PSPSP(:)
REAL(KIND=JPRB),INTENT(IN):: PSP1D(:,:)
REAL(KIND=JPRB),INTENT(IN):: PGMV(:,:,:,:)
REAL(KIND=JPRB),INTENT(IN):: PGMVS(:,:,:)
REAL(KIND=JPRB),INTENT(IN):: PGFL(:,:,:,:)
INTEGER(KIND=JPIM),INTENT(IN):: KSTEP
LOGICAL,INTENT(IN):: LDREADGPTRAJ

REAL(KIND=JPRB), ALLOCATABLE :: ZSP(:,:), ZGP(:,:,:)
REAL(KIND=JPRB) :: ZR(NPROMA,NFLEVG)
INTEGER(KIND=JPIM) :: IVSETSC(NFLEVG)
INTEGER(KIND=JPIM):: ISTEP,JSTEP,JGFL,IGP,IFLD 
INTEGER(KIND=JPIM):: JKGLO,ICEND,IBL,JBL,JROF,JFLD,JLEV,J
INTEGER(KIND=JPIM):: IGPX(YGFL%NUMFLDS)
CHARACTER(LEN=17) :: CLFILE
LOGICAL :: LLFIRST,LLAST
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTEGER(KIND=JPIM):: IFLDS,I2DFLDS,I3DFLDS,JJ
! Needs to be in this position because of bug in pgf90 5.2-4
#include "gprcp.intfb.h"

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:STORE_TRAJ_MAIN',0,ZHOOK_HANDLE)
ISTEP=MSTEPTRAJW(KSTEP)
IF (istep>0) THEN
  IF (istep == 1) THEN
    llfirst = .TRUE.
  ELSE
    llfirst = .FALSE.
  ENDIF
  IF (LIFSTRAJ) THEN
    IF(MIOTRAJMAIN(istep)== -1) THEN
      DO JSTEP=1,istep-1
        IF(MIOTRAJMAIN(jstep) /= jstep)THEN
          WRITE(NULERR,*)'HOLE IN MAIN TRAJ',jstep,ISTEP,MIOTRAJMAIN(jstep)
          CALL ABOR1('STORE_TRAJ_MAIN:HOLE')
        ENDIF
      ENDDO
      llast=.true.
      DO JSTEP=kstep+1,nstop
        IF(MSTEPTRAJW(JSTEP) > 0) llast=.false.
      ENDDO

      IF (LDREADGPTRAJ) THEN
        I3DFLDS=0
        DO JGFL=1,YGFL%NUMFLDS
          IF (YGFLC(JGFL)%LTRAJIO ) I3DFLDS=I3DFLDS+1
        ENDDO
        IF (I3DFLDS == 0) THEN
          WRITE(NULERR,*) 'NO GRIDPOINT FIELDS TO WRITE TO TRAJECTORY'
          CALL ABOR1('STORE_TRAJ_MAIN:I3DFLDS=0')
        ENDIF

        CLFILE(1:17)=CFNTRAJHRGRID

        write(clfile( 7: 8),'(I2.2)')nuptra
        write(nulout,*)'Saving main trajectory in ',clfile,' at step ',istep
        I2DFLDS=0
        IFLDS=NFLEVG*I3DFLDS+I2DFLDS
        ALLOCATE(ZGP(NPROMA,IFLDS,NGPBLKS))

        CALL GSTATS(1938,0)
        IGP=1
        DO JGFL=1,YGFL%NUMFLDS
          IF ( YGFLC(JGFL)%LTRAJIO ) THEN
            IGPX(JGFL)=IGP
            IGP=IGP+NFLEVG
          ENDIF
        ENDDO
        CALL GSTATS(1938,1)
        CALL GSTATS(1465,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JBL,JGFL)
        DO JBL=1,NGPBLKS
          DO JGFL=1,YGFL%NUMFLDS
            IF ( YGFLC(JGFL)%LTRAJIO ) THEN
              ZGP(:,IGPX(JGFL):IGPX(JGFL)+NFLEVG-1,JBL)=PGFL(:,:,YGFLC(JGFL)%MP,JBL)
            ENDIF
          ENDDO
        ENDDO
!$OMP END PARALLEL DO 
        CALL GSTATS(1465,1)

        CALL WRITE_GRID_TRAJ(trim(clfile),main_grib,mtype_main3_traj,&
         & mtype_main2_traj,I3DFLDS,I2DFLDS,ZGP,PSPSP,NINTERPTRAJ,llfirst,llast)

        IF (istep==1 .AND. NUPTRA==0) THEN
          clfile(1:17)=CFNTRAJBGGRID
          do jj=0,muptra-1
            write(clfile( 7: 8),'(I2.2)')jj
            write(nulout,*)'Saving main background state in ',clfile,' at step ',istep
            CALL WRITE_GRID_TRAJ(trim(clfile),mbackgr_grib(jj),mtype_main3_traj,&
           & mtype_main2_traj,I3DFLDS,I2DFLDS,ZGP,PSPSP,NINTERPTRAJ,llfirst,.true.)
          enddo
        ENDIF

        DEALLOCATE(ZGP)

        MIOTRAJMAIN(ISTEP)=ISTEP
      ENDIF

      IF (NS3D>NSPTRAJ) CALL ABOR1('STORE_TRAJ_MAIN: NS3D>NSPTRAJ')

      ALLOCATE(TRAJ_BUF(NFLEVL,NSPEC2,NSPTRAJ))
      CALL GSTATS(1465,0)
      IF (LDREADGPTRAJ) THEN
        IF (LSPRT) THEN
          IFLD=NSPTRAJ-1
        ELSE
          IFLD=NSPTRAJ
        ENDIF
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
        DO J=1,NSPEC2
          TRAJ_BUF(:,J,1:IFLD)=PSP3D(:,J,1:IFLD)
        ENDDO
!$OMP END PARALLEL DO
      ELSE
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
        DO J=1,NSPEC2
          TRAJ_BUF(:,J,1:NS3D)=PSP3D(:,J,:)
        ENDDO
!$OMP END PARALLEL DO
      ENDIF
      CALL GSTATS(1465,1)

      IF (LSPRT.OR.(.NOT.LDREADGPTRAJ)) THEN
        ! Real temperature spectral fields are required for i/o.
        ! We use the fact that the grid-point array contains
        ! real temperature, and calculate spectral real temperature
        ! by performing a direct transform.

        ALLOCATE(ZSP(NFLEVL,NSPEC2))
        IVSETSC(:)=NBSETLEV(:)
        CALL DIR_TRANS(PSPSCALAR=ZSP, PGP=PGMV(:,:,YT0%MT,:), KPROMA=NPROMA,&
         & KVSETSC=IVSETSC)  
        CALL GSTATS(1465,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
        DO J=1,NSPEC2
          TRAJ_BUF(:,J,3)=ZSP(:,J)
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1465,1)
        IF (.NOT.LDREADGPTRAJ) THEN
          IF (YQ%LGP) THEN
            CALL DIR_TRANS(PSPSCALAR=ZSP,PGP=PGFL(:,:,YQ%MP,:), KPROMA=NPROMA,&
             & KVSETSC=IVSETSC)  
            CALL GSTATS(1465,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
            DO J=1,NSPEC2
              TRAJ_BUF(:,J,4)=ZSP(:,J)
            ENDDO
!$OMP END PARALLEL DO
            CALL GSTATS(1465,1)
          ENDIF
          IF (YO3%LGP) THEN
            CALL DIR_TRANS(PSPSCALAR=ZSP,PGP=PGFL(:,:,YO3%MP,:),KPROMA=NPROMA,&
             & KVSETSC=IVSETSC)  
            CALL GSTATS(1465,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
            DO J=1,NSPEC2
              TRAJ_BUF(:,J,5)=ZSP(:,J)
            ENDDO
!$OMP END PARALLEL DO
            CALL GSTATS(1465,1)
          ENDIF
        ENDIF
      ENDIF
      DEALLOCATE(ZSP)
      
      ! Spectral filtering of trajectories potentially applied
      ! Am,n=Am,n/(1+fac-1)*((n*(n+1)**(exp/2)/(N*(N+1)**(exp/2)

      CLFILE(1:17)=CFNTRAJHRSPEC

      write(clfile( 7: 8),'(I2.2)')nuptra
      !    write(clfile(18:20),'(I3.3)')istep
      ! Only Vor, Div, Tem are written out as spectral fields if LREADGPTRAJ
      CALL copy_spa2spec(NSPTRAJ,1,NS1D,TRAJ_BUF,PSPSP,PSP1D,traj_spec(mstart))
      if (FILTERFACTOR==1.0_JPRB .OR. traj_spec(mstart)%nsmax < FILTERRESOL) then
        write(nulout,*)'GREPTRAJ Saving main trajectory in ',clfile,' at step ',istep
        CALL WRITE_SPEC(trim(clfile),traj_spec(mstart),llfirst)
      else
        write(nulout,*)'GREPTRAJ Saving main trajectory in ',clfile,' at step ',istep,&
       & ' spectral filtering applied with fac=',FILTERFACTOR,' and exponent=',FILTEREXPO
        CALL WRITE_SPEC(trim(clfile),traj_spec(mstart),llfirst,PFACTOR=FILTERFACTOR,&
         & PEXPO=FILTEREXPO)
      ENDIF

      IF (istep==1 .AND. NUPTRA==0) THEN
        clfile(1:17)=CFNTRAJBGSPEC
        do jj=0,muptra-1
          write(clfile( 7: 8),'(I2.2)') jj
          ! Only Vor, Div, Tem are written out as spectral fields if LREADGPTRAJ
          CALL copy_spa2spec(NSPTRAJ,1,NS1D,TRAJ_BUF,PSPSP,PSP1D,BCKG_SPEC(jj))
          if (FILTERFACTOR==1.0_JPRB .OR. BCKG_SPEC(jj)%nsmax < FILTERRESOL) then
            write(nulout,*)'GREPTRAJ Saving spectral background state in ',clfile,' at step ',istep
            CALL WRITE_SPEC(trim(clfile),BCKG_SPEC(jj),llfirst)
          else
            write(nulout,*)'GREPTRAJ Saving spectral background state in ',clfile,' at step ',istep, &
             & ' spectral filtering applied with fac=',FILTERFACTOR,' and exponent=',FILTEREXPO
            CALL WRITE_SPEC(trim(clfile),BCKG_SPEC(jj),llfirst,PFACTOR=FILTERFACTOR,PEXPO=FILTEREXPO)
          endif
        enddo
      endif

      MIOTRAJMAIN(ISTEP)=ISTEP
      DEALLOCATE(TRAJ_BUF)


    ELSE
      WRITE(NULOUT,*)'GREPTRAJ Warning: Main traj at step,',KSTEP,ISTEP,&
       & 'already written'  
    ENDIF
  ELSE
    IF (LTRAJGP) THEN
      IF(.NOT.ALLOCATED(TRAJ_GMV))&
       & CALL ABOR1('STORE_TRAJ_MAIN:TRAJ_GMV NOT ALLOCATED')  
      IF(ISTEP > UBOUND(TRAJ_GMV,5)) THEN
        WRITE(NULERR,*)ISTEP,UBOUND(TRAJ_GMV,5)
        CALL ABOR1('STORE_TRAJ_MAIN:TRAJ_GMV TO SMALL')
      ENDIF
      IF(NPROMA /= UBOUND(PGMV,1)) THEN
        WRITE(NULERR,*) NPROMA, UBOUND(PGMV,1)
        CALL ABOR1('STORE_TRAJ_MAIN:WRONG FIRST DIM. OF PGMV')
      ENDIF
      IF(NGPBLKS /= UBOUND(PGMV,4)) THEN
        WRITE(NULERR,*) NGPBLKS, UBOUND(PGMV,4)
        CALL ABOR1('STORE_TRAJ_MAIN:WRONG FOURTH DIM. OF PGMV')
      ENDIF
      IF(NPROMA /= UBOUND(PGMVS,1)) THEN
        WRITE(NULERR,*) NPROMA, UBOUND(PGMVS,1)
        CALL ABOR1('STORE_TRAJ_MAIN:WRONG FIRST DIM. OF PGMVS')
      ENDIF
      IF(NGPBLKS /= UBOUND(PGMVS,3)) THEN
        WRITE(NULERR,*) NGPBLKS, UBOUND(PGMV,3)
        CALL ABOR1('STORE_TRAJ_MAIN:WRONG THIRD DIM. OF PGMVS')
      ENDIF
      IF(NPROMA /= UBOUND(PGFL,1)) THEN
        WRITE(NULERR,*) NPROMA, UBOUND(PGFL,1)
        CALL ABOR1('STORE_TRAJ_MAIN:WRONG FIRST DIM. OF PGFL')
      ENDIF
      IF(NGPBLKS /= UBOUND(PGFL,4)) THEN
        WRITE(NULERR,*) NGPBLKS, UBOUND(PGFL,4)
        CALL ABOR1('STORE_TRAJ_MAIN:WRONG FOURTH DIM. OF PGFL')
      ENDIF
      CALL GSTATS(1052,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JKGLO,ICEND,IBL,JFLD,JROF,JLEV,ZR)
      DO JKGLO=1,NGPTOT,NPROMA
        ICEND=MIN(NPROMA,NGPTOT-JKGLO+1)
! The loops below explicitly from 1 to ICEND prevent from uninitialized values
! from ICEND+1 to NPROMA
        IBL=(JKGLO-1)/NPROMA+1
        DO JFLD=1,YT5%NDIM
          DO JLEV=1,NFLEVG
            DO JROF=1,ICEND
              TRAJ_GMV(JROF,JLEV,JFLD,IBL,istep)=PGMV(JROF,JLEV,JFLD,IBL)
            ENDDO
          ENDDO
        ENDDO
        DO JFLD=1,YT5%NDIMS
          DO JROF=1,ICEND
            TRAJ_GMVS(JROF,JFLD,IBL,istep)=PGMVS(JROF,JFLD,IBL)
          ENDDO
        ENDDO
        DO JFLD=1,YGFL%NDIM5
          DO JLEV=1,NFLEVG
            DO JROF=1,ICEND
              TRAJ_GFL(JROF,JLEV,JFLD,IBL,istep)=PGFL(JROF,JLEV,JFLD,IBL)
            ENDDO
          ENDDO
        ENDDO
        IF (LSPRT) THEN   ! TRAJ_GMV must contain Tv if LSPRT=.T.
                          ! At this point PGMV contains real temperature, so
                          ! we need to convert to Tv before storing.
          CALL GPRCP(NPROMA,1,ICEND,NFLEVG,PQ=PGFL(:,:,YQ%MP,IBL),PR=ZR)
          DO JLEV=1,NFLEVG
            DO JROF=1,ICEND
              TRAJ_GMV(JROF,JLEV,YT5%MT,IBL,istep)=ZR(JROF,JLEV)* &
               & TRAJ_GMV(JROF,JLEV,YT5%MT,IBL,istep)/RD
            ENDDO
          ENDDO
        ENDIF
      ENDDO
!$OMP END PARALLEL DO
      CALL GSTATS(1052,1)
      IF (LPRTTRAJ) WRITE(NULOUT,*)'GREPTRAJ STORE_TRAJ_MAIN GRID istep=',istep
    ENDIF
    IF(.NOT.LTRAJGP .OR. kstep==NSTART) THEN
      CALL copy_spa2spec(NS3D,1,NS1D,PSP3D,PSPSP,PSP1D,traj_spec(istep))
      IF (LPRTTRAJ) WRITE(NULOUT,*)'GREPTRAJ STORE_TRAJ_MAIN SPEC istep=',istep
    ENDIF
  ENDIF
ENDIF

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:STORE_TRAJ_MAIN',1,ZHOOK_HANDLE)
END SUBROUTINE STORE_TRAJ_MAIN

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

SUBROUTINE GET_TRAJ_SPEC(PSP3D,PSPSP,PSP1D,KSTEP,LDBACKGR)

REAL(KIND=JPRB), INTENT(OUT) :: PSP3D(NFLEVL,NSPEC2,NS3D),PSPSP(NSPEC2)
REAL(KIND=JPRB), INTENT(OUT) :: PSP1D(NFLEVL,NS1D)
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: KSTEP
LOGICAL, OPTIONAL, INTENT(IN) :: LDBACKGR
INTEGER(KIND=JPIM) :: istep
REAL(KIND=JPRB) :: ZHOOK_HANDLE
LOGICAL :: LLBACKGR

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:GET_TRAJ_SPEC',0,ZHOOK_HANDLE)
IF (PRESENT(kstep)) THEN
  istep=MSTEPTRAJR(kstep)
  IF (istep<1) CALL ABOR1('GET_TRAJ_SPEC: istep<1')
ELSE
  istep=MSTART
  IF (istep<1) CALL ABOR1('GET_TRAJ_SPEC: MSTART<1')
ENDIF

! If LDBACKGR=.true. the background state is read 
IF (PRESENT(LDBACKGR)) THEN
  LLBACKGR=LDBACKGR
ELSE
  LLBACKGR=.FALSE.
ENDIF

IF (LLBACKGR .AND. ISTEP /= 1) THEN
  WRITE(NULERR,*)'GET_TRAJ_SPEC: LLBACKGR, ISTEP ',LLBACKGR, ISTEP
  CALL ABOR1('GET_TRAJ_SPEC: If LDBACKGR istep must be 1 ')
ENDIF

IF (.NOT.ltrajgp .OR. istep==MSTART .OR. LLBACKGR) THEN
  IF (LLBACKGR) THEN
    CALL copy_spec2spa(NS3D,1,NS1D,bckg_spec(nuptra),PSP3D,PSPSP,PSP1D)
    IF (LPRTTRAJ) WRITE(NULOUT,*)'GREPTRAJ GET_TRAJ_SPEC BACKGROUND SPEC nuptra=',nuptra
  ELSE
    CALL copy_spec2spa(NS3D,1,NS1D,traj_spec(istep),PSP3D,PSPSP,PSP1D)
    IF (LPRTTRAJ) WRITE(NULOUT,*)'GREPTRAJ GET_TRAJ_SPEC SPEC istep=',istep
  ENDIF
ELSE
  WRITE(nulerr,*)'GET_TRAJ_SPEC:THIS CALL IS USELESS'
ENDIF

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:GET_TRAJ_SPEC',1,ZHOOK_HANDLE)
END SUBROUTINE GET_TRAJ_SPEC

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

SUBROUTINE GET_TRAJ_GRID(PGMV,PGMVS,PGFL,kstep,LDBACKGR)

REAL(KIND=JPRB),INTENT(OUT):: PGMV(:,:,:,:)
REAL(KIND=JPRB),INTENT(OUT):: PGMVS(:,:,:)
REAL(KIND=JPRB),INTENT(OUT):: PGFL(:,:,:,:)
INTEGER(KIND=JPIM),INTENT(IN):: kstep
LOGICAL, OPTIONAL, INTENT(IN) :: LDBACKGR
INTEGER(KIND=JPIM) :: istep, ii, jj, ill, ist
LOGICAL :: llder, lluvder, llvor, LLBACKGR
REAL(KIND=JPRB), ALLOCATABLE :: ZSP(:,:), ZGP(:,:,:), ZSPVOR(:,:), ZSPDIV(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZSPEC(:,:,:), ZSP1D(:,:)
INTEGER(KIND=JPIM) :: IVSETSC(1+(NSPTRAJ-2)*NFLEVG)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM):: JKGLO,ICEND,IBL

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:GET_TRAJ_GRID',0,ZHOOK_HANDLE)
istep=MSTEPTRAJR(kstep)

! If LDBACKGR=.true. the background state is read 
IF (PRESENT(LDBACKGR)) THEN
  LLBACKGR=LDBACKGR
ELSE
  LLBACKGR=.FALSE.
ENDIF

IF (LLBACKGR .AND. ISTEP /= 1) THEN
  WRITE(NULERR,*)'GET_TRAJ_GRID: LLBACKGR, KSTEP ',LLBACKGR, ISTEP
  CALL ABOR1('GET_TRAJ_GRID: If LLBACKGR kstep must be 1 ')
ENDIF

IF (ltrajgp) THEN
  IF (LLBACKGR) THEN
    IF(.NOT.ALLOCATED(BCKG_GMV))&
     & CALL ABOR1('GET_TRAJ_GRID:BCKG_GMV NOT ALLOCATED')  
  ELSE
    IF(.NOT.ALLOCATED(TRAJ_GMV))&
     & CALL ABOR1('GET_TRAJ_GRID:TRAJ_GMV NOT ALLOCATED')  
    IF(ISTEP > UBOUND(TRAJ_GMV,5)) THEN
      WRITE(NULERR,*)ISTEP,UBOUND(TRAJ_GMV,5)
      CALL ABOR1('GET_TRAJ_GRID:TRAJ_GMV TO SMALL')
    ENDIF
  ENDIF
  CALL GSTATS(1051,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JKGLO,ICEND,IBL)
  DO JKGLO=1,NGPTOT,NPROMA
    ICEND=MIN(NPROMA,NGPTOT-JKGLO+1)
! The loops below explicitly from 1 to ICEND prevent from uninitialized values
! from ICEND+1 to NPROMA
    IBL=(JKGLO-1)/NPROMA+1
    IF (LLBACKGR) THEN
      PGMV(1:ICEND,:,1:YT5%NDIM,IBL)=BCKG_GMV(1:ICEND,:,1:YT5%NDIM,IBL)
      PGMVS(1:ICEND,1:YT5%NDIMS,IBL)=BCKG_GMVS(1:ICEND,1:YT5%NDIMS,IBL)
      PGFL(1:ICEND,:,1:YGFL%NDIM5,IBL)=BCKG_GFL(1:ICEND,:,1:YGFL%NDIM5,IBL)
    ELSE
      PGMV(1:ICEND,:,1:YT5%NDIM,IBL)=TRAJ_GMV(1:ICEND,:,1:YT5%NDIM,IBL,istep)
      PGMVS(1:ICEND,1:YT5%NDIMS,IBL)=TRAJ_GMVS(1:ICEND,1:YT5%NDIMS,IBL,istep)
      PGFL(1:ICEND,:,1:YGFL%NDIM5,IBL)=TRAJ_GFL(1:ICEND,:,1:YGFL%NDIM5,IBL,istep)
    ENDIF
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1051,1)
  IF (LPRTTRAJ) THEN
    IF (LLBACKGR) THEN
      WRITE(NULOUT,*)'GREPTRAJ GET_TRAJ_GRID BACKGROUND GRID'
    ELSE
      WRITE(NULOUT,*)'GREPTRAJ GET_TRAJ_GRID GRID istep=',istep
    ENDIF
  ENDIF
ELSE
  CALL ABOR1('TRAJ_MAIN_MOD:NOT YET DONE/GFL')
  llder=.true.
  lluvder=LUVDER.AND.llder
  llvor  =LVOR  .AND.llder

  ALLOCATE(ZSPEC(NFLEVL,NSPEC2,nsptraj))
  ALLOCATE(ZSPVOR(NFLEVL,NSPEC2))
  ALLOCATE(ZSPDIV(NFLEVL,NSPEC2))
  ALLOCATE(ZSP(1+NFLEVL*(nsptraj-2),NSPEC2))
  ALLOCATE(ZGP(NPROMA,NGPTRAJ,NGPBLKS))
  ALLOCATE(ZSP1D(NFLEVL,NS1D))

  ZGP(:,:,:)=0.0_JPRB

  IF (LLBACKGR) THEN
    CALL copy_spec2spa(nsptraj,1,ns1d,bckg_spec(nuptra),ZSPEC,ZSP(1,:),ZSP1D)
  ELSE
    CALL copy_spec2spa(nsptraj,1,ns1d,traj_spec(istep),ZSPEC,ZSP(1,:),ZSP1D)
  ENDIF
  ZSPVOR(:,:)=ZSPEC(:,:,1)
  ZSPDIV(:,:)=ZSPEC(:,:,2)
  IF(NBSETSP == MYSETV) THEN
    jj=1
  ELSE
    jj=0
  ENDIF
  CALL GSTATS(1895,0)
!cjfe!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(II,ILL)
  DO ii=3,NSPTRAJ
    DO ill=1,NFLEVL
      jj=jj+1
      ZSP(jj,:)=ZSPEC(ill,:,ii)
    ENDDO
  ENDDO
!cjfe!$OMP END PARALLEL DO
  CALL GSTATS(1895,1)

  IVSETSC(1)=NBSETSP
  jj=1
  CALL GSTATS(1053,0)
  DO ii=3,NSPTRAJ
    IVSETSC(jj+1:jj+NFLEVG)=NBSETLEV(:)
    jj=jj+NFLEVG
  ENDDO
  CALL GSTATS(1053,1)

  IST=(NSPTRAJ-2)*NFLEVL
  IF(NBSETSP == MYSETV) IST=IST+1
  CALL INV_TRANS(PSPVOR=ZSPVOR, PSPDIV=ZSPDIV, &
   & PSPSCALAR=ZSP(1:IST,:), PGP=ZGP(:,:,:), KPROMA=NPROMA, &
   & LDSCDERS=llder,LDVORGP=llvor,LDDIVGP=llder,LDUVDER=lluvder, &
   & KVSETUV=NBSETLEV,KVSETSC=IVSETSC)  

!  PGRID(:,1:ngptraj,:)=ZGP(:,:,:)

  DEALLOCATE(ZSPEC)
  DEALLOCATE(ZSPVOR)
  DEALLOCATE(ZSPDIV)
  DEALLOCATE(ZSP)
  DEALLOCATE(ZGP)
  DEALLOCATE(ZSP1D)
  IF (LPRTTRAJ) THEN
    IF (LLBACKGR) THEN
      WRITE(NULOUT,*)'GREPTRAJ GET_TRAJ_GRID BACKGROUND GRID'
    ELSE
      WRITE(NULOUT,*)'GREPTRAJ GET_TRAJ_GRID SPEC istep=',istep
    ENDIF
  ENDIF
ENDIF

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:GET_TRAJ_GRID',1,ZHOOK_HANDLE)
END SUBROUTINE GET_TRAJ_GRID

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

SUBROUTINE READ_TRAJ_GRID(kstep,LDLASTRAJ,LDBACKGR)

INTEGER(KIND=JPIM), INTENT(IN) :: kstep
LOGICAL, INTENT(IN) :: LDLASTRAJ
LOGICAL, OPTIONAL, INTENT(IN) :: LDBACKGR
INTEGER(KIND=JPIM) :: jstep,jkglo,iend,ibl
INTEGER(KIND=JPIM) :: j1,j2,j3,j4
CHARACTER(LEN=20) :: CLFILE
REAL(KIND=JPRB), ALLOCATABLE :: ZTRAJGRID3(:,:,:,:)
REAL(KIND=JPRB), ALLOCATABLE :: ZTRAJGRID2(:,:,:)
INTEGER(KIND=JPIM) :: JGFL,IGP
INTEGER(KIND=JPIM) :: IDIM2,IDIM3,isub,ipersub,istep
INTEGER(KIND=JPIM) :: IGRIBCD(YGFL%NUMFLDS),IDUM(1)
LOGICAL :: llnew, LLBACKGR,LLCLOSE
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:READ_TRAJ_GRID',0,ZHOOK_HANDLE)

! If LDBACKGR=.true. the background state is read 
IF (PRESENT(LDBACKGR)) THEN
  LLBACKGR=LDBACKGR
ELSE
  LLBACKGR=.FALSE.
ENDIF
LLCLOSE = LLBACKGR .OR. LDLASTRAJ
IF (LLBACKGR .AND. KSTEP /= 1) THEN
  WRITE(NULERR,*)'READ_TRAJ_GRID: LLBACKGR, KSTEP ',LLBACKGR, KSTEP
  CALL ABOR1('READ_TRAJ_GRID: If LDBACKGR kstep must be 1 ')
ENDIF

clfile='                    '
IF (LLBACKGR) THEN
  CLFILE(1:17)=CFNTRAJBGGRID
ELSE
  CLFILE(1:17)=CFNTRAJHRGRID
ENDIF
write(CLFILE( 7: 8),'(I2.2)')nuptra

IF (N_COUPLED_WINDOWS>0 .AND. .NOT.LLBACKGR) THEN
  ipersub=(NSTEPTRAJ-1)/N_COUPLED_WINDOWS
  isub=N_COUPLED_WINDOWS-(kstep-1)/ipersub
  istep=MOD(kstep-1,ipersub)+1
  IF (kstep==NSTEPTRAJ) THEN
    isub=1
    istep=ipersub+1
  ENDIF
  write(nulout,*)'READ_TRAJ_GRID: N_COUPLED_WINDOWS, NSTEPTRAJ=',N_COUPLED_WINDOWS, NSTEPTRAJ
  write(nulout,*)'READ_TRAJ_GRID: kstep,ipersub,isub,istep=',kstep,ipersub,isub,istep
  
  IF (ipersub*N_COUPLED_WINDOWS/=NSTEPTRAJ-1) CALL ABOR1('READ_TRAJ_GRID: Error ipersub')
  IF (isub<1 .OR. isub>N_COUPLED_WINDOWS) CALL ABOR1('READ_TRAJ_GRID: Error isub')
  IF (istep<1 .OR. istep>ipersub+1) CALL ABOR1('READ_TRAJ_GRID: Error istep')
  clfile='TRAJHRXX_YY/trajgrid'
  write(clfile( 7: 8),'(I2.2)')nuptra
  write(clfile(10:11),'(I2.2)')isub
ELSE
  istep=kstep
ENDIF

IF (LLBACKGR) THEN
  write(nulout,*)'Reading background gridpoint fields from -',CLFILE,'-'
ELSE
  write(nulout,*)'Reading main gridpoint trajectory from ',CLFILE
ENDIF

IF (.NOT.LDLASTRAJ .AND. .NOT.LLBACKGR) THEN
  IF(MIOTRAJMAIN(kstep)== -1) THEN
    DO JSTEP=1,kstep-1
      IF(MIOTRAJMAIN(jstep) /= jstep)THEN
        WRITE(NULERR,*)'HOLE IN MAIN GRID TRAJ',JSTEP
        CALL ABOR1('READ_TRAJ_GRID:')
      ENDIF
    ENDDO
  ELSE
    WRITE(NULERR,*)'GRID TRAJ. AT STEP ',KSTEP,'ALREADY READ'
!    CALL ABOR1('READ_TRAJ_GRID:')
  ENDIF
ENDIF

IF (ltrajgp) THEN

  IDIM3=0
  DO JGFL=1,YGFL%NUMFLDS
    IF ( YGFLC(JGFL)%LTRAJIO ) THEN
      IDIM3=IDIM3+1
      IGRIBCD(IDIM3) = YGFLC(JGFL)%IGRBCODE
    ENDIF
  ENDDO
  IF (IDIM3 == 0) THEN
    WRITE(NULERR,*) 'NO GRIDPOINT FIELDS READ FROM TRAJECTORY'
    CALL ABOR1('READ_TRAJ_GRID:IDIM3=0')
  ENDIF

  llnew=(istep==1)

  IDIM2=0
  ALLOCATE(ZTRAJGRID3(NPROMA,NFLEVG,IDIM3,NGPBLKS))
  ALLOCATE(ZTRAJGRID2(0,0,0))
  CALL GSTATS(1055,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J4,J3,J2,J1)
  DO J4=1,NGPBLKS
    DO J3=1,IDIM3
      DO J2=1,NFLEVG
        DO J1=1,NPROMA
          ZTRAJGRID3(J1,J2,J3,J4) = 0.0
        ENDDO
      ENDDO
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1055,1)

  ! ky: option larpegef_trajhr=T not yet coded,
  !     and option larpegef_trajbg=T not yet coded.
  !     * LLBACKGR=T and larpegef_trajbg=T => read background ARPEGE file
  !       by calling READ_GRID_TRAJ_FROMFA (must call at least SUGRIDUA)
  !     * LLBACKGR=T and larpegef_trajbg=F => read background GRIB file
  !       by calling READ_GRID_TRAJ
  !     * LLBACKGR=F and larpegef_trajhr=T => read trajectory ARPEGE file
  !       by calling READ_GRID_TRAJ_FROMFA (must call at least SUGRIDUA)
  !     * LLBACKGR=F and larpegef_trajhr=F => read trajectory GRIB file
  !       by calling READ_GRID_TRAJ
  !     Missing cases (read ARPEGE files) to be implemented later
  !      (cf. 'nyc'-commented future code).
  !nyc LLARPEGEF= &
  !nyc  &(LARPEGEF_TRAJHR.AND.(.NOT.LLBACKGR)).OR.(LARPEGEF_TRAJBG.AND.LLBACKGR)
  !nyc IF (LLARPEGEF) THEN
  !nyc   CALL READ_GRID_TRAJ_FROMFA(CLFILE,...,LDBACKGR=LLBACKGR)
  !nyc ELSE
  CALL READ_GRID_TRAJ(trim(clfile),IGRIBCD,IDUM,IDIM3,IDIM2,&
   & ZTRAJGRID3,ZTRAJGRID2,LLNEW,LDBACKGR=LLBACKGR,LDCLOSE=LLCLOSE)
  !nyc ENDIF

  CALL GSTATS(1056,0)
  ! This seemingly unneccesary copy is because TRAJ_GMV etc. is real*4
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JKGLO,IEND,IBL,IGP,JGFL)
  DO JKGLO=1,NGPTOT,NPROMA
    IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
    IBL=(JKGLO-1)/NPROMA+1
    IGP=1
    DO JGFL=1,YGFL%NUMFLDS
      IF ( YGFLC(JGFL)%LTRAJIO ) THEN
        IF (LLBACKGR) THEN
          BCKG_GFL(1:IEND,:,YGFLC(JGFL)%MP,IBL)=ZTRAJGRID3(1:IEND,:,IGP,IBL)
        ELSE
          TRAJ_GFL(1:IEND,:,YGFLC(JGFL)%MP,IBL,KSTEP)=ZTRAJGRID3(1:IEND,:,IGP,IBL)
        ENDIF
        IGP=IGP+1
      ENDIF
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1056,1)
  DEALLOCATE(ZTRAJGRID3)
  DEALLOCATE(ZTRAJGRID2)
  IF (LPRTTRAJ) THEN
    IF (LLBACKGR) THEN
      WRITE(NULOUT,*)'GREPTRAJ READ_TRAJ_GRID BACKGROUND GRID nuptra=',nuptra
    ELSE
      WRITE(NULOUT,*)'GREPTRAJ READ_TRAJ_GRID GRID kstep=',kstep
    ENDIF
  ENDIF
ELSE
  IF (LLBACKGR) THEN
    ! ky: option larpegef_trajbg=T not yet coded.
    !     * LLBACKGR=T and larpegef_trajbg=T => read background ARPEGE file
    !       by calling READ_SPEC_FROMFA (must call at least SUSPEC)
    !     * LLBACKGR=T and larpegef_trajbg=F => read background GRIB file
    !       by calling READ_SPEC
    !     Missing cases (read ARPEGE files) to be implemented later.
    IF(.NOT.ALLOCATED(BCKG_SPEC)) CALL ABOR1('TRAJ_MAIN_MOD:BCKG_SPEC NOT ALLOCATED')
    IF (LARPEGEF_TRAJBG) THEN
      ! ky: not yet validated.
      CALL READ_SPEC_FROMFA(KSTEP,BCKG_SPEC(NUPTRA),LDBACKGR=LLBACKGR)
    ELSE
      CALL READ_SPEC(trim(clfile),BCKG_SPEC(NUPTRA),iSTEP,LDBACKGR=LLBACKGR)
    ENDIF
  ELSE
    IF(.NOT.ALLOCATED(TRAJ_SPEC)) CALL ABOR1('TRAJ_MAIN_MOD:TRAJ_SPEC NOT ALLOCATED')
    IF (LARPEGEF_TRAJHR) THEN
      ! ky: not yet validated.
      CALL READ_SPEC_FROMFA(KSTEP,TRAJ_SPEC(KSTEP),LDBACKGR=LLBACKGR)
    ELSE
      CALL READ_SPEC(trim(clfile),TRAJ_SPEC(KSTEP),iSTEP,LDBACKGR=LLBACKGR)
    ENDIF
  ENDIF
ENDIF
!!!!IF (.NOT.LDLASTRAJ) MIOTRAJMAIN(KSTEP)=KSTEP

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:READ_TRAJ_GRID',1,ZHOOK_HANDLE)
END SUBROUTINE READ_TRAJ_GRID

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

SUBROUTINE READ_TRAJ_SPEC(kstep,LDLASTRAJ,LDBACKGR)

INTEGER(KIND=JPIM), INTENT(IN) :: kstep
LOGICAL, INTENT(IN) :: LDLASTRAJ
LOGICAL, OPTIONAL, INTENT(IN) :: LDBACKGR
INTEGER(KIND=JPIM) :: jstep, ist,jkglo,iend,ibl,jlev,jl
REAL(KIND=JPRB) :: zsp2d(1,NSPEC2), zsp1d(NFLEVL,NS1D)
LOGICAL :: llder, lluvder, llvor, LLBACKGR
CHARACTER(LEN=20) :: CLFILE
REAL(KIND=JPRB), ALLOCATABLE :: ZGMV(:,:,:,:),ZGMVS(:,:,:),ZGFL(:,:,:,:)
REAL(KIND=JPRB) :: ZQ(NPROMA,NFLEVG,NGPBLKS)
REAL(KIND=JPRB) :: ZR(NPROMA,NFLEVG)

INTEGER(KIND=JPIM) :: IVSETSC(1)
INTEGER(KIND=JPIM) :: IOFF,IDIM3,ISTGMV,IENGMV,IDIMGMVS,ISTUV,IENUV,isub,ipersub,istep
INTEGER(KIND=JPIM) :: J
REAL(KIND=JPRB) :: ZHOOK_HANDLE

! Needs to be in this position because of bug in pgf90 5.2-4
#include "gprcp.intfb.h"

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:READ_TRAJ_SPEC',0,ZHOOK_HANDLE)

! If LDBACKGR=.true. the background state is read 
IF (PRESENT(LDBACKGR)) THEN
  LLBACKGR=LDBACKGR
ELSE
  LLBACKGR=.FALSE.
ENDIF

IF (LLBACKGR .AND. KSTEP /= 1) THEN
  WRITE(NULERR,*)'READ_TRAJ_SPEC: LLBACKGR, KSTEP ',LLBACKGR, KSTEP
  CALL ABOR1('READ_TRAJ_SPEC: If LLBACKGR kstep must be 1 ')
ENDIF

clfile='                    '
IF (LLBACKGR) THEN
  CLFILE(1:17)=CFNTRAJBGSPEC
ELSE
  CLFILE(1:17)=CFNTRAJHRSPEC
ENDIF

write(CLFILE( 7: 8),'(I2.2)')nuptra

IF (N_COUPLED_WINDOWS>0 .AND. .NOT.LLBACKGR) THEN
  ipersub=(NSTEPTRAJ-1)/N_COUPLED_WINDOWS
  isub=N_COUPLED_WINDOWS-(kstep-1)/ipersub
  istep=MOD(kstep-1,ipersub)+1
  IF (kstep==NSTEPTRAJ) THEN
    isub=1
    istep=ipersub+1
  ENDIF
  write(nulout,*)'READ_TRAJ_SPEC: N_COUPLED_WINDOWS, NSTEPTRAJ=',N_COUPLED_WINDOWS, NSTEPTRAJ
  write(nulout,*)'READ_TRAJ_SPEC: kstep,ipersub,isub,istep=',kstep,ipersub,isub,istep
  
  IF (ipersub*N_COUPLED_WINDOWS/=NSTEPTRAJ-1) CALL ABOR1('READ_TRAJ_SPEC: Error ipersub')
  IF (isub<1 .OR. isub>N_COUPLED_WINDOWS) CALL ABOR1('READ_TRAJ_SPEC: Error isub')
  IF (istep<1 .OR. istep>ipersub+1) CALL ABOR1('READ_TRAJ_SPEC: Error istep')
  clfile='TRAJHRXX_YY/trajspec'
  write(clfile( 7: 8),'(I2.2)')nuptra
  write(clfile(10:11),'(I2.2)')isub
ELSE
  istep=kstep
ENDIF

IF (.NOT.LDLASTRAJ .AND. .NOT. LLBACKGR) THEN
  IF(MIOTRAJMAIN(kstep)== -1) THEN
    DO JSTEP=1,kstep-1
      IF(MIOTRAJMAIN(jstep) /= jstep)THEN
        WRITE(NULERR,*)'HOLE IN MAIN SPEC TRAJ',JSTEP
        CALL ABOR1('READ_TRAJ_SPEC:')
      ENDIF
    ENDDO
  ELSE
    IF (LTRAJRESET) THEN
      WRITE(NULOUT,*)'GREPTRAJ Reading spectral trajectory at step ',kstep,' again.'
    ELSE
      WRITE(NULERR,*)'TRAJ. AT STEP ',KSTEP,'ALREADY READ'
      CALL ABOR1('READ_TRAJ_SPEC:')
    ENDIF
  ENDIF
ENDIF

IF (ltrajgp) THEN

  IF (LLBACKGR) THEN
    IF(.NOT.ALLOCATED(BCKG_SPEC)) CALL ABOR1('TRAJ_MAIN_MOD:BCKG_SPEC NOT ALLOCATED')
    IF (LARPEGEF_TRAJBG) THEN
      CALL READ_SPEC_FROMFA(KSTEP,BCKG_SPEC(NUPTRA),LDBACKGR=LLBACKGR)
    ELSE
      CALL READ_SPEC(trim(clfile),bckg_spec(nuptra),istep,LDBACKGR=LLBACKGR)
    ENDIF
  ELSE
    IF (.NOT.LDLASTRAJ) THEN
      IF(.NOT.ALLOCATED(TRAJ_SPEC)) CALL ABOR1('TRAJ_MAIN_MOD:TRAJ_SPEC NOT ALLOCATED')
      IF (LARPEGEF_TRAJHR) THEN
        CALL READ_SPEC_FROMFA(KSTEP,TRAJ_SPEC(MSTART),LDBACKGR=LLBACKGR)
      ELSE
        CALL READ_SPEC(trim(clfile),traj_spec(mstart),istep,LDBACKGR=LLBACKGR)
      ENDIF
  
      IF(kstep == MSTART) THEN
        traj_spec_tmp0=traj_spec(kstep)
      ENDIF
    ELSE
      traj_spec(kstep)=traj_spec_tmp0
      WRITE(NULOUT,*)'GREPTRAJ testing: kstep MSTART  ',kstep,MSTART
    ENDIF
  ENDIF

  ALLOCATE(TRAJ_BUF(NFLEVL,NSPEC2,NSPTRAJ))

  ! Only Vor, Div, Tem are read in as spectral fields if LREADGPTRAJ

  IF (LLBACKGR) THEN
    CALL copy_spec2spa(NSPTRAJ,1,NS1D,bckg_spec(nuptra),traj_buf,zsp2d,zsp1d)
  ELSE
    CALL copy_spec2spa(NSPTRAJ,1,NS1D,traj_spec(mstart),traj_buf,zsp2d,zsp1d)
  ENDIF

! TRANSINV_MDL cannot be used because the number of fields in
! SP5HV is hard wired inside TRANSINV_MDL. In particular, if LGPQ
! and/or LGPO3, transforms would not be performed for these fields.

  llder=.true.
  lluvder=LUVDER.AND.llder
  llvor  =LVOR  .AND.llder

  IF(NBSETSP == MYSETV) THEN
    IST=1
  ELSE
    IST=0
  ENDIF
  IVSETSC(1)=NBSETSP

  ISTUV=1
  IENUV=YT0%NDIMUV
  IDIMGMVS=YT0%NDIMS
  ISTGMV=YT0%NDIMUV+1
  IENGMV=YT0%NDIM
  IOFF=YGFL%NUMFLDS-YGFL%NUMSPFLDS
  IDIM3=YGFL%NUMSPFLDS
  IF(LLDER) IDIM3=IDIM3*3
  
  ALLOCATE(ZGMV(NPROMA,NFLEVG,YT5%NDIM,NGPBLKS))
  ALLOCATE(ZGMVS(NPROMA,YT5%NDIMS,NGPBLKS))
  ALLOCATE(ZGFL(NPROMA,NFLEVG,YGFL%NDIM5,NGPBLKS))
  ZGMV(:,:,ISTUV:IENUV,NGPBLKS)=0.0_JPRB
  ZGMVS(:,1:IDIMGMVS,NGPBLKS)=0.0_JPRB
  ZGMV(:,:,ISTGMV:IENGMV,NGPBLKS)=0.0_JPRB  
  If (.NOT.LREADGPTRAJ) THEN
    ZGFL(:,:,IOFF+1:IOFF+IDIM3,NGPBLKS)=0.0_JPRB
    CALL INV_TRANS(&
     & PSPVOR=traj_buf(:,:,1),PSPDIV=traj_buf(:,:,2),PSPSC2=ZSP2D(1:IST,:),&
     & PSPSC3A=traj_buf(:,:,3:3+NFTHER-1),&
     & PSPSC3B=traj_buf(:,:,4:), &
     & LDSCDERS=LLDER,LDVORGP=LLVOR,LDDIVGP=LLDER,LDUVDER=LLUVDER,&
     & KPROMA=NPROMA,KVSETUV=NBSETLEV,KVSETSC2=IVSETSC(1:1),&
     & KVSETSC3A=NBSETLEV,KVSETSC3B=NBSETLEV,&
     & PGPUV=ZGMV(:,:,ISTUV:IENUV,:),&
     & PGP2 =ZGMVS(:,1:IDIMGMVS,:),&
     & PGP3A=ZGMV(:,:,ISTGMV:IENGMV,:),&
     & PGP3B=ZGFL(:,:,IOFF+1:IOFF+IDIM3,:))  
  ELSE
    CALL INV_TRANS(&
     & PSPVOR=traj_buf(:,:,1),PSPDIV=traj_buf(:,:,2),PSPSC2=ZSP2D(1:IST,:),&
     & PSPSC3A=traj_buf(:,:,3:3+NFTHER-1),&
     & LDSCDERS=LLDER,LDVORGP=LLVOR,LDDIVGP=LLDER,LDUVDER=LLUVDER,&
     & KPROMA=NPROMA,KVSETUV=NBSETLEV,KVSETSC2=IVSETSC(1:1),&
     & KVSETSC3A=NBSETLEV,&
     & PGPUV=ZGMV(:,:,ISTUV:IENUV,:),&
     & PGP2 =ZGMVS(:,1:IDIMGMVS,:),&
     & PGP3A=ZGMV(:,:,ISTGMV:IENGMV,:))  
  ENDIF

  IF (LSPRT) THEN
    ! Convert both grid point and spectral trajectory temperature to Tv if LSPRT=.t.
    ! Ignore CLWC and CIWC effects
    IF (.NOT.LREADGPTRAJ) THEN
      CALL GSTATS(1059,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
      DO J=1,NGPBLKS
        ZQ(:,:,J)=ZGFL(:,:,YQ%MP,J)
      ENDDO
!$OMP END PARALLEL DO
      CALL GSTATS(1059,1)
    ELSE
      ! Humidity is read in from file in the call to the READ_TRAJ_GRID routine.
      ! This is done just before the call to this routine (READ_TRAJ_SPEC)
      IF (LLBACKGR) THEN
        CALL GSTATS(1059,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
        DO J=1,NGPBLKS
          ZQ(:,:,J)=BCKG_GFL(:,:,YQ%MP,J)
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1059,1)
      ELSE
        CALL GSTATS(1059,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
        DO J=1,NGPBLKS
          ZQ(:,:,J)=TRAJ_GFL(:,:,YQ%MP,J,KSTEP)
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1059,1)
      ENDIF
    ENDIF
    CALL GSTATS(1057,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) &
!$OMP&PRIVATE(JKGLO,IST,IEND,JLEV,JL,IBL,ZR)
    DO JKGLO=1,NGPTOT,NPROMA
      IST =1
      IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
      IBL=(JKGLO-1)/NPROMA+1
      CALL GPRCP (NPROMA,IST,IEND,NFLEVG,PQ=ZQ(:,:,IBL),PR=ZR)

      DO JLEV=1,NFLEVG
        DO JL=IST,IEND
          ZGMV(JL,JLEV,YT5%MT,IBL)=ZR(JL,JLEV)* &
           & ZGMV(JL,JLEV,YT5%MT,IBL)/RD
        ENDDO
      ENDDO
    ENDDO
!$OMP END PARALLEL DO
    CALL GSTATS(1057,1)
    ! Replace T by Tv in traj_buf and traj_spec
    CALL DIR_TRANS(PSPSCALAR=traj_buf(:,:,3),KVSETSC=NBSETLEV,KPROMA=NPROMA,&
     &      PGP=ZGMV(:,:,YT5%MT,:))

    IF (LLBACKGR) THEN
      CALL copy_spa2spec(NSPTRAJ,1,NS1D,traj_buf,zsp2d,zsp1d,bckg_spec(nuptra))
    ELSE
      CALL copy_spa2spec(NSPTRAJ,1,NS1D,traj_buf,zsp2d,zsp1d,traj_spec(mstart))
    ENDIF
  ENDIF

  CALL GSTATS(1058,0)
!This seemingly unneccesary copy is because TRAJ_GMV etc. is real*4
! If LSPRT TRAJ_GMV contains virtual temperature
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JKGLO,IEND,IBL)
  DO JKGLO=1,NGPTOT,NPROMA
    IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
    IBL=(JKGLO-1)/NPROMA+1
    IF (LLBACKGR) THEN
      BCKG_GMV(1:IEND,:,ISTUV:IENUV,IBL)=ZGMV(1:IEND,:,ISTUV:IENUV,IBL)
      BCKG_GMVS(1:IEND,1:IDIMGMVS,IBL)=ZGMVS(1:IEND,1:IDIMGMVS,IBL)
      BCKG_GMV(1:IEND,:,ISTGMV:IENGMV,IBL)=ZGMV(1:IEND,:,ISTGMV:IENGMV,IBL)
      IF (.NOT.LREADGPTRAJ) THEN
        BCKG_GFL(1:IEND,:,IOFF+1:IOFF+IDIM3,IBL)=&
         & ZGFL(1:IEND,:,IOFF+1:IOFF+IDIM3,IBL)
      ENDIF
    ELSE
      TRAJ_GMV(1:IEND,:,ISTUV:IENUV,IBL,KSTEP)=ZGMV(1:IEND,:,ISTUV:IENUV,IBL)
      TRAJ_GMVS(1:IEND,1:IDIMGMVS,IBL,KSTEP)=ZGMVS(1:IEND,1:IDIMGMVS,IBL)
      TRAJ_GMV(1:IEND,:,ISTGMV:IENGMV,IBL,KSTEP)=ZGMV(1:IEND,:,ISTGMV:IENGMV,IBL)
      IF (.NOT.LREADGPTRAJ) THEN
        TRAJ_GFL(1:IEND,:,IOFF+1:IOFF+IDIM3,IBL,KSTEP)=&
         & ZGFL(1:IEND,:,IOFF+1:IOFF+IDIM3,IBL)
      ENDIF
    ENDIF
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1058,1)

  DEALLOCATE(TRAJ_BUF)
  IF (LPRTTRAJ) THEN
    IF (LLBACKGR) THEN
      WRITE(NULOUT,*)'GREPTRAJ READ_TRAJ_SPEC BACKGROUND GRID nuptra=',nuptra
    ELSE
      WRITE(NULOUT,*)'GREPTRAJ READ_TRAJ_SPEC GRID kstep=',kstep
    ENDIF
  ENDIF
  DEALLOCATE(ZGFL)
  DEALLOCATE(ZGMV)
  DEALLOCATE(ZGMVS)
ELSE
  IF (LLBACKGR) THEN
    IF(.NOT.ALLOCATED(BCKG_SPEC)) CALL ABOR1('TRAJ_MAIN_MOD:BCKG_SPEC NOT ALLOCATED')
    IF (LARPEGEF_TRAJBG) THEN
      ! ky: not yet validated.
      CALL READ_SPEC_FROMFA(KSTEP,BCKG_SPEC(NUPTRA),LDBACKGR=LLBACKGR)
    ELSE
      CALL READ_SPEC(trim(clfile),BCKG_SPEC(nuptra),iSTEP,LDBACKGR=LLBACKGR)
    ENDIF
    IF (LPRTTRAJ) WRITE(NULOUT,*)'GREPTRAJ READ_TRAJ_SPEC BACKGROUND SPEC nuptra=',nuptra
  ELSE
    IF(.NOT.ALLOCATED(TRAJ_SPEC)) CALL ABOR1('TRAJ_MAIN_MOD:TRAJ_SPEC NOT ALLOCATED')
    IF (LARPEGEF_TRAJHR) THEN
      CALL READ_SPEC_FROMFA(KSTEP,TRAJ_SPEC(KSTEP),LDBACKGR=LLBACKGR)
    ELSE
      CALL READ_SPEC(trim(clfile),TRAJ_SPEC(KSTEP),iSTEP,LDBACKGR=LLBACKGR)
    ENDIF
    IF (LPRTTRAJ) WRITE(NULOUT,*)'GREPTRAJ READ_TRAJ_SPEC SPEC kstep=',kstep
  ENDIF
ENDIF
IF (.NOT.LDLASTRAJ) MIOTRAJMAIN(KSTEP)=KSTEP

IF (LHOOK) CALL DR_HOOK('TRAJ_MAIN_MOD:READ_TRAJ_SPEC',1,ZHOOK_HANDLE)
END SUBROUTINE READ_TRAJ_SPEC
!-----------------------------------------------------------------------

END MODULE TRAJ_MAIN_MOD

