!------------------------------------------------------------------------
!		MODULES EXTERIEURS
!------------------------------------------------------------------------
!	Constantes de dimensionnement
	MODULE CONSTANTES
	    INTEGER,PARAMETER		:: NTASK=110	! Nb maximum de fichier
	    INTEGER,PARAMETER		:: NCA=160	! Longueur caracteres
	    INTEGER,PARAMETER		:: NTY=5	! Nb de type d'objet mes
							!(option,scalaire,
							!temps_egal,temps_inegal
							!,green)
	    INTEGER,PARAMETER		:: NCN=6	! Nb max de quantité
							! pour chaque type
							! =max(NOPT+1,NR(i))
	    INTEGER,SAVE		:: NBL		! Nb max de bloc
	    INTEGER,DIMENSION(NCN,NTY),SAVE	:: NTS	! Nb de fichier pour chq
							! objet mesure
	    INTEGER,DIMENSION(NTASK,NCN,NTY),SAVE	:: NTK	! Nb de mesures
								! pour chaque
								! fichier et chq
								! objet mesures
	    INTEGER,DIMENSION(NTASK),SAVE	:: NSM	! Ponderation fichiers
	END MODULE CONSTANTES
!----------------------------------------------------------------------------
!	Fichiers externes
	MODULE FICHIERS
	    USE CONSTANTES,ONLY: NCA
	    CHARACTER(LEN=NCA),PARAMETER	:: WORKDIR='/home/tremblay/calculs/david/stat2/ '
	    CHARACTER(LEN=NCA),PARAMETER	:: FICREF='tampin.dat '
	    CHARACTER(LEN=NCA),PARAMETER	:: FICREP='repert.dat '
	    CHARACTER(LEN=NCA),SAVE		:: FICMOY
	    CHARACTER(LEN=NCA),SAVE		:: FICIN	! Entree
	    CHARACTER(LEN=NCA),SAVE		:: FICGIOUT	! Green
	    CHARACTER(LEN=NCA),SAVE		:: FICPAOUT	! Sortie
	    CHARACTER(LEN=NCA),SAVE		:: FICCOV	! Covari
	    CHARACTER(LEN=NCA),SAVE		:: FICGTOUT	! idem, mais
	    CHARACTER(LEN=NCA),SAVE		:: FICPTOUT	! apres moyenne
	    CHARACTER(LEN=NCA),SAVE		:: FICTCOV
	END MODULE FICHIERS
!----------------------------------------------------------------------------
!	Parametres de simulation
	MODULE PARA_SIM
	    USE CONSTANTES,ONLY: NCN,NTY
	    TYPE PARAMETRE
	    	SEQUENCE
		REAL(8)				:: BETA,U,MU,REMPLD,TPAR,TPER,TPRM
		INTEGER				:: TRAN,N,M,NWARM,NMODUL
		INTEGER,DIMENSION(NTY-1)	:: NR
		INTEGER,DIMENSION(2)		:: ZETA
		INTEGER				:: NBLOC,NIMPRI,NOPT,NVEC
		INTEGER,DIMENSION(NCN,NTY)	:: MESC
		INTEGER,DIMENSION(500,2)	:: VEC
	    END TYPE PARAMETRE
	END MODULE PARA_SIM
!----------------------------------------------------------------------------
!	Mesure
	MODULE MESURES
	    USE CONSTANTES,ONLY:NCN,NCA,NTY
	    CHARACTER(LEN=NCA),DIMENSION(NCN,NTY),SAVE	:: MESUR !Nom des objets
								 !mesures
	    INTEGER,DIMENSION(2),SAVE			:: KOPT	!position de la
								!fct d'autocorr
								!et de la covar
								!parmi les optio
	END MODULE MESURES
!----------------------------------------------------------------------------
!	Identification
	MODULE IDENT
	    USE CONSTANTES,ONLY: NTASK,NCA
	    CHARACTER(LEN=NCA),SAVE			:: REPWEB
	    CHARACTER(LEN=NCA),SAVE			:: NANUM	! nom
	    CHARACTER(LEN=NCA),SAVE			:: PREFIX	! Prefix
	    CHARACTER(LEN=8),SAVE			:: DTE		! Date
	    CHARACTER(LEN=NCA),DIMENSION(NTASK),SAVE	:: SUFFIX	! Suffix
	    CHARACTER(LEN=8),DIMENSION(NTASK),SAVE	:: DTEA		! Date
	    CHARACTER(LEN=NCA),DIMENSION(NTASK),SAVE	:: CIDNUM	! Germe
	END MODULE IDENT
!----------------------------------------------------------------------------
!	Variables contenant les valeurs a moyenner
	MODULE VARIAB
	    USE CONSTANTES,ONLY: NTS,NBL
	    USE PARA_SIM
	    REAL(8),DIMENSION(:,:),ALLOCATABLE,SAVE		:: XSC,VSC
	    REAL(8),DIMENSION(:,:,:,:),ALLOCATABLE,SAVE		:: XTE,VTE
	    REAL(8),DIMENSION(:,:,:,:,:),ALLOCATABLE,SAVE	:: XTI,VTI
	    REAL(8),DIMENSION(:,:,:,:,:),ALLOCATABLE,SAVE	:: XTG,VTG
	    REAL(8),DIMENSION(:,:,:,:,:),ALLOCATABLE,SAVE	:: XCV
	    REAL(8),DIMENSION(:),ALLOCATABLE,SAVE		:: XCO
	    REAL(8),DIMENSION(:),ALLOCATABLE,SAVE		:: XMSC,VMSC
	    REAL(8),DIMENSION(:,:,:),ALLOCATABLE,SAVE		:: XMTE,VMTE
	    REAL(8),DIMENSION(:,:,:,:),ALLOCATABLE,SAVE		:: XMTI,VMTI
	    REAL(8),DIMENSION(:,:,:,:),ALLOCATABLE,SAVE		:: XMTG,VMTG
	    REAL(8),DIMENSION(:,:,:,:),ALLOCATABLE,SAVE		:: XMCV
	END MODULE VARIAB
!----------------------------------------------------------------------------
!	Autres variables
	MODULE VARIA2
	    USE CONSTANTES,ONLY: NTS
	    REAL(8),DIMENSION(:,:),ALLOCATABLE,SAVE	:: OX,VX
	    REAL(8),DIMENSION(:),ALLOCATABLE,SAVE	:: XMUPROP,SIGMOY,&
	        &FLUCT,TIMEX
	    REAL(8),DIMENSION(:,:),ALLOCATABLE,SAVE	:: COMP
	    REAL(8),DIMENSION(0:2),SAVE			:: OXM,VXM
	    REAL(8),SAVE				:: XMMUPROP,SIGMMOY,&
	        &FLUCTM,TIMEXM
	    REAL(8),DIMENSION(1:2),SAVE			:: COMPM
	END MODULE
!-----------------------------------------------------------------------------
!
	PROGRAM STATISTIQUE
!	******************************************************	
!	Fichier: stat.f, Executable: stat.out
!	Ce programme calcul des moyennes et des ecarts-types
!	des differentes quantites mesurees par le programme
!	de simulation Monte Carlo lors de differentes simulations.
!	Ces quantites sont regroupees en 5 groupes: les options,
!	les quantites scalaires, a temps egal (qx,qy), a temps
!	inegal (tau,qx,qy) et les fonctions de Green (tau,qx,qy,1:2)
!	Dans le groupe option on a place les quantites qui sont
!	toujours mesurees tel les fluctuations, le signe moyen,
!	le remplissage, le potentiel chimique, etc.
!	******************************************************
!	Derniere revision:	S Allen [ septembre 1998 ]

	USE CONSTANTES
	USE FICHIERS,ONLY: FICGTOUT,FICPTOUT,FICTCOV,FICMOY
	USE MESURES,ONLY: KOPT
	USE VARIAB
	USE VARIA2
	USE PARA_SIM
	IMPLICIT NONE
	INTEGER 			:: I,J,K,L,IL,KL,LL,JL,S
	TYPE(PARAMETRE) 		:: PARA

