C
C   Copyright (c) 1998 Silvano Bonazzola
C
C    This file is part of LORENE.
C
C    LORENE is free software; you can redistribute it and/or modify
C    it under the terms of the GNU General Public License as published by
C    the Free Software Foundation; either version 2 of the License, or
C    (at your option) any later version.
C
C    LORENE is distributed in the hope that it will be useful,
C    but WITHOUT ANY WARRANTY; without even the implied warranty of
C    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C    GNU General Public License for more details.
C
C    You should have received a copy of the GNU General Public License
C    along with LORENE; if not, write to the Free Software
C    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
C
C
C
C $Id: gpar2s.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $
C $Log: gpar2s.f,v $
C Revision 1.2  2012/03/30 12:12:43  j_novak
C Cleaning of fortran files
C
C Revision 1.1.1.1  2001/11/20 15:19:30  e_gourgoulhon
C LORENE
C
c Revision 1.1  1998/06/22  10:31:12  eric
c Initial revision
c
C
C $Header: /cvsroot/Lorene/F77/Source/Poisson2d/gpar2s.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $
C
C

	SUBROUTINE GPAR2S(NDL1,NDR,IND,C64,ERRE,BB,CC)

C
C## Routine modifiee le 02/08/96
C
C		ROUTINE POUR LE CALCUL DE L'INTEGRALE D'UN SCALAIRE
C		UN ESPACE A 2-DIMENSIONS EN COORDONNES SPHERIQUE
C		LES PROBLEMES MOULTICOUCHES. L'INTEGRALE EST EFFECTUE
C		AUSSI DANS LA COQUILLE COMPACTIFIEE.
C		LA VARIABLE DE COMPACTIFICATION EST
C
C		1/r=(1-.5*COMPACT*(1-COS(PI(LR-1)/NR))/RAY
C
C		OU RAY EST LE RAYON DE LA DERNIERE COQUILLE.
C
C			ARGUMENTS DE LA ROUTINE:
C
C		NDL1	=TABLEAU CONTENENT LES PARAMETRES DES COQUILLES:
C			 DANS NDL1(1) IL-Y-A LE NOMBRE DES COQUILLES, DANS
C			 NDL1(2),NDL1(3),...NDL1(NZON+1) LES DEGRES DE LIBERTE
C			 EN r DES DIFFERENTES COQUILLES.
C
C		NDR	=PREMIERE DIMENSION DES TABLEAUX DE TRAVAIL
C			 EXACTEMENT COMME DECLARE DANS LE PROGRAMME APPELLANT.
C		IND	=DRAPEAU: 
C
C		         IND=0   L'INTEGRALE EST EFFECTUEE SEULMENT
C				 SUR LES COQUILLES AVEC UN RAYON FINI
C			 IND=1   L'INTEGRALE EST EFFECTUEE AUSSI
C				 SUR LA COQUILLE COMPACTIFIEE
C				 DANS LA COQUILLE  COMPACTIFIIE LA FONCTION
C				 A INTEGRER DOIT ETRE DISVISEE PAR u**4
C			          
C		C64=TABLEAUX DE TRAVAIL.
C
C		ERRE	= TABLEAU CONTENENT L'ECHANTILLONAGE DANS LES DIFFERENTES
C		          COQUILLES: RR1(1) VAUT NATURELLENT 0, RR1(2)=1 (TOU-
C		BB(LR,LZON)=  IMPUT CONTENENT LE COEFFICIENTS DE TCHEBITCHEV
C			      RADIAUX DES DIFFERENTES COQUIILES RELATIF
C		              A l=0.
C			  DANS LA ZONE COMPACTIFIEE LES DEVELLOPEMNT
C		          EST EFFECTUE EN COEFF DE TCHEBYTCHEV EN 1/r.
C		          LA FONCTION EST SUPPOSEE ETRE PREABLEMENT
C			  MULTIPLIE PAR r**2
C		CC(LR,LZON)=TABLEAU DE TRAVAIL ET TABLEAU OUTPUT
C		 	    DANS CC(1,1) IL-Y-A L'INTEGRALE
C		            SUR TOUTES LES COQUILLES AVEC RAYON FINI.
C		            DANS CC(2,1) L'INTEGRALE SUR LA COQUILLE COM-
C			    PACTIFIEE		            
C		     
C
	IMPLICIT NONE
C
	character*120 header
	data header/'$Header: /cvsroot/Lorene/F77/Source/Poisson2d/gpar2s.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $'/

	INTEGER NZOE,NZON,NDL1,IND,NDR,LZON,NDL,NR1,IDEAL
     1	,NR,LR,NR12,NR10,INT
C

	double PRECISION CC,C64,BB,RR1,OUT1,AMA1,R1,R2,S1,S2
     1	,ERRE,RR2

		PARAMETER (INT=15)
C
	DIMENSION CC(NDR,*),C64(*),BB(NDR,*),RR1(INT),NDL(INT),NDL1(*)
	DIMENSION RR2(INT),ERRE(NDR,*)
C
	NZOE=NDL1(1)
	NZON=NZOE
	IF(IND.GT.1) NZON=NZOE-1
	DO LZON=1,NZON
	NDL(LZON)=NDL1(LZON)
	ENDDO

	NDL(1)=NZON
	IF(INT.LT.NZOE+1) THEN
	PRINT*,'ROUTINE GPAR2S: NZOE TROP GRAND PAR RAPPORT A INT'
	PRINT*,'INT,NZOE=',INT,NZOE
	STOP
	ENDIF
C
	DO LZON=2,NZOE+1
	IF(NDL1(LZON)+2.GT.NDR) THEN
	PRINT*,'ROUTINE GR2P1S: TABLEAUX INSUFF. DIMENSIONNES, LZON,NR1,NDR='
	PRINT*,LZON,NR1,NDR
	STOP
	ENDIF
	ENDDO
C
C		ON TRAITE LE CAS POUR LZON=1. C'EST-A-DIRE LE CALCUL DU PO-
C		TENTIEL DANS LE NOYAU SPHERIQUE CENTRALE.
C
C		PREPARATION DES POUR LE CALCUL DES COEFFICIENTS DE LEGENDRE
C		POUR LE NOYAU SPHERIQUE
C
	LZON=1
	NR1=NDL1(2)
C
	RR1(1)=0
	RR2(1)=ERRE(NR1,1)
C
C		CALCUL DANS LE CAS l=0.
C
C       ---------------------------------------------------------------
C		IDEAL=1 ON DESIALISE'
		IDEAL=1
C       ---------------------------------------------------------------
C
	IF(IDEAL.EQ.1) THEN
	NR1=NDL1(2)
	BB(NR1-1,1)=BB(NR1-1,1)+BB(NR1,1)*.5
	BB(NR1+0,1)=0
	BB(NR1+1,1)=0
	BB(NR1+2,1)=0
	IF(NZON.GT.1) THEN
	DO LZON=2,NZON
	NR=NR1-1
	NR1=NDL1(LZON+1)
	RR1(LZON)=ERRE(1,LZON)
	RR2(LZON)=(ERRE(NR1,LZON)-RR1(LZON))*.5
	BB(NR1-2,LZON)=BB(NR1-2,LZON)+.5*BB(NR1,LZON)*.5
	BB(NR1-3,LZON)=BB(NR1-3,LZON)+   BB(NR,LZON)
	DO LR=NR1-2,NR1+2
	BB(LR,LZON)=0
	ENDDO
	ENDDO
	DO LR=NR1-2,NR1+2
	BB(LR,1)=0
	ENDDO
	ENDIF
C
	ELSE
	DO LZON=1,NZON
	NR1=NDL1(LZON+1)
	BB(NR1,LZON)=BB(NR1,LZON)*.5
	BB(NR1+1,LZON)=0
	BB(NR1+2,LZON)=0
	ENDDO
	ENDIF
C
	DO LZON=2,NZOE+1
	NDL(LZON)=NDL1(LZON)+2
	ENDDO
C
C		MULTIPLICATION PAR r
	RR1(NZON+1)=ERRE(NDL1(NZON+1),NZON)
C
	CALL DIVQ1S(NDL,NDR,2,RR1,BB,CC)
C
C		CALCUL DE LA PRIMITIVE.
C
	CALL PRIQ1S(NDL,NDR,1,RR1,CC,BB)
C	
	NR1=NDL(NZON+1)
	NR=NR1-1
	DO LR=1,NR1
	C64(LR)=BB(LR,NZON)
	ENDDO
C
	IF(NZON.GT.1) THEN
	CALL EXTM1S(NR,1,0,C64,AMA1)
	ELSE
	CALL EXTR1S(NR,1,0,0,C64,AMA1)
	ENDIF
C
	CC(1,1)=AMA1
	IF(IND.EQ.0.) RETURN
C
C		CALCUL DANS LA COUCHE EXTERIEURE
C
C		MULTIPLICATION PAR u=1/r
C
	NR1=NDL1(NZOE+1)
	R1=ERRE(1,NZOE)
	R2=(ERRE(NR1,NZOE)-R1)*.5
C
	NR=NR1-1
	NR12=NR1+2
	NR10=NR1+1
C
	S1=-R1*R2
	S2=-R2*R2	
C	
	DO LR=1,NR1
	CC(LR,1)=BB(LR,NZOE)
	ENDDO
C
	DO LR=NR10,NR12+1
	CC(LR,1)=0
	ENDDO
	CC(NR1,1)=CC(NR1,1)*.5
C
	CALL DIRCMS(NR12,NDR,1,0,S1,S2,CC,BB)
C
	CALL PRIMS(NR12,BB,C64,1,CC)
C
 	CALL EXTM1S(NR12,1,0,C64,OUT1)
	CC(1,1)=AMA1*.5
	CC(2,1)=OUT1*.5
C  100	FORMAT(1X,10E10.3)
C  101	FORMAT(1X,' ')
	RETURN
	END
