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 ILGGOS(NDIM,NEQ,AA,BB,CS,CC)

C
C		I(NVERSION) L(ALACIEN) G(ALERKIN) CO(QUILLE) S(IMPLE)
C		PRECISION
C
C	ROUTINE POUR LA SOLUTION DE L'EQUATION :
C
C	(COE2*D/dr2+COE1/(a+br)*D/dr+COE0/(a+br)**2)*CC=CS
C
C		UNE SOLUTION PARTICULIERE AINSI QUE UNE SOLUTION LIBRE
C		SONT TROUVEES.
C		POUR AVOIR UNE SOLUTION GENERALE IL FAUT AJOUTER LA SOLUTION
C		LIBRE r**l POUR LES COUILLES OU LA SOLUTION EST DEVELOPPE
C		EN PUISSANCE DE r OU LA SOLUTION u**(l+1) POUR LA DERNIERE
C		COQUILLE SI LA SOLUTION EST DEVELOPPE EN PUISSANCE DE u=1/r.
C
C		CONTRAIREMENT A LA ROUTINE ILGCOS, LES 2 SOLUTIONS LIBRES SONT
C		DES SOLUTIONS EXACTES DU LAPLACIEN. EN OUTRE, LE DESALIASING
C		DOIT ETRE EFFECTUE A L'EXTERIEUR DE LA ROUTINE
C
C	 LA MATRICE DE L'OPERATEUR EST CALCULEE AVEC LA ROUTINE MAGL3S.
C	
C		ARUMENTS DE LA ROUTINE:
C
C		NDIM	=DIMENSIONS DES TABLEAU. MEME DIMENSION QUE DANS LE
C			 PROGRAMME APPELANT
C		NEQ	=NOMBRE D'EQUATION A TRAITER SIMULTANEMENT
C		AA	=TABLEAU DE TRAVAIL: DIMENSIONS MINIMES AA(NDIM,7)
C		BB 	=MATRICE DE L'OPERATEUR (FOURNIE PAR MAGL3S). CETTE 
C			 MATRICE CONTIENT AUSSI D'AUTRES ELEMENTS NECESSAIRES
C			 AU CALCUL. (COEF(4),COEF(5), LES COEFFICIENTS DES
C			 COMBINAISONS LINEAIRES NECESSAIRES A ELIMINER
C			 CERTAINES TERMES EXTRA-DIAGONAUX DE LA MATRICE
C			 AINSI QUE LE NOMBRE DES DIAGONALES DANS BB.
C
C		CS	=TABLEAU INPUT CONTENANT LES NEQ 2EME MEMBRES
C		         DU SYSTEME.
C		CC	=TABLEAU OUTPUT CONTENANT LES NEQ COEFFICIENTS
C			 DE LA SOLUTION.
C		
	IMPLICIT NONE
C
C $Id: ilggos.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $
C $Log: ilggos.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:41:15  hyc
c *** empty log message ***
c
C Revision 1.1  1997/05/08 07:35:13  hyc
C Initial revision
C
C
C $Header: /cvsroot/Lorene/F77/Source/Poisson2d/ilggos.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/ilggos.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $'/

	INTEGER NDIM,NR,IDEG,NEQ,LEQ,LR,IER,NEQ1,NR1

	double PRECISION BB,R1,R2,CS,CC,AA,RAP

	DIMENSION BB(NDIM,*),CS(NDIM,*),CC(NDIM,*),AA(NDIM,*)
C
	NR=BB(1,5)
	NR1=NR+1
C
	IF(NDIM+1.LT.NR1) THEN
	PRINT 101
	PRINT*,'DIMENSIONS INSUFFISANTES DANS LA ROUTINE ILGGOS'
	PRINT*,'NR1,NDIM=',NR1,NDIM
	STOP
	ENDIF
C
	IDEG=BB(NR1,5)
C
	BB(NR1,5)=0
C
	R1=BB(NR1+1,4)
	R2=BB(NR1+1,5)
C
	IF(IDEG.LT.315.OR.IDEG.GT.318) THEN
	PRINT 101
	PRINT*,'ROUTINE ILGGOS:'
	PRINT*,'LA ROUTINE MAGL3S N''A PAS ETE APPELEE AVANT L''APPEL'
	PRINT*,'DE CETTE ROUTINE'
	STOP
	ENDIF
C
C		CAS NON DEGENERE EPAIS: R2 > 10*R1 OU COQUILLE COMPACTI-
C		FIEE
C
	IF(IDEG.EQ.315) THEN
C
	DO 17 LEQ=1,NEQ
	DO 18 LR=1,NR1
	CC(LR+1,LEQ)=CS(LR,LEQ)
   18	CONTINUE
  	CC(1,LEQ)=0
   17	CONTINUE
C
	DO 19 LEQ=1,NEQ
	DO 20 LR=2,NR1-3
	CC(LR,LEQ)=(CC(LR,LEQ)-CC(LR+2,LEQ))/(LR-1)
   20	CONTINUE
   19	CONTINUE
C
	DO 21 LEQ=1,NEQ
	DO 22 LR=2,NR1-3
	CC(LR,LEQ)=CC(LR,LEQ)-CC(LR+2,LEQ)
   22	CONTINUE
   21	CONTINUE
C
	RAP=BB(NR1,6)
	DO 23 LEQ=3,5
	BB(1,LEQ)=0
   23	CONTINUE
C
	NEQ1=NEQ+1
	DO LR=1,NR1
	CC(LR,NEQ1)=0
	ENDDO
	CC(NR1,NEQ1)=1
	DO 24 LEQ=1,NEQ1
	CC(NR1-4,LEQ)=CC(NR1-4,LEQ)-RAP*CC(NR1,LEQ)
   24	CONTINUE
C
	CALL LEQT1S(BB,NR1,1,3,NDIM,CC,NEQ1,NDIM,0,AA,IER)
C
	DO LEQ=1,NEQ1
	DO LR=NR1+1,NR1+2
	CC(LR,LEQ)=0
	ENDDO
	ENDDO
C
	CALL DIRCMS((NR+2),NDIM,NEQ1,0,R1,R2,CC,CS)
	CALL DIRCMS((NR+2),NDIM,NEQ1,0,R1,R2,CS,CC)
C
	RETURN
	ENDIF
C
C		CAS R2 < 10*R1
C
C		TESTE
C
	IF(IDEG.EQ.316) THEN
	NEQ1=NEQ+1
C
	CALL DIRCMS(NR,NDIM,NEQ,0,R1,R2,CS,CC)
C
	DO 35 LEQ=1,NEQ
	DO 36 LR=NR1-2,1,-1
	CC(LR+2,LEQ)=CC(LR,LEQ)
   36	CONTINUE
	CC(NR1,LEQ)=CC(NR1,LEQ)
   35	CONTINUE
C	
	DO 37 LEQ=1,NEQ
	CC(1,LEQ)=0
	CC(2,LEQ)=0
   37	CONTINUE
C
	DO 38 LEQ=1,NEQ
	DO 39 LR=3,NR1-2
	CC(LR,LEQ)=(CC(LR,LEQ)-CC(LR+2,LEQ))/(LR-2)
   39	CONTINUE
   38	CONTINUE
C
	DO 40 LEQ=1,NEQ
	DO 41 LR=3,NR1-2
	CC(LR,LEQ)=CC(LR,LEQ)-CC(LR+2,LEQ)
   41	CONTINUE
   40	CONTINUE
C
	RAP=BB(NR1,3)
	BB(NR1,3)=0
C
	DO 42 LEQ=1,NEQ
	CC(NR1-3,LEQ)=CC(NR1-3,LEQ)-CC(NR1,LEQ)*RAP
   42	CONTINUE
C
	RAP=BB(NR1,4)
C
	DO 43 LEQ=1,NEQ
	CC(NR1-2,LEQ)=CC(NR1-2,LEQ)-RAP*CC(NR1,LEQ)
   43	CONTINUE
	BB(NR1,4)=0
C
	RAP=BB(NR1,6)
	DO 44 LEQ=1,NEQ
	CC(NR1-3,LEQ)=CC(NR1-3,LEQ)-RAP*CC(NR1-2,LEQ)
   44	CONTINUE
	BB(NR1,6)=0
C
	DO 45 LR=1,NR1
	CC(LR,NEQ1)=0
   45	CONTINUE
	CC(2,NEQ1)=1
C
	CALL LEQT1S(BB,NR1,1,1,NDIM,CC,NEQ1,NDIM,0,AA,IER)
C
	DO LEQ=1,NEQ+1
	CC(NR1,LEQ)=CC(NR1,LEQ)*2
	ENDDO
	RETURN
	ENDIF
C
C		CAS COEF(3).NE.0)
	
	IF(IDEG.EQ.317.OR.IDEG.EQ.318) THEN