!	----------      LECTURE DES DONNEES       ------------
!	Cette section relit 1- Le nom des fichiers de donnees
!	dans le repertoire approprie, 2- la selection des mesures dans 
!	le fichier trnp.dat pour ensuite 3- lire les donnees
!	necessaires aux calculs statistiques dans les fichiers
!	diary.0...#.
	

	CALL LECTURE_PARA(PARA)
	CALL IDENTIFICATION(PARA)
	CALL LECTURE_DATA(PARA)

!	----------       CALCULS STATISTIQUES     ------------
!	Les calculs se font a l'aide des sous-routines 
!	MOYENNE_DATA, MOYENNE_DATA2 et ECART_TYPE_PONDERE. L'uni-
!	versalite de ces ss-routs. est obtenu en passant 
!	seulement des vecteurs de 16 elements en trocant les
!	matrices a l'aide du pointeur ':' (FORTRAN 90).

	CALL MOYENNE_DATA(NTS(1,NTY),NTK(1:NTS(1,NTY),1,NTY),XMUPROP(1:NTS(1,NTY)),XMMUPROP)

	DO I=1,2
	    CALL MOYENNE_DATA(NTS(1,NTY),NTK(1:NTS(1,NTY),1,NTY),COMP(1:NTS(1,NTY),I),COMPM(I))
	END DO

	CALL MOYENNE_DATA(NTS(1,NTY),NTK(1:NTS(1,NTY),1,NTY),SIGMOY(1:NTS(1,NTY)),SIGMMOY)

	CALL MOYENNE_DATA(NTS(1,NTY),NTK(1:NTS(1,NTY),1,NTY),FLUCT(1:NTS(1,NTY)),FLUCTM)

	DO I=0,2
	    CALL MOYENNE_DATA(NTS(1,NTY),NTK(1:NTS(1,NTY),1,NTY),OX(1:NTS(1,NTY),I),&
		&OXM(I))
	    CALL ECART_TYPE_PONDERE(NTS(1,NTY),NTK(1:NTS(1,NTY),1,NTY),OX(1:NTS(1,NTY)&
		&,I),VX(1:NTS(1,NTY),I),OXM(I),VXM(I))
	END DO

	DO L=1,PARA%NR(1)
	    IF(NTS(L,1).GT.0)THEN
		CALL MOYENNE_DATA(NTS(L,1),NTK(1:NTS(L,1),L,1),XSC(1:NTS(L,1),L),&
		    &XMSC(L))
	    ENDIF
	END DO

	DO L=1,PARA%NR(2)
	    IF(NTS(L,2).GT.0)THEN
	        DO S=1,PARA%NVEC
	            I=PARA%VEC(S,1)
	            J=PARA%VEC(S,2)
	            CALL MOYENNE_DATA(NTS(L,2),NTK(1:NTS(L,2),L,2),XTE(1:NTS(L,2),&
		        &I,J,L),XMTE(I,J,L))
	            CALL ECART_TYPE_PONDERE(NTS(L,2),NTK(1:NTS(L,2),L,2),XTE(&
		        &1:NTS(L,2),I,J,L),VTE(1:NTS(L,2),I,J,L),XMTE(I,J,L),&
		        &VMTE(I,J,L))
		END DO
	    ENDIF
	END DO

        DO L=1,PARA%NR(3)
	    IF(NTS(L,3).GT.0)THEN
	        DO S=1,PARA%NVEC
	            I=PARA%VEC(S,1)
	            J=PARA%VEC(S,2)
		    DO K=0, PARA%TRAN
		        CALL MOYENNE_DATA(NTS(L,3),NTK(1:NTS(L,3),L,3),XTI(1:NTS(&
		    	    &L,3),K,I,J,L),XMTI(K,I,J,L))
			CALL ECART_TYPE_PONDERE(NTS(L,3),NTK(1:NTS(L,3),L,3),&
			    &XTI(1:NTS(L,3),K,I,J,L),VTI(1:NTS(L,3),K,I,J,L),&
			    &XMTI(K,I,J,L),VMTI(K,I,J,L))
		    END DO
		END DO
	    ENDIF
	END DO

	DO L=1,PARA%NR(4)
	    IF(NTS(L,4).GT.0)THEN
		DO IL=1,2
		    JL=2*L-2+IL
		    DO S=1,PARA%NVEC
	            I=PARA%VEC(S,1)
	            J=PARA%VEC(S,2)
			DO K=0,PARA%TRAN
			    CALL MOYENNE_DATA(NTS(L,4),NTK(1:NTS(L,4),L,4),&
			        &XTG(1:NTS(L,4),K,I,J,JL),XMTG(K,I,J,JL))
			    CALL ECART_TYPE_PONDERE(NTS(L,4),NTK(1:NTS(L,4),L,4),&
			        &XTG(1:NTS(L,4),K,I,J,JL),VTG(1:NTS(L,4),K,I,J,JL)&
			        &,XMTG(K,I,J,JL),VMTG(K,I,J,JL))
			END DO
		    END DO
		END DO
	    ENDIF
	END DO

	IF(NTS(KOPT(1),NTY).GT.0)THEN
	    DO S=1,PARA%NVEC
	        I=PARA%VEC(S,1)
	        J=PARA%VEC(S,2)
	        DO K=1,PARA%TRAN
		    DO IL=1,PARA%TRAN
		        CALL MOYENNE_DATA3(NTS(KOPT(1),NTY),NTK(1:NTS(KOPT(1),NTY)&
			    &,KOPT(1),NTY),XTG(1:NTS(KOPT(1),NTY),IL,I,J,1),XTG(&
			    &1:NTS(KOPT(1),NTY),K,I,J,1),XCV(1:NTS(&
			    &KOPT(1),NTY),IL,K,I,J),XMCV(IL,K,I,J))
		    END DO
		END DO
	    END DO
	ENDIF

	TIMEXM=0
	DO I=1,NTS(1,NTY)
	   TIMEXM=TIMEXM+TIMEX(I)
	END DO

!	-------------       IMPRESSION         ---------------
!	Impression des resultats dans le fichier results.dat

	OPEN(UNIT=17,FILE=FICMOY,ACCESS='SEQUENTIAL',POSITION='APPEND')
	OPEN(UNIT=2,FILE=FICPTOUT,ACCESS='SEQUENTIAL',POSITION='REWIND',DELIM=&
	    &'APOSTROPHE')
	OPEN(UNIT=11,FILE=FICGTOUT,ACCESS='SEQUENTIAL',POSITION='REWIND',DELIM=&
	    &'APOSTROPHE')
	CALL SORTIE1(PARA)
	CALL SORTIE2(PARA)
	IF(PARA%ZETA(1).GT.0.OR.PARA%ZETA(2).GT.0)THEN
	    OPEN(UNIT=15,FILE=FICTCOV,ACCESS='SEQUENTIAL',POSITION='REWIND')
	    CALL SORTIEC(PARA)
	    CLOSE(15)
	ENDIF
	CALL SORTIEM(NTS(1,NTY))
	CLOSE(11)
	CLOSE(2)
	CLOSE(17)
	STOP
	END PROGRAM STATISTIQUE

