cpledn_mod.F90

Go to the documentation of this file.

MODULE cpledn_mod
CONTAINS
SUBROUTINE cpledn(KN,KDBLE,PX,DDX,KFLAG,PW,PXN,DDXN,PXMOD)

!**** *CPLEDN* - Routine to compute the Legendre polynomial of degree N

!     Purpose.
!     --------
!           Computes Legendre polynomial of degree N

!**   Interface.
!     ----------
!        *CALL* *CPLEDN(KN,KDBLE,PX,DDX,KFLAG,PW,PXN,DDXN,PXMOD)*

!        Explicit arguments :
!        --------------------
!              KN       :  Degree of the Legendre polynomial
!              KDBLE    :  0, single precision
!                          1, double precision
!              PX       :  abcissa where the computations are performed
!              DDX      :  id in double precision
!              KFLAG    :  When KFLAG.EQ.1 computes the weights
!              PW       :  Weight of the quadrature at PXN
!              PXN      :  new abscissa (Newton iteration)
!              DDXN     :  id in double precision
!              PXMOD    :  PXN-PX

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

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

!     Externals.
!     ----------
!        None

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

!     Modifications.
!     --------------
!        Original : 87-10-15
!        Michel Rochas, 90-08-30 (Lobatto+cleaning)
!     ------------------------------------------------------------------



USE parkind1  ,ONLY : jpim     ,jprb
USE parkind2  ,ONLY : jprh

IMPLICIT NONE


!     DUMMY INTEGER SCALARS
INTEGER(KIND=JPIM) :: KDBLE
INTEGER(KIND=JPIM) :: KFLAG
INTEGER(KIND=JPIM) :: KN

!     DUMMY REAL SCALARS
REAL(KIND=JPRB) :: PW
REAL(KIND=JPRB) :: PX
REAL(KIND=JPRB) :: PXMOD
REAL(KIND=JPRB) :: PXN


REAL(KIND=JPRH) :: DDX,DDXN,DLX,DLK,DLKM1,DLKM2,DLLDN,DLXN,DLMOD
REAL(KIND=JPRH) :: DLG,DLGDN

INTEGER(KIND=JPIM), PARAMETER :: JPKS=kind(px)
INTEGER(KIND=JPIM), PARAMETER :: JPKD=kind(ddx)

!     LOCAL INTEGER SCALARS
INTEGER(KIND=JPIM) :: IZN, JN

!     LOCAL REAL SCALARS
REAL(KIND=JPRB) :: ZG, ZGDN, ZK, ZKM1, ZKM2, ZLDN, ZMOD, ZX, ZXN


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

!*       1. Single precision computations.
!           ------------------------------

izn = kn

zk = 0.0_jprb
dlk = 0.0_jprb
dlxn = 0.0_jprb
IF(kdble == 0)THEN

!*       1.1   NEWTON ITERATION STEP.

  zkm2 = 1
  zkm1 = px
  zx   = px
  DO jn=2,izn
    zk = (REAL(2*jn-1,jprb)*ZX*ZKM1-REAL(jn-1,jprb)*ZKM2)/REAL(JN,JPRB)
    zkm2 = zkm1
    zkm1 = zk
  ENDDO
  zkm1 = zkm2
  zldn = (REAL(kn,jprb)*(zkm1-zx*zk))/(1.0_JPRB-ZX*ZX)
  zmod = -zk/zldn
  zxn = zx+zmod
  pxn = zxn
  ddxn = REAL(zxn,jpkd)
  pxmod = zmod

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

!*         2.    Double precision computations.
!                ------------------------------

ELSE

!*       2.1   NEWTON ITERATION STEP.

  dlkm2 = 1.0_jprb
  dlkm1 = ddx
  dlx = ddx
  DO jn=2,izn
    dlk = (REAL(2*jn-1,jpkd)*DLX*DLKM1-REAL(jn-1,jpkd)*DLKM2)/REAL(JN,JPKD)
    dlkm2 = dlkm1
    dlkm1 = dlk
  ENDDO
  dlkm1 = dlkm2
  dlldn = (REAL(kn,jpkd)*(dlkm1-dlx*dlk))/(1.0_JPRB-DLX*DLX)
  dlmod = -dlk/dlldn
  dlxn = dlx+dlmod
  pxn = REAL(dlxn,jpks)
  ddxn = dlxn
  pxmod = REAL(dlmod,jpks)
ENDIF
!     ------------------------------------------------------------------

!*         3.    Computes weight.
!                ----------------


IF(kflag == 1)THEN
  dlkm2 = 1.0_jprb
  dlkm1 = dlxn
  dlx = dlxn
  DO jn=2,izn
    dlk = (REAL(2*jn-1,jpkd)*DLX*DLKM1-REAL(jn-1,jpkd)*DLKM2)/REAL(JN,JPKD)
    dlkm2 = dlkm1
    dlkm1 = dlk
  ENDDO
  dlkm1 = dlkm2
  pw = REAL((1.0_JPRB-DLX*DLX)/(REAL(KN*KN,JPKD)*DLKM1*DLKM1),JPKS)
ENDIF

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

END SUBROUTINE cpledn
END MODULE cpledn_mod