C
C		IDEG=317 -> LE POTENTIEL EST CALCULE DANS LES COQUILLES
C		MINCES COMPACTES (DEVELOPPEMENT EN r)
C
C		IDEG=318 -> LE POTENTIEL EST CALCULE AVEC UNE EXPANSION EN
C		1/r
c
	NEQ1=NEQ+1
C
	DO LR=1,NR1
	CS(LR,NEQ1)=0
	ENDDO
C
	DO 48 LEQ=4,5
	BB(1,LEQ)=0
   48	CONTINUE
C
	DO LEQ=1,NEQ
	CS(NR1,LEQ)=CS(NR1,LEQ)*.5
	CS(NR1+1,LEQ)=0
	CS(NR1+2,LEQ)=0
	ENDDO
C
	IF(IDEG.EQ.317) THEN
	CALL DIRCMS(NR1,NDIM,NEQ,0,R1,R2,CS,CC)
	CALL DIRCMS((NR1+1),NDIM,NEQ,0,R1,R2,CC,CS)
	ENDIF
C	
	DO LEQ=1,NEQ
	CS(NR1,LEQ)=CS(NR1,LEQ)*.5
	ENDDO
C
	DO 51 LEQ=1,NEQ
	DO 52 LR=1,NR1-2
	CC(LR+2,LEQ)=CS(LR,LEQ)
   52	CONTINUE
   51	CONTINUE