!-------------------------------------------------------------------------
!		LECTURE_PARA
!
!	Cette sous-routine fait la lecture des parametres dans le fichier
!	FICIN
!
	SUBROUTINE LECTURE_PARA(PARA)
	USE CONSTANTES,ONLY:NCA
	USE FICHIERS,ONLY: FICREF,FICIN,WORKDIR
	USE PARA_SIM
	USE IDENT,ONLY: REPWEB,PREFIX
	IMPLICIT NONE
	CHARACTER(LEN=NCA)		:: FICSED,FICHSIN,FICWEB,TEMPO,NOM
	INTEGER				:: I1,I2,I,J,K
	TYPE(PARAMETRE)			:: PARA
	CHARACTER 			:: BUFFER
	
	I1=INDEX(WORKDIR,' ')-1
	I2=INDEX(FICREF,' ')-1
	NOM(1:I1+I2)=WORKDIR(1:I1)//FICREF(1:I2)
	OPEN(UNIT=13,FILE=NOM,STATUS='OLD',ACCESS='SEQUENTIAL',POSITION=&
	    &'REWIND',ERR=100)
	READ(13,*) TEMPO
	READ(13,*) PREFIX
	READ(13,*) FICSED
	READ(13,*) FICIN
	READ(13,*) FICHSIN
	READ(13,*) FICWEB
	READ(13,*) REPWEB
	CLOSE(UNIT=13)
	DO I=I1+1,I1+I2
	    NOM(I:I)=' '
	END DO
	I2=INDEX(FICIN,' ')-1
	NOM(I1+1:I1+I2)=FICIN(1:I2)
	OPEN(UNIT=3,FILE=NOM,STATUS='OLD',ACCESS='SEQUENTIAL',POSITION=&
	    &'REWIND',ERR=110)
	READ(3,*) PARA%BETA
	READ(3,*) PARA%TRAN
	READ(3,*) PARA%U
	READ(3,*) PARA%MU
	READ(3,*) PARA%REMPLD
	READ(3,*) PARA%TPAR
	READ(3,*) PARA%TPER
	READ(3,*) PARA%TPRM
	READ(3,*) PARA%N
	READ(3,*) PARA%M
	READ(3,*) PARA%NVEC
	READ(3,*) BUFFER
	DO I=1,PARA%NVEC
	   READ(3,*) PARA%VEC(I,1),PARA%VEC(I,2)
	END DO
	IF (PARA%NVEC==0) THEN
	   PARA%NVEC=PARA%N*PARA%M
	   DO I=1,PARA%N
	      DO J=1,PARA%M
	         K=I+(J-1)*PARA%M
	     END DO
	  END DO
	END IF
	CLOSE(UNIT=3)
	RETURN
100	WRITE(*,*) 'Ne peut ouvrir le fichier FICREF'; STOP
110	WRITE(*,*) 'Ne peut ouvrir le fichie FICIN'; STOP
	END SUBROUTINE LECTURE_PARA

!---------------------------------------------------------------------------
!
	SUBROUTINE IDENTIFICATION(PARA)
	USE CONSTANTES,ONLY: NTS,NTY
	USE FICHIERS
	USE IDENT
	USE PARA_SIM
	IMPLICIT NONE
	CHARACTER(LEN=10)			:: NUMTOASCII
	CHARACTER(LEN=NCA)			:: TP1,TP2,TP3,TP4,TP5
	CHARACTER(LEN=NCA)			:: NOMFICH,NOM
	INTEGER					:: I,I1,I2,I3,I4,I5,I6,I7
	INTEGER					:: IQ=0
	TYPE(PARAMETRE),INTENT(IN)		:: PARA
!
	NTS(1,NTY)=0
	I1=INDEX(WORKDIR,' ')-1
	I2=INDEX(FICREP,' ')-1
	NOM(1:I1+I2)=WORKDIR(1:I1)//FICREP(1:I2)
	NOM(I1+I2+1:NCA)=' '
        TP1=NUMTOASCII(INT(ABS(PARA%U)))
        TP2=NUMTOASCII(INT(ANINT(100*(PARA%REMPLD))))
        TP3=NUMTOASCII(PARA%N)
        TP4=NUMTOASCII(PARA%M)
        TP5=NUMTOASCII(INT(PARA%BETA))
        I1=INDEX(TP1,' ')
        I2=INDEX(TP2,' ')
        I3=INDEX(TP3,' ')
        I4=INDEX(TP4,' ')
        I5=INDEX(TP5,' ')
        I6=INDEX(PREFIX,' ')
	I7=I1+I2+I3+I4+I5+I6-3
        NANUM(1:I7+1)=PREFIX(1:I6-1)//TP1(1:I1-1)//TP2(1:I2-1)//&
	    &TP3(1:I3-1)//TP4(1:I4-1)//TP5(1:I5-1)//'re'//'. '
	OPEN(UNIT=3,FILE=NOM,STATUS='OLD',ACCESS='SEQUENTIAL',POSITION=&
	    &'REWIND',ERR=100)
	DO
	    NOMFICH(1:NCA)=' '
	    READ(3,*,IOSTAT=IQ) NOMFICH
	    IF(IQ.NE.0)THEN
		EXIT
	    ELSE
		I1=INDEX(NOMFICH,'.')
		IF(NANUM(1:I7).EQ.NOMFICH(I1+1:I7+I1))THEN
		    NTS(1,NTY)=NTS(1,NTY)+1
		    I3=INDEX(NOMFICH,' ')
		    I2=INDEX(NOMFICH(I1+1:I3),'.')+I1
		    CIDNUM(NTS(1,NTY))(1:I1)=NOMFICH(1:I1-1)//' '
		    SUFFIX(NTS(1,NTY))(1:I3-I2)=NOMFICH(I2+1:I3-1)//' '
		ENDIF
	    ENDIF
	END DO
	CLOSE(3)
	I6=INDEX(REPWEB,' ')-1
	FICMOY=REPWEB(1:I6)//'moy.'//NANUM(1:I7-3)//'.dat'
	FICGTOUT=REPWEB(1:I6)//'moy.'//NANUM(1:I7-3)//'gi.dat'
	FICPTOUT=REPWEB(1:I6)//'moy.'//NANUM(1:I7)//'dat'
	FICTCOV=REPWEB(1:I6)//'moy.'//NANUM(1:I7-3)//'cv.dat'
	RETURN
100	WRITE(*,*)'--- Erreur : Fichier FICREP inexistant ---',NOM; STOP
	END SUBROUTINE IDENTIFICATION

!------------------------------------------------------------------------------
!
        SUBROUTINE LECTURE_DATA(PARA)
        USE FICHIERS,ONLY: FICGIOUT,FICPAOUT,FICCOV
        USE CONSTANTES
	USE MESURES
        USE IDENT
        USE PARA_SIM
        USE VARIAB
        USE VARIA2
        IMPLICIT NONE
	INTEGER,PARAMETER			:: LO=21
	CHARACTER(LEN=LO),DIMENSION(2),PARAMETER:: NOMOPT=(/'Matrice de covariance','Fct autocorrelation  '/)
        CHARACTER(LEN=10)                       :: NUMTOASCII
        CHARACTER(LEN=NCA)                      :: LIGNE
	CHARACTER(LEN=NCA)			:: FICHIER
	CHARACTER(LEN=1)			:: YNMS,BUFFER
        REAL(8)                                 :: BETA,MU,U,TPAR,TPER,TPRM
        REAL(8)                                 :: REMPLD,EPS,TEMP
        INTEGER                                 :: LNWARM,N,M,TRAN,NVEC
        INTEGER,DIMENSION(500,2)		:: VEC
        TYPE(PARAMETRE),INTENT(INOUT)           :: PARA
        INTEGER,DIMENSION(NTASK+3)              :: IOS
        INTEGER,DIMENSION(NCN,NTY)		:: NS
	INTEGER,DIMENSION(NTY,NTASK)		:: NQM
	INTEGER,DIMENSION(NCN,NTY,NTASK)	:: NPOS
	INTEGER,DIMENSION(NTY-1)		:: NR
        INTEGER                                 :: I,J,K,L,KL,LK,IQ,S
        INTEGER                                 :: I1,I2,I3,I4,I5,NT,LT
        INTEGER                                 :: NUNIT,NUMY,MESC,NOPT
        
	EPS=(PARA%BETA/PARA%TRAN)**2
        NT=NTS(1,NTY)
        NTS=0
        NTK=0
	PARA%ZETA(:)=0
        PARA%NWARM=0
	PARA%MESC=0
	PARA%NOPT=1
        I1=INDEX(NANUM,' ')-1
        I2=INDEX(REPWEB,' ')-1
        DO I=1,NT
            DO J=1,NCA
                FICPAOUT(J:J)=' '
            END DO
            I3=INDEX(CIDNUM(I),' ')-1
            I4=INDEX(SUFFIX(I),' ')-1
            FICPAOUT(1:I1+I2+I3+I4+1)=REPWEB(1:I2)//CIDNUM(I)(1:I3)//'.'//&
                &NANUM(1:I1)//SUFFIX(I)(1:I4)
            NUNIT=10+I
            OPEN(UNIT=NUNIT,FILE=FICPAOUT,STATUS='OLD',ACCESS='SEQUENTIAL',&
                &POSITION='REWIND',DELIM='APOSTROPHE',IOSTAT=IOS(I))
            IF(IOS(I).GT.0)THEN
                WRITE(*,*)'Erreur : Ne peut ouvrir le fichier ',FICPAOUT
            ELSE
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) DTEA(NTS(1,NTY)+1)
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) BETA
                READ(NUNIT,*) TRAN
                READ(NUNIT,*) U
                READ(NUNIT,*) MU
                READ(NUNIT,*) REMPLD
                READ(NUNIT,*) TPAR
                READ(NUNIT,*) TPER
                READ(NUNIT,*) TPRM
                READ(NUNIT,*) N
                READ(NUNIT,*) M
                READ(NUNIT,*) NVEC
                READ(NUNIT,*) BUFFER
                DO K=1,NVEC
	           READ(NUNIT,*) VEC(K,1),VEC(K,2)
	        END DO
	        IF (NVEC==0) THEN
	           NVEC=N*M
	           DO K=1,N
	              DO J=1,M
	                 S=K+(J-1)*M
	                 VEC(S,1)=K
	                 VEC(S,2)=J
	              END DO
	           END DO
	        END IF
!       Verifier si les parametres sont bons
                IF((DABS(BETA-PARA%BETA).GT.EPS).OR.(TRAN.NE.PARA%TRAN).OR.(&
                    &DABS(U-PARA%U).GT.EPS).OR.(DABS(MU-PARA%MU).GT.EPS)&
                    &.OR.(DABS(TPAR-PARA%TPAR).GT.EPS).OR.(DABS(TPER-&
                    &PARA%TPER).GT.EPS).OR.(DABS(TPRM-PARA%TPRM).GT.EPS).OR.&
                    &(N.NE.PARA%N).OR.(M.NE.PARA%M).OR.(NVEC.NE.PARA%NVEC))THEN
                    IOS(I)=1
                ELSE
                    DO S=1,NVEC
                       IF((PARA%VEC(S,1).NE.VEC(S,1)).OR.(PARA%VEC(S,2).NE.VEC(S,2))) THEN
                          IOS(I)=1
                          GOTO 555
                       END IF
                    END DO
                    NTS(1,NTY)=NTS(1,NTY)+1
                    READ(NUNIT,*) NTK(NTS(1,NTY),1,NTY)
		    PARA%MESC(1,NTY)=PARA%MESC(1,NTY)+NTK(NTS(1,NTY),1,NTY)
                    READ(NUNIT,*) LNWARM
                    PARA%NWARM=MAX(PARA%NWARM,LNWARM)
                    READ(NUNIT,*) PARA%NMODUL
                    READ(NUNIT,*) PARA%NBLOC
                    READ(NUNIT,*) PARA%NIMPRI
                    READ(NUNIT,*) NOPT
		    LK=0
                    DO J=1,NOPT
			LIGNE(:)=' '
                        READ(NUNIT,*) YNMS,LIGNE
                        IF(YNMS.EQ.'Y'.OR.YNMS.EQ.'y')THEN
			    NQM(NTY,I)=NQM(NTY,I)+1
			    LK=LK+1
			    IQ=0
			    IF(PARA%NOPT.GT.1)THEN
				DO K=2,PARA%NOPT
				    IF(LIGNE.EQ.MESUR(K,NTY))THEN
					IQ=1
					NPOS(LK,NTY,I)=K
					NTS(K,NTY)=NTS(K,NTY)+1
					NTK(NTS(K,NTY),K,NTY)=NTK(NTS(1,NTY),1,NTY)
					EXIT
				    ENDIF
				END DO
			    ENDIF
			    IF(IQ.EQ.0)THEN
				PARA%NOPT=PARA%NOPT+1
				MESUR(PARA%NOPT,NTY)=LIGNE
				NPOS(LK,NTY,I)=PARA%NOPT
				NTS(PARA%NOPT,NTY)=1
			    ENDIF
                        ENDIF
                    END DO
		    DO L=1,NTY-1
                        READ(NUNIT,*) NR(L)
                    END DO
		    DO L=1,NTY-1
			LK=0
                	DO J=1,NR(L)
			    LIGNE(:)=' '
                            READ(NUNIT,*) YNMS,MESC,LIGNE
                            IF(YNMS.EQ.'Y'.OR.YNMS.EQ.'y')THEN
				NQM(L,I)=NQM(L,I)+1
				LK=LK+1
				IQ=0
				IF(PARA%NR(L).GT.0)THEN
				    DO K=1,PARA%NR(L)
					IF(LIGNE.EQ.MESUR(K,L))THEN
					    IQ=1
					    NPOS(LK,L,I)=K
					    NTS(K,L)=NTS(K,L)+1
					    NTK(NTS(K,L),K,L)=MESC
					    EXIT
					ENDIF
				    END DO
				ENDIF
				IF(IQ.EQ.0)THEN
				    PARA%NR(L)=PARA%NR(L)+1
				    MESUR(PARA%NR(L),L)=LIGNE
				    NPOS(LK,L,I)=PARA%NR(L)
				    NTS(PARA%NR(L),L)=1
				    NTK(NTS(PARA%NR(L),L),PARA%NR(L),L)=MESC
				ENDIF
                            ENDIF
			END DO
                    END DO
                ENDIF
