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 EXRM1S(NR,NDIM,NEQ,INR,IDR,IMP,DEN,SOM)

	IMPLICIT double PRECISION (A-H,O-Z)

C
C##	version du 16/10/95 
C
C
C		ROUTINE POUR LE CALCUL DES VALEURS ET DE LA DERIVE'E
C		PREMIERE EN r=0 ET r=1 DE PLUSIEURS FONCTIONS A 1 DIMENSION
C		AVEC ECHANTILLONNAGE RAREFIE' A L'ORIGINE.
C		Modifiee le 12/10/95: Dans le cas impair la somme doit aller
C		jusq'a NR (et non NR1)
C
C
C		ARGUMENTS DE LA ROUTINE:
C
C		NR	=NOMBRE DE DEGRES DE LIBERTE'-1
C		NDIM	=DIMENSIONS DES TABLEAUX COMME DECLAREES DANS LE
C			 PROGRAMME APPELANT
C		NEQ	=NOMBBRE DES FONCTIONS DONT ON VEUT CALCULER LES
C			 VALEURS AUX BORDS
C		INR	=PARAMETRE: SI INR=0 LA FONCTION EST CALCULEE EN
C			 r=0, SI INR=1 EN r=1.
C		IDR	=PARAMETRE: SI IDR=0 LA FONCTION EST CALCULEE
C			 SI IDR=1, LA DERIVEE 1ere EST CALCULEE
C		IMP	=INDICE DE TENSORIALITE' IMP=0 SCALAIRE, IMP=1 VECTEUR
C		DEN	=TABLEAU INPUT (A 2-D) CONTENANT LES COEFFICIENTS DE
C			 TCHEBYTCHEV DES NEQ FONCTIONS.
C		SOM	=OUTPUT DES VALEURS DES NEQ FONCTIONS OU DE LEURS
C			 DERIVEES PREMIERES EN r=0, OU r=1.
C
C		L'INPUT DEN N'EST PAS DETRUIT
C
C		Routine ayant ete testee selon le protocol normal le 02/01/88
C
C
C $Id: exrm1s.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $
C $Log: exrm1s.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:31  e_gourgoulhon
C LORENE
C
c Revision 1.2  1997/05/23  11:28:36  hyc
c *** empty log message ***
c
C Revision 1.1  1997/05/07 16:38:31  hyc
C Initial revision
C
C
C $Header: /cvsroot/Lorene/F77/Source/Poisson2d/exrm1s.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/exrm1s.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $'/

	DIMENSION DEN(NDIM,*),SOM(*),ID1(514),AD2(514)
	DIMENSION ID3(514)
	SAVE NCONT,ID1,AD2,ID3
	DATA NCONT/0/
C
	N514=514
	IF (NR.GT.N514) THEN
C
	PRINT*,'DIMENSIONS INSUFF. DANS LA ROUTINE EXRM1S, NR=',NR
	CALL EXIT
	ENDIF
C
	NR1=NR+1
C
C		PREPARATION DES TABLEAUX
C
	IF (NCONT.NE.NR1) THEN
	NCONT=NR1
C
	DO 1 LR=1,NR1
	LR2=LR*2
	ID1(LR)=(LR2-2)**2
	AD2(LR)=(LR2-1)**2
	ID3(LR)=(LR2-1)
   1	CONTINUE
C
	AD2(NR1)=AD2(NR1)*.5
	ID1(NR1)=ID1(NR1)/2
	ENDIF
C
C		CAS FONCTION PAIRE
C
C		CALCUL DE LA VALEUR DE LA FONCTION EN r=0
C
	IF (INR.EQ.0) THEN
C
	IF (IMP.EQ.0) THEN
C
C		CALCUL DE LA DERIVEE EN r=0
C
	IF (IDR.EQ.1) THEN
	DO 2 LEQ=1,NEQ
	SOM(LEQ)=0
   2	CONTINUE
	RETURN
	ENDIF
C
C		CALCUL DE LA FONCTION EN r=0
C
	IF (IDR.EQ.0) THEN
	DO 3 LEQ=1,NEQ
	SOM(LEQ)=(DEN(1,LEQ)+DEN(NR1,LEQ))*.5
