SUBROUTINE FSPGLH(KM,KMLOC,KSL,KDGL,KFIELDS,PFIELD,&
 & KPTRVOR,KPTRDIV,KPTRU,KPTRV,KPTRSC,KPTRNSD,KFLDUV,KFLDSC,KFLDNSD,&
 & KFLDPTRUV,KFLDPTRSC)  

!**** *FSPGLH* - Dynamics calculations in Fourier space

!     Purpose.
!     --------
!         Perform dynamics calculations in Fourier space, specifically in
!         Fourier space before transposition (where you have access to all
!         latitudes for a given zonal wave number M).

!**   Interface.
!     ----------
!        CALL FSPGLH(...)
!        Explicit arguments : 
!        -------------------- 
!        KM - zonal wavenumer
!        KMLOC - local zonal wavenumber
!!       KSL - first latitude for given KM
!        KDGL - number of Gaussian latitudes
!        KFIELDS - number of fields in PFIELD
!        PFIELD - fourier data
!        KPTRVOR - pointer to first vort.field in PFIELD
!        KPTRDIV - pointer to first div. field in PFIELD
!        KPTRU - pointer to first u field in PFIELD
!        KPTRV - pointer to first v field in PFIELD
!        KPTRSC  - pointer to first scalar field in PFIELD 
!        KPTRNSD  - pointer to first N.S der.  field in PFIELD
!        KFLDUV - number of u/v fields (also for vor. and div.)
!        KFLDSC - number of scalar fields
!        KFLDNSD - number of N.S der.  field
!        KFLDPTRUV - level list for U-V type fields
!        KFLDPTRSC - level list for scalar fields

!     Method.
!     -------
!       This routine is passed as an external to the transform package
!       when calling INV_TRANS. Inside the transform package the routine is 
!       invoked from routine FSPGL_INT. Tha argument list can thus not be
!       changed without a corrosponding change to this routine.
  
!     Externals.   None.
!     ----------
!     Author.
!     -------
!        Mats Hamrud *ECMWF*

!     Modifications.
!     --------------
!        Original : 00-10-26
!        P. Bechtold 26-Oct-2008  non-oro GWD (LEGWWMS)

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCT0   , ONLY : LSLAG    ,LRFRIC
USE YOMLEG   , ONLY : R1MU2
USE YOMMP    , ONLY : MYLEVS
USE YOMDYN   , ONLY : RKRF     ,TSTEP
USE YOEPHY   , ONLY : LEGWWMS

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDGL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELDS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDUV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDSC 
INTEGER(KIND=JPIM),INTENT(IN)    :: KM 
INTEGER(KIND=JPIM)               :: KMLOC ! Argument NOT used
INTEGER(KIND=JPIM),INTENT(IN)    :: KSL 
REAL(KIND=JPRB)   ,TARGET,INTENT(INOUT) :: PFIELD(2*KFIELDS,0:KDGL+1) 
INTEGER(KIND=JPIM)               :: KPTRVOR ! Argument NOT used
INTEGER(KIND=JPIM)               :: KPTRDIV ! Argument NOT used 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPTRU 
INTEGER(KIND=JPIM)               :: KPTRV   ! Argument NOT used
INTEGER(KIND=JPIM)               :: KPTRSC  ! Argument NOT used
INTEGER(KIND=JPIM)               :: KPTRNSD ! Argument NOT used
INTEGER(KIND=JPIM)               :: KFLDNSD ! Argument NOT used
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDPTRUV(KFLDUV) 
INTEGER(KIND=JPIM)               :: KFLDPTRSC(KFLDSC) ! Argument NOT used

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

REAL(KIND=JPRB) :: ZCOS2
INTEGER(KIND=JPIM) :: JGL,JLEV,IR,ILEV
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

!*       1.1.1  RAYLEIGH FRICTION ON U ( FOR M=0 ONLY)

IF (LEGWWMS) THEN
  IF(LRFRIC .AND. LSLAG) THEN
    IF(KM == 0) THEN
      DO JGL=KSL,KDGL-KSL+1
        ZCOS2 = R1MU2(JGL)**6
        DO JLEV=1,KFLDUV
          IR = KPTRU+2*JLEV-2
          ILEV = MYLEVS(KFLDPTRUV(JLEV))
  !       IF(PFIELD(IR,JGL) > 0.0_JPRB ) THEN
            PFIELD(IR,JGL) = PFIELD(IR,JGL)/(1.0_JPRB+RKRF(ILEV)*ZCOS2*TSTEP)
  !       ENDIF
        ENDDO
      ENDDO
    ENDIF
  ENDIF
ENDIF

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

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