555         CONTINUE
            ENDIF
        END DO
        ALLOCATE(OX(NTS(1,NTY),0:2),VX(NTS(1,NTY),0:2),COMP(NTS(1,NTY),1:2))
        ALLOCATE(XMUPROP(NTS(1,NTY)),SIGMOY(NTS(1,NTY)),FLUCT(NTS(1,NTY)),TIMEX(NTS(1,NTY)))
        IF(PARA%NR(1).GT.0)THEN
            LT=0
            DO I=1,PARA%NR(1)
                LT=MAX(LT,NTS(I,1))
            END DO
            ALLOCATE(XSC(LT,PARA%NR(1)),VSC(LT,PARA%NR(1)),XMSC(PARA%NR(1)),VMSC(PARA%NR(1)))
        ENDIF
        IF(PARA%NR(2).GT.0)THEN
            LT=0
            DO I=1,PARA%NR(2)
                LT=MAX(LT,NTS(I,2))
            END DO
            ALLOCATE(XTE(LT,PARA%N,PARA%M,PARA%NR(2)),VTE(LT,PARA%N,PARA%M,PARA%NR(2)))
            ALLOCATE(XMTE(PARA%N,PARA%M,PARA%NR(2)),VMTE(PARA%N,PARA%M,PARA%NR(2)))
        ENDIF
        IF(PARA%NR(3).GT.0)THEN
            LT=0
            DO I=1,PARA%NR(3)
                LT=MAX(LT,NTS(I,3))
            END DO
            ALLOCATE(XTI(LT,0:PARA%TRAN,PARA%N,PARA%M,PARA%NR(3)),VTI(LT,0:PARA%TRAN,&
                &PARA%N,PARA%M,PARA%NR(3)),XMTI(0:PARA%TRAN,PARA%N,PARA%M,PARA%NR(3)),VMTI(&
                &0:PARA%TRAN,PARA%N,PARA%M,PARA%NR(3)))
        ENDIF
        IF(PARA%NR(4).GT.0)THEN
            LT=0
            DO I=1,PARA%NR(4)
                LT=MAX(LT,NTS(I,4))
            END DO
            ALLOCATE(XTG(LT,0:PARA%TRAN,PARA%N,PARA%M,2*PARA%NR(4)),VTG(LT,0:PARA%TRAN&
                &,PARA%N,PARA%M,2*PARA%NR(4)),XMTG(0:PARA%TRAN,PARA%N,PARA%M,2*PARA%NR(4)),&
                &VMTG(0:PARA%TRAN,PARA%N,PARA%M,2*PARA%NR(4)))
        ENDIF
	L=0
	DO K=2,PARA%NOPT
	    I=LEN_TRIM(MESUR(K,NTY))
	    MESUR(K,NTY)(I+1:LO)=' '
	    SELECT CASE (MESUR(K,NTY)(1:LO))
	    CASE (NOMOPT(1))
		L=L+1
		KOPT(1)=K
		PARA%ZETA(1)=1
		ALLOCATE(XCV(NTS(K,NTY),PARA%TRAN,PARA%TRAN,PARA%N,PARA%M),&
		    &XMCV(PARA%TRAN,PARA%TRAN,PARA%N,PARA%M))
	    CASE (NOMOPT(2))
		L=L+1
		KOPT(2)=K
		PARA%ZETA(2)=1
		NBL=0
		DO I=1,NTS(K,NTY)
		    NBL=NBL+NTK(I,K,NTY)
		END DO
		ALLOCATE(XCO(NBL))
	    END SELECT
	    IF(L.EQ.2)THEN
		EXIT
	    ENDIF
	END DO
        NS=0
        DO I=1,NT
            FICGIOUT(:)=' '
            FICCOV(:)=' '
            NUNIT=10+I
            IF(IOS(I).LT.1)THEN
                NS(1,NTY)=NS(1,NTY)+1
                IF(NS(1,NTY).GT.NTS(1,NTY).OR.NS(1,NTY).GT.NTASK)THEN
                    WRITE(*,*) 'Manque espace alloue pour 1',ns(1,NTY),'>',nts(1,NTY)
                    STOP
                ENDIF
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) OX(NS(1,NTY),0),VX(NS(1,NTY),0)
                READ(NUNIT,*) XMUPROP(NS(1,NTY))
                READ(NUNIT,*) COMP(NS(1,NTY),1)
                READ(NUNIT,*) COMP(NS(1,NTY),2)
                READ(NUNIT,*) SIGMOY(NS(1,NTY))
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) OX(NS(1,NTY),1),VX(NS(1,NTY),1)
                READ(NUNIT,*) OX(NS(1,NTY),2),VX(NS(1,NTY),2)
                DO J=1,NQM(1,I)
                    NS(NPOS(J,1,I),1)=NS(NPOS(J,1,I),1)+1
                    IF(NS(NPOS(J,1,I),1).GT.NTS(NPOS(J,1,I),1))THEN
                        WRITE(*,*)'Manque espace alloue: ',ns(npos(j,1,i),1),nts(npos(j,1,i),1)
                        STOP
                    ENDIF
		    PARA%MESC(NPOS(J,1,I),1)=PARA%MESC(NPOS(J,1,I),1)+NTK(NS(NPOS(J,1,I),1),NPOS(J,1,I),1)
                    READ(NUNIT,*) XSC(NS(NPOS(J,1,I),1),NPOS(J,1,I))
                END DO
                READ(NUNIT,*) FLUCT(NS(1,NTY))
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) LIGNE
                DO J=1,NQM(2,I)
                    NS(NPOS(J,2,I),2)=NS(NPOS(J,2,I),2)+1
                    IF(NS(NPOS(J,2,I),2).GT.NTS(NPOS(J,2,I),2))THEN
                        WRITE(*,*)'Manque espace alloue: ',npos(j,2,i),ns(npos(j,2,i),2),nts(npos(j,2,i),2)
                        STOP
                    ENDIF
		    PARA%MESC(NPOS(J,2,I),2)=PARA%MESC(NPOS(J,2,I),2)+NTK(NS(NPOS(J,2,I),2),NPOS(J,2,I),2)
                    READ(NUNIT,*) LIGNE
                    READ(NUNIT,*) LIGNE
                    READ(NUNIT,*) LIGNE
                    DO S=1,NVEC
                        L=VEC(S,1)
                        K=VEC(S,2)
                        READ(NUNIT,*)NUMY,NUMY,XTE(NS(NPOS(J,2,I),2),L,K,NPOS(J,2,I)),&
                            &VTE(NS(NPOS(J,2,I),2),L,K,NPOS(J,2,I))
                    END DO
                END DO
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) LIGNE
                DO J=1,NQM(3,I)
                    NS(NPOS(J,3,I),3)=NS(NPOS(J,3,I),3)+1
                    IF(NS(NPOS(J,3,I),3).GT.NTS(NPOS(J,3,I),3))THEN
                        WRITE(*,*)'Manque espace alloue: ',NPOS(J,3,I),ns(npos(j,3,i),3),nts(npos(j,3,i),3)
                        STOP
                    ENDIF
		    PARA%MESC(NPOS(J,3,I),3)=PARA%MESC(NPOS(J,3,I),3)+NTK(NS(NPOS(J,3,I),3),NPOS(J,3,I),3)
                    READ(NUNIT,*) LIGNE
                    READ(NUNIT,*) LIGNE
                    READ(NUNIT,*) LIGNE
                    DO S=1,NVEC
                        L=VEC(S,1)
                        K=VEC(S,2)
                        DO KL=0,TRAN
                            READ(NUNIT,*)NUMY,NUMY,NUMY,XTI(NS(NPOS(J,3,I),3),KL,&
                                &L,K,NPOS(J,3,I)),VTI(NS(NPOS(J,3,I),3),KL,L,K,NPOS(J,3,I))
                        END DO
                    END DO
                END DO
                READ(NUNIT,*) LIGNE
                READ(NUNIT,*) TIMEX(NS(1,NTY))
                CLOSE(NUNIT)
                I3=INDEX(CIDNUM(I),' ')-1
                I4=INDEX(SUFFIX(I),' ')-1
                FICGIOUT(1:I1+I2+I3+I4+1)=REPWEB(1:I2)//CIDNUM(I)(1:I3)//'.'//&
                    &NANUM(1:I1-3)//'gi.'//SUFFIX(I)(1:I4)
                OPEN(UNIT=9,FILE=FICGIOUT,STATUS='OLD',ACCESS='SEQUENTIAL',&
                    &POSITION='REWIND',DELIM='APOSTROPHE',IOSTAT=IOS(NTASK+1))
                IF(IOS(NTASK+1).GT.0)THEN
                    WRITE(*,*)'Erreur : Ne peut ouvrir le fichier ',FICGIOUT
                ELSE
		    READ(9,*) LIGNE
		    READ(9,*) NUMY
		    READ(9,*) NUMY
		    READ(9,*) LIGNE
                    DO J=1,NQM(4,I)
                        NS(NPOS(J,4,I),4)=NS(NPOS(J,4,I),4)+1
                        IF(NS(NPOS(J,4,I),4).GT.NTS(NPOS(J,4,I),4))THEN
                            WRITE(*,*)'Manque espace alloue: ',NPOS(j,4,i),ns(npos(j,4,i),4),nts(npos(j,4,i),4)
                            STOP
                        ENDIF
			PARA%MESC(NPOS(J,4,I),4)=PARA%MESC(NPOS(J,4,I),4)+NTK(NS(NPOS(J,4,I),4),NPOS(J,4,I),4)
                        READ(9,*) LIGNE
                        READ(9,*) LIGNE
                        DO LK=1,2
                            READ(9,*) LIGNE
                            READ(9,*) LIGNE
                            READ(9,*) LIGNE
                            DO S=1,NVEC
                                L=VEC(S,1)
                                K=VEC(S,2)
                                DO KL=0,TRAN
                                    READ(9,*)NUMY,NUMY,NUMY,XTG(NS(NPOS(J,4,I),4),&
                                        &KL,L,K,2*(NPOS(J,4,I)-1)+LK),VTG(NS(NPOS(J,4,I),4)&
                                        &,KL,L,K,2*(NPOS(J,4,I)-1)+LK)
                                END DO
                            END DO
                        END DO
                    END DO
                    CLOSE(9)
                ENDIF
                IF(PARA%ZETA(1).GT.0.OR.PARA%ZETA(2).GT.0)THEN
		    DO J=1,PARA%NOPT-1
			IF(NPOS(J,NTY,I).EQ.KOPT(1))THEN
			    PARA%ZETA(1)=2
			ELSE IF(NPOS(J,NTY,I).EQ.KOPT(2))THEN
			    PARA%ZETA(2)=2
			ENDIF
		    END DO
		ENDIF
		IF(PARA%ZETA(1).GT.1.OR.PARA%ZETA(2).GT.1)THEN
                    FICCOV(1:I1+I2+I3+I4+1)=REPWEB(1:I2)//CIDNUM(I)(1:I3)//'.'&
                        &//NANUM(1:I1-3)//'cv.'//SUFFIX(I)(1:I4)
                    OPEN(UNIT=10,FILE=FICCOV,POSITION='REWIND',STATUS='OLD',&
                        &ACCESS='SEQUENTIAL',IOSTAT=IOS(NTASK+2))
                    IF(IOS(NTASK+2).GT.0)THEN
                        WRITE(*,*)'Erreur : Ne peut ouvrir le fichier ',FICCOV
                    ELSE
                        READ(10,*) NUMY
                        READ(10,*) NUMY
                        IF(PARA%ZETA(1).GT.1)THEN
                            NS(KOPT(1),NTY)=NS(KOPT(1),NTY)+1
			    PARA%MESC(KOPT(1),NTY)=PARA%MESC(KOPT(1),NTY)+NTK(NS(KOPT(1),NTY),KOPT(1),NTY)
                            IF(NS(KOPT(1),NTY).GT.NTS(KOPT(1),NTY))THEN
                                WRITE(*,*)'Il y a pas assez espace alloue: COV'
                                STOP
                            ENDIF
                            READ(10,*) LIGNE
                            READ(10,*) NUMY
                            READ(10,*) LIGNE
                            DO S=1,NVEC
                                L=VEC(S,1)
                                K=VEC(S,2)
                                DO J=1,TRAN
                                    DO KL=1,TRAN
                                        READ(10,*)NUMY,NUMY,NUMY,NUMY,XCV(&
                                            &NS(KOPT(1),NTY),KL,J,L,K)
                                    END DO
                                END DO
                            END DO
			    PARA%ZETA(1)=1
                        ENDIF
                        IF(PARA%ZETA(2).GT.1)THEN
                            NS(KOPT(2),NTY)=NS(KOPT(2),NTY)+1
                            IF(NS(KOPT(2),NTY).GT.NTS(KOPT(2),NTY))THEN
                                WRITE(*,*)'Il y a pas assez espace alloue: CORREL'
                                STOP
                            ENDIF
                            READ(10,*) LIGNE
                            READ(10,*) NTK(NS(KOPT(2),NTY),KOPT(2),NTY)
                            KL=0
                            CONTENU_FICH: DO
                                READ(10,*) LIGNE
                                DO J=1,NTK(NS(KOPT(2),NTY),KOPT(2),NTY)
                                    PARA%MESC(KOPT(2),NTY)=PARA%MESC(KOPT(2),NTY)+1
                                    READ(10,20) NUMY,XCO(PARA%MESC(KOPT(2),NTY))
                                END DO
                                NS(KOPT(2),NTY)=NS(KOPT(2),NTY)+1
                                READ(10,*,IOSTAT=KL) NTK(NS(KOPT(2),NTY),KOPT(2),NTY)
                                IF(KL.NE.0)THEN
                                    NS(KOPT(2),NTY)=NS(KOPT(2),NTY)-1
                                    EXIT CONTENU_FICH
                                ENDIF
                            END DO CONTENU_FICH
			    PARA%ZETA(2)=1
                        ENDIF
                        CLOSE(10)
                    ENDIF
                ENDIF
            ENDIF
	    IF(CIDNUM(I)(1:3).EQ.'moy')THEN
		FICHIER(1:NCA)=' '
		FICHIER=REPWEB(1:I2)//CIDNUM(I)(1:I3)//'.'//NANUM(1:I1-3)//'.'&
		    &//SUFFIX(I)(1:I4)
		OPEN(UNIT=17,FILE=FICHIER,POSITION='REWIND',STATUS='OLD',&
		    &IOSTAT=IOS(NTASK+3))
		IF(IOS(NTASK+3).GT.0)THEN
		    WRITE(*,*)'Erreur ne peut ouvrir le fichier ',FICHIER
		ELSE
		    NSM(I)=0
		    DO
			READ(17,*,IOSTAT=IOS(NTASK+3)) LIGNE
			IF(IOS(NTASK+3).NE.0)THEN
			    EXIT
			ELSE
			    IF(LIGNE(1:2).NE.'NO')THEN
				NSM(I)=NSM(I)+1
			    ENDIF
			ENDIF
		    END DO
		ENDIF
		CLOSE(17)
	    ELSE
		NSM(I)=1
	    ENDIF
        END DO
20      FORMAT(I5,E16.4)
        END SUBROUTINE LECTURE_DATA
!------------------------------------------------------------------------------
!	Sous-routines d'impression
	SUBROUTINE SORTIE1(PARA)
	USE CONSTANTES,ONLY: NCN
	USE PARA_SIM
	USE MESURES
	USE IDENT
	USE VARIAB,ONLY: XMSC
	USE VARIA2
	IMPLICIT NONE
	CHARACTER(8)					:: DATE
	INTEGER						:: I1,I,J,S
	REAL(8)						:: TEMP
	TYPE(PARAMETRE),INTENT(IN)			:: PARA

	I1=INDEX(NANUM,' ')
	NANUM(I1-3:I1-1)='  '
	DTE=DATE()
!       Sortie des parametres et resultats au fichier (UNIT=2)
        WRITE(2,*) '------------------------------------------------------------'
        WRITE(2,*)  DTE,		'Date mm/dd/yy'
	I=0
        WRITE(2,*)  I,		'No. simulation'
        WRITE(2,*)  NANUM,		'Prefixe fichier'
        WRITE(2,*) ' '
        WRITE(2,*) 'Parametres de simulation'
        WRITE(2,*) ' '
        WRITE(2,17) PARA%BETA,          'BETA'
        WRITE(2,15) PARA%TRAN,          'TRAN'
        WRITE(2,17) PARA%U,             'U'
        WRITE(2,17) PARA%MU,            'MU'
        WRITE(2,17) PARA%REMPLD,        'Remplissage desire'
        WRITE(2,17) PARA%TPAR,          'TPAR'
        WRITE(2,17) PARA%TPER,          'TPER'
        WRITE(2,17) PARA%TPRM,          'TPRM'
        WRITE(2,15) PARA%N,             'Nombre de sites par chaine N'
        WRITE(2,15) PARA%M,             'Nombre de chaines M'
        WRITE(2,15) PARA%NVEC
        WRITE(2,*) 'Kx        KY'
        DO S=1,PARA%NVEC
            WRITE(2,16) PARA%VEC(S,1),PARA%VEC(S,2)
        END DO
        WRITE(2,15) PARA%MESC(1,NTY),   'Nombre total de mesures'
        WRITE(2,15) PARA%NWARM,         'Nombre de rechauffement'
        WRITE(2,15) PARA%NMODUL,        'NMODUL: Nb de tranche de stabilisation'
        WRITE(2,15) PARA%NBLOC,         'Nombre de mesures dans un bloc'
        WRITE(2,15) PARA%NIMPRI,        'Borne impression'
        WRITE(2,15) PARA%NOPT-1,        'Nombre option de calcul'
	DO I=2,PARA%NOPT
            WRITE(2,13,ADVANCE='NO')	'y'
	    I1=LEN_TRIM(MESUR(I,NTY))
	    WRITE(2,*)			MESUR(I,NTY)(1:I1)
	END DO
        WRITE(2,15) PARA%NR(1),           'Nombre de routines scalaire'
        WRITE(2,15) PARA%NR(2),           'Nombre de routines temps egal'
        WRITE(2,15) PARA%NR(3),           'Nombre de routines temps inegal'
        WRITE(2,15) PARA%NR(4),           'Nombre de routines fct de Green'
        DO I=1,NTY-1
	    DO J=1,PARA%NR(I)
		WRITE(2,14,ADVANCE='NO')	'y',PARA%MESC(J,I)
		I1=LEN_TRIM(MESUR(J,I))
		WRITE(2,*)			MESUR(J,I)(1:I1)
	    END DO
        END DO
        WRITE(2,*) ' '
        WRITE(2,*) 'Parametres de la bande'
        WRITE(2,*) ' '
        WRITE(2,20) OXM(0),VXM(0),	'Remplissage mesure'
        WRITE(2,21) XMMUPROP,		'Mu propose'
        WRITE(2,21) COMPM(1),		'Proportion de spin-flip accepte'
        WRITE(2,21) COMPM(2),		'Proportion de global move accepte'
        WRITE(2,21) SIGMMOY,		'Signe moyen du produit des det.'
        WRITE(2,*) ' '
        WRITE(2,20) OXM(1),VXM(1),	'Energie cinetique'
        WRITE(2,20) OXM(2),VXM(2),	'Energie totale'
	TEMP=0.
	IF(PARA%MESC(1,1).GT.0)THEN
            WRITE(2,21) XMSC(1),	'Energie des electrons libres'
	ENDIF
        WRITE(2,21) FLUCTM,		'Fluctuation du nombre de particules'
