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 FCIR3S(NDEG,NDR,NDY,NNN64,IN1,IPPP,IDR,IND
     1  ,C64,CC,CS,DENT,DEN)

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

C
C
C		ROUTINE POUR LE CALCUL DES TRANSFORMEES INVERSES DE FOURIER
C		ET DE TCHEBYTCHEV POUR L'ECHANTILLONAGE RAREFIE' A 3 DIM.
C		EXPLOITANT EVENTUELLEMENT LES SYMETRIES DES FONCTIONS A 
C		TRANSFORMER (SYMETRIES EXISTANTES PAR EX. EN COORDONNES
C		SPHERIQUES)
C		
C		LE 3ME INDICE EST SUPPOSE' ETRE PERIODIQUES (COORDONNE AZI-
C		MUTHALE FI), LE 2ME VARIE ENTRE 0 ET PI. DANS UN DEVELOPPEMENT
C		EN COORDONNES SPHERIQUES, LES COEFFICIENTS DE FOURIER D'UNE
C		FONCTION SCALAIRE SERONT DES FONCTIONS SYMETRIQUES EN THETA SI
C		LES COEFFICIENTS  DE FOURIER SONT PAIRES ET ANTISYMETRIQUES
C		SONT IMPAIRS. LE DEVELOPPEMENT EN THETA EST DONC EFFECTUE' EN  
C		POLYNOMES DE TCHEBYTCHEV DU 1ER GENRE POUR LES FONCTIONS
C		PAIRES ET DU 2ME GENRE (EN SERIE DE SINUS) POUR LES FONCTIONS
C		IMPAIRES. ANALOGUEMENT LES COEFFICIENTS Cml(r) SONT DES
C		FONCTIONS SYMETRIQUES EN r SI m+l EST PAIRE ET ANTISYMETRIQUES
C		DANS LE CAS OPPOSE'. PAR CONSEQUENT LE DEVELOPPEMENT EN r
C		DES COEFFICIENTS  Cml(r) EST EFFECTUE SUR L'INTERVALLE
C		0<r<1 EN TENANT COMPTE DE LA PARITE'. LA TRANSFORMATION 
C
C	N.B.	DOIT ETRE PAR CONSEQUENT ORDONNEE, C'EST A DIRE IL FAUT
C	---	D'ABORD PROCEDER A LA TRANSFORMATION DE TCHEBYTCHEV  SUR
C		LA VARIABLE r (1ERE INDICE), PUIS A LA TRANSFORMATION EN THETA 
C		(2ME INDICE) ET ENFIN LA TRANSFORMATION EN FI (3ME INDICE).
C		CELA PEUT ETRE GENANT. LA ROUTINE FGIR3S EVITE CET INCO-
C		VENIENT. DANS LE CAS D'UNE SUPERSYMETRIE (FONCTION SYMETRIQUE
C		OU ANTI-SYMETRIQUE PAR RAPPORT AU PLAN z=0 ET SYMETRIQUE
C		PAR RAPPORT A LA TRANSFORMATION x,y -> -x,-y L'ORDRE DANS
C		L'APPEL N'EST PAS NECESSAIRE.
C
C	ATTENTION !
C       ---------
C
C		DANS LE CAS OU IL Y A DES SYMETRIES, LA ROUTINE TRAITE
C		LES FONCTIONS DEFINIES DANS LE 1ER QUADRANT.
C		LE DOMAINE DE VARIABILITE DE LA VARIABLE z=COS(theta)
C		EST [0,1], theta VARIE ENTRE PI/2 ET 0.
C
C
C			LE STOCKAGE DES COEFFICIENTS EST LE SUIVANT (Cfr.
C		LA ROUTINE FUCE3S). DANS DEN(LR,LT,1) IL Y A LE COEFFICIENT
C		CORRESPONDANTS A LA FREQUENCE ZERO DU DEVELOPPEMENT EN COSINUS
C		DANS DEN(LR,LT,2),DEN(LR,LT,3) LES COFFICIENTS COSINUS ET
C		SINUS DE LA FREQUENCE 1, DANS DEN(LR,LT,4), DEN(LR,LT,5)
C		LES COEFFICIENTS DE LA FREQUENCE 2 ET AINSI DE SUITE.
C			 DEN(LR,1,LM),DEN(LR,3,LM)... DEN(LR,2*n+1,LM)  
C		SONT LES COEFFICIENTS DU DEVELOPPEMENT SUR LES POLYNOMES
C		DE TCHEBYTCHEV DU 1ER ORDRE. DEN(LR,2,LM),DEN(LR,4,LM)...
C		DEN(LR,2*n,LM) LES COEFFICIENTS DE TCHEBYTCHEV DU 2M ORDRE.
C		DEN(1,LR,LM),DEN(3,LR,LM)... SONT LES COEFFICIENTS
C		DU DEVELOPPEMENT EN POLYNOMES DE CHEBYTCHEV DES FON-
C		CTIONS SYMETRIQUES EN r, ET DEN(2,LR,LM),DEN(4,LR,LM)...
C		DES FONCTIONS ANTISYMETRIQUES.	
C
C		ARGUMENTS DE LA ROUTINE:
C
C			NDEG	= TABLEAU, NDEG(3) CONTENANT LES DE-
C				  GRES DE LIBERTE DES TRANSFORMEES
C				  A EFFECTUER, NDEG(1) CONCERNE LE PRE-
C				  MIER INDICE DE LA MATRICE, NDEG(2)
C				  LE 2ME INDICE, NDEG(3) LE 3me INDICE DE LA
C				  MATRICE.					
C				  NDEG DOIT IMPERATIVEMENT ETRE DE LA
C				  FORME 2**m*3**p*5**q POUR LES TRANS-
C				  FORMEES DE FOURIER (m,p,q NOMBRES 
C				  ENTIERS)
C				  ET 2**p*3**p*5*q+1 POUR LES TRANSFOR-
C				  MEES DE TCHEBYTCHEV.
C				  NDEG(3) PEUT EVENTUELLEMENT ETRE =1. DANS
C				  CE CAS L'OUTPUT EST IDENTIQUE A L'INPUT
C				  SI IDR=0 ET ZERO SI IDR > 0.
C
C		NDY,NDZ  =DIMESION DU TABLEAU YY(LR,LY,LZ).
C		POUR DES RAISONS DE CRAYTINISATION NDY ET NDZ NE DOIVENT PAS
C		ETRE UN MULTIPLE DE 8.
C
C		NNN64	= PARAMETRE DE LA VECTORIZATION, PAR EXEMPLE
C			 NNN64=64 SIGNIFIE QUE 64 FONCTIONS A TRANSFORMER
C			 SONT VECTORIZEE.
C
C
C		IN1	= PARAMETRE, SI IN1=1 LA TRANSFORMEE EST
C			 EFFECTUEE SUR LE PREMIER INDICE, SI IN1=2 SUR LE
C			 DEUXIEME, SI IN1=3 SUR LE 3me,.
C		IPPP	= PARAMETRE DEFINISSANT LA TENSORIALITE' DE LA FONCTION
C			  A TRANSFORMER ET LES SYMETRIES EXISTANTES.
C
C			SI IN1=1:
C		IPPP=0,1  AUCUNE SYMETRIE, LA FONCTION EST SCALAIRE OU
C			  VECTORIELLE.
C		IPP=2,3	  SYMETRIES PAR RAPPORT AU PLAN z=0 (SEULEMENT)
C			  FONCTION SCALAIRE OU VECTORIELLE
C		IPP=4,5	  SUPER-SYMETRIES: SYMETRIES PAR RAPPORT AU PLAN
C			  z=0, ET INVARIANCE PAR RAPPORT A LA TRANSFORMATION
C			  x,y -> -x,-y
C
C			IN1=2
C		IPPP=0,1  AUCUNE SYMETRIE, LA FONCTION EST SCALAIRE
C			     OU VECTORIELLE
C		IPPP=20,21 LA FONCTION EST SUPPOSEE ETRE SYMETRIQUE
C			 PAR RAPPORT AU PLAN z=0, SACLAIRE (IPPP=20) OU
C			 VECTORIELLE IPPP=21)
C		IPPP=30,31 LA FONCTION EST SUPPOSEE ETRE ANTI-SYMETRIQUE
C			 PAR RAPPORT AU PLAN z=0, SCALAIRE (IPPP=30, OU
C			 VECTORIELLE IPPP=31)
C
C		IPPP > 39  LA FONCTION A DES SUPER-SYMETRIES , C'EST A DIRE
C			 SYMETRIQE OU ANTI-SYMETRIQUE PAR RAPPORT AU 
C		         PLAN z=0, ET SYMETRIQUE PAR RAPPORT A LA TRANSFORMA-
C			 TION x,y -> -x,-y. PLUS EN DETAIL:
C		IPPP=40,41  LA FONCTION EST PAIRE (RESPECTIVEMENT SCALAIRE ET
C			  VECTORIELLE) PAR RAPPORT A LA TRANSFORMATION z -> -z
C               IPPP=50,51 LA FONCTION EST ANTISYMETRIQUE PAR RAPPORT AU
C			   PLAN z=0 (RESPECTIVEMENT SCALAIRE ET VECTORIELLE)
C		           PUISQUE LA FONCTION EST SYMETRIQUE OU ANTISYM-
C			   METRIQUE PAR RAPPORT A LA TRANSFORMATION r -> -r
C			   LORSQUE IN1=1, IPPP DOIT VALOIR 40,LORSQUE LA 
C			   FONCTION EST PAIRE PAR RAPPORT r=0, ET 50 DANS LE CAS
C			   CONTRAIRE.
C
C			IN1=3
C		IPPP=4,5 CAS DES SUPER-SYMETRIES.
C						
C				
C		IDR	=PARAMETRE: DEFINISSANT LES DIFFERENTS OPERATEURS
C			 APPLIQUES
C			 AUX COEFFICIENTS DE LA FONCTION D'ENTRE' SELON LE
C			 TABLEAU SUIVANT:
C					SORTIE EN OUTPUT (POUR IND=1)
C					----------------
C		         IDR=0  IN1=1	TRANSFORMATION INVERSE DE TCHEBYTCHEV 
C					COEFF.-> r. (IND ARBITRAIRE)
C			 IDR=1 IN1=1   CALCUL DES COEFFICIENTS DE TCHEBYTCHEV
C				        DE L'OPERATEUR 1/r*D/DR POUR LES FON-
C					CTIONS PAIRES ET DE 1/r*D/DR-1/r**2
C					pour les fonctions IMPAIres en r.
C			 IDR=2  IN1=1	CALCUL DE D2/DR2
C
C			 IDR=3  IN1=1   COEFFICIENTS DES LA FONCTION APRES
C					MULTIPLICATION PAR r**2
C			 IDR=4 IN1=1    COEFFICIENTS DE LA FONCTION APRES
C					DIVISION PAR r**2.
C
C			 IDR=5 IN1=1    MULTIPLICATION  PAR r.(SEUL.POUR IND=1)
C
C			 IDR=6 IN1=1    DIVISION PAR r.(SEUL.POUR IND=1) 
C
C			 IDR=7 IN1=1    DERIVATION PAR RAPPORT A r.(IND=1)
C 
C
C			 IDR=0,IN1=2	TRANSFORMATION INVERSE DE TCHEBYTCHEV
C					DU 1ER OU 2ME TYPE COEFF.-> teta.(IND 
C					ARBITRAIRE)
C			 IDR=1 IN1=2	CALCUL DES COEFFICIENTS DE LA FONCTION
C					APRES L'APPLICATION DE L'OPERATEUR
C					COS(THETA)/SIN(THETA)*D/DTHETA POUR LES
C					FONCTIONS DEVELOPPES EN POLYNOMES
C					DE TCHEBYTCHEV DU 1ER TYPE ET DE
C					L'OPERATEUR 
C					COS(TET)/SIN(TET)*D/DTET-1/SIN(TET)**2
C					POUR LES FONCTIONS DEVELOPPEES EN POLY-
C					NOMES DU 2ME TYPE.
C			IDR=2 IN1=2     COEFFICIENTS APRES APPLICATION DE L'O-
C					PERATEUR D2/DTET2
C			IDR=3 IN1=2     MULTIPLICATION PAR SIN(THETA)**2
C
C			IDR=4 IN1=2	DIVISION PAR SIN(THETA)**2
C
C POUR LES TRANSFORMES DE LEGENDRE :
C
C		CETTE ROUTINE EFFECTUE LES TRANSF. TCHEB. -> LEGENDRE ET 
C		VICE VERSA SEULEMENT DANS LE CAS SENS SYMETRIES.
C		DANS LE CAS AVEC SYMETRIES LA ROUTINE CEPLE3S.FOR
C		EFFECTUE LA TRANSFORMATION DEMANDE DANS TOUS LES CAS
C		DE FIGURE.
C
C		LA CONVENTION DES INDICES EST LA SUIVANTE:
C		LA FONCTION ASSOCIEE DE LAGRANGE D'ORDRE
C		m ET DE DEGREE j DEFINIE DANS LA LITTERATURE
C		
C				 m
C				P
C				 j
C		AVEC m.LE.j m.GE.0, j.GE.0 
C
C		EST STOCKEE DANS UN TABLEAU AYANT LES INDICES 
C
C			M=2*m J=j-m+1.	POUR m PAIRE (COS ET SIN POUR m > 0.)
C			M=2*m+1 J=j-m+1
C 		ET      
C			M=2*m   J=j-m+2 POUR m IMPAIRE
C                       M=2*m+1 J=j-m+2
C
C
C
C			IDR=5 IN1=2	TRANSFORMATION TCEBYTCHEV -> FONCTION
C								m
C					ASSOCIEES DE LEGENDRE P  (teta) POUR
C								l
C					m > 0.
C			IDR=6 IN1=2     TRANSFORMATION INVERSE DE LA PRECEDENTE.
C
C			IDR=7 IN1=2     TRASFORMATION TCHEBYTCHEV -> LEGENDRE
C				       	CAS m=0 inclu.
C			IDR=8 IN1=2     TRANSFORMATION INVERSE DE LA PRECEDENTE.
C
C			IDR=9 IN1=2      DERIVEE PAR RAPPORT A theta (SEULEMENT
C				         POUR IND=1 ET POUR IPAR > 0)
C			IDR=10 IN1=2     MULTIPLICATION PAR SIN(theta) (SEU-
C			                 LEMENT POUR IND=1)
c			IDR=11 IN1=2	DIVISION PAR SIN(theta) SEULEMENT 
C				        POUR IND=1)
C
C
C			IDR=0 IN1=3     TRANSFORMATION INVERSE DE FOURIER
C					COEFF.-> ESPACE DE FI (IND ARBITRAIRE)
C			IDR=1 IN1=3     CALCUL DES COEFFICIENTS APRES L'AP-
C					PLICATION DE L'OPERATEUR D/DFI
C			IDR=2 IN1=3	CALCUL DES COEFFICIENTS APRES L'AP-
C					LICATION DE L'OPERATEUR D2/DFI2
C
C		IND	= PARAMETRE: SI IND=1 ON A EN SORTIE LES COEFFICIENTS
C			  DE FOURIER OU DE TCHEBYTCHEV APRES L'APPLICATION
C			  DES OPERATEURS DEFINIS PLUS HAUT, SI IND=2 ON A
C			  EN OUTPUT LES FONCTIONS APRES L'APPLICATION 
C			  DES OPERATEURS DEFINIS PLUS HAUT A L'INPUT.
C
C		N.B.		LA TRANSFORMATION DANS L'ESPACE DE CONFI-
C               ---	        GURATIONS EST CORRECTE SEULEMENT POUR LES
C				TRANSFORMATIONS QUI RESPECTENT LA PARITE'
C				LES CAS IDR=5,6,7 ET IN1=1 NE RESPECTENT 
C				PAS LA PARITE' ET PAR CONSEQUENT SEULEMENT 
C				LES COEFFICIENTS SONT CALCULES. (IND=2 ESCLU)
C
C		C64,CS= TABLEAUX DE TRAVAIL: DIMENSION MINIME=
C			   (NNN64+1)*((MAX(NDEG(1),NDEG(2))+3)
C               CC      = TABLEAU DE TRAVAIL DE DIMENSIONS SUP. A
C                         (NR1+2)*MAX(NNN64+1,NT1+1)	
C
C		DENT	= TABLEAU DE TRAVAIL 3DIM. DIMENSIONS MIN. NDEG(1)
C			  NDEG(2),NDEG(3)/2+1
C		DEN	=TABLEAU A 3 DIMENSIONS CONTENANT LA FONCTION
C			 A TRANSFORMER EN INPUT, ET LA TRANSFORMEE EN
C			 OUTPUT.
C
C		Routine ayant testee avec le protocol ordinaire le 28/3/1987
C		Routine modifiee le 4/septembre 1993, le 26/septembre 1993
C		Routine modifiee le 28/mars 1994
C		Routine modifiee le 28/octobre 1994 - DEN(NDR,NDY,*),DENT(NDR,NDY,*)
C		Routine modifiee le 10/mars 1997 - Entroduit l'operateur
C                                cos(theta)/sin(theta)/D/dtheta dans le cas
C			         avec symmetrie z -> -z seulemnt cas IPAR=20
C                                IDR=1 
C             
C
C
C
C $Id: fcir3s.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $
C $Log: fcir3s.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.4  1997/05/31  14:41:01  hyc
c Correction N64 -> NNN64 (trouvee par Joachim).
c
C Revision 1.3  1997/05/23 11:43:21  hyc
C *** empty log message ***
C
C Revision 1.2  1997/05/07 22:19:54  eric
C Nouvelle version fournie par Silvano.
C
C Revision 1.1  1997/03/17 20:06:53  hyc
C Initial revision
C
C
C $Header: /cvsroot/Lorene/F77/Source/Poisson2d/fcir3s.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/fcir3s.f,v 1.2 2012/03/30 12:12:43 j_novak Exp $'/

CC	PARAMETER (N128=129)	! dans la version de Silvano

	PARAMETER (N256=257)

	DIMENSION IDE1(N256),DEN(NDR,NDY,*),C64(*)
	DIMENSION CC(NDR,*),CS(*),NDEG(*)
	DIMENSION IDE2(N256),IDE3(N256),IDE4(N256),DENT(NDR,NDY,*),NDEG1(3)
	DIMENSION IDE5(N256),IDE6(N256)
C
	DATA INITI,NEQ,NCY,NCR,NCZ/0,0,0,0,0/

	save	N25,IDE1,IDE2,IDE3,IDE4,IDE5,IDE6,INITI,NR1,NY1,NZ1
	save	NY11,NCR,NCY,NCZ,NEQ,NR,NZ,NY,NNN65,NN64Z,NN65Z,NR1Y1
	save	MULTZ,IRESTZ,N6Z,MULT1,IREEE2,II,I2,N64Z,N65Z,LYY1,LYY2
	save	LDY,IRR2Z,N6565Z,N365Z

C
C		INITIALISATION.
C
	IF(INITI.NE.314) THEN
C
	N25=N256/2
	DO 700 L=1,N25
	IDE1(L+L)=-L
	IDE1(L+L+1)=L
	IDE2(L+L)=-L*L
	IDE2(L+L+1)=-L*L
  700	CONTINUE
C
	DO 701 L=1,N256
	J1=L+L-1
	J2=J1-1
C	IDE3(L)=-(L+L-1)**2
C	IDE4(L)=-(L+L-2)**2
	IDE3(L)=-J1**2
	IDE4(L)=-J2**2
	IDE5(L)=J1
	IDE6(L)=J2	
  701	CONTINUE
C	
	INITI=314
	ENDIF
C
	NR1=NDEG(1)
	NY1=NDEG(2)
	NZ1=NDEG(3)
	NY11=NY1+1
C
	IF(NCY.EQ.NY1.AND.NCZ.EQ.NZ1.AND.NCR.EQ.NR1.
     1	AND.NEQ.EQ.NNN64) GO TO 800
C
	IF(NR1.GT.N256.OR.NY1.GT.N256.OR.NZ1.GT.N256) THEN
	PRINT 2000,NR1,NY1,NZ1
2000	FORMAT(1X,'DIMENSIONS INSUFF. DANS LA SUB.FCIR3S,NR1,NY1,NZ1=',3I3)
		PRINT*,'IN1=',IN1
	CALL EXIT
	ENDIF
C
	NCR=NR1
	NCY=NY1
	NCZ=NZ1
	NEQ=NNN64
	NR=NR1-1
	NZ=NZ1-1
	NY=NY1-1
	NNN65=NNN64
	IF((NNN64/8)*8.EQ.NNN64)NNN65=NNN64+1
C
C		PREPARATION DES ELEMENTS NECESSAIRES POUR LA TRANSFORMATION
C		DU 3ME INDICE DU TABLEAU
C
	NN64Z=NNN64
	NN65Z=NNN65
	NR1Y1=NR1*NY1
	MULTZ=(NR1Y1)/NN64Z
	IRESTZ=NR1Y1-MULTZ*NN64Z
C
C		OPTIMISATION DE NN64Z (VOIR PLUS HAUT)
C
	IF(MULTZ.GT.0.AND.NNN64.GT.NR1) THEN
	N6Z=(NNN64/NR1)*NR1
	MULT1=NR1Y1/N6Z
	IREEE2=NR1Y1-MULT1*N6Z
	II=0
	I2=0
	IF(IRESTZ.GT.0)II=1
	IF(IREEE2.GT.0)I2=1
	IF(MULT1+I2.LE.MULTZ+II) THEN
	MULTZ=MULT1
	NN64Z=N6Z
	NN65Z=NN64Z
	IF((NN64Z/8)*8.EQ.NN64Z)NN65Z=NN64Z+1
	IRESTZ=IREEE2
	ENDIF
	ENDIF
C
	IF(MULTZ.EQ.0) THEN
	NN64Z=NR1Y1
	NN65Z=NN64Z
	IF((NN64Z/8)*8.EQ.NN64Z)NN65Z=NN64Z+1
	MULTZ=1
	IRESTZ=0
	ENDIF
C
	IF(IRESTZ.GT.0) THEN
	N64Z=IRESTZ
	N65Z=N64Z
	IF((N64Z/8)*8.EQ.N64Z)N65Z=N64Z+1	
	ENDIF
C
	LYY1=1
	LYY2=NN64Z/NR1
	LDY=LYY2-LYY1
	IRR2Z=NN64Z-(NN64Z/NR1)*NR1
	N6565Z=NN65Z+NN65Z
	N365Z=N6565Z+NN65Z
C
 800	CONTINUE
	IMPP=IPPP
	IF(IPPP.GT.9) IMPP=IPPP/10

C11111111111111111111111111111111111111111111111111111111111111111111111111111111
C111111111111111111111111111111111111111111111111111111111111111111111111111
C
C		TRANSFORMATION DU PREMIER INDICE
	IF(IN1.EQ.1) THEN
	IF(IPPP.LT.2) THEN
	IMP=IPPP
C
	NDEG1(1)=NDEG(1)
	NDEG1(3)=NDEG(3)
C
	DO 130 LZ=1,NZ1
	LY1=0
	DO 131 LY=1,NY1,2
	LY1=LY1+1
	DO 132 LR=1,NR1
C	DENT(LR,LZ,LY1)=DEN(LR,LY,LZ)
	DENT(LR,LY1,LZ)=DEN(LR,LY,LZ)
  132	CONTINUE
  131	CONTINUE
  130	CONTINUE
C
	ITCH=0
	IF(IMP.EQ.1) ITCH=1
	NDEG1(2)=LY1
	CALL CIRX3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR,IND,C64,CC,CS,DENT)
