!-------------------------------------- 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 GAUSS8(NRACP,RACP,PG,SIA,RAD,PGSSIN2,SINM1,SINM2,SIN2) 2,4
#if defined (DOC)
*
C
C *****************************************************************
C CALCULE LES NRACP RACINES POSITIVES DU POLYNOME DE LEGENDRE DE
C DEGRE 2*NRACP (ICI-APRES NOTE PN) DEFINI SUR L INTERVALLE DES
C COLATITUDES ALLANT DE 0 (POLE NORD) A PI (POLE SUD). ON SAIT QUE
C LES 2*NRACP RACINES SONT ANTI-SYMETRIQUES P/R A L EQUATEUR PI/2,
C ETANT POSITIVES ENTRE COLAT=0 ET COLAT =PI/2.
C ON CALCULE ENSUITE LES POIDS DE GAUSS ASSOCIES AUX COLATITUDES
C GAUSSIENNES (ICI APRES NOTEES CG), AINSI QU UN CERTAIN NOMBRE DE
C FONCTIONS DE CG DEFINIES PLUS LOIN. ON RAPPELLE ENFIN QUE LA LATI-
C TUDE LAT=COLAT-PI/2, ET DONC QUE SIN(LAT)=COS(COLAT).
C NRACP : NOMBRE DE RACINES POSITIVES DU POLYNOME DE LEGENDRE
C : DE DEGRE 2*NRACP.
C RACP(I) : RACINES DE PN, =SIN(LG)=COS(CG).
C PG(I) : POIDS DE GAUSS CORRESPONDANTS.
C SIA(I) : SIN(CG)=COS(LG).
C RAD(I) : COLATITUDE CG EN RADIANS.
C PGSSIN2(I) : POIDS DE GAUSS / (SIN(CG))**2.
C SINM1(I) : (SIN(CG))**-1.
C SINM2(I) : (SIN(CG))**-2.
C VOIR NST 8, CHAP. A, PP.1-7, ET APPENDICE D12, PP. 26-27.
C VERSION REVISEE PAR MICHEL BELAND, 9 DECEMBRE 1980.
C VERSION "REAL*8" ... P. KOCLAS AVRIL 1993...
C *****************************************************************
C
C
#endif
*
IMPLICIT NONE
C -----------------------------------------------------------------
INTEGER NRACP
REAL*8 RACP(*),PG(*),SIA(*),RAD(*),PGSSIN2(*),SINM1(*),SINM2(*)
1 ,SIN2(*)
C --------------------------------------------------------------
REAL*8 XLIM,PI,FI,FI1,FN,DOT,DN,DN1,A,B,C,G,GM,GP,GT,RACTEMP,
+ GTEMP
INTEGER I,IR,IRM,IRP
C
C ON DEMANDE UNE PRECISION DE 1.E-13 POUR LES RACINES DE PN.
C
XLIM=1.D-13
PI = 4.D0*ATAN(1.D0)
IR = 2*NRACP
FI=DBLE(IR)
FI1=FI+1.D0
FN=DBLE(NRACP)
C
C ON UTILISE UNE FORMULE ASYMPTOTIQUE POUR OBTENIR LES VALEURS
C APPROXIMATIVES DES COLATITUDES GAUSSIENNES
C CG(I) = (PI/2) * (2*I-1)/(2*NRACP).
C VOIR ABRAMOWITZ AND STEGUN, P. 787, EQU. 22.16.6 .
C
DO 20 I=1,NRACP
DOT=DBLE(I-1)
RACP(I)=-PI*.5D0*(DOT+.5D0)/FN + PI*.5D0
RACP(I) = SIN(RACP(I))
20 CONTINUE
C
C ON CALCULE ENSUITE LES CONSTANTES FACTEURS DE P(N+1) ET P(N-1)
C DANS L EXPRESSION DE LA PSEUDO-DERIVEE DE PN.
C
DN = FI/SQRT(4.D0*FI*FI-1.D0)
DN1=FI1/SQRT(4.D0*FI1*FI1-1.D0)
A = DN1*FI
B = DN*FI1
IRP = IR + 1
IRM = IR -1
C
C ON EMPLOIE ENSUITE UNE METHODE DE NEWTON POUR AUGMENTER LA PREC.
C SI RACTEMP EST UNE SOL. APPROXIMATIVE DE PN(RACP)=0., ALORS LA
C SEQUENCE RACTEMP(I+1)=RACTEMP(I)-PN(RACTEMP(I))/DER.PN(RACTEMP(I))
C CONVERGE VERS RACP DE FACON QUADRATIQUE.
C VOIR ABRAMOWITZ AND STEGUN, P.18, EQU. 3.9.5.
C ORDLEG CALCULE LA VALEUR DE PN (RACP) , NORMALISE.
C
DO 50 I=1,NRACP
42 CALL ORDLEG8
(G,RACP(I),IR)
CALL ORDLEG8
(GM,RACP(I),IRM)
CALL ORDLEG8
(GP,RACP(I),IRP)
GT = (A*GP-B*GM)/(RACP(I)*RACP(I)-1.D0)
RACTEMP = RACP(I) - G/GT
GTEMP = RACP(I) - RACTEMP
RACP(I) = RACTEMP
IF( ABS(GTEMP).GT.XLIM) GO TO 42
50 CONTINUE
C
C ON CALCULE ENSUITE LES POIDS DE GAUSS SELON L ALGORITHME
C PG(I) = 2./[(1.-RACP(I)**2)*(DER.PN(RACP(I)))**2].
C VOIR ABRAMOWITZ AND STEGUN, P.887, EQU. 25.4.29.
C NOTE: ON DOIT MULTIPLIER LA PRECEDENTE FORMULE PAR UN FACTEUR
C DE DENORMALISATION, LES PN DONNES PAR ORDLEG ETANT NORMALISES.
C ON SE SERT D UNE FORMULE DE RECURRENCE POUR LA DERIVEE DE PN.
C
DO 60 I=1,NRACP
A=2.D0*(1.-RACP(I)**2)
CALL ORDLEG8
(B,RACP(I),IRM)
B = B*B*FI*FI
PG(I)=A*(FI-.5D0)/B
RAD(I) = ACOS(RACP(I))
SIA(I) = SIN(RAD(I))
C=(SIA(I))**2
SINM1(I) = 1.D0/SIA(I)
SINM2(I) = 1.D0/C
PGSSIN2(I) =PG(I)/C
SIN2(I)=C
60 CONTINUE
C
RETURN
END