Télécharger la plaquette Cast3M


fr en

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