C
	DO 4 LR=2,NR1,2
	SOM(LEQ)=SOM(LEQ)-DEN(LR,LEQ)
   4	CONTINUE
C
	DO 5 LR=3,NR1-1,2
	SOM(LEQ)=SOM(LEQ)+DEN(LR,LEQ)
   5	CONTINUE
   3	CONTINUE
C
	RETURN
	ENDIF
	ENDIF
C
C		CAS FONCTION IMPAIRES (CALCUL FONCTION EN r=0)
C
	IF (IMP.EQ.1) THEN
C
C		CALCUL DE LA FONCTION IMPAIRE EN r=0
C
	IF (IDR.EQ.0) THEN
	DO 6 LEQ=1,NEQ
	SOM(LEQ)=0
   6	CONTINUE
	RETURN
	ENDIF
C
C		CALCUL DE LA DERIVEE EN r=0
C
	IF (IDR.EQ.1) THEN
C
C		CAS FONCTIONS IMPAIRES (CALCUL DERIVEE EN r=0)
C
	DO 7 LEQ=1,NEQ
	SOM(LEQ)=-DEN(1,LEQ)
	DO 8 LR=3,NR,2
	SOM(LEQ)=SOM(LEQ)-DEN(LR,LEQ)*ID3(LR)
   8	CONTINUE
C
	DO 9 LR=2,NR1,2
	SOM(LEQ)=SOM(LEQ)+DEN(LR,LEQ)*ID3(LR)
   9	CONTINUE
   7	CONTINUE
C
	RETURN
	ENDIF
C
		ENDIF
	ENDIF
C
C
C		CALCUL FONCTION EN r=1
C
	IF (INR.EQ.1) THEN
C
C		CALCUL VALEUR DE LA FONCTION EN r=1
C
	IF (IDR.EQ.0) THEN
C
	IF (IMP.EQ.0) THEN
C
	DO 10 LEQ=1,NEQ
	SOM(LEQ)=(DEN(1,LEQ)+DEN(NR1,LEQ))*.5
C
	DO 11 LR=2,NR
	SOM(LEQ)=SOM(LEQ)+DEN(LR,LEQ)
   11	CONTINUE
   10	CONTINUE
C
	RETURN
	ENDIF
C
C	CAS FONCTIONS IMPAIRES (CALCUL VALEUR DE LA FONCTION EN r=1)
C
	IF (IMP.EQ.1) THEN
C
	DO 12 LEQ=1,NEQ
	SOM(LEQ)=-DEN(1,LEQ)
	DO 13 LR=2,NR
	SOM(LEQ)=SOM(LEQ)-DEN(LR,LEQ)
   13	CONTINUE
   12	CONTINUE
C
	RETURN
	ENDIF
	ENDIF
C
C		CALCUL DE LA DERIVEE EN r=1
C
	IF (IDR.EQ.1) THEN
C
C		CAS FONCTIONS PAIRES
C
	IF (IMP.EQ.0) THEN
C
	DO 14 LEQ=1,NEQ
	SOM(LEQ)=0
   14	CONTINUE
C
	DO 15 LEQ=1,NEQ
	DO 16 LR=2,NR1
	SOM(LEQ)=SOM(LEQ)+DEN(LR,LEQ)*ID1(LR)
   16	CONTINUE
   15	CONTINUE
	RETURN
	ENDIF
C
C		CAS FONCTIONS IMPAIRES (CALCUL DE LA DERIVEE EN r=1)
C
	IF (IMP.EQ.1) THEN
C
	DO 17 LEQ=1,NEQ
	SOM(LEQ)=-DEN(1,LEQ)
C
	DO 18 LR=2,NR
	SOM(LEQ)=SOM(LEQ)-DEN(LR,LEQ)*AD2(LR)
   18	CONTINUE
   17	CONTINUE
C
	RETURN
	ENDIF
C
	ENDIF
C
	ENDIF
	RETURN
  100	FORMAT(1X,10E10.3)
  101	FORMAT(1X,' ')
	END