!
!       Format d'impression
13      FORMAT(A2,2X)
14      FORMAT(A2,2X,I6,2X)
15      FORMAT(I10,2x,A)
16	FORMAT(I3,7X,I3)
17      FORMAT(F10.6,2x,A)
20      FORMAT(F10.7,1x,F10.7,2x,A)
21      FORMAT(F12.6,2x,A)
!
        END SUBROUTINE SORTIE1
!---------------------------------------------------------------------------
	SUBROUTINE SORTIE2(PARA)
	USE CONSTANTES,ONLY: NCN
	USE PARA_SIM
	USE MESURES
	USE VARIAB
	USE VARIA2, ONLY: TIMEXM
	USE PARA_SIM
	IMPLICIT NONE
	INTEGER						:: I,J,K,L,L1,L2,I1,S
	TYPE(PARAMETRE),INTENT(IN)			:: PARA
!
!
        WRITE(2,*) ' '
        WRITE(2,*) 'Quantites a temps egal'
        WRITE(2,*) ' '
	DO L=1,PARA%NR(2)
	    I1=LEN_TRIM(MESUR(L,2))
            WRITE(2,*) MESUR(L,2)(1:I1)
            WRITE(2,*) 'qx    qy      x         err(x)'
            WRITE(2,*) ' '
	    DO S=1,PARA%NVEC
	        J=PARA%VEC(S,1)
	        I=PARA%VEC(S,2)
		WRITE(2,20)I,J,XMTE(J,I,L),VMTE(J,I,L)
	    END DO
        END DO
        WRITE(2,*) 'Quantites a temps inegal'
        WRITE(2,*) ' '
	DO L=1,PARA%NR(3)
	    I1=LEN_TRIM(MESUR(L,3))
            WRITE(2,*) MESUR(L,3)(1:I1)
            WRITE(2,*) ' qx  qy  tau     X            err'
            WRITE(2,*) ' '
	    DO S=1,PARA%NVEC
	        J=PARA%VEC(S,1)
	        I=PARA%VEC(S,2)
		DO K=0,PARA%TRAN
		    WRITE(2,21)I,J,K,XMTI(K,J,I,L),VMTI(K,J,I,L)
		END DO
	    END DO
        END DO
	WRITE(2,*) ' '
	WRITE(2,*) TIMEXM
!
        WRITE(11,*) '----------------------------------------------------------'
        WRITE(11,FMT='(A,2x,A)') '0',             'No. simulation'
        WRITE(11,*) PARA%MESC(1,4),            'Nb mesures effectuees'
        WRITE(11,*) ' '
	DO L=1,PARA%NR(4)
	    L1=2*L-1
	    L2=2*L
	    I1=LEN_TRIM(MESUR(L,4))
            WRITE(11,*) ' '
            WRITE(11,*) MESUR(L,4)(1:I1)
            WRITE(11,*) ' '
            WRITE(11,*) 'PREMIERE COMPOSANTE (Spin-up ou Reel)'
            WRITE(11,*) ' qx  qy  tau     G            err'
	    DO S=1,PARA%NVEC
	        J=PARA%VEC(S,1)
	        I=PARA%VEC(S,2)
		DO K=0,PARA%TRAN
		    WRITE(11,21)I,J,K,XMTG(K,J,I,L1),VMTG(K,J,I,L1)
		END DO
	    END DO
            WRITE(11,*) ' '
            WRITE(11,*) 'DEUXIEME COMPOSANTE (Spin-down ou imaginaire)'
            WRITE(11,*) ' qx  qy  tau     G            err'
	    DO S=1,PARA%NVEC
	        J=PARA%VEC(S,1)
	        I=PARA%VEC(S,2)
		DO K=0,PARA%TRAN
		    WRITE(11,21)I,J,K,XMTG(K,J,I,L2),VMTG(K,J,I,L2)
		END DO
	    END DO
        END DO
        WRITE(11,*) ' '
20	FORMAT(2I4,3x,2F13.6)
21      FORMAT(2I4,I6,3x,2F13.6)
!
!
        END SUBROUTINE SORTIE2
