Télécharger la plaquette Cast3M


fr en

Télécharger tbobj.eso

Retour à la liste

Numérotation des lignes : 

tbobj

  1. C TBOBJ     SOURCE    PV        20/12/19    22:54:43     10826          
  2. C OBJLIR SOURCE ENSAM    94/08/09
  3.         SUBROUTINE TBOBJ
  4. C INITIALISATION ET REMPLISSAGE D'UN TABLEAU A PARTIR D'UN OBJET
  5. C       EV      EVOLUTION
  6. C       CE      CHAMP PAR ELEMENT
  7. C       CH      CHAMP PAR POINT
  8.  
  9. *
  10. *  DEFINITION DES VARIABLES
  11. *
  12.       IMPLICIT INTEGER(I-N)
  13. -INC TMNTAB
  14. -INC SMEVOLL
  15. -INC SMLREEL
  16. -INC SMLENTI
  17. -INC SMLMOTS
  18. -INC SMTABLE
  19. -INC SMCHPOI
  20. -INC SMELEME
  21. -INC PPARAM
  22. -INC SMCHAML
  23.         POINTEUR        EV.MEVOLL
  24.         POINTEUR        PTB.MLENTI
  25.         POINTEUR        CH.MCHPOI
  26.         POINTEUR        CE.MCHELM
  27.         REAL*8          EPSILN
  28.         LOGICAL         ZD,ZH
  29.         INTEGER         ITABX,ITABY,NBPX,NBPY
  30.         POINTEUR        LR.MLREEL,LRX.MLREEL,LRY.MLREEL
  31.         POINTEUR        LIX.MLENTI,LIY.MLENTI
  32.         POINTEUR        LMY.MLMOTS
  33.         POINTEUR        KEV.KEVOLL
  34.         INTEGER         NBEVOL
  35.         INTEGER         JG,IE,IEV,IEL,IX,IY
  36.         REAL*8          RA,RB
  37.         LOGICAL         ZN
  38.         INTEGER         PAGESX,PAGESY
  39.         POINTEUR        TB.MTABLE
  40.         REAL*8          XVALRE
  41.         INTEGER         IVALRE
  42.         INTEGER         NBNOEU,NBELEM
  43.         LOGICAL         ZEGALE
  44.  
  45. ***************************************************
  46. *
  47. *  LECTURE D'UN OBJET EVOLUTION
  48. *
  49. ***************************************************
  50.         ENTRY EVLIRE ( EV, TABTR, EPSILN, ITABX, ITABY)
  51.  
  52. ***************************************************
  53. **  INITIALISATION DES VARIABLE
  54. ***************************************************
  55.         IF  (TABTR.NE.0) SEGSUP TABTR
  56.         NBEVOL = 0
  57.  
  58. ***************************************************
  59. **  ANALYSE DE L'EVOLUTION: DIM DU TABLEAU
  60. ***************************************************
  61. * SI PAS D'EVOLUTION SORTIR
  62.         IF  (EV.EQ.0) RETURN
  63.  
  64. * RECHERCHE LES EV AVEC DU NEMERIQUE EN ABSCISSE
  65.         SEGACT EV
  66.         ITABX=1
  67.         DO 3400 IEV=1 , EV.IEVOLL (/1)
  68.           NBEVOL = NBEVOL + 1
  69.           KEV = EV.IEVOLL (IEV)
  70.           SEGACT KEV
  71.           IF  (KEV.TYPX (1:8).EQ.'LISTREEL') ITABX = ITABX+1
  72.           IF  (KEV.TYPX (1:8).EQ.'LISTENTI') ITABX = ITABX+1
  73.           SEGDES KEV
  74. 3400    CONTINUE
  75.         IF  (ITABX.EQ.1) THEN
  76.           SEGDES EV
  77.           RETURN
  78.         ENDIF
  79.  
  80. * ON CHERCHE LA PREMIERE
  81.         DO 3401 IEV=1 , EV.IEVOLL (/1)
  82.           KEV = EV.IEVOLL (IEV)
  83.           SEGACT KEV
  84.           IF  (KEV.TYPX (1:8).EQ.'LISTREEL') GOTO 3402
  85.           IF  (KEV.TYPX (1:8).EQ.'LISTENTI') GOTO 3402
  86.           SEGDES KEV
  87. 3401    CONTINUE
  88.  
  89.  
  90. * ON COMMENCE L'INITIALISATION DE LA COLONNE ABCSISSE
  91. 3402    CONTINUE
  92.         IF  (KEV.TYPX (1:8).EQ.'LISTREEL') THEN
  93.           LRX=KEV.IPROGX
  94.           SEGACT LRX
  95.           JG=LRX.PROG (/1)
  96.           SEGINI LR
  97.           DO 3101 IE=1 , JG
  98.             LR.PROG (IE) = LRX.PROG (IE)
  99. 3101      CONTINUE
  100.           SEGDES LRX
  101.         ELSEIF  (KEV.TYPX (1:8).EQ.'LISTENTI') THEN
  102.           LIX=KEV.IPROGX
  103.           SEGACT LIX
  104.           JG=LIX.LECT (/1)
  105.           SEGINI LR
  106.           DO 3102 IE=1 , JG
  107.             LR.PROG (IE) = DBLE (LIX.LECT (IE))
  108. 3102      CONTINUE
  109.           SEGDES LIX
  110.         ENDIF
  111.         SEGDES KEV
  112.  
  113. * SI PLUS D'UNE VALEUR ON INITIALISE EPSILN
  114.         IF  (LR.PROG (/1).GT.1) THEN
  115.         IF  (EPSILN.EQ.0.D0 ) THEN
  116.           EPSILN = ABS (LR.PROG (1)-LR.PROG (2))
  117.  
  118.           DO 3004 IEV=1 , EV.IEVOLL (/1)
  119.           KEV = EV.IEVOLL (IEV)
  120.           SEGACT KEV
  121.  
  122.           IF  (KEV.TYPX (1:8).EQ.'LISTREEL') THEN
  123.           LRX = KEV.IPROGX
  124.           SEGACT LRX
  125.           DO 3003 IY=1 , LRX.PROG (/1)
  126.            DO 3002 IX=1 , LRX.PROG (/1)
  127.              IF  (IX.EQ.IY) GOTO 3003
  128.              RA = ABS (LRX.PROG (IX)-LRX.PROG (IY))
  129.              EPSILN = MIN  (EPSILN,RA)
  130. 3002       CONTINUE
  131. 3003      CONTINUE
  132.           SEGDES LRX
  133.           ENDIF
  134.  
  135.           SEGDES KEV
  136. 3004      CONTINUE
  137.           EPSILN = EPSILN/3.0
  138.         ENDIF
  139.         ENDIF
  140.  
  141. * SI PLUS D'UNE EV ON CONTINUE A REMPLIR LR
  142.         IF  (NBEVOL.GT.1) THEN
  143.           DO 3107 IEV=2 , NBEVOL
  144.           KEV = EV.IEVOLL (IEV)
  145.           SEGACT KEV
  146.  
  147.           IF  (KEV.TYPX (1:8).EQ.'LISTREEL') THEN
  148.           LRX = KEV.IPROGX
  149.           SEGACT LRX
  150.  
  151.             DO 3105 IEL=1 , LRX.PROG (/1)
  152.               RA = LRX.PROG (IEL)
  153.               ZN = .TRUE.
  154.               DO 3103 IET=1 , JG
  155.                 RB = LR.PROG (IET)
  156.                 IF  (ZEGALE (RA,RB,EPSILN)) ZN=.FALSE.
  157. 3103          CONTINUE
  158.               IF  (ZN) THEN
  159.                 JG = JG + 1
  160.                 SEGADJ LR
  161.                 LR.PROG (JG) = RA
  162.               ENDIF
  163. 3105        CONTINUE
  164.  
  165.           SEGDES LRX
  166.           ENDIF
  167.  
  168.           IF  (KEV.TYPX (1:8).EQ.'LISTENTI') THEN
  169.           LIX = KEV.IPROGX
  170.           SEGACT LIX
  171.  
  172.             DO 3115 IEL=1 , LIX.LECT (/1)
  173.               RA = DBLE (LIX.LECT (IEL))
  174.               ZN = .TRUE.
  175.               DO 3113 IET=1 , JG
  176.                 RB = LR.PROG (IET)
  177.                 IF  (ZEGALE (RA,RB,EPSILN)) ZN=.FALSE.
  178. 3113          CONTINUE
  179.               IF  (ZN) THEN
  180.                 JG = JG + 1
  181.                 SEGADJ LR
  182.                 LR.PROG (JG) = RA
  183.               ENDIF
  184. 3115        CONTINUE
  185.  
  186.           SEGDES LIX
  187.           ENDIF
  188.  
  189.           SEGDES KEV
  190. 3107      CONTINUE
  191.         ENDIF
  192.  
  193.         ITABY = JG + 1
  194.  
  195. ***************************************************
  196. *  ** INITIALISATION DE LA STRUCTURE TABLEAU
  197. ***************************************************
  198. 3200    CONTINUE
  199. *
  200. * CALCUL DU NOMBRE DE PAGES MAXI
  201. *
  202.         PAGESX =  (ITABX-2) / 4 + 1
  203.         PAGESY =  (ITABY-2) / 20 + 2
  204. **    write(6,*) 'pagesx pagesy itabx itaby',pagesx,pagesy,itabx,itaby
  205. *
  206. * INITIALISE L'OJET TABTR
  207. *
  208.         SEGINI TABTR
  209.         CALL TBINI  (TABTR,ITABX,ITABY)
  210. *
  211. * RECHERCHE LES TITRES: GENERAL, COL, LIG, ETC
  212. *
  213.         TABTR.TITGEN=EV.IEVTEX
  214.         IX = 1
  215.         DO 3207 IEV=1 , NBEVOL
  216.           KEV=EV.IEVOLL (IEV)
  217.           SEGACT KEV
  218.           IF  (KEV.TYPX (1:8).EQ.'LISTREEL') THEN
  219.             TABTR.ELEM (IX+1,1)   = KEV.KEVTEX
  220.             TABTR.TITCOL (IX+1) = KEV.KEVTEX
  221.             IX = IX + 1
  222.           ENDIF
  223.           IF  (KEV.TYPX (1:8).EQ.'LISTENTI') THEN
  224.             TABTR.ELEM (IX+1,1)    = KEV.KEVTEX
  225.             TABTR.TITCOL (IX+1)  = KEV.KEVTEX
  226.             IX = IX + 1
  227.           ENDIF
  228.           SEGDES KEV
  229. 3207    CONTINUE
  230.  
  231. ***************************************************
  232. * REMPLIT LE TABLEAU EN CONVERTISSANT TOUT EN CHAINES
  233. ***************************************************
  234.         TABTR.YTYPE (1) = 'LISTREEL'
  235.         DO 3430 IY=2 , ITABY
  236.           TABTR.ELEM (1,IY) = F_LTOA  (LR.PROG (IY-1))
  237. 3430    CONTINUE
  238.         IF( NBEVOL.EQ.1) THEN
  239.           IEV=1
  240.           KEV=EV.IEVOLL (IEV)
  241.           SEGACT KEV
  242.           IF  (KEV.TYPY (1:8).EQ.'LISTREEL') THEN
  243.              LRY=KEV.IPROGY
  244.              SEGACT LRY
  245.              TABTR.YTYPE (IEV+1) = 'LISTREEL'
  246.              DO 33081 IEL=1 , LRY.PROG (/1)
  247.               TABTR.ELEM (IEV+1,IEL+1) = F_LTOA (LRY.PROG (IEL))
  248. 33081        CONTINUE
  249.              SEGDES LRY
  250.           ELSEIF  (KEV.TYPY (1:8).EQ.'LISTENTI') THEN
  251.              TABTR.YTYPE (IEV+1) = 'LISTENTI'
  252.              LIY=KEV.IPROGY
  253.              SEGACT LIY
  254.              DO 33082 IEL=1 , LIY.LECT(/1)
  255.                 TABTR.ELEM (IEV+1,IEL+1) = F_ITOA (LIY.LECT (IEL))
  256. 33082        CONTINUE
  257.              SEGDES LIY
  258.           ELSEIF  (KEV.TYPY (1:8).EQ.'LISTMOTS') THEN
  259.              LMY=KEV.IPROGY
  260.              SEGACT LMY
  261.              TABTR.YTYPE (IEV+1) = 'LISTMOTS'
  262.              DO 33083 IEL=1 , LMY.MOTS(/2)
  263.                 TABTR.ELEM (IEV+1,IEL+1) = LMY.MOTS (IEL)
  264. 33083        CONTINUE
  265.              SEGDES LMY
  266.            ENDIF
  267.         ELSE
  268.         DO 3301 IEV=1 , NBEVOL
  269.           KEV=EV.IEVOLL (IEV)
  270.           SEGACT KEV
  271.  
  272.           IF  (KEV.TYPX (1:8).EQ.'LISTREEL') THEN
  273.           LRX=KEV.IPROGX
  274.  
  275.           IF  (KEV.TYPY (1:8).EQ.'LISTREEL') THEN
  276.           LRY=KEV.IPROGY
  277.           SEGACT LRX
  278.           SEGACT LRY
  279.           TABTR.YTYPE (IEV+1) = 'LISTREEL'
  280.           DO 3308 IEL=1 , LRX.PROG (/1)
  281.             RA = LRX.PROG (IEL)
  282.             DO 3300 IY=1 , ITABY-1
  283.               RB = LR.PROG (IY)
  284.               IF  (ZEGALE (RA,RB,EPSILN)) THEN
  285.                 TABTR.ELEM (IEV+1,IY+1) = F_LTOA (LRY.PROG (IEL))
  286.                ENDIF
  287. 3300         CONTINUE
  288. 3308      CONTINUE
  289.           SEGDES LRY
  290.           ENDIF
  291.  
  292.           IF  (KEV.TYPY (1:8).EQ.'LISTENTI') THEN
  293.           LIY=KEV.IPROGY
  294.           SEGACT LRX
  295.           SEGACT LIY
  296.           TABTR.YTYPE (IEV+1) = 'LISTENTI'
  297.           DO 3318 IEL=1 , LRX.PROG (/1)
  298.             RA = LRX.PROG (IEL)
  299.             DO 3310 IY=1 , ITABY-1
  300.               RB = LR.PROG (IY)
  301.               IF  (ZEGALE (RA,RB,EPSILN)) THEN
  302.                 TABTR.ELEM (IEV+1,IY+1) = F_ITOA (LIY.LECT (IEL))
  303.                ENDIF
  304. 3310         CONTINUE
  305. 3318      CONTINUE
  306.           SEGDES LIY
  307.           ENDIF
  308.  
  309.           IF  (KEV.TYPY (1:8).EQ.'LISTMOTS') THEN
  310.           LMY=KEV.IPROGY
  311.           SEGACT LRX
  312.           SEGACT LMY
  313.           TABTR.YTYPE (IEV+1) = 'LISTMOTS'
  314.           DO 3338 IEL=1 , LRX.PROG (/1)
  315.             RA = LRX.PROG (IEL)
  316.             DO 3330 IY=1 , ITABY-1
  317.               RB = LR.PROG (IY)
  318.               IF  (ZEGALE (RA,RB,EPSILN)) THEN
  319.                 TABTR.ELEM (IEV+1,IY+1) = LMY.MOTS (IEL)
  320.                ENDIF
  321. 3330         CONTINUE
  322. 3338      CONTINUE
  323.           SEGDES LMY
  324.           ENDIF
  325.  
  326.           SEGDES LRX
  327.           ENDIF
  328.  
  329.           IF  (KEV.TYPX (1:8).EQ.'LISTENTI') THEN
  330.           LIX=KEV.IPROGX
  331.  
  332.           IF  (KEV.TYPY (1:8).EQ.'LISTREEL') THEN
  333.           LRY=KEV.IPROGY
  334.           SEGACT LIX
  335.           SEGACT LRY
  336.           TABTR.YTYPE (IEV+1) = 'LISTREEL'
  337.           DO 3348 IEL=1 , LIX.LECT (/1)
  338.             RA = DBLE (LIX.LECT (IEL))
  339.             DO 3340 IY=1 , ITABY-1
  340.               RB = LR.PROG (IY)
  341.               IF  (ZEGALE (RA,RB,EPSILN)) THEN
  342.                 TABTR.ELEM (IEV+1,IY+1) = F_LTOA (LRY.PROG (IEL))
  343.                ENDIF
  344. 3340         CONTINUE
  345. 3348      CONTINUE
  346.           SEGDES LRY
  347.           ENDIF
  348.  
  349.           IF  (KEV.TYPY (1:8).EQ.'LISTENTI') THEN
  350.           LIY=KEV.IPROGY
  351.           SEGACT LIX
  352.           SEGACT LIY
  353.           TABTR.YTYPE (IEV+1) = 'LISTENTI'
  354.           DO 3358 IEL=1 , LIX.LECT (/1)
  355.             RA = DBLE (LIX.LECT (IEL))
  356.             DO 3350 IY=1 , ITABY-1
  357.               RB = LR.PROG (IY)
  358.               IF  (ZEGALE (RA,RB,EPSILN)) THEN
  359.                 TABTR.ELEM (IEV+1,IY+1) = F_ITOA (LIY.LECT (IEL))
  360.                ENDIF
  361. 3350         CONTINUE
  362. 3358      CONTINUE
  363.           SEGDES LIY
  364.           ENDIF
  365.  
  366.           IF  (KEV.TYPY (1:8).EQ.'LISTMOTS') THEN
  367.           LMY=KEV.IPROGY
  368.           SEGACT LIX
  369.           SEGACT LMY
  370.           TABTR.YTYPE (IEV+1) = 'LISTMOTS'
  371.           DO 3368 IEL=1 , LIX.LECT (/1)
  372.             RA = DBLE (LIX.LECT (IEL))
  373.             DO 3360 IY=1 , ITABY-1
  374.               RB = LR.PROG (IY)
  375.               IF  (ZEGALE (RA,RB,EPSILN)) THEN
  376.                 TABTR.ELEM (IEV+1,IY+1) = LMY.MOTS (IEL)
  377.                ENDIF
  378. 3360         CONTINUE
  379. 3368      CONTINUE
  380.           SEGDES LMY
  381.           ENDIF
  382.  
  383.           SEGDES LIX
  384.           ENDIF
  385.  
  386.           SEGDES KEV
  387. 3301    CONTINUE
  388.        ENDIF
  389.  
  390.         SEGDES EV
  391.         SEGDES TABTR
  392. *
  393.         RETURN
  394. *
  395. *****   FIN EVLIRE    *****************************
  396. ***************************************************
  397.  
  398. ***************************************************
  399. *
  400. *  LECTURE D'UN CHAMP PAR ELEMENT
  401. *
  402. ***************************************************
  403.         ENTRY CELIRE ( CE, TABTR, EPSILN, ITABX, ITABY)
  404.  
  405. ***************************************************
  406. **  INITIALISATION DES VARIABLE
  407. ***************************************************
  408.         IF  (TABTR.NE.0) SEGSUP TABTR
  409.  
  410. ***************************************************
  411. **  ANALYSE DU CHAMP PAR ELEMENT => DIM DU TABLEAU
  412. ***************************************************
  413.         IF  (CE.EQ.0) RETURN
  414.         SEGACT CE
  415.          IF  (CE.ICHAML (1).EQ.0) RETURN
  416.          MCHAM1 = CE.ICHAML (1)
  417.          SEGACT MCHAM1
  418.           ITABX = 1
  419.           DO 4020 IX=1,MCHAM1.TYPCHE (/2)
  420. c ici normalement il faut tester le type
  421. c           IF  (MCHAM1.TYPCHE (IX).EQ.'REEL*8')  THEN ITAX=ITABX+1
  422. c           IF  (MCHAM1.TYPCHE (IX).EQ.'REEL*4')  THEN ITAX=ITABX+1
  423. c           IF  (MCHAM1.TYPCHE (IX).EQ.'INTEGER') THEN ITAX=ITABX+1
  424.             itabx=itabx+1
  425. 4020      CONTINUE
  426.           MELVA1 = MCHAM1.IELVAL (1)
  427.           SEGACT MELVA1
  428.            NBNOEU=MELVA1.VELCHE (/1)
  429.            NBELEM =MELVA1.VELCHE (/2)
  430.            ITABY = 1 + NBNOEU*NBELEM
  431.            IF  (ITABY.EQ.1) RETURN
  432.           SEGDES MELVA1
  433.          SEGDES MCHAM1
  434.         SEGDES CE
  435. ***************************************************
  436. *  ** INITIALISATION DE LA STRUCTURE TABLEAU
  437. ***************************************************
  438. *
  439. * CALCUL DU NOMBRE DE PAGES
  440. *
  441.         PAGESX =  (ITABX-2) / 4 + 1
  442.         PAGESY =  (ITABY-2) / 20 + 1
  443. *
  444. * INITIALISE L'OJET TABTR
  445. *
  446.         SEGINI TABTR
  447.         CALL TBINI  (TABTR,ITABX,ITABY)
  448.  
  449. ***************************************************
  450. *  ** REMPLISSAGE DU TABLEAU
  451. ***************************************************
  452.         SEGACT CE
  453.         TABTR.TITGEN  = CE.TITCHE
  454.         MCHAM1 = CE.ICHAML (1)
  455.         SEGACT MCHAM1
  456.  
  457. * INITIALISATION DE LA COLONNE 1
  458.         TABTR.TITCOL (1) = 'NOEUDS'
  459.         TABTR.ELEM (1,1)   = 'NOEUDS'
  460.         IPT1 = CE.IMACHE (1)
  461.         SEGACT IPT1
  462.         IY=2
  463.         DO 4040 IYN=1 , NBNOEU
  464.         DO 4030 IYE=1 , NBELEM
  465.           IVALRE = IPT1.NUM (IYN,IYE)
  466.           TABTR.ELEM (1,IY) = F_ITOA (IVALRE)
  467.           IY = IY+1
  468. 4030    CONTINUE
  469. 4040    CONTINUE
  470.         SEGDES IPT1
  471.  
  472. * REMPLISSAGE DU RESTE DU TABLEAU
  473.         IX = 2
  474.         DO 4200 IEX=1 , MCHAM1.IELVAL (/1)
  475. c ici normalement on ne prend que les types numeriques
  476. c  cf teste ci-dessus
  477. c       IF    ( (MCHAM1.TYPCHE (IEX).EQ.'REEL*8')
  478. c     #    .OR. (MCHAM1.TYPCHE (IEX).EQ.'REEL*4')
  479. c     #    .OR. (MCHAM1.TYPCHE (IEX).EQ.'INTEGER')) THEN
  480.           TABTR.TITCOL (IX)   = MCHAM1.NOMCHE (IEX)
  481.           TABTR.ELEM   (IX,1) = MCHAM1.NOMCHE (IEX)
  482.  
  483.         MELVA1 = MCHAM1.IELVAL (IEX)
  484.         SEGACT MELVA1
  485.           IY = 2
  486.           DO 4060 IYN=1 , NBNOEU
  487.           DO 4050 IYE=1 , NBELEM
  488.             RA=MELVA1.VELCHE (IYN,IYE)
  489.             TABTR.ELEM  (IX,IY  ) = F_LTOA (RA)
  490.             IY = IY+1
  491. 4050      CONTINUE
  492. 4060      CONTINUE
  493.         SEGDES MELVA1
  494.  
  495.         IX=IX+1
  496. c       ENDIF
  497. 4200    CONTINUE
  498.         SEGDES MCHAM1
  499.         SEGDES CE
  500. *
  501.         SEGDES TABTR
  502. *
  503.         RETURN
  504. *
  505. *****    FIN DE TBLIRE    *************************
  506. ***************************************************
  507.  
  508. ***************************************************
  509. *
  510. *  LECTURE D'UN OBJET CHPOINT
  511. *
  512. ***************************************************
  513.         ENTRY CHLIRE ( CH, TABTR, EPSILN, ITABX, ITABY)
  514.  
  515. ***************************************************
  516. **  INITIALISATION DES VARIABLE
  517. ***************************************************
  518.         IF  (TABTR.NE.0) SEGSUP TABTR
  519.  
  520. ***************************************************
  521. **  ANALYSE DU CHPOINT: DIM DU TABLEAU
  522. ***************************************************
  523.         IF  (CH.EQ.0) RETURN
  524.         SEGACT CH
  525.           MSOUP1 = CH.IPCHP (1)
  526.           SEGACT MSOUP1
  527.             ITABX = MSOUP1.NOCOMP (/2) + 1
  528.             IPT1  = MSOUP1.IGEOC
  529.             SEGACT IPT1
  530.               ITABY = IPT1.NUM (/2) + 1
  531.             SEGDES IPT1
  532.           SEGDES MSOUP1
  533.         SEGDES CH
  534.  
  535. ***************************************************
  536. *  ** INITIALISATION DE LA STRUCTURE TABLEAU
  537. ***************************************************
  538. *
  539. * CALCUL DU NOMBRE DE PAGES
  540. *
  541.         PAGESX =  (ITABX-2) / 4 + 1
  542.         PAGESY =  (ITABY-2) / 20 + 1
  543. *
  544. * INITIALISE L'OJET TABTR
  545. *
  546.         SEGINI TABTR
  547.         CALL TBINI  (TABTR,ITABX,ITABY)
  548. *
  549. * RECHERCHE LES TITRES: GENERAL, COL, ETC
  550. *
  551.         SEGACT CH
  552.         TABTR.TITGEN  = CH.MOCHDE
  553.         TABTR.SSTITR = ' '
  554.         MSOUP1 = CH.IPCHP (1)
  555.         SEGACT MSOUP1
  556.         DO 5208 IX=2 , ITABX
  557.           TABTR.TITCOL (IX) = MSOUP1.NOCOMP (IX-1)
  558. 5208    CONTINUE
  559.         SEGDES MSOUP1
  560.         SEGDES CH
  561.  
  562. ***************************************************
  563. * REMPLIT LE TABLEAU EN CONVERTISSANT TOUT EN CHAINES
  564. ***************************************************
  565.         SEGACT CH
  566.           MSOUP1 = CH.IPCHP (1)
  567.           SEGACT MSOUP1
  568.             MPOVA1 = MSOUP1.IPOVAL
  569.             SEGACT MPOVA1
  570.             DO 5218 IX=1 , ITABX-1
  571.               TABTR.ELEM (IX+1,1)=MSOUP1.NOCOMP (IX)
  572.               DO 5216 IY=1 , ITABY-1
  573.                 TABTR.ELEM (IX+1,IY+1)=F_LTOA (MPOVA1.VPOCHA (IY,IX))
  574. 5216          CONTINUE
  575. 5218        CONTINUE
  576.             IPT1=MSOUP1.IGEOC
  577.             SEGACT IPT1
  578.             DO 5220 IY=1 , ITABY-1
  579.               TABTR.ELEM (1,IY+1)=F_ITOA (IPT1.NUM (1,IY))
  580. 5220        CONTINUE
  581.             SEGDES IPT1
  582.             SEGDES MPOVA1
  583.           SEGDES MSOUP1
  584.  
  585.         SEGDES CH
  586. *
  587.         SEGDES TABTR
  588.         RETURN
  589. *
  590. *****    FIN DE CHLIRE    *************************
  591. ***************************************************
  592. *
  593.         END
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  

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