Télécharger ampint.eso

Retour à la liste

Numérotation des lignes :

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

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