Télécharger la plaquette Cast3M


fr en

Télécharger tbafnt.eso

Retour à la liste

Numérotation des lignes : 

tbafnt

  1. C TBAFNT    SOURCE    GOUNAND   16/06/23    21:15:10     8982           
  2. c subroutine utilisee dans tableau
  3. ***************************************************
  4. *
  5. *  AFFICHE LE TITRE SOUS TITRE ET DATE
  6. *      A LA BONNE POSITION
  7. *
  8. ***************************************************
  9.         SUBROUTINE TBAFNT ( IPX, IPY, TABTR )
  10. *
  11. *  DEFINITION DES VARIABLES
  12. *
  13.       IMPLICIT INTEGER(I-N)
  14. -INC TMNTAB
  15. -INC SMLENTI
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19.         INTEGER       IPX,IPY
  20.         INTEGER       IEX,IX,IDEBX,IFINX,IXD
  21.         INTEGER       IEY,IY,IDEBY,IFINY,IYD
  22.         INTEGER       NBC,ICOUL
  23.         CHARACTER*128  TMPCAR
  24.         REAL        RXPOS,RYPOS,HMIN
  25.         POINTEUR      LI.MLENTI
  26.         LOGICAL       ZH,ZB,ZG,ZD,ZGH,ZGB,ZGG,ZGD
  27.         LOGICAL       ZZH,ZZB,ZZGH,ZZGB
  28.         INTEGER       N,NBMCX,A,B
  29. *
  30.         LI = 0
  31. *
  32. * AFFICHAGE DU TITRE
  33. *
  34.         ICOUL = TABTR.ITITC
  35.         CALL CHCOUL (ICOUL)
  36.         TMPCAR = TABTR.TITGEN
  37.         CALL CFORMA (TMPCAR,66,NBMCX,LI)
  38.         IF  (LI.EQ.0) GOTO 1202
  39.         RXPOS = 1.
  40.         IF  (ZHORIZ) THEN
  41.           RYPOS = 20.5
  42.         ELSE
  43.           RYPOS = 29.2
  44.         ENDIF
  45.         SEGACT LI
  46.         DO 1201 N=1 , NBMCX
  47.             A = LI.LECT (2*N-1)
  48.             B = LI.LECT (2*N)
  49.             NBC = B-A+1
  50.             CALL TRLABL  (RXPOS,RYPOS,0.,TMPCAR (A:B),NBC,HMIN)
  51.             RYPOS = RYPOS - 0.5
  52. 1201    CONTINUE
  53.         SEGSUP LI
  54. 1202    CONTINUE
  55. *
  56. * AFFICHAGE DU SOUS TITRE
  57. *
  58.         TMPCAR = TABTR.SSTITR
  59.         CALL CFORMA (TMPCAR,66,NBMCX,LI)
  60.         IF  (LI.EQ.0) GOTO 1204
  61.         RXPOS = 1.
  62.         IF  (ZHORIZ) THEN
  63.           RYPOS = 19.5
  64.         ELSE
  65.           RYPOS = 28.2
  66.         ENDIF
  67.         SEGACT LI
  68.         DO 1203 N=1 , NBMCX
  69.             A = LI.LECT (2*N-1)
  70.             B = LI.LECT (2*N)
  71.             NBC = B-A+1
  72.             CALL TRLABL  (RXPOS,RYPOS,0.,TMPCAR (A:B),NBC,HMIN)
  73.             RYPOS = RYPOS - 0.5
  74. 1203    CONTINUE
  75.         SEGSUP LI
  76. 1204    CONTINUE
  77. *
  78. * AFFICHAGE DE LA DATE
  79. *
  80.         IF  ( TABTR.ZDATE ) THEN
  81.           CALL GIBDAT (JOUR,MOIS,IANNEE)
  82.           iannee=mod(iannee,100)
  83.           TMPCAR (1:14)='Le 00/00/20   '
  84.           WRITE  (TMPCAR (4:5),FMT='(I2)') JOUR
  85.           WRITE  (TMPCAR (7:8),FMT='(I2)') MOIS
  86.           WRITE  (TMPCAR (12:13),FMT='(I2)') IANNEE
  87.           IF  (ZHORIZ) THEN
  88.             RXPOS = 20.
  89.             RYPOS = 19.5
  90.           ELSE
  91.             RXPOS = 15.
  92.             RYPOS = 28.2
  93.           ENDIF
  94.           CALL TRLABL (RXPOS,RYPOS,0.,TMPCAR (1:14),14,HMIN)
  95.         ENDIF
  96. *
  97. * AFFICHAGE DES TIRES DE COLONNES
  98. *
  99.         IXD   = TABTR.IHDEC (IPX,IPY)
  100.         IYD   = TABTR.IVDEC (IPX,IPY)
  101.         IDEBX = TABTR.CSGX  (IPX,IPY)
  102.         IFINX = TABTR.CIDX  (IPX,IPY)
  103.           IX=2+IXD
  104.           DO 1210 IEX=IDEBX , IFINX
  105.                 LI = 0
  106.                 IF  (TABTR.ZAULIG) THEN
  107.                   ZG  = .TRUE.
  108.                   ZH  = .TRUE.
  109.                   ZD  = .TRUE.
  110.                   ZB  = .TRUE.
  111.                   ZGG = TABTR.ZGVSEP (IEX  ,1 )
  112.                   ZGH = TABTR.ZGHSEP (IEX  ,1 )
  113.                   ZGD = TABTR.ZGVSEP (IEX+1,1 )
  114.                   ZGB = .TRUE.
  115.                 ELSE
  116.                   ZG  = TABTR.ZVSEP   (IEX  ,1 )
  117.                   ZH  = TABTR.ZHSEP   (IEX  ,1 )
  118.                   ZD  = TABTR.ZVSEP   (IEX+1,1 )
  119.                   ZB  = TABTR.ZHSEP   (IEX  ,2 )
  120.                   ZGG = TABTR.ZGVSEP (IEX  ,1 )
  121.                   ZGH = TABTR.ZGHSEP (IEX  ,1 )
  122.                   ZGD = TABTR.ZGVSEP (IEX+1,1 )
  123.                   ZGB = TABTR.ZGHSEP (IEX  ,2 )
  124.                 ENDIF
  125.                 TMPCAR = TABTR.TITCOL (IEX)
  126.             IF  (TABTR.IHTCOL.EQ.1) THEN
  127.                 ICOUL = TABTR.ICOLC
  128.         CALL TBAFNC (TMPCAR,ICOUL,IX,5+IYD,ZH,ZB,ZG,ZD
  129.      >                  ,ZGH,ZGB,ZGG,ZGD,TABTR)
  130.             ELSE
  131.         CALL CFORMA (TMPCAR,12,NBMCX,LI)
  132.         IF  (LI.EQ.0) GOTO 1210
  133.         SEGACT LI
  134.         DO 1240 N=1 , TABTR.IHTCOL
  135.           IF  (N.EQ.1) THEN
  136.             ZZH  = ZH
  137.             ZZGH = ZGH
  138.           ELSE
  139.             ZZH  = .FALSE.
  140.             ZZGH = .FALSE.
  141.           ENDIF
  142.           IF  (N.EQ.TABTR.IHTCOL) THEN
  143.             ZZB  = ZB
  144.             ZZGB = ZGB
  145.           ELSE
  146.             ZZB  = .FALSE.
  147.             ZZGB = .FALSE.
  148.           ENDIF
  149.           IF  (N.LE.NBMCX) THEN
  150.             A = LI.LECT (2*N-1)
  151.             B = LI.LECT (2*N)
  152.             ICOUL = TABTR.ICOLC
  153.         CALL TBAFNC (TMPCAR (A:B),ICOUL,IX,4+N+IYD,ZZH,ZZB,ZG,ZD
  154.      >                  ,ZZGH,ZZGB,ZGG,ZGD,TABTR)
  155.           ELSE
  156.             TMPCAR = ' '
  157.             ICOUL = TABTR.ICOLC
  158.         CALL TBAFNC (TMPCAR,ICOUL,IX,4+N+IYD,ZZH,ZZB,ZG,ZD
  159.      >                  ,ZZGH,ZZGB,ZGG,ZGD,TABTR)
  160.           ENDIF
  161. 1240    CONTINUE
  162.         SEGSUP LI
  163.             ENDIF
  164.             IX = IX + 1
  165. 1210      CONTINUE
  166. *
  167. * AFFICHAGE DU TITRE DE LA COLONNE 1
  168. *
  169.         IEX = 1
  170.         LI = 0
  171.         IF  (TABTR.ZAULIG) THEN
  172.           ZG  = .TRUE.
  173.           ZH  = .TRUE.
  174.           ZD  = .TRUE.
  175.           ZB  = .TRUE.
  176.           ZGG = .TRUE.
  177.           ZGH = TABTR.ZGHSEP (IEX  ,1 )
  178.           ZGD = TABTR.ZGVSEP (IEX+1,1 )
  179.           ZGB = .TRUE.
  180.         ELSE
  181.           ZG  = TABTR.ZVSEP   (IEX  ,1 )
  182.           ZH  = TABTR.ZHSEP   (IEX  ,1 )
  183.           ZD  = TABTR.ZVSEP   (IEX+1,1 )
  184.           ZB  = TABTR.ZHSEP   (IEX  ,2 )
  185.           ZGG = TABTR.ZGVSEP (IEX  ,1 )
  186.           ZGH = TABTR.ZGHSEP (IEX  ,1 )
  187.           ZGD = TABTR.ZGVSEP (IEX+1,1 )
  188.           ZGB = TABTR.ZGHSEP (IEX  ,2 )
  189.         ENDIF
  190.         TMPCAR = TABTR.TITCOL (IEX)
  191.         IF  (TABTR.IHTCOL.EQ.1) THEN
  192.                 ICOUL = TABTR.ICOLC
  193.         CALL TBAFNC (TMPCAR,ICOUL,1+IXD,5+IYD,ZH,ZB,ZG,ZD
  194.      >                  ,ZGH,ZGB,ZGG,ZGD,TABTR)
  195.         ELSE
  196.          CALL CFORMA (TMPCAR,12,NBMCX,LI)
  197.          IF  (LI.EQ.0) GOTO 1260
  198.          SEGACT LI
  199.          DO 1250 N=1 , TABTR.IHTCOL
  200.           IF  (N.EQ.1) THEN
  201.             ZZH  = ZH
  202.             ZZGH = ZGH
  203.           ELSE
  204.             ZZH  = .FALSE.
  205.             ZZGH = .FALSE.
  206.           ENDIF
  207.           IF  (N.EQ.TABTR.IHTCOL) THEN
  208.             ZZB  = ZB
  209.             ZZGB = ZGB
  210.           ELSE
  211.             ZZB  = .FALSE.
  212.             ZZGB = .FALSE.
  213.           ENDIF
  214.           IF  (N.LE.NBMCX) THEN
  215.             A = LI.LECT (2*N-1)
  216.             B = LI.LECT (2*N)
  217.             ICOUL = TABTR.ICOLC
  218.         CALL TBAFNC (TMPCAR (A:B),ICOUL,1+IXD,4+N+IYD,ZZH,ZZB,ZG,ZD
  219.      >                  ,ZZGH,ZZGB,ZGG,ZGD,TABTR)
  220.           ELSE
  221.             TMPCAR = ' '
  222.             ICOUL = TABTR.ICOLC
  223.         CALL TBAFNC (TMPCAR,ICOUL,1+IXD,4+N+IYD,ZZH,ZZB,ZG,ZD
  224.      >                  ,ZZGH,ZZGB,ZGG,ZGD,TABTR)
  225.           ENDIF
  226. 1250     CONTINUE
  227.          SEGSUP LI
  228.         ENDIF
  229. 1260    CONTINUE
  230. *
  231. * AFFICHAGE DES TIRES DE LIGNES
  232. *
  233.         ICOUL = TABTR.ITEXC
  234.         IDEBY = TABTR.CSGY (IPX,IPY)
  235.         IFINY = TABTR.CIDY (IPX,IPY)
  236.           IY=5+TABTR.IHTCOL+IYD
  237.           DO 1220 IEY=IDEBY , IFINY
  238.             ZB = TABTR.ZHSEP   (1,IEY+1)
  239.             ZH = TABTR.ZHSEP   (1,IEY  )
  240.             ZGG= TABTR.ZGVSEP (1,IEY  )
  241.             IF  ( (IEY.EQ.IFINY).AND.TABTR.ZAULIG) THEN
  242.               TABTR.ZHSEP (1,IEY+1)=.TRUE.
  243.             ENDIF
  244.             IF  ( (IEY.EQ.IDEBY).AND.TABTR.ZAULIG) THEN
  245.               TABTR.ZHSEP (1,IEY)=.TRUE.
  246.             ENDIF
  247.             IF  (TABTR.ZAULIG) THEN
  248.               TABTR.ZGVSEP (1,IEY  ) = .TRUE.
  249.             ENDIF
  250.         CALL TBAFN  ( 1, IEY, 1+IXD, IY, TABTR )
  251.             TABTR.ZHSEP   (1,IEY+1) = ZB
  252.             TABTR.ZHSEP   (1,IEY  ) = ZH
  253.             TABTR.ZGVSEP (2,IEY  ) = ZGG
  254.             IY = IY + 1
  255. 1220      CONTINUE
  256. *
  257. * AFFICHAGE DU NUMERO DE PAGE
  258. *
  259.         ICOUL = TABTR.ITEXC
  260.         CALL CHCOUL (ICOUL)
  261.         IF  (TABTR.ZPAGE) THEN
  262.           TMPCAR = 'page 000/000'
  263.           WRITE  (TMPCAR (6:8)  ,FMT=' (I3)')  (TABTR.PX* (IPY-1)+IPX)
  264.           WRITE  (TMPCAR (10:12),FMT=' (I3)')  (TABTR.PX*TABTR.PY)
  265.           IF  (ZHORIZ) THEN
  266.             RXPOS = 12.
  267.             RYPOS = 0.
  268.           ELSE
  269.             RXPOS = 8.5
  270.             RYPOS = 0.
  271.           ENDIF
  272.           CALL TRLABL (RXPOS,RYPOS,0.,TMPCAR (1:12),12,HMIN)
  273.         ENDIF
  274. *
  275.         END
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  

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