C
	DO LZ=1,NZ1
	LY1=0
	DO LY=1,NY1,2
	LY1=LY1+1
	DO LR=1,NR1
C	DEN(LR,LY,LZ)=DENT(LR,LZ,LY1)
	DEN(LR,LY,LZ)=DENT(LR,LY1,LZ)
	ENDDO
	ENDDO
	ENDDO
C
C	TRANSFORMATION INVERSE PARTIE ANTISYMETRIQUE
C	
	DO LZ=1,NZ1
	LY1=0
	DO LY=2,NY1,2
	LY1=LY1+1
	DO LR=1,NR1
C	DENT(LR,LZ,LY1)=DEN(LR,LY,LZ)
	DENT(LR,LY1,LZ)=DEN(LR,LY,LZ)
	ENDDO
	ENDDO
	ENDDO
C
	NDEG1(2)=LY1
	ITCH=1
	IF(IMP.EQ.1) ITCH=0
C
	CALL CIRX3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR,IND,C64,CC,CS,DENT)
C
	DO LZ=1,NZ1
	LY1=0
	DO LY=2,NY1,2
	LY1=LY1+1
	DO LR=1,NR1
C	DEN(LR,LY,LZ)=DENT(LR,LZ,LY1)
	DEN(LR,LY,LZ)=DENT(LR,LY1,LZ)
	ENDDO
	ENDDO
	ENDDO
	RETURN
		ENDIF
