Télécharger la plaquette Cast3M


fr en

Télécharger tbafnc.eso

Retour à la liste

Numérotation des lignes : 

tbafnc

  1. C TBAFNC    SOURCE    PV        05/09/22    21:26:55     5181
  2. c subroutine utilisee dans tableau
  3. ***************************************************
  4. *
  5. *  AFFICHE UNE CHAINE A LA POSITION FX,FY
  6. *   AVEC LES BONS ENCADREMENTS
  7. *
  8. ***************************************************
  9.         SUBROUTINE TBAFNC  (CHAINE,ICOUL,FX,FY,ZH,ZB
  10.      >               ,ZG,ZD,ZGH,ZGB,ZGG,ZGD,TABTR)
  11.  
  12. *
  13. *  DEFINITION DES VARIABLES
  14. *
  15.       IMPLICIT INTEGER(I-N)
  16. -INC TMNTAB
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20.         CHARACTER* (*) CHAINE
  21.         INTEGER       FX,FY,ICOUL
  22.         LOGICAL       ZH,ZB,ZG,ZD,ZGH,ZGB,ZGG,ZGD
  23.         INTEGER       NBC
  24.         REAL        RXPOS,RYPOS,HMIN
  25.         REAL        A (2),B (2),TX (2),TY (2),TZ(2)
  26. *
  27.         tz(1)=0
  28.         tz(2)=0
  29. *
  30. * AFFICHAGE DU CONTENU
  31. *
  32.         CALL CHCOUL (ICOUL)
  33.         RXPOS = FX * 3.75 - 3.6    + 0.05
  34.         IF  (ZHORIZ) THEN
  35.           RYPOS = 21.2 - FY * 0.65   - 0.1
  36.         ELSE
  37.           RYPOS = 29.9 - FY * 0.65   - 0.1
  38.         ENDIF
  39.         NBC = LEN  ( CHAINE )
  40.         CALL TRLABL  (RXPOS,RYPOS,tz(1),CHAINE,NBC,HMIN)
  41. *
  42. *  CALCUL DES COORDONNEES DE LA BOITE
  43. *
  44.         A (1) =  (FX - 1) * 3.75        + 0.05
  45.         B (1) = FX * 3.75              + 0.05
  46.         IF  (ZHORIZ) THEN
  47.           A (2) = 21. -  (FY - 1) * 0.65  - 0.1
  48.           B (2) = 21. - FY * 0.65        - 0.1
  49.         ELSE
  50.           A (2) = 29.7 -  (FY - 1) * 0.65  - 0.1
  51.           B (2) = 29.7 - FY * 0.65        - 0.1
  52.         ENDIF
  53. *
  54. * AFFICHAGE DES ENCADREMENTS
  55. *
  56.         ICOUL = TABTR.ILIGC
  57.         CALL CHCOUL (ICOUL)
  58.         IF  (ZG) THEN
  59.           TX (1) = A (1)
  60.           TY (1) = A (2)
  61.           TX (2) = A (1)
  62.           TY (2) = B (2)
  63.           CALL POLRL  (2,TX,TY,tz)
  64.         ENDIF
  65.         IF  (ZH) THEN
  66.           TX (1) = A (1)
  67.           TY (1) = A (2)
  68.           TX (2) = B (1)
  69.           TY (2) = A (2)
  70.           CALL POLRL  (2,TX,TY,tz)
  71.         ENDIF
  72.         IF  (ZD) THEN
  73.           TX (1) = B (1)
  74.           TY (1) = A (2)
  75.           TX (2) = B (1)
  76.           TY (2) = B (2)
  77.           CALL POLRL  (2,TX,TY,tz)
  78.         ENDIF
  79.         IF  (ZB) THEN
  80.           TX (1) = A (1)
  81.           TY (1) = B (2)
  82.           TX (2) = B (1)
  83.           TY (2) = B (2)
  84.           CALL POLRL  (2,TX,TY,tz)
  85.         ENDIF
  86.         IF  (ZGG) THEN
  87.           TX (1) = A (1)+.05
  88.           TY (1) = A (2)
  89.           TX (2) = A (1)+.05
  90.           TY (2) = B (2)
  91.           CALL POLRL  (2,TX,TY,tz)
  92.         ENDIF
  93.         IF  (ZGH) THEN
  94.           TX (1) = A (1)
  95.           TY (1) = A (2)+.05
  96.           TX (2) = B (1)
  97.           TY (2) = A (2)+.05
  98.           CALL POLRL  (2,TX,TY,tz)
  99.         ENDIF
  100.         IF  (ZGD) THEN
  101.           TX (1) = B (1)+.05
  102.           TY (1) = A (2)
  103.           TX (2) = B (1)+.05
  104.           TY (2) = B (2)
  105.           CALL POLRL  (2,TX,TY,tz)
  106.         ENDIF
  107.         IF  (ZGB) THEN
  108.           TX (1) = A (1)
  109.           TY (1) = B (2)+.05
  110.           TX (2) = B (1)
  111.           TY (2) = B (2)+.05
  112.           CALL POLRL  (2,TX,TY,tz)
  113.         ENDIF
  114.         ICOUL = TABTR.ITEXC
  115.         CALL CHCOUL (ICOUL)
  116. *
  117.         END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

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