C HANN      SOURCE    OF166741  25/02/20    21:16:43     12165          
C HANN      SOURCE    ISPRA      90/02/22
      SUBROUTINE HANN
      IMPLICIT INTEGER(I-N)
      IMPLICIT  REAL*8(A-H,O-Z)
      CHARACTER *72 TI
      CHARACTER*12 MOTX,MOTY
      CHARACTER*2 CNH
C=======================================================================
C  =  CALCUL DE LA 'FENETRE' DE HANNING                               =
C  =                                                                  =
C  =  SYNTAXE :                                                       =
C  =                                                                  =
C  =    SPEC = HANN  EVO1 N (COUL);                                   =
C  =                                                                  =
C  =                                                                  =
C  =    EVO1    : OBJET DE TYPE EVOLUTIO CONTENANT LE SPECTRE A TRAITER=
C  =              ( UNE COURBE SEULEMENT )                            =
C  =    N       : NUMERO DE HANNING                                   =
C  =    COUL    : COULEUR ATTRIBUEE A L'OBJET CREE (FACULTATIF)       =
C  =              ( DEFAUT = COULEUR DU EVO1)                         =
C  =                                                                  =
C  =  CREATION    : 22/02/90                                          =
C  =  PROGRAMMEUR : A.P. ET P.P.                                      =
C=======================================================================
C
-INC CCGEOME

-INC PPARAM
-INC CCOPTIO
-INC SMEVOLL
-INC SMLREEL
C
      SEGMENT MTRAV1
          IMPLIED XX(NPOINT),YY(NPOINT)
      ENDSEGMENT
C
C     LECTURE DE L'OBJET EVOLUTIO CONTENANT LE SPECTRE
C
      CALL LIROBJ('EVOLUTIO',IPSIG,1,IRET2)
      IF(IRET2.EQ.0) RETURN
C
C     LECTURE DU NUMERO DE HANNING
C
      CALL LIRENT(NH,1,IRET1)
      IF(IRET1.EQ.0) RETURN
C
C     LECTURE DE LA COULEUR
C
      CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0)
      IF(icoul.eq.0) icoul=idcoul+1
      icoul=icoul-1
C
      IF(IERR.NE.0) RETURN
C
      MEVOL1=IPSIG
      SEGACT MEVOL1
      KEVOL1=MEVOL1.IEVOLL(1)
      SEGACT KEVOL1
C
      IF(ICOUL.EQ.0) ICOUL=KEVOL1.NUMEVX
      MOTX=KEVOL1.NOMEVX
      MOTY=KEVOL1.NOMEVY
C
      IF(NH.GT.99)THEN
        CNH='**'
      ELSE
        WRITE(CNH,'(I2)')NH
      ENDIF
      IF(NH.GT.9)THEN
        INH=1
      ELSE
        INH=2
      ENDIF
      TI='HANNING('//CNH(INH:2)//') '//MEVOL1.IEVTEX(1:59+INH)
C
      MLREE1=KEVOL1.IPROGX
      MLREE2=KEVOL1.IPROGY
      SEGACT MLREE1
      SEGACT MLREE2
C
      NPOINT=MLREE2.PROG(/1)
C
      SEGINI MTRAV1
C
C     CHARGEMENT DES TABLEAUX DE TRAVAIL
C
      DO 10 I=1,NPOINT
        XX(I)=MLREE2.PROG(I)
        YY(I)=MLREE1.PROG(I)
  10    CONTINUE
C
C     DUPLICATION DES ABSCICES
C
      SEGDES MLREE1
      JG=NPOINT
      SEGINI MLREE1
      DO 11 I=1,NPOINT
 11     MLREE1.PROG(I)=YY(I)
      SEGDES MLREE1
C
C     CALCUL DE LA FENETRE
C
      CALL HANNIN(NH,XX,NPOINT,YY)
      IF(IIMPI.EQ.1) WRITE(IOIMP,*)' CALCUL DE FENETRE '
C
      SEGDES MLREE2
C
C     CREATION ET CALCUL DES LISTES DE LA DSP
C
      JG=NPOINT
      SEGINI MLREE2
        DO 20 I=1,NPOINT
        MLREE2.PROG(I)=YY(I)
  20    CONTINUE
C
      SEGDES MLREE2
C
C     CREATION DE L'OBJET EVOLUTIO DSP
C
      N=1
      SEGINI MEVOLL
      IPVO=MEVOLL
      IEVTEX=TI
      ITYEVO='REEL'
      SEGINI KEVOLL
      KEVTEX=TI
      IEVOLL(1)=KEVOLL
      TYPX='LISTREEL'
      TYPY='LISTREEL'
C
      IPROGX=MLREE1
      NOMEVX=MOTX(1:12)
C
      IPROGY=MLREE2
      NOMEVY=MOTY(1:12)
C
      NUMEVX=ICOUL
      NUMEVY='REEL'
C
      SEGSUP MTRAV1
      SEGDES KEVOL1
      SEGDES MEVOL1
C
      SEGDES KEVOLL,MEVOLL
      CALL ECROBJ('EVOLUTIO',IPVO)
C
      RETURN
      END