C
C1.1.1.1.1.1.1.1.1.1.1.1.1.1..1.1.1.1.1.1.1...........................
C
	IF(IMPP.GE.2.AND.IMPP.LT.4) THEN
	IMP=IMPP
	ITCH=0
	IF((IMP/2)*2.NE.IMP) ITCH=1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
	LZ1=1
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
C
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=LZ1
C
	CALL CIRX3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR,IND,C64,CC,CS,DENT)
C
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,1)=DENT(LR,LY,1)
	ENDDO
	ENDDO
	IF(NZ1.EQ.1) RETURN
	LZ1=1
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DENT(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ITCH=0
	IF((IMP/2)*2.EQ.IMP) ITCH=1
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=LZ1
	CALL CIRX3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR,IND,C64,CC,CS,DENT)
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DENT(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO	
	RETURN
	ENDIF
C
C1^1^1^^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^^^^^^^^^^^^^^^^^^^^^^^^
C

C		CAS SUPER-SYMETRIQUE:IN1=1
C
	IF(IMPP.GE.4) THEN
	IMP=1
	IF((IMPP/2)*2.EQ.IMPP) IMP=0
	ITCH=1
	IF(IMP.EQ.0) ITCH=0
C
	CALL CIRX3S(NDEG,NDR,NDY,NNN64,ITCH,IDR,IND,C64,CC,CS,DEN)
	RETURN
	ENDIF
	ENDIF
C
CCC2222222222222222222222222222222222222222222222222222222222222222222222222.
C222222222222222222222222222222222222222222222222222222222222222222222222.
C
C		TRANSFORMATION DU 2ME INDICE
C
		IF(IN1.EQ.2) THEN
		IF(NY1.LT.2) RETURN
		IF(IMPP.LE.1) THEN
		IMP=IMPP
C
	NDEG1(1)=NDEG(1)
	NDEG1(2)=NDEG(2)
C
	IF(IDR.EQ.9) THEN
	DO LZ=1,NZ1
	DO LR=1,NR1
	DEN(LR,1,LZ)=0
	ENDDO
	ENDDO
C
	DO LY=2,NY1
	LY1=-(LY-1)
	DO LR=1,NR1
	DEN(LR,LY,1)=DEN(LR,LY,1)*LY1
	ENDDO
	ENDDO
	IF(NZ1.EQ.1) RETURN	
C
	DO LZ=2,NZ1,4
	DO JF=LZ,MIN0(LZ+1,NZ1)
	DO LY=2,NY1
	LY1=LY-1
	DO LR=1,NR1
	DEN(LR,LY,JF)=DEN(LR,LY,JF)*LY1	
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	IF(NZ1.LT.4) RETURN
	DO LZ=4,NZ1,4
	DO JF=LZ,MIN0(LZ+1,NZ1)
	DO LY=2,NY1
	LY1=-(LY-1)
	DO LR=1,NR1
	DEN(LR,LY,JF)=DEN(LR,LY,JF)*LY1
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	RETURN
	ENDIF		
C
	IF(IDR.GT.9) THEN
	PRINT*,'LE CALCUL POUR IDR.GT.9) EST EFFECTUE SEULEMENT DANS LE'
	PRINT*,'CAS OU IL Y AURAIT DES SYMETRIES'
	CALL EXIT
	ENDIF
C
	IF(IDR.GT.4) GO TO 630
C
	DO 100 LY=1,NY1
	DO 101 LR=1,NR1
	DENT(LR,LY,1)=DEN(LR,LY,1)
  101	CONTINUE
  100	CONTINUE
C
	JZT=1
	IF(NDEG(3).GT.1) THEN
	DO 102 LZ=4,NZ1,4
	JZT=JZT+1
	JZ=LZ+1
	DO 103 LY=1,NY1
	DO 104 LR=1,NR1
	DENT(LR,LY,JZT)=DEN(LR,LY,LZ)
  104	CONTINUE
  103	CONTINUE
C
	IF(JZ.LE.NZ1) THEN
	JZT=JZT+1
	DO 105 LY=1,NY1
	DO 106 LR=1,NR1
	DENT(LR,LY,JZT)=DEN(LR,LY,JZ)
  106	CONTINUE
  105	CONTINUE
	ENDIF
  102	CONTINUE
C
		ENDIF
C
	NDEG1(3)=JZT
C
	ITCH=1
	IF(IMP.EQ.1) ITCH=2
C
	CALL CIY23S(NDEG1,NDR,NDY,NNN64,ITCH,IDR,IND,C64,CC,CS,DENT)
C
C		LES COEFFICIENTS SONT STOCKES DANS DEN(LR,LT,LM).
C
	DO 107 LY=1,NY1
	DO 108 LR=1,NR1
	DEN(LR,LY,1)=DENT(LR,LY,1)
  108	CONTINUE
  107	CONTINUE
C
		IF(NDEG(3).EQ.1) RETURN
	JZT=1
	DO 109 LZ=4,NZ1,4
	JZT=JZT+1
	JZ=LZ+1
       	DO 110 LY=1,NY1
        DO 111 LR=1,NR1
	DEN(LR,LY,LZ)=DENT(LR,LY,JZT)
  111	CONTINUE
  110	CONTINUE
C
	IF(LZ.LE.NZ1) THEN
	JZT=JZT+1
	DO 112 LY=1,NY1
	DO 113 LR=1,NR1
	DEN(LR,LY,JZ)=DENT(LR,LY,JZT)
  113	CONTINUE
  112	CONTINUE
	ENDIF
  109	CONTINUE
C
C		DEVELOPPEMENT EN POLYNOMES DE TCHEBYTCHEV DU 2ME TYPE.
C
	JZT=0
	DO 114 LZ=2,NZ1,4
	JZT=JZT+1
	JZ=LZ+1
	DO 115 LY=1,NY1
	DO 116 LR=1,NR1
	DENT(LR,LY,JZT)=DEN(LR,LY,LZ)
  116	CONTINUE   
  115	CONTINUE   
	IF(JZ.LE.NZ1)THEN
	JZT=JZT+1
	DO 117 LY=1,NY1
	DO 118 LR=1,NR1
	DENT(LR,LY,JZT)=DEN(LR,LY,JZ)
  118	CONTINUE   
  117	CONTINUE   
	ENDIF
  114	CONTINUE   
C
	NDEG1(3)=JZT
	ITCH=2
	IF(IMP.EQ.1) ITCH=1
	CALL CIY23S(NDEG1,NDR,NDY,NNN64,ITCH,IDR,IND,C64,CC,CS,DENT)
C
C		LE COEFFICIENTS SONT STOCKES DANS DEN(LR,LT,LM)
C
	JZT=0
	DO 119 LZ=2,NZ1,4
	JZT=JZT+1
	JZ=LZ+1
	DO 120 LY=1,NY1
	DO 121 LR=1,NR1
	DEN(LR,LY,LZ)=DENT(LR,LY,JZT)
  121	CONTINUE   
  120	CONTINUE   
C
	JZT=JZT+1
	IF(JZ.LE.NZ1) THEN
	DO 122 LY=1,NY1
	DO 123 LR=1,NR1
	DEN(LR,LY,JZ)=DENT(LR,LY,JZT)
  123	CONTINUE   
  122	CONTINUE   
	ENDIF
  119	CONTINUE   
	RETURN
C
  630	CONTINUE
C
C		TRANSFORMATION LEGENDRE -> TCHEBYTCHEV ET VICE VERSA.
C
	ITCH=0
C
	IF(IDR.EQ.6.OR.IDR.EQ.8) ITCH=1
C	
	IF(NDEG(3).EQ.1) THEN
C	
C		L'ORDRE m DE LA FOCTION ASSOCIEE DE LEGENDRE EST
C		TRANSMIS A LA ROUTINE CIY23S VIA C64(1)
C	
	C64(1)=0
	CALL CIY23S(NDEG,NDR,NDY,NNN64,ITCH,IDR,1,C64,CC,CS,DEN)
	RETURN 
	ENDIF
C
C		CAS NZ1 > 1
C
	NZ2=NZ/2
C
	ITCH=0
C		TRANSLATION DES COEFFICIENTS DE LEGENDRE POUR DES RAISONS
C		DE COMPATIBILTE' AVEC CHELES
C
	IF(IDR.EQ.6.OR.IDR.EQ.8) THEN
C
	DO JM=1,NZ2,2
	JM1=JM*2
	JM2=JM1+1
	DO LY=1,NY1-1
	LY1=LY+1
	DO LR=1,NR1
	DEN(LR,LY,JM1)=DEN(LR,LY1,JM1)
	DEN(LR,LY,JM2)=DEN(LR,LY1,JM2)
	ENDDO
	ENDDO
	ENDDO
C
	IF((NZ1/4)*4.NE.NZ1) THEN
C
	DO LY=1,NY1-1
	LY1=LY+1
	DO LR=1,NR1
	DEN(LR,LY,NZ1)=DEN(LR,LY1,NZ1)
	ENDDO
	ENDDO
	ENDIF
C
	ITCH=1
	ENDIF
C
	NDEG1(3)=2
	JM0=0
	DO JM=1,NZ2
	JM0=JM0+2
	JM1=JM0+1
C
	DO LY=1,NY1	
	DO LR=1,NR1
	DENT(LR,LY,1)=DEN(LR,LY,JM0)
	ENDDO
	DO LR=1,NR1
	DENT(LR,LY,2)=DEN(LR,LY,JM1)
	ENDDO
	ENDDO
C
	C64(1)=JM
	CALL CIY23S(NDEG1,NDR,NDY,NNN64,ITCH,IDR,1,C64,CC,CS,DENT)
C
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,JM0)=DENT(LR,LY,1)
	ENDDO
	DO LR=1,NR1
	DEN(LR,LY,JM1)=DENT(LR,LY,2)
	ENDDO
	ENDDO
C
	ENDDO
C
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,1)=DEN(LR,LY,NZ1)
	ENDDO
	ENDDO
C		
	NDEG1(3)=1
	C64(1)=NZ2+1
C
	CALL CIY23S(NDEG1,NDR,NDY,NNN64,ITCH,IDR,1,C64,CC,CS,DENT)
C
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,NZ1)=DENT(LR,LY,1)
	ENDDO		
	ENDDO
C
	IF(IDR.GT.6) THEN
C
	NDEG1(3)=1
	C64(1)=0
C
	CALL CIY23S(NDEG1,NDR,NDY,NNN64,ITCH,IDR,1,C64,CC,CS,DEN)
C
	ENDIF

	IF(IDR.EQ.5.OR.IDR.EQ.7) THEN
C
C		L'OUTPUT SORTANT DE CHELES EST TRANSLATE' 
C		DANS DEN
C
	DO JM=1,NZ2,2
	JM1=JM*2
	JM2=JM1+1
	DO LY=NY1-1,1,-1
	LY1=LY+1
	DO LR=1,NR1
	DEN(LR,LY1,JM1)=DEN(LR,LY,JM1)
	DEN(LR,LY1,JM2)=DEN(LR,LY,JM2)
	ENDDO
	ENDDO
C
C		NETTOYAGE
C
	DO LR=1,NR1
	DEN(LR,1,JM1)=0
	DEN(LR,1,JM2)=0
	ENDDO
	ENDDO