C	
	DO 53 LEQ=1,NEQ
	CC(1,LEQ)=0
	CC(2,LEQ)=0
   53	CONTINUE
C
	DO 54 LEQ=1,NEQ
	DO 55 LR=3,NR1-2
	CC(LR,LEQ)=(CC(LR,LEQ)-CC(LR+2,LEQ))/(LR-2)
   55	CONTINUE
   54	CONTINUE
C
	DO 56 LEQ=1,NEQ
	DO 57 LR=3,NR1-2
	CC(LR,LEQ)=CC(LR,LEQ)-CC(LR+2,LEQ)
   57	CONTINUE
   56	CONTINUE
C
	RAP=BB(NR1,4)
C
	DO 58 LEQ=1,NEQ
	CC(NR1-3,LEQ)=CC(NR1-3,LEQ)-RAP*CC(NR1,LEQ)
   58	CONTINUE
C
	DO 59 LR=1,NR1
	CC(LR,NEQ1)=0
  59	CONTINUE
	CC(2,NEQ1)=1
	CC(1,NEQ1)=1
C
	BB(NR1,4)=0
C
	CALL LEQT1S(BB,NR1,2,2,NDIM,CC,NEQ1,NDIM,0,AA,IER)
C
	DO LEQ=1,NEQ1
	CC(NR1,LEQ)=CC(NR1,LEQ)*2
	ENDDO
C
	RETURN
	ENDIF
C
  100	FORMAT(1X,10E10.3)
  101	FORMAT(1X,' ')
  200	FORMAT(1X,8E15.8)
	RETURN
	END
