SUBROUTINE copy_spec2spa(ks3d,ks2d,ks1d,YD_SPEC,PSP3D,PSP2D,PSP1D)

!     Purpose.
!     --------
!       Copy SPECTRAL_FIELD type into SPA3/SPA2-like arrays.
!       Fields are truncated or padded with zeroes if resolution
!       is different.

!     Author.
!     -------
!       Yannick Tremolet *ECMWF*

!     Modifications.
!     --------------
!       Original  : 14-05-02
!     C.Fischer   03-03-31 Aladin spectral treatment added.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
! ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMCT0, ONLY: LELAM
USE YOMDIM, ONLY: NSMAX, NUMP, NFLEVL, NSPEC2, NMSMAX
USE YOMLAP, ONLY: NASM0, MYMS
USE YEMLAP, ONLY: NESM0, NCPL4M
USE YOMMP , ONLY: NBSETSP, MYSETV
USE SPECTRAL_FIELDS_MOD

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KS3D 
INTEGER(KIND=JPIM),INTENT(IN)    :: KS2D 
INTEGER(KIND=JPIM),INTENT(IN)    :: KS1D 
TYPE(SPECTRAL_FIELD),INTENT(IN)    :: YD_SPEC 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSP3D(NFLEVL,NSPEC2,KS3D) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSP2D(NSPEC2,KS2D) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSP1D(NFLEVL,KS1D) 
INTEGER(KIND=JPIM) :: jf,jm,im,I_LEN,js1,js2
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

IF (LHOOK) CALL DR_HOOK('COPY_SPEC2SPA',0,ZHOOK_HANDLE)
IF (ks3d /= YD_SPEC%ns3d) CALL ABOR1('Wrong number of 3D fields')
IF (ks2d /= YD_SPEC%ns2g) CALL ABOR1('Wrong number of 2D fields')
IF ((ks1d /= YD_SPEC%ns1d).AND.LELAM) CALL ABOR1('Wrong number of 1D fields')

IF ((NSMAX<YD_SPEC%nsmax).AND.(.NOT.LELAM)) THEN      ! Truncate in IFS
  CALL GSTATS(1214,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JF,JM,IM,I_LEN,JS1,JS2)
  DO jf=1,ks3d
    DO jm=1,NUMP
      im=MYMS(jm)
      I_LEN=2*(NSMAX-im+1)-1
      js1=NASM0(im)
      js2=YD_SPEC%NASM0(im)
      PSP3D(:,js1:js1+I_LEN,jf) = YD_SPEC%sp3d(:,js2:js2+I_LEN,jf)
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JF,JM,IM,I_LEN,JS1,JS2)
  DO jf=1,ks2d
    DO jm=1,NUMP
      im=MYMS(jm)
      I_LEN=2*(NSMAX-im+1)-1
      js1=NASM0(im)
      js2=YD_SPEC%NASM0(im)
      PSP2D(js1:js1+I_LEN,jf) = YD_SPEC%sp2d(js2:js2+I_LEN,jf)
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1214,1)
ELSEIF ((NSMAX>YD_SPEC%nsmax).AND.(.NOT.LELAM)) THEN  ! Pad with zeros in IFS
  PSP3D(:,:,:) = 0.0_JPRB
  CALL GSTATS(1215,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JF,JM,IM,I_LEN,JS1,JS2)
  DO jf=1,YD_SPEC%ns3d
    DO jm=1,YD_SPEC%NUMP
      im=MYMS(jm)
      I_LEN=2*(YD_SPEC%NSMAX-im+1)-1
      js1=NASM0(im)
      js2=YD_SPEC%NASM0(im)
      PSP3D(:,js1:js1+I_LEN,jf) = YD_SPEC%sp3d(:,js2:js2+I_LEN,jf)
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
  PSP2D(:,:) = 0.0_JPRB
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JF,JM,IM,I_LEN,JS1,JS2)
  DO jf=1,YD_SPEC%ns2d
    DO jm=1,YD_SPEC%NUMP
      im=MYMS(jm)
      I_LEN=2*(YD_SPEC%NSMAX-im+1)-1
      js1=NASM0(im)
      js2=YD_SPEC%NASM0(im)
      PSP2D(js1:js1+I_LEN,jf) = YD_SPEC%sp2d(js2:js2+I_LEN,jf)
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1215,1)
ELSEIF ((((NSMAX<YD_SPEC%nsmax).AND.(NMSMAX<=YD_SPEC%nmsmax)).OR. &
   & ((NSMAX<=YD_SPEC%nsmax).AND.(NMSMAX<YD_SPEC%nmsmax))) &
   & .AND.(LELAM)) THEN      ! Truncate in Aladin  
  DO jf=1,ks3d
    DO jm=1,NUMP
      im=MYMS(jm)
      I_LEN=NCPL4M(im)-1
      js1=NESM0(im)
      js2=YD_SPEC%NESM0(im)
      PSP3D(:,js1:js1+I_LEN,jf) = YD_SPEC%sp3d(:,js2:js2+I_LEN,jf)
    ENDDO
  ENDDO
  DO jf=1,ks2d
    DO jm=1,NUMP
      im=MYMS(jm)
      I_LEN=NCPL4M(im)-1
      js1=NESM0(im)
      js2=YD_SPEC%NESM0(im)
      PSP2D(js1:js1+I_LEN,jf) = YD_SPEC%sp2d(js2:js2+I_LEN,jf)
    ENDDO
  ENDDO