C
	IF(MOD(NZ2+1,2).EQ.0) RETURN
C
	DO LY=NY1-1,1,-1
	LY1=LY+1
	DO LR=1,NR1
	DEN(LR,LY1,NZ1)=DEN(LR,LY,NZ1)
	ENDDO
	ENDDO
C
C		NETTOYAGE
C
	DO LR=1,NR1
	DEN(LR,1,NZ1)=0
	ENDDO
C
	RETURN
	ENDIF
		ENDIF
C
C...............................................2.2.2.2.2.2.2.2.2.2.2.2.
C
C		CAS AVEC SYMETTRIE PAR RAPPORT AU PLAN  z=0 (Seulememt)
C
	IF(IMPP.EQ.2) THEN
	IF(IDR.EQ.5.OR.IDR.EQ.6.OR.IDR.EQ.7) THEN
	PRINT*,' ROUTINE FCIR3S:CE CAS N EST PAS ENCOR CONTEMPLE,IDR=',IDR
	PRINT*,'LA ROUTINE CEPL3S REMPLACE CE CAS !'
	STOP
	ENDIF
C
C
	IF(IDR.EQ.1.AND.IPPP.EQ.21) THEN
	PRINT*,' ROUTINE FCIR3S:CE CAS N EST PAS ENCOR CONTEMPLE,IDR=',IDR
	PRINT*,'Sorry !'
	STOP
	ENDIF

	IF(IPPP.EQ.20) THEN
	IF(IDR.EQ.1) THEN
	IF(IND.NE.1) THEN
		PRINT*,'Routine FCIR3S: Si IDR=1, IND doit etre'
                PRINT*,'necessairemnt = 1, IDR,IND=',IDR,IND
		STOP
	ENDIF
C
	
C		CALCUL DE COS(theta(/SIN(theta)*D/dtheta
C
C
C    1)- Calcul de la derivee

C
	DO LR=1,NR1
	DEN(LR,1,1)=0
	ENDDO
C
	DO LR=1,NR1
	DEN(LR,NY1,1)=DEN(LR,NY1,1)*.5
	ENDDO
C
	DO LZ=4,NZ1,4
	DO J=LZ,MIN0(LZ+1,NZ1)
	DO LR=1,NR1
	DEN(LR,NY1,J)=DEN(LR,NY1,J)*.5
	ENDDO
	ENDDO
	ENDDO
C
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,1)=DEN(LR,LY,1)*IDE6(LY)
	ENDDO
	ENDDO
C
	DO LZ=4,NZ1,4
	DO J=LZ,MIN0(LZ+1,NZ1)
	DO LR=1,NR1
	DEN(LR,1,J)=0
	ENDDO
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=IDE6(LY)*DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
C  2)- Division par sin(theta)
C
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=1
	ID=-1
C
	DO LR=1,NR1
	DEN(LR,NY1+1,1)=0
	ENDDO
	NDEG1(2)=NY1+1
C
	CALL DISR3S(NDEG1,NDR,NDY,1,ID,DEN,DENT)
C
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	DO J=LZ,MIN0(LZ+1,NZ1)
	DO LY=1,NY1
	DO LR=1,NR1
	CC(LR,LY)=DEN(LR,LY,J)
	ENDDO
	ENDDO
C
	DO LR=1,NR1
	CC(LR,NY1+1)=0
	ENDDO
C
	CALL DISR3S(NDEG1,NDR,NDY,1,ID,CC,DEN)
C
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,J)=DEN(LR,LY,1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
C
C   3)-  3EME PAS: MULTIPLICATION PAR COS(THETA)
C
	CALL DISR3S(NDEG1,NDR,NDY,0,3,DENT,DEN)
