Télécharger la plaquette Cast3M


fr en

Télécharger hann.eso

Retour à la liste

Numérotation des lignes : 

hann

  1. C HANN      SOURCE    BP208322  16/11/18    21:17:32     9177           
  2. C HANN      SOURCE    ISPRA      90/02/22
  3.       SUBROUTINE HANN
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT  REAL*8(A-H,O-Z)
  6.       CHARACTER *72 TI
  7.       CHARACTER*12 MOTX,MOTY
  8.       CHARACTER*2 CNH
  9. C=======================================================================
  10. C  =  CALCUL DE LA 'FENETRE' DE HANNING                               =
  11. C  =                                                                  =
  12. C  =  SYNTAXE :                                                       =
  13. C  =                                                                  =
  14. C  =    SPEC = HANN  EVO1 N (COUL);                                   =
  15. C  =                                                                  =
  16. C  =                                                                  =
  17. C  =    EVO1    : OBJET DE TYPE EVOLUTIO CONTENANT LE SPECTRE A TRAITER=
  18. C  =              ( UNE COURBE SEULEMENT )                            =
  19. C  =    N       : NUMERO DE HANNING                                   =
  20. C  =    COUL    : COULEUR ATTRIBUEE A L'OBJET CREE (FACULTATIF)       =
  21. C  =              ( DEFAUT = COULEUR DU EVO1)                         =
  22. C  =                                                                  =
  23. C  =  CREATION    : 22/02/90                                          =
  24. C  =  PROGRAMMEUR : A.P. ET P.P.                                      =
  25. C=======================================================================
  26. C
  27. -INC CCGEOME
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMEVOLL
  32. -INC SMLREEL
  33. C
  34.       SEGMENT MTRAV1
  35.           IMPLIED XX(NPOINT),YY(NPOINT)
  36.       ENDSEGMENT
  37. C
  38. C     LECTURE DE L'OBJET EVOLUTIO CONTENANT LE SPECTRE
  39. C
  40.       CALL LIROBJ('EVOLUTIO',IPSIG,1,IRET2)
  41.       IF(IRET2.EQ.0) RETURN
  42. C
  43. C     LECTURE DU NUMERO DE HANNING
  44. C
  45.       CALL LIRENT(NH,1,IRET1)
  46.       IF(IRET1.EQ.0) RETURN
  47. C
  48. C     LECTURE DE LA COULEUR
  49. C
  50.       CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0)
  51.       IF(icoul.eq.0) icoul=idcoul+1
  52.       icoul=icoul-1
  53. C
  54.       IF(IERR.NE.0) RETURN
  55. C
  56.       MEVOL1=IPSIG
  57.       SEGACT MEVOL1
  58.       KEVOL1=MEVOL1.IEVOLL(1)
  59.       SEGACT KEVOL1
  60. C
  61.       IF(ICOUL.EQ.0) ICOUL=KEVOL1.NUMEVX
  62.       MOTX=KEVOL1.NOMEVX
  63.       MOTY=KEVOL1.NOMEVY
  64. C
  65.       IF(NH.GT.99)THEN
  66.         CNH='**'
  67.       ELSE
  68.         WRITE(CNH,'(I2)')NH
  69.       ENDIF
  70.       IF(NH.GT.9)THEN
  71.         INH=1
  72.       ELSE
  73.         INH=2
  74.       ENDIF
  75.       TI='HANNING('//CNH(INH:2)//') '//MEVOL1.IEVTEX(1:59+INH)
  76. C
  77.       MLREE1=KEVOL1.IPROGX
  78.       MLREE2=KEVOL1.IPROGY
  79.       SEGACT MLREE1
  80.       SEGACT MLREE2
  81. C
  82.       NPOINT=MLREE2.PROG(/1)
  83. C
  84.       SEGINI MTRAV1
  85. C
  86. C     CHARGEMENT DES TABLEAUX DE TRAVAIL
  87. C
  88.       DO 10 I=1,NPOINT
  89.         XX(I)=MLREE2.PROG(I)
  90.         YY(I)=MLREE1.PROG(I)
  91.   10    CONTINUE
  92. C
  93. C     DUPLICATION DES ABSCICES
  94. C
  95.       SEGDES MLREE1
  96.       JG=NPOINT
  97.       SEGINI MLREE1
  98.       DO 11 I=1,NPOINT
  99.  11     MLREE1.PROG(I)=YY(I)
  100.       SEGDES MLREE1
  101. C
  102. C     CALCUL DE LA FENETRE
  103. C
  104.       CALL HANNIN(NH,XX,NPOINT,YY)
  105.       IF(IIMPI.EQ.1) WRITE(IOIMP,*)' CALCUL DE FENETRE '
  106. C
  107.       SEGDES MLREE2
  108. C
  109. C     CREATION ET CALCUL DES LISTES DE LA DSP
  110. C
  111.       JG=NPOINT
  112.       SEGINI MLREE2
  113.         DO 20 I=1,NPOINT
  114.         MLREE2.PROG(I)=YY(I)
  115.   20    CONTINUE
  116. C
  117.       SEGDES MLREE2
  118. C
  119. C     CREATION DE L'OBJET EVOLUTIO DSP
  120. C
  121.       N=1
  122.       SEGINI MEVOLL
  123.       IPVO=MEVOLL
  124.       IEVTEX=TI
  125.       ITYEVO='REEL'
  126.       SEGINI KEVOLL
  127.       KEVTEX=TI
  128.       IEVOLL(1)=KEVOLL
  129.       TYPX='LISTREEL'
  130.       TYPY='LISTREEL'
  131. C
  132.       IPROGX=MLREE1
  133.       NOMEVX=MOTX(1:12)
  134. C
  135.       IPROGY=MLREE2
  136.       NOMEVY=MOTY(1:12)
  137. C
  138.       NUMEVX=ICOUL
  139.       NUMEVY='REEL'
  140. C
  141.       SEGSUP MTRAV1
  142.       SEGDES KEVOL1
  143.       SEGDES MEVOL1
  144. C
  145.       SEGDES KEVOLL,MEVOLL
  146.       CALL ECROBJ('EVOLUTIO',IPVO)
  147. C
  148.       RETURN
  149.       END
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales