C
C   Copyright (c) 1997 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

	SUBROUTINE ILGPRS(NRR,NDR,NEQ,IPAR,COEF,BB,DEN,CC)

C
	IMPLICIT NONE
C
C		I(NVERSION) L(APLACIEN) G(ALERKIN) S(PHERIQUE) R(AREFIE)
C		S(IMPLE PRECISION)
C
C		ROUTINE POUR LA SOLUTION DE L'EQUATION:
C
C		(COE2*D/dr**2+1/r*COE1*D/dr+COE0/r**2)*CC=DEN
C	
C		AVEC L'APPROXIMATION DE GALERKIN
C
C		EN COORDONNEES SPHERIQUES AVEC ECHANTILLONNAGE RAREFIE' EN r=0.
C		LES CAS PAIRS, IMPAIRS DEGENERE'S OU NON SONT TRAITES DANS
C		LA MEME ROUTINE. LA MATRICE DE L'OPERATEUR EST CALCULEE DANS 
C		DANS CETTE ROUTINE
C
C		ARGUMENTS DE LA ROUTINE:  
C
C	NR	=NOMBRE DE DEGRES DE LIBERTE-1
C	NDR	=DIMENSIONS DES TABLEAUX			
C	NEQ	=NOMBRE D'EQUATIONS A RESOUDRE SIMULTANEMENT AVEC LE MEME
C		 OPERATEUR
C	COEF	=TABLEAU INPUT CONTENANT LES COEFFICIENTS DE L'OPERATEUR
C		 COE2=1,COE2=COEF(2),COE3=COEF(3). CE TABLEAU EST EMPLOYE
C		 AUSSI COMME TABLEAU DE TRAVAIL ET SES DIMENSIONS DOIVENT
C		 ETRE > A NR
C	BB	=TABLEAU DE TRAVAIL CONTENANT LA MATRICE DE L'OPERATEUR
C		 DIMENSIONS > NR*4
C	DEN	=TABLEAU D'ENTRE' CONTENANT LES N1*NEQ COEFFICIENTS DU
C		 2ME MEMBRE. DIMENSIONS DU TABLEAU GE.(N+1)*NEQ
C	CC	=TABLEAU OUTPUT CONTENANT LES N1*NEQ COEFFICIENTS DE LA 
C		 SOLUTION. DIMENSIONS DU TABLEAU GE.(N+1)*NEQ
C		 
C
C $Id: ilgprs.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $
C $Log: ilgprs.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.2  1997/05/23  11:40:56  hyc
c *** empty log message ***
c
C Revision 1.1  1997/05/08 07:34:49  hyc
C Initial revision
C
C
C $Header: /cvsroot/Lorene/F77/Source/Poisson2d/ilgprs.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $
C
C
	character*120 header
	data header/'$Header: /cvsroot/Lorene/F77/Source/Poisson2d/ilgprs.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $'/

	INTEGER N129,NDR,L,IPA,NC,NEQ,J,IPAR,NR,NR1,ICOE,NRR

	double PRECISION ADE20,ADE10,ADE00,CC,COEF,BB,DEN
     1	,COE2,COE3,X1,RAP

	PARAMETER (N129=250)
	DIMENSION DEN(NDR,*),BB(NDR,*),CC(NDR,*),COEF(*)
	DIMENSION ADE20(N129,5),ADE10(N129,5),ADE00(N129,5)
C
	SAVE NC,ADE20,ADE10,ADE00
	DATA NC/0/
C

	IPA=1
	IF((IPAR/2)*2.EQ.IPAR) IPA=0
C
	NR=NRR-IPA
	NR1=NR+1	
C
C		INVERSION DU SYSTEME DANS LE CAS DEGENERE
C
C
	IF(NR1.EQ.NC) GO TO 999
C
C		PREPARATION MATRICE OPERATEUR
C
	IF(NR1.GT.N129) THEN
	PRINT*,'ROUTINE ILGPRS: DIMENSIONS TABLEAUX INTERNES INSUFFISANTES:'
	PRINT*,'NR1,N129=',NR1,N129
	STOP
	ENDIF
C
	NC=NR1
	DO L=1,NR1-4
	ADE20(L,1)=8*(L+L-1)
	ENDDO
C
	DO L=1,NR1-4
	ADE20(L,2)=24*(L+L+1)
	ENDDO
C
	DO L=1,NR1-5
	ADE20(L,3)=24*(L+L+3)
	ENDDO
C
	DO L=1,NR1-6
	ADE20(L,4)=8*(L+L+5)
	ENDDO
	DO L=1,NR1
	ADE20(L,5)=0
	ENDDO
C
	DO L=NR-2,NR
	ADE20(L,1)=L*(16*L-8)
	ENDDO
C
	DO L=NR-1,NR
	ADE20(L-1,2)=48*L**2-72*L+24
	ENDDO
C
	ADE20(NR-2,3)=80*NR**2-168*NR+64
	ADE20(NR-3,3)=-16*NR**2+104*NR-120
C
	DO L=NR-1,NR
	ADE20(L-3,3)=-16*L**2+104*L-120
	ENDDO	
C
	DO L=NR-1,NR
	ADE20(L-3,4)=-48*L**2+136*L-56
	ENDDO
	ADE20(NR-4,5)=-80*NR**2+232*NR-96
C
	DO J=1,2
	DO L=1,NR1-4
	ADE10(L,J)=8
	ENDDO
	ENDDO
C
	DO J=3,4
	DO L=1,NR1-4
	ADE10(L,J)=-8
	ENDDO
	ENDDO
C
	DO L=NR-2,NR
	ADE10(L,1)=L*8
	ENDDO
C
	DO L=NR-2,NR-1
	ADE10(L,2)=8*L
	ENDDO
C
	ADE10(NR-2,3)=NR*8
C
	DO L=NR-1,NR
	ADE10(L-3,3)=-L*8+8
	ENDDO	
C
	DO L=NR-1,NR
	ADE10(L-3,4)=-8*(L-1)
	ENDDO
C
	ADE10(NR-4,5)=-8*NR
C
	DO J=1,5
	DO L=1,NR1
	ADE00(L,J)=0
	ENDDO
	ENDDO
C
	DO L=1,NR1-4
	ADE00(L,1)=4.D+00/L
	ENDDO
C
	DO L=1,NR1-4
	ADE00(L,2)=-ADE00(L,1)
	ENDDO
C
	DO J=1,2
	DO L=1,NR1-4
	ADE00(L,J+2)=ADE00(L,J+2)-ADE00(L+2,J)
	ENDDO
	ENDDO 
C
	DO L=NR-2,NR
	ADE00(L,1)=4
	ENDDO
C
	DO L=NR-2,NR-1
	ADE00(L,2)=-4
	ENDDO
C
	ADE00(NR-2,3)=4
	ADE00(NR-3,3)=-4
	ADE00(NR-4,3)=-4
	ADE00(NR-3,4)=4
	ADE00(NR-4,4)=4
	ADE00(NR-4,5)=-4	
C
 999	CONTINUE
C
C		PREPARATION MATRICE
C
	DO J=1,5
	DO L=1,NR
	BB(L,J)=0
	ENDDO
	ENDDO
C
	IF(IPAR.EQ.0) THEN
	COE2=COEF(2)
	COE3=COEF(3)
	ELSE
C
	COE2=COEF(2)+2
	COE3=COEF(3)+COEF(2)
C
	CALL DI2RAS(NR,NDR,1,-1,NEQ,DEN,CC)
	DO J=1,NEQ
	DO L=1,NR1
	DEN(L,J)=CC(L,J)
	ENDDO
	ENDDO
	ENDIF
C
	DO J=1,4
	DO L=1,NR-5
	BB(L,J)=ADE20(L,J)+COE2*ADE10(L,J)+COE3*ADE00(L,J)
	ENDDO
	DO L=NR-3,NR
	BB(L,J)=ADE20(L,J)+COE2*ADE10(L,J)+COE3*ADE00(L,J)
	ENDDO
	ENDDO
	L=NR-4
	DO J=1,5
	BB(L,J)=ADE20(L,J)+COE2*ADE10(L,J)+COE3*ADE00(L,J)
	ENDDO
C
	RAP=BB(NR-4,5)/BB(NR-3,4)
	DO J=2,5
	BB(NR-4,J)=BB(NR-4,J)-RAP*BB(NR-3,J-1)
	ENDDO
C
	X1=.1
	ICOE=0
	IF(ABS(COE3).GT.X1) THEN
	ICOE=1
	DO J=1,4
	DO L=NR-1,1,-1
	BB(L+1,J)=BB(L,J)
	ENDDO
	ENDDO
	DO J=2,4
	BB(1,J)=0
	ENDDO
	BB(1,2)=1
	ENDIF		
C
C		PREPARATION COMBINAISON LINEAIRE
C
	DO 1 J=1,NEQ
	DO 2 L=1,NR1-4
	DEN(L,J)=(DEN(L,J)-DEN(L+2,J))/L
   2	CONTINUE
   1	CONTINUE
C
	DO 3 J=1,NEQ
	DO 4 L=1,NR1-4
	DEN(L,J)=DEN(L,J)-DEN(L+2,J)
  4	CONTINUE
  3	CONTINUE
C
	DO J=1,NEQ
	DEN(NR-4,J)=DEN(NR-4,J)-RAP*DEN(NR-3,J)
	ENDDO
C
	IF(ICOE.EQ.1) THEN
	DO J=1,NEQ
	DO L=NR-1,1,-1
	DEN(L+1,J)=DEN(L,J)
	ENDDO
	DEN(1,J)=0
	ENDDO
	ENDIF
C
C		COMBINAISON LINEAIRE DES COEFFICIENTS CORRESPONDANT A LA
C		REDUCTION DE LA MATRICE DE L'OPERATEUR A UNE MATRICE A
C		BANDES.
C
	CALL LEQT1S(BB,NR,ICOE,(3-ICOE),NDR,DEN,NEQ,NDR,0,COEF,J)
C
	DO J=1,NEQ
	CC(1,J)=DEN(1,J)*2
	CC(2,J)=DEN(1,J)+DEN(2,J)
	DO L=3,NR
	CC(L,J)=DEN(L-1,J)+DEN(L,J)
	ENDDO
	ENDDO
C
	DO J=1,NEQ
	CC(NR1,J)=0
	ENDDO
C
	CALL EXRM1S(NR,NDR,NEQ,0,0,0,CC,COEF)
	IF(IPAR.EQ.0) THEN
	DO J=1,NEQ
	CC(NR1,J)=-COEF(J)*2
	ENDDO
	RETURN
	ELSE
	DO J=1,NEQ
	CC(NR1,J)=COEF(J)
	CC(NR1+1,J)=0
	ENDDO
	CALL DI2RAS(NRR,NDR,0,1,NEQ,CC,DEN)
	DO J=1,NEQ
	DO L=1,NRR+1
	CC(L,J)=DEN(L,J)
	ENDDO
	ENDDO
	ENDIF
C
	RETURN
 100	FORMAT(1X,10E10.3)
 102	FORMAT(1X,10E11.4)
 
 101	FORMAT(1X,' ')
	END
C