C
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	DO J=LZ,MIN0(LZ+1,NZ1)
	DO LY=1,NY1
	DO LR=1,NR1
	CC(LR,LY)=DENT(LR,LY,J)
	ENDDO
	ENDDO		
	CALL DISR3S(NDEG1,NDR,NDY,0,3,CC,DENT)
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DENT(LR,LY,1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
C		ON TRAITE LES TERMES EN COS(theta)*SIN(theta)
C
C		MULTIPLICATION DE LA DERIVE PAR COS(theta)
C
	DO LZ=2,NZ1,4
	DO J=LZ,MIN0(LZ+1,NZ1)
	DO LY=1,NY1,2
	DO LR=1,NR1
	CC(LR,LY)=DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
	DO LY=2,NY1,2
	DO LR=1,NR1
	CC(LR,LY)=-DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
C
	ID=0
C
	CALL DISR3S(NDEG1,NDR,NDY,ID,3,CC,DENT)
C
	DO LY=1,NY1
	DO LR=1,NR1
	CC(LR,LY)=DEN(LR,LY,J)
	ENDDO
	ENDDO
C
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DENT(LR,LY,1)
	ENDDO
	ENDDO
C
	ID=-1
C
	CALL DISR3S(NDEG1,NDR,NDY,5,ID,CC,DENT)
C
C		ON calcule COS(theta)*D/dhteta - 1/SIN(theta)
C

	DO LY=1,NY1
	DO LR=1,NR1
	CC(LR,LY)=DEN(LR,LY,J)-DENT(LR,LY,1)
	ENDDO
	ENDDO
C
C		ON DIVISE L'EXPRESSION AINSI OBTEMUE PAR sin(theta)
C            POUR OBTENIRE COS(theta)/SIN(theta)*D/dtheta - 1/SIN(theta)**2
C
	ID=-1
C
	CALL DISR3S(NDEG1,NDR,NDY,4,ID,CC,DENT)
C
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DENT(LR,LY,1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	ENDIF
	RETURN
	ENDIF
	ENDIF
C
	NY11=NY1+1
	IDR1=IDR
	IF(IDR.EQ.10) IDR1=5
	IF(IDR.EQ.11) IDR1=6
	
	ITCH=0
	IF(IPPP.EQ.21) ITCH=1
C
	IF(IDR.EQ.2) THEN
	IF(ITCH.EQ.0) THEN
C	
	DO LR=1,NR1
	DEN(LR,1,1)=0
	ENDDO
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,1)=DEN(LR,LY,1)*IDE4(LY)
	ENDDO
	ENDDO
C
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=0
	ENDDO
C
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE4(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=-DEN(LR,1,J)
	ENDDO
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE3(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
C
	ELSE
	DO LR=1,NR1
	DEN(LR,1,1)=-DEN(LR,1,1)
	ENDDO
C
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,1)=DEN(LR,LY,1)*IDE3(LY)
	ENDDO
	ENDDO
C
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=-DEN(LR,1,J)
	ENDDO
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE3(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE4(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
C
	ENDIF
	IF(IND.EQ.1) RETURN
	IDR1=0
	ENDIF
C
	IF(IDR.EQ.9) THEN
	IF(ITCH.EQ.0) THEN
C
	DO LR=1,NR1
	DEN(LR,1,1)=0
	ENDDO
C
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,1)=DEN(LR,LY,1)*IDE6(LY)
	ENDDO
	ENDDO
C
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=0
	ENDDO
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE6(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LY=2,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,J)=-DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
	DO LY=3,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
	ELSE
C
	DO LY=2,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,1)=-DEN(LR,LY,1)*IDE5(LY)
	ENDDO
	ENDDO
C
	DO LY=3,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,1)=DEN(LR,LY,1)*IDE5(LY)
	ENDDO
	ENDDO
C	
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LY=2,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,J)=-DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
	DO LY=3,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=0
	ENDDO
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE6(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
C
	ENDIF
	RETURN
	ENDIF
C
	DO LY=1,NY1
	DO LR=1,NR1
C	DENT(LY,LR,1)=DEN(LR,LY,1)
	DENT(LR,LY,1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
C
	LZ1=1
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
 	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
C	DENT(LY,LR,LZ1)=DEN(LR,LY,J)
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO	
	ENDIF
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=LZ1
C
	CALL CITY3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR1,IND,C64,CC,CS,DENT)
C
	IF(IND.EQ.1) THEN
	DO LY=1,NY1
	DO LR=1,NR1
C	DEN(LR,LY,1)=DENT(LY,LR,1)
	DEN(LR,LY,1)=DENT(LR,LY,1)
	ENDDO
	ENDDO
	IF(NZ1.EQ.1) RETURN
	LZ1=1
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
C	DEN(LR,LY,J)=DENT(LY,LR,LZ1)
	DEN(LR,LY,J)=DENT(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ELSE
C
	DO LY=1,NY1
	LY1=NY11-LY
	DO LR=1,NR1
C	DEN(LR,LY1,1)=DENT(LY,LR,1)
	DEN(LR,LY1,1)=DENT(LR,LY,1)
	ENDDO
	ENDDO
	IF(NZ1.EQ.1) RETURN
	LZ1=1
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	LY1=NY11-LY
	DO LR=1,NR1
C	DEN(LR,LY1,J)=DENT(LY,LR,LZ1)
	DEN(LR,LY1,J)=DENT(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
C
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
C	DENT(LY,LR,LZ1)=DEN(LR,LY,J)
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	NDEG1(3)=LZ1
C
	ITCH=1
	IF(IPPP.EQ.21) ITCH=0
	CALL CITY3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR1,IND,C64,CC,CS,DENT)
C
	IF(IND.EQ.1) THEN
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
C	DEN(LR,LY,J)=DENT(LY,LR,LZ1)
	DEN(LR,LY,J)=DENT(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	RETURN
	ENDIF
C
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	LY1=NY11-LY
	DO LR=1,NR1
C	DEN(LR,LY,J)=DENT(LY1,LR,LZ1)
	DEN(LR,LY,J)=DENT(LR,LY1,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	RETURN
	ENDIF
C
C		CAS ANTISYMETRIQUE
C
	IF(IPPP.EQ.30) THEN
	IDR1=IDR
	IF(IDR.EQ.2) THEN
C
	DO LR=1,NR1
	DEN(LR,1,1)=-DEN(LR,1,1)
	ENDDO
C
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,1)=DEN(LR,LY,1)*IDE3(LY)
	ENDDO
	ENDDO
C
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=-DEN(LR,1,J)
	ENDDO
	ENDDO
	ENDDO
C	
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE3(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C 
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE4(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
	IF(IND.EQ.1) RETURN
	IDR1=0
	ENDIF
C
	IF(IDR.EQ.9) THEN
	DO LR=1,NR1
	DEN(LR,1,1)=-DEN(LR,1,1)
	ENDDO
	DO LY=2,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,1)=DEN(LR,LY,1)*IDE5(LY)
	ENDDO
	ENDDO
	DO LY=3,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,1)=-DEN(LR,LY,1)*IDE5(LY)
	ENDDO
	ENDDO
C
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=-DEN(LR,1,J)
	ENDDO
	DO LY=2,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
	DO LY=3,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,J)=-DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,J)
	DO J=LZ,LZ2
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=-DEN(LR,LY,J)*IDE6(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
	RETURN
	ENDIF	
C
	IF(IDR.EQ.3.OR.IDR.EQ.4.OR.IDR.EQ.10.OR.IDR.EQ.11) THEN
C
	IF(IDR.EQ.3) ID=2
	IF(IDR.EQ.10) ID=1
	IF(IDR.EQ.4) ID=-2
	IF(IDR.EQ.11) ID=-1
C
	IF(NZ1.GT.1) THEN
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	JZ1=LZ1
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
C
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1	
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	NZ2=NZ1/2
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=NZ2
C
	CALL DISR3S(NDEG1,NDR,NDY,1,ID,DENT,DEN)
C
	DO LZ=1,NZ2
	LZ1=LZ+NZ2
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,LZ1)=DEN(LR,LY,LZ)
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=1,NZ2
	LZ1=LZ+NZ2
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ)=DENT(LR,LY,LZ1)	
	ENDDO
	ENDDO
	ENDDO
C
	NDEG1(3)=NZ2
C
	CALL DISR3S(NDEG1,NDR,NDY,0,ID,DENT,DEN)
C
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
C
	LZ1=1
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,J)=DEN(LR,LY,LZ1)	
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,J)=DEN(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=1,NZ1
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,LZ)=DENT(LR,LY,LZ)
	ENDDO
	ENDDO
	ENDDO
	IF(IND.EQ.1) RETURN
	IDR1=0
	ELSE
C
C		CAS NZ1=1
C
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
C
	CALL DISR3S(NDEG,NDR,NDY,0,ID,DENT,DEN)
	IF(IND.EQ.1) RETURN
	IDR1=0
	ENDIF
	ENDIF
C
	DO LY=1,NY1
	DO LR=1,NR1
C	DENT(LY,LR,1)=DEN(LR,LY,1)
	DENT(LR,LY,1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
C
	LZ1=1
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
C	DENT(LY,LR,LZ1)=DEN(LR,LY,J)
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
C
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=LZ1
	ITCH=1
C
	CALL CITY3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR1,IND,C64,CC,CS,DENT)
C
	DO LY=1,NY1
	DO LR=1,NR1
C	DEN(LR,LY,1)=DENT(LY,LR,1)
	DEN(LR,LY,1)=DENT(LR,LY,1)
	ENDDO
	ENDDO
C
	IF(NZ1.EQ.1) RETURN
	LZ1=1
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
C	DEN(LR,LY,J)=DENT(LY,LR,LZ1)
	DEN(LR,LY,J)=DENT(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=LZ1
	ITCH=2
C
	CALL CIY23S(NDEG1,NDR,NDY,NNN64,ITCH,IDR1,1,C64,CC,CS,DENT)
C
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DENT(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO				
	RETURN
	ENDIF
C
	IF(IPPP.EQ.31) THEN
	IDR1=IDR
	IF(IDR.EQ.2) THEN
C
	DO LR=1,NR1
	DEN(LR,1,1)=0
	ENDDO
C
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,1)=DEN(LR,LY,1)*IDE4(LY)
	ENDDO
	ENDDO
C
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=0
	ENDDO
	ENDDO
	ENDDO
C	
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE4(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C 
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=-DEN(LR,1,J)
	ENDDO
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE3(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
	IF(IND.EQ.1) RETURN
	IDR1=0
	ENDIF
C
	IF(IDR.EQ.9) THEN
	DO LR=1,NR1
	DEN(LR,1,1)=0
	ENDDO
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,1)=-DEN(LR,LY,1)*IDE6(LY)
	ENDDO
	ENDDO
C
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=0
	ENDDO
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=-DEN(LR,LY,J)*IDE6(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,J)
	DO J=LZ,LZ2
	DO LR=1,NR1
	DEN(LR,1,J)=-DEN(LR,1,J)
	ENDDO
	DO LY=2,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,J)=DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
	DO LY=3,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,J)=-DEN(LR,LY,J)*IDE5(LY)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
	RETURN
	ENDIF	