!---------------------------------------------------------------------------
!
	SUBROUTINE SORTIEC(PARA)
	USE CONSTANTES,ONLY: NTK,NTS,NTY
	USE PARA_SIM
	USE MESURES
	USE VARIAB,ONLY: XCV,XMCV,XCO
	IMPLICIT NONE
	INTEGER					:: I,J,K,L,S
	TYPE(PARAMETRE),INTENT(IN)		:: PARA
	WRITE(15,FMT='(A)') '0'
	WRITE(15,*) PARA%MESC(KOPT(1),NTY)
	WRITE(15,*) ' '
	IF(PARA%ZETA(1).GT.0)THEN
	    WRITE(15,*) 'Matrice de covariance spin-up'
	    WRITE(15,*) ' '
	    WRITE(15,*) PARA%MESC(KOPT(1),NTY)/PARA%NBLOC
	    WRITE(15,*) ' '
	    WRITE(15,*) ' qx   qy    tau1   tau2          C'
	    DO S=1,PARA%NVEC
	        J=PARA%VEC(S,1)
	        I=PARA%VEC(S,2)
		DO K=1,PARA%TRAN
		    DO L=1,PARA%TRAN
		        WRITE(15,10) I,J,K,L,XMCV(L,K,J,I)
		    END DO
		END DO
	    END DO
	ENDIF
	IF(PARA%ZETA(2).GT.0)THEN
	    WRITE(15,*) 'FONCTION autocorrelation'
	    K=0
	    DO I=1,NTS(KOPT(2),NTY)
		WRITE(15,*) ' '
		WRITE(15,*) NTK(I,KOPT(2),NTY),         'Nb blocs'
		WRITE(15,*) ' '
		WRITE(15,*) ' n         C(n)'
		DO J=1,NTK(I,KOPT(2),NTY)
		    K=K+1
		    WRITE(15,20) J-1,XCO(K)
		END DO
	    END DO
	ENDIF
10	FORMAT(2(I4,1X),2(I6,1X),E14.4)
20	FORMAT(I4,1X,E14.4)
	END SUBROUTINE SORTIEC
!
!---------------------------------------------------------------------------
!
	SUBROUTINE SORTIEM(NT)
	USE IDENT,ONLY: CIDNUM,DTEA
	IMPLICIT NONE
	INTEGER						:: I,I1,IDNUM
	INTEGER,INTENT(IN)				:: NT
	REAL(8)						:: ASCIITONUM
!
	WRITE(17,*) 'NO de simulation     date'
	DO I=1,NT
	    IF(CIDNUM(I)(1:3).NE.'moy')THEN
		I1=INDEX(CIDNUM(I),' ')
		IDNUM=NINT(ASCIITONUM(CIDNUM(I)(1:I1-1)))
		WRITE(17,90) IDNUM,DTEA(I)
	    END IF
	END DO
90	FORMAT(I9,2X,'',A8,'')
	END SUBROUTINE SORTIEM
!---------------------------------------------------------------------------
!
!
	SUBROUTINE MOYENNE_DATA(NUMTASK,NMES,X,MOY)
	INTEGER,INTENT(IN)			:: NUMTASK
	INTEGER,INTENT(IN),DIMENSION(NUMTASK)	:: NMES
	REAL(8),INTENT(IN),DIMENSION(NUMTASK)	:: X
	REAL(8),INTENT(OUT)			:: MOY
	INTEGER					:: I,NMT
	MOY=0.
	NMT=0
	DO I=1,NUMTASK
	    MOY=MOY+X(I)*NMES(I)
	    NMT=NMT+NMES(I)
	END DO
	MOY=MOY/NMT
	END SUBROUTINE MOYENNE_DATA

        SUBROUTINE MOYENNE_DATA3(NUMTASK,NMES,X1,X2,X,MOY)
	IMPLICIT NONE
        INTEGER,INTENT(IN)                      :: NUMTASK
        INTEGER,INTENT(IN),DIMENSION(NUMTASK)   :: NMES
        REAL(8),INTENT(IN),DIMENSION(NUMTASK)   :: X,X1,X2
        REAL(8),INTENT(OUT)                     :: MOY
	REAL(8)					:: MOY1,MOY2
        INTEGER                                 :: I,NMT
        NMT=0
	DO I=1,NUMTASK
	    NMT=NMT+NMES(I)
	    MOY1=MOY1+X1(I)*NMES(I)
	    MOY2=MOY2+X2(I)*NMES(I)
	END DO
	MOY1=MOY1/NMT
	MOY2=MOY2/NMT
        MOY=0.
        DO I=1,NUMTASK
            MOY=MOY+NMES(I)*(NMES(I)-1)*X(I)+NMES(I)*(X1(I)*X2(I)-X1(I)*MOY2-&
		&MOY1*X2(I)+MOY1*MOY2)
        END DO
        MOY=MOY/(NMT*(NMT-1))
        END SUBROUTINE MOYENNE_DATA3

	SUBROUTINE ECART_TYPE_PONDERE(NUMTASK,NMES,X,SIG,MOY,VAR)
	IMPLICIT NONE
	INTEGER,INTENT(IN)			:: NUMTASK
	INTEGER,INTENT(IN),DIMENSION(NUMTASK)	:: NMES
	REAL(8),INTENT(IN),DIMENSION(NUMTASK)	:: X,SIG
	REAL(8),INTENT(IN)			:: MOY
	REAL(8),INTENT(OUT)			:: VAR
	INTEGER					:: I,NMT
	VAR=0.
	NMT=0
	DO I=1, NUMTASK
	   NMT=NMT+NMES(I)
	   VAR=VAR+(X(I)-MOY)**2*NMES(I)+SIG(I)*SIG(I)*(NMES(I)-1)
	END DO
	VAR=SQRT(VAR/(NMT-1))
	END SUBROUTINE ECART_TYPE_PONDERE
	

!	----------       FONCTION NUMTOASCII        ----------
!	Fonction servant a creer des suffixes numeraux a 
!	partir de la liste ascii de 0 a 9.
!	Cf. Christian Foisy (1996)

	CHARACTER(LEN=10) FUNCTION NUMTOASCII(I)
	IMPLICIT NONE
	CHARACTER(LEN=10) 				:: TMP
	INTEGER						:: J,K
	INTEGER,INTENT(IN)				:: I
	
	J=I
	K=1
	NUMTOASCII(1:10)='           '
	TMP=NUMTOASCII
	DO WHILE (J.GT.0.OR.K.EQ.1)
	   TMP(K:K)=CHAR(ICHAR('0')+MOD(J,10))
	   K=K+1
	   J=J/10
	END DO
	
	J=INDEX(TMP,' ')
	DO K=1, J-1
	   NUMTOASCII(K:K)=TMP(J-K:J-K)
	END DO
	
	END FUNCTION NUMTOASCII       

	REAL(8) FUNCTION ASCIITONUM(CARACT)
	IMPLICIT NONE
	CHARACTER(LEN=*),INTENT(IN)			:: CARACT
	INTEGER						:: I,J,L,K,NUM
!
	K=0
	NUM=0
	I=INDEX(CARACT,'.')
	DO
	    K=K+1
	    IF(CARACT(K:K).NE.' ') EXIT
	END DO
	J=INDEX(CARACT(K:),' ')
	IF(J.EQ.0)THEN
	    J=LEN(CARACT)+1
	ENDIF
	IF(I.EQ.0)THEN
	    I=J
	ENDIF
	DO L=K,I-1
	    NUM=NUM+10**(I-L-1)*(IACHAR(CARACT(L:L))-48)
	END DO
	ASCIITONUM=REAL(NUM)
	DO L=I+1,J-1
	    ASCIITONUM=ASCIITONUM+10.**(I-L)*(IACHAR(CARACT(L:L))-48)
	ENDDO

	END FUNCTION ASCIITONUM
!	------------------------------------------------------
!	------------------------------------------------------