ELSEIF ((((NSMAX>YD_SPEC%nsmax).AND.(NMSMAX>=YD_SPEC%nmsmax)).OR. &
   & ((NSMAX>=YD_SPEC%nsmax).AND.(NMSMAX>YD_SPEC%nmsmax))) &
   & .AND.(LELAM)) THEN  ! Pad with zeros in Aladin  
  PSP3D(:,:,:) = 0.0_JPRB
  DO jf=1,YD_SPEC%ns3d
    DO jm=1,YD_SPEC%NUMP
      im=MYMS(jm)
      I_LEN=YD_SPEC%ncpl4m(im)-1
      js1=NESM0(im)
      js2=YD_SPEC%NESM0(im)
      PSP3D(:,js1:js1+I_LEN,jf) = YD_SPEC%sp3d(:,js2:js2+I_LEN,jf)
    ENDDO
  ENDDO
  PSP2D(:,:) = 0.0_JPRB
  DO jf=1,YD_SPEC%ns2d
    DO jm=1,YD_SPEC%NUMP
      im=MYMS(jm)
      I_LEN=YD_SPEC%ncpl4m(im)-1
      js1=NESM0(im)
      js2=YD_SPEC%NESM0(im)
      PSP2D(js1:js1+I_LEN,jf) = YD_SPEC%sp2d(js2:js2+I_LEN,jf)
    ENDDO
  ENDDO
ELSEIF (((NSMAX/=YD_SPEC%nsmax).OR.(NMSMAX/=YD_SPEC%nmsmax)).AND. &
   & (LELAM)) THEN  ! Unfeasible cases left in Aladin  
  CALL ABOR1('COPY_SPEC_SPA error: mismatch in Aladin spectral truncations')
ELSE                                   ! Copy
  CALL GSTATS(1850,0)
  PSP3D(:,:,:)=YD_SPEC%sp3d(:,:,:)
  IF(NBSETSP == MYSETV) THEN
    PSP2D(:,:)  =YD_SPEC%sp2d(:,:)
  ENDIF
  CALL GSTATS(1850,1)
ENDIF

IF (LELAM) THEN
  DO jf=1,ks1d
    PSP1D(:,jf) = YD_SPEC%sp1d(:,jf)
  ENDDO
ENDIF

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