!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
SUBROUTINE ALLP2( P , G , D , X , LR , HEM , R , NLATP) 2
*
#if defined (DOC)
*
*
* Calcul des fonctions de legendre et de leurs derivees
* pour une troncature triangulaire, modele global
*
* Auteur jean cote janvier 1987 , nouvelle version pour le CRAY XMP
*
* Revision:
*
* JM Belanger CMDA/SMC Jan 2001
* . 32 bits conversion
* (REAL*8 argument to intrinsic function SQRT).
*
* R = NOMBRE D'ONDES EST-OUEST
* LR = NOMBRE DE COMPOSANTES POUR UN M DONNE
* (COMPOSANTES SYMETRIQUES SI HEMISPHERIQUE)
* LA = ESPACEMENT INTERNIVEAU DES COEFFICIENTS SPECTRAUX
* (DIMENSION DES POLYNOMES = 2*LA SI HEMISPHERIQUE)
* P[L,M] = ALP
* G[L,M] = ( 1 - X**2 ) D P[L,M]/D X = DALP
* D[L,M] = - L * ( L + 1 ) * P[L,M] = DELALP
* X = SIN( LATITUDE )
* E,F[L,M] = CONSTANTES INDEPENDANTES DE LA LATITUDE
* A[L] = SQRT( 1 + 1/(2*L) )
* B[L] = - L * ( L + 1 )
* C[L] = L * X
* IND[L] = INDICES DES ELEMENTS DIAGONAUX CAD L=M
* R = TRONCATURE ( NOMBRE D'ONDE EST-OUEST MAX )
#endif
*
**
IMPLICIT NONE
INTEGER R, NLATP, LR(0:R), HEM, JLAT
REAL*8 P(0:R,0:R,NLATP) , G(0:R,0:R,NLATP) , D(0:R,0:R,NLATP)
REAL*8 X(NLATP)
*
REAL*8 onehalf
REAL*8 XP , XP2, P0, ENM, FNM
INTEGER ILAT , M , L , N
data onehalf /0.5/
*-------------------------------------------------------------------
*
*
* P[M,M]
*
DO 30 ILAT=1,NLATP
XP2 = SQRT( 1.0 - X(ILAT) ** 2 )
P(0,0,ILAT) = SQRT(onehalf)
DO 31 M=1,R
XP = FLOAT(M)
P(0,M,ILAT) = SQRT( (2.0*XP+1.0)/(2.0*XP) )
% * XP2 * P(0,M-1,ILAT)
31 CONTINUE
30 CONTINUE
*
* G[M,M] , D[M,M]
*
DO 40 ILAT=1,NLATP
DO 41 M=0,R
XP = FLOAT(M)
G(0,M,ILAT) = - X(ILAT)*XP * P(0,M,ILAT)
D(0,M,ILAT) = -(XP * ( XP + 1.0 )) * P(0,M,ILAT)
41 CONTINUE
40 CONTINUE
*
* P[L,M] , G[L,M] , D[L,M] L > M
*
DO 50 N=1,R
DO 51 M=0, R
P0 = FLOAT(M+N)
XP = FLOAT(M)
ENM = SQRT( ((P0*P0-XP*XP)*(2.0*P0+1.0))/(2.0*P0-1.0) )
FNM = SQRT( (2.0*P0+1.0)/((P0*P0-XP*XP)*(2.0*P0-1.0)) )
*
DO 52 JLAT = 1, NLATP
L = JLAT
P(N,M,L) = ( X(L) * P0 * P(N-1,M,L)
S - G(N-1,M,L) ) * FNM
G(N,M,L) = ENM * P(N-1,M,L) - X(L) * P0 * P(N,M,L)
D(N,M,L) = - P0 * (P0+1.0) * P(N,M,L)
52 CONTINUE
51 CONTINUE
50 CONTINUE
*
RETURN
END