C
C
	IF(IDR.EQ.3.OR.IDR.EQ.4.OR.IDR.EQ.10.OR.IDR.EQ.11) THEN
	IF(IDR.EQ.3) ID=2
	IF(IDR.EQ.10) ID=1
	IF(IDR.EQ.4) ID=-2
	IF(IDR.EQ.11) ID=-1
C
	IF(NZ1.GT.1) THEN
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	JZ1=LZ1
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
C
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1	
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	NZ2=NZ1/2
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=NZ2
C
	CALL DISR3S(NDEG1,NDR,NDY,0,ID,DENT,DEN)
C
	DO LZ=1,NZ2
	LZ1=LZ+NZ2
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,LZ1)=DEN(LR,LY,LZ)
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=1,NZ2
	LZ1=LZ+NZ2
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ)=DENT(LR,LY,LZ1)	
	ENDDO
	ENDDO
	ENDDO
C
	NDEG1(3)=NZ2
C
	CALL DISR3S(NDEG1,NDR,NDY,1,ID,DENT,DEN)
C
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
C
	LZ1=1
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,J)=DEN(LR,LY,LZ1)	
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,J)=DEN(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	DO LZ=1,NZ1
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,LZ)=DENT(LR,LY,LZ)
	ENDDO
	ENDDO
	ENDDO
	ELSE
C
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
	CALL DISR3S(NDEG,NDR,NDY,1,ID,DENT,DEN)
	ENDIF
	IF(IND.EQ.1) RETURN
	IDR1=0
	ENDIF
C
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,1)=DEN(LR,LY,1)
	ENDDO
	ENDDO
	LZ1=1
	IF(NZ1.GT.1) THEN
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ENDIF
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=LZ1
	ITCH=2
C
	CALL CIY23S(NDEG1,NDR,NDY,NNN64,ITCH,IDR1,1,C64,CC,CS,DENT)
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,1)=DENT(LR,LY,1)
	ENDDO
	ENDDO
	IF(NZ1.EQ.1) RETURN
	LZ1=1
	DO LZ=4,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,J)=DENT(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
C	DENT(LY,LR,LZ1)=DEN(LR,LY,J)
	DENT(LR,LY,LZ1)=DEN(LR,LY,J)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
	ITCH=1	
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=LZ1
	CALL CITY3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR1,IND,C64,CC,CS,DENT)
	LZ1=0
	DO LZ=2,NZ1,4
	LZ2=MIN0(LZ+1,NZ1)
	DO J=LZ,LZ2
	LZ1=LZ1+1
	DO LY=1,NY1
	DO LR=1,NR1
C	DEN(LR,LY,J)=DENT(LY,LR,LZ1)
	DEN(LR,LY,J)=DENT(LR,LY,LZ1)
	ENDDO
	ENDDO
	ENDDO
	ENDDO
C
	RETURN
	ENDIF
C
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^2^2^2^2^2^2^2^2^2^2^2^2^
C	
C
C		CAS AVEC SUPERSYMETRIES
C
	IF(IDR.EQ.5.OR.IDR.EQ.6.OR.IDR.EQ.7) THEN
	PRINT*,' ROUTINE FCIR3S:CE CAS N EST PAS ENCOR CONTEMPLE,IDR=',IDR
	PRINT*,'Sorry !'
	STOP
	ENDIF
C
	ITCH=1
	IF(IPPP.EQ.40) ITCH=0
C
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=NZ1
C	
	IF(IDR.EQ.0.AND.ITCH.EQ.0) THEN
	DO LZ=1,NZ1
	DO LY=2,NY1,2
	DO LR=1,NR1
	DEN(LR,LY,LZ)=-DEN(LR,LY,LZ)
	ENDDO
	ENDDO
	ENDDO
	 CALL CITY3S(NDEG1,NDR,NDY,NNN64,0,0,2,C64,CC,CS,DEN)
	RETURN
	ENDIF
C
	IDR1=IDR
	IF(IPPP.EQ.40.OR.IPPP.EQ.41) THEN
	IMP=1
	IF((IMPP/2)*2.EQ.IMPP) IMP=0
C
	ITCH=1
	IF(IPPP.EQ.40) ITCH=0
C
	IF(IDR.EQ.10) IDR1=5
	IF(IDR.EQ.11) IDR1=6
	IF(IDR.EQ.5.OR.IDR.EQ.6.OR.IDR.EQ.7) THEN
	PRINT*,' ROUTINE FCIR3S:CE CAS N EST PAS ENCORE CONTEMPLE,IDR=',IDR
	PRINT*,' LA ROUTINE CEPL3S.FOR EFFECTUE LES TRANSFORMATIONS DE-'
	PRINT*,' MANDEES'
	STOP
	ENDIF
C
	IF(IDR.EQ.1) THEN
C
C		CALCUL DE COS/SIN*D/dtheta (cas paire. le cas impaire
C	        reste a faire)
C
	IF(IPPP.NE.40) THEN
	PRINT*,'ROUTINE FCIR3S: CES CAS N EST PAS CONTEMPLE. Sorry !'
	PRINT*,'IDR,IPPP=',IDR,IPPP
		STOP
	ENDIF
C
C		PREMIER PAS :CALCUL DE D/dtheta
C
	DO LZ=1,NZ1
	DO  LR=1,NR1
	DEN(LR,1,LZ)=0
	ENDDO
C	
	DO LY=2,NY1
	DO LR=1,NR1
	DEN(LR,LY,LZ)=DEN(LR,LY,LZ)*IDE6(LY)
	ENDDO
	ENDDO
	ENDDO
C
	ID=-1	
	NDEG(2)=NY1
	NDEG(3)=NZ1
	DO LZ=1,NZ1
	DO LR=1,NR1
	DEN(LR,NY1,LZ)=DEN(LR,NY1,LZ)*.5
	ENDDO
	ENDDO
C
C		 2EME PAS : DIVISION PAR SIN(theta)
C
	CALL DISR3S(NDEG,NDR,NDY,1,ID,DEN,DENT)
C
C		 3EME PAS: MULTIPLICATION PAR COS(THETA)
C
C
	DO LZ=1,NZ1
	DO LY=2,NY1-1,2
	LY2=LY+1
	DO LR=1,NR1
	DEN(LR,LY2,LZ)=-(DENT(LR,LY,LZ)+DENT(LR,LY2,LZ))*.5
	ENDDO
	ENDDO
C
	DO LR=1,NR1
	DEN(LR,1,LZ)=-DENT(LR,1,LZ)
	ENDDO
	ENDDO
C
	DO LZ=1,NZ1
	DO LR=1,NR1
	DEN(LR,NY1,LZ)=DEN(LR,NY1,LZ)*2
	ENDDO
	ENDDO
C                                                        !! JUSQU'ICI
		IF(IND.EQ.1) THEN
C
	DO LZ=1,NZ1
	DO LY=1,NY1-1,2
	LY2=LY+1
	DO LR=1,NR1
	DEN(LR,LY2,LZ)=(DENT(LR,LY,LZ)+DENT(LR,LY2,LZ))*.5
	ENDDO
	ENDDO
	ENDDO
	RETURN
		ELSE
	DO LZ=1,NZ1
	DO LY=1,NY1-1,2
	LY2=LY+1
	DO LR=1,NR1
	DEN(LR,LY2,LZ)=-(DENT(LR,LY,LZ)+DENT(LR,LY2,LZ))*.5
	ENDDO
	ENDDO
	ENDDO
	 CALL CITY3S(NDEG1,NDR,NDY,NNN64,0,0,2,C64,CC,CS,DEN)
	RETURN
	ENDIF
	ENDIF
C
C		CALCUL DE LA DERIVEE 2EME
C
	IF(IDR.EQ.2) THEN
	IF(ITCH.EQ.0) THEN
C
C		CAS PAIRE
C
	DO 450 LZ=1,NZ1
	DO 451 LR=1,NR1
	DEN(LR,1,LZ)=0
  451	CONTINUE
C	
	DO 452 LY=2,NY1
	DO 453 LR=1,NR1
	DEN(LR,LY,LZ)=DEN(LR,LY,LZ)*IDE4(LY)
  453	CONTINUE
  452	CONTINUE
  450	CONTINUE
	ELSE
C
C		CAS IMPAIRE
C
	DO 454 LZ=1,NZ1
	DO 455 LR=1,NR1
	DEN(LR,1,LZ)=-DEN(LR,1,LZ)
  455	CONTINUE
	DO 456 LY=2,NY1
	DO 457 LR=1,NR1
	DEN(LR,LY,LZ)=DEN(LR,LY,LZ)*IDE3(LY)
  457	CONTINUE
  456	CONTINUE
  454	CONTINUE
C
	ENDIF
	IF(IND.EQ.1) RETURN
	IDR1=0
	ENDIF
C
	IF(IDR.EQ.9) THEN
C
C		CALCUL DE D/dtheta
C
	IF(ITCH.EQ.0) THEN
C
C		CAS PAIRE
C
	DO 458 LZ=1,NZ1
	DO 459 LR=1,NR1
	DEN(LR,1,LZ)=0
  459	CONTINUE
C	
	DO 460 LY=2,NY1
	DO 461 LR=1,NR1
	DEN(LR,LY,LZ)=DEN(LR,LY,LZ)*IDE6(LY)
  461	CONTINUE
  460	CONTINUE
  458	CONTINUE
C
	ELSE
C
C		CAS IMPAIRE
C
	DO 462 LZ=1,NZ1
	DO 463 LR=1,NR1
	DEN(LR,1,LZ)=DEN(LR,1,LZ)
  463	CONTINUE
C
	DO 464 LY=2,NY1,2
	DO 465 LR=1,NR1
	DEN(LR,LY,LZ)=-DEN(LR,LY,LZ)*IDE5(LY)
 465	CONTINUE
 464	CONTINUE
C
	DO 466 LY=3,NY1,2
	DO 467 LR=1,NR1
	DEN(LR,LY,LZ)=DEN(LR,LY,LZ)*IDE5(LY)
  467	CONTINUE
  466	CONTINUE
  462	CONTINUE
	ENDIF
C
	RETURN
	ENDIF
C
C		LE DERIVEES REVIENNENT DANS L'ESPACE DES CONFIGURATIONS
C
	CALL CITY3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR1,IND,C64,CC,CS,DEN)
C
	IF(IND.EQ.1) RETURN
C
	DO 474 LZ=1,NZ1
	DO 475 LY=1,NY1
	LY1=NY11-LY
	DO 476 LR=1,NR1
	DENT(LR,LY1,1)=DEN(LR,LY,LZ)
  476	CONTINUE
  475	CONTINUE
	DO LY=1,NY1
	DO LR=1,NR1
	DEN(LR,LY,LZ)=DENT(LR,LY,1)
	ENDDO
	ENDDO
  474	CONTINUE
C
	RETURN
		ENDIF
C
C		CAS ANTISYMETRIQUE PAR RAPPORT AU PLAN z=0
C
	IF(IPPP.EQ.50) THEN
C	
	IMP=1
	NDEG1(1)=NR1
	NDEG1(2)=NY1
	NDEG1(3)=NZ1
C	
	IDR1=IDR
	ITCH=1
C
	IF(IDR.EQ.2) THEN
C
	DO 484 LZ=1,NZ1
	DO 481 LR=1,NR1
	DEN(LR,1,LZ)=-DEN(LR,1,LZ)
  481	CONTINUE
C
	DO 482 LY=2,NY1
	DO 483 LR=1,NR1
	DEN(LR,LY,LZ)=DEN(LR,LY,LZ)*IDE3(LY)
  483	CONTINUE
  482	CONTINUE
  484	CONTINUE
	IF(IND.EQ.1) RETURN
	IDR1=0
	ENDIF
C
	IF(IDR.EQ.3.OR.IDR.EQ.4.OR.IDR.EQ.10.OR.IDR.EQ.11) THEN
	IF(IDR.EQ.3) ID=2
	IF(IDR.EQ.10) ID=1
	IF(IDR.EQ.4) ID=-2
	IF(IDR.EQ.11) ID=-1
	CALL DISR3S(NDEG,NDR,NDY,0,ID,DEN,DENT)
C
	DO 485 LZ=1,NZ1
	DO 486 LY=1,NY1
	DO 487 LR=1,NR1
	DEN(LR,LY,LZ)=DENT(LR,LY,LZ)
  487	CONTINUE
  486	CONTINUE
  485	CONTINUE
C
	IF(IND.EQ.1.OR.IABS(ID).NE.2) RETURN
	IDR1=0
	ENDIF
C
	IF(IDR.EQ.9) THEN
C
	DO 488 LZ=1,NZ1
	DO 489 LR=1,NR1
	DEN(LR,1,LZ)=-DEN(LR,1,LZ)
  489	CONTINUE
C	
	DO 490 LY=2,NY1,2
	DO 491 LR=1,NR1
	DEN(LR,LY,LZ)=DEN(LR,LY,LZ)*IDE5(LY)
  491	CONTINUE
  490	CONTINUE
C
	DO 492 LY=3,NY1,2
	DO 493 LR=1,NR1
	DEN(LR,LY,LZ)=-DEN(LR,LY,LZ)*IDE5(LY)
  493	CONTINUE
  492	CONTINUE
  488	CONTINUE
C
	IF(IND.EQ.1) RETURN
	IDR1=0
	ENDIF
C
	DO 494 LZ=1,NZ1
	DO 495 LY=1,NY1
	DO 496 LR=1,NR1
C	DENT(LY,LR,LZ)=DEN(LR,LY,LZ)
	DENT(LR,LY,LZ)=DEN(LR,LY,LZ)
  496	CONTINUE
  495	CONTINUE
  494	CONTINUE
C	
	CALL CITY3S(NDEG1,NDR,NDY,NNN64,ITCH,IDR1,IND,C64,CC,CS,DENT)
C
	DO 497 LZ=1,NZ1
	DO 498 LY=1,NY1
	DO 499 LR=1,NR1
C	DEN(LR,LY,LZ)=DENT(LY,LR,LZ)
	DEN(LR,LY,LZ)=DENT(LR,LY,LZ)
  499	CONTINUE
  498	CONTINUE
  497	CONTINUE
C
	RETURN
		ENDIF
C
	IF(IPPP.EQ.51) THEN
C
	IF(IDR.EQ.2) THEN
	DO 500 LZ=1,NZ1
	DO 501 LY=2,NY1
	DO 502 LR=1,NR1
	DEN(LR,LY,LZ)=DEN(LR,LY,LZ)*IDE4(LY)
  502	CONTINUE
  501	CONTINUE
  500	CONTINUE
C
	IF(IND.EQ.1) RETURN
	IDR1=0
	ENDIF
	IF(IDR.EQ.9) THEN
C
	DO 503 LZ=1,NZ1
	DO 504 LR=1,NR1
	DEN(LR,1,LZ)=0
  504	CONTINUE
C	
	DO 505 LY=2,NY1
	DO 506 LR=1,NR1
	DEN(LR,LY,LZ)=-DEN(LR,LY,LZ)*IDE6(LY)
  506	CONTINUE
  505	CONTINUE
  503	CONTINUE
C
	RETURN
	ENDIF
C
	IF(IDR.EQ.3.OR.IDR.EQ.4.OR.IDR.EQ.10.OR.IDR.EQ.11) THEN
	IF(IDR.EQ.3) ID=2
	IF(IDR.EQ.10) ID=1
	IF(IDR.EQ.4) ID=-2
	IF(IDR.EQ.11) ID=-1
C
	CALL DISR3S(NDEG,NDR,NDY,1,ID,DEN,DENT)
C
	DO 507 LZ=1,NZ1
	DO 508 LY=1,NY1
	DO 509 LR=1,NR1
	DEN(LR,LY,LZ)=DENT(LR,LY,LZ)
  509	CONTINUE
  508	CONTINUE
  507	CONTINUE
C
	IF(IND.EQ.1.OR.IABS(ID).NE.2) RETURN
	IDR1=0
	ENDIF
C
	ITCH=2
	CALL CIY23S(NDEG,NDR,NDY,NNN64,ITCH,IDR1,1,C64,CC,CS,DEN)
C
		RETURN
	ENDIF
	ENDIF
C	
C 33333333333333333333333333333333333333333333333333333333333333333333333***
C 333333333333333333333333333333333333333333333333333333333333333333333333
C
C		TRANSFORMATION DU 3ME INDICE
C
		IF(IN1.EQ.3) THEN
C
	CALL FUCI3S(NDEG,NDR,NDY,NNN64,1,3,IDR,IND,CC,CS,C64,DEN)
C
	ENDIF
C
1000	FORMAT(1X,10E11.3)
1010	FORMAT(1X,' ')
2010	FORMAT(1X,20I5)
	RETURN
	END

