Télécharger ampint.eso

Retour à la liste

Numérotation des lignes :

  1. C AMPINT SOURCE CB215821 17/03/03 21:15:00 9330
  2. C Changement interactif (dans la fenetre de trace) de l'amplification
  3. C d'une deformee lors de son trace
  4. C L'appel est fait par PRTRAC
  5. C
  6. C NDEF (E) : nombre de deformees du trace
  7. C SDEF (E/S) : SEGMENT contenant les amplitudes imposees par l'utilisateur
  8. C en interactif
  9. C IIMP (S) : numero de la deformee dont on souhaite modifier
  10. C l'amplification
  11. C
  12. SUBROUTINE AMPINT(NDEF,VCHC,IPDEF,IIMP)
  13. IMPLICIT INTEGER(I-N)
  14. -INC CCOPTIO
  15. -INC SMTEXTE
  16. REAL X(5),Y(5),VCHC(70)
  17. REAL*8 AMPLLU
  18. CHARACTER*8 TEXT,LEGEND(7)
  19. CHARACTER*2 TEXT1
  20. LOGICAL ZOK
  21.  
  22. SEGMENT SDEF
  23. REAL AMPIMP(NDEF)
  24. ENDSEGMENT
  25.  
  26. SDEF=IPDEF
  27. NDEF=AMPIMP(/1)
  28.  
  29. C-----------------------------------------------------------------------
  30. C PARTIE 1 : CHOIX DU NUMERO DE LA DEFORMEE --> IIMP
  31. C-----------------------------------------------------------------------
  32. C
  33. C Si plusieurs deformees, on affiche un menu de choix interactif du
  34. C numero de la deformee a modifier
  35. IF (NDEF.GT.1) THEN
  36. 200 CONTINUE
  37. LEGEND(1)=' Saisie'
  38. DO I=1,6
  39. IF (I.LE.NDEF) THEN
  40. WRITE(LEGEND(I+1),fmt='(i5)') I
  41. ELSE
  42. LEGEND(I+1)=' '
  43. ENDIF
  44. ENDDO
  45. CALL TRMESS('Choisissez le numero de la deformee')
  46. CALL MENU(LEGEND,7,8)
  47. CALL TRDIG(XP,YP,INCLE)
  48. ICLE=INCLE+1
  49. C Cas ICLE = 1 : bouton Saisie, acquisition au clavier
  50. IF (ICLE.EQ.1) THEN
  51. ZOK=.TRUE.
  52. WRITE (TEXT1,'(i2)') NDEF
  53. 300 CONTINUE
  54. IF (ZOK) THEN
  55. CALL TRGET('Saisissez le numero de la deformee '//
  56. & '(entre 1 et '//TEXT1//') : ',TEXT)
  57. ELSE
  58. CALL TRGET('Erreur ! Saisissez a nouveau le numero de '//
  59. & ' la deformee (entre 1 et '//TEXT1//') : ',TEXT)
  60. ENDIF
  61. SEGINI MTEXTE
  62. MTEXT=TEXT
  63. NCART=8
  64. CALL ECROBJ('TEXTE',MTEXTE)
  65. CALL LIRENT(IIMP,0,IRETOU)
  66. SEGSUP MTEXTE
  67. C Cas ou le numero acquis est hors des bornes (1,NDEF)
  68. IF ((IIMP.LT.1).OR.(IIMP.GT.NDEF)) THEN
  69. ZOK=.FALSE.
  70. GOTO 300
  71. ENDIF
  72. C Cas ICLE = 2,3,4,5,6,7 : boutons avec numeros proposes par defaut
  73. ELSEIF ((ICLE.GE.2).AND.(ICLE.LE.7)) THEN
  74. IF (ICLE.GT.(NDEF+1)) GOTO 200
  75. IIMP=ICLE-1
  76. C Autres cas : retour au debut du menu
  77. ELSE
  78. GOTO 200
  79. ENDIF
  80. C Si l'on a une seule deformee, elle est toute trouvee !
  81. ELSE
  82. IIMP=1
  83. ENDIF
  84. C
  85. C-----------------------------------------------------------------------
  86. C PARTIE 2 : CHOIX DE LA VALEUR DE L'AMPLIFICATION --> AMPIMP(IIMP)
  87. C-----------------------------------------------------------------------
  88. C
  89. C Menu pour le choix de la nouvelle amplification
  90. 400 CONTINUE
  91. LEGEND(1)=' Ok '
  92. LEGEND(2)=' Saisie'
  93. C On propose 5 valeurs d'amplification automatiquement
  94. DO I=1,5
  95. XAMP = AMPIMP(IIMP)*(2.**(i-3))
  96. WRITE(LEGEND(I+2),fmt='(1pe8.2)') XAMP
  97. ENDDO
  98. C On rappelle l'amplification choisie
  99. WRITE (TEXT,fmt='(1pe8.2)') AMPIMP(IIMP)
  100. WRITE (TEXT1,'(i2)') IIMP
  101. CALL TRMESS('Deformee numero '//TEXT1//', '//
  102. & 'nouvelle amplification : '//TEXT)
  103. C Recherche du bouton clique par l'utilisateur
  104. CALL MENU(LEGEND,7,8)
  105. CALL TRDIG(XP,YP,INCLE)
  106. ICLE=INCLE+1
  107. C Cas ICLE = 1 : bouton OK, on quitte le programme
  108. IF (ICLE.EQ.1) THEN
  109. VCHC(IIMP)=AMPIMP(IIMP)
  110. GOTO 999
  111. C Cas ICLE = 2 : bouton Saisie, acquisition au clavier
  112. ELSEIF (ICLE.EQ.2) THEN
  113. CALL TRGET('Saisissez l''amplification : ',TEXT)
  114. SEGINI MTEXTE
  115. MTEXT=TEXT
  116. NCART=8
  117. CALL ECROBJ('TEXTE',MTEXTE)
  118. CALL LIRREE(AMPLLU,0,IRETOU)
  119. SEGSUP MTEXTE
  120. IF (IRETOU.NE.0) AMPIMP(IIMP)=AMPLLU
  121. C Cas ICLE = 3,4,5,6,7 : boutons avec valeurs proposees par defaut
  122. ELSEIF ((ICLE.GE.3).AND.(ICLE.LE.7)) THEN
  123. AMPIMP(IIMP)=AMPIMP(IIMP)*(2.**(ICLE-5))
  124. ENDIF
  125. C Ensuite, on repart au debut du menu
  126. GOTO 400
  127. C
  128. C-----------------------------------------------------------------------
  129. C FIN DU PROGRAMME
  130. C-----------------------------------------------------------------------
  131. C
  132. 999 CONTINUE
  133. RETURN
  134. END
  135.  
  136.  
  137.  

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