Télécharger la plaquette Cast3M


fr en

Télécharger devso4.eso

Retour à la liste

Numérotation des lignes : 

devso4

  1. C DEVSO4    SOURCE    CB215821  20/11/25    13:25:10     10792          
  2.       SUBROUTINE DEVSO4(KPREF,KTRES,KTLIAA,KTLIAB,KTNUM,NINS,
  3.      &                   ICHAIN,MTABLE,REPRIS,LMODYN,ITDYN,ITSORT)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Operateur DYNE :                                               *
  9. *     Creation et remplissage de la table resultat                   *
  10. *                                                                    *
  11. *--------------------------------------------------------------------*
  12. *                                                                    *
  13. *     Parametres:                                                    *
  14. *                                                                    *
  15. * e   KTRES   segment de sauvegarde des resultats                    *
  16. * e   KTLIAA  segment descriptif des liaisons en base A              *
  17. * e   KTLIAB  segment descriptif des liaisons en base B              *
  18. * e   KTNUM   segment contenant les parametres numeriques            *
  19. * e   NINS    on veut une sortie tous les NINS pas de calcul         *
  20. * e   ICHAIN  Segment MLENTI (ACTIF) contenant les adresses des      *
  21. *             chaines dans la pile des mots de CCNOYAU               *
  22. *   s MTABLE  table resultat de l'operateur DYNE                     *
  23. * e   REPRIS  vrai si reprise de calcul, faux sinon                  *
  24. *                                                                    *
  25. *     Structure de MTABLE (table de resultats) :                     *
  26. *                                                                    *
  27. *     . 'SOUSTYPE'        : 'RESULTAT_DYNE'                          *
  28. *                                                                    *
  29. *     . 'TEMPS_DE_SORTIE' : LISTREEL des temps                       *
  30. *                                                                    *
  31. *     . 'REPRISE'         : TABLE                                    *
  32. *                                                                    *
  33. *     . I : table des resultats au I eme pas de sortie               *
  34. *     . I . 'DEPLACEMENT'       | : CHPOINT resultat                 *
  35. *           'VITESSE'           |                                    *
  36. *           'DEPLACEMENT_1/2'   |                                    *
  37. *           'VITESSE_1/2'       |                                    *
  38. *           'ACCELERATION'      |                                    *
  39. *           'ACCELERATION_1/2'  |                                    *
  40. *           'TRAVAIL_EXTERIEUR' |                                    *
  41. *           'TRAVAIL_INTERIEUR' |                                    *
  42. *     ou                                                             *
  43. *     .  'DEPLACEMENT'       | : Liste des valeurs des variables     *
  44. *        'VITESSE'           |   demandees en fonction du temps      *
  45. *        'DEPLACEMENT_1/2'   |   (LISTREEL)                          *
  46. *        'VITESSE_1/2'       |                                       *
  47. *        'ACCELERATION'      |                                       *
  48. *        'ACCELERATION_1/2'  |                                       *
  49. *        'TRAVAIL_EXTERIEUR' |                                       *
  50. *        'TRAVAIL_INTERIEUR' |                                       *
  51. *                                                                    *
  52. *     . TL1 : TABLE contenant les resultats de la liaison,           *
  53. *             TL1 etant une table definissant une liaison.           *
  54. *                                                                    *
  55. *--------------------------------------------------------------------*
  56.  
  57. -INC PPARAM
  58. -INC CCOPTIO
  59. -INC SMTABLE
  60. -INC SMLREEL
  61. -INC SMLENTI
  62. -INC SMCHPOI
  63. -INC CCNOYAU
  64. *
  65.       SEGMENT,MPREF
  66.          INTEGER IPOREF(NPREF)
  67.       ENDSEGMENT
  68.       SEGMENT,MTLIAA
  69.          INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  70.          REAL*8 XPALA(NLIAA,NXPALA)
  71.       ENDSEGMENT
  72.       SEGMENT,MTLIAB
  73.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  74.          REAL*8 XPALB(NLIAB,NXPALB)
  75.          REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  76.       ENDSEGMENT
  77.       SEGMENT,MTRES
  78.          REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
  79.          REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
  80.          REAL*8 XMREP(NLIAB,4,IDIMB)
  81.          INTEGER ICHRES(NVES),IPORES(NRESPO,NPRES),IPOREP(NREP)
  82.          INTEGER ILIRES(NRESLI,NCRES)
  83.          INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
  84.          INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
  85.          INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
  86.          INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
  87.          INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
  88.          INTEGER ILPOLA(NLIAA,2)
  89.       ENDSEGMENT
  90.       SEGMENT,MTNUM
  91.          REAL*8 XDT(NPC1),XTEMPS(NPC1)
  92.       ENDSEGMENT
  93. *
  94.       POINTEUR LCHAIN.MLENTI
  95.       POINTEUR MTABU.MTABLE, MTAB4.MTABLE
  96. *
  97.       INTEGER ipotab(8)
  98.       LOGICAL L0,L1,REPRIS,LMODYN
  99.       CHARACTER*8 TYPRET,TYPOBJ
  100.       CHARACTER*72 CHARRE,CHARRI,iwri
  101. *
  102.       MPREF  = KPREF
  103.       MTRES  = KTRES
  104.       MTLIAA = KTLIAA
  105.       MTLIAB = KTLIAB
  106.       MTNUM  = KTNUM
  107.       NRES   = XRES(/1)
  108.       NCRES  = XRES(/2)
  109.       NPRES  = XRES(/3)
  110.       NREP   = XREP(/1)
  111.       NLSA   = XRESLA(/1)
  112.       NLSB   = XRESLB(/1)
  113.       NTVAR  = ILIREB(/2)
  114.       NLIAB  = XMREP(/1)
  115.       NLIAA  = ILPOLA(/1)
  116.       IF (MTLIAA.NE.0) THEN
  117.       NPLAA  = IPLIA(/2)
  118.       NXPALA = XPALA(/2)
  119.       ELSE
  120.       NPLAA  = 0
  121.       NXPALA = 0
  122.       ENDIF
  123.       NPLB = JPLIB(/1)
  124.       IDIMB = XMREP(/3)
  125.       LCHAIN = ICHAIN
  126.       INDC10 = -12345
  127.       MTAB1 = -6661
  128.       MTAB3 = -6663
  129.  
  130.       IF (ITSORT.EQ.INDC10) GOTO 1234
  131.  
  132.  
  133. ************************************************************************
  134. *   ----------     CREATION DE LA TABLE RESULTAT :     ----------
  135. ************************************************************************
  136.  
  137.       M = 3 + NLSA + NLSB
  138. c       IF (NRES.NE.0) THEN
  139. c       a priori on ne sait pas si on va sortir des listreel (autant que 
  140. c       de variables -> NRES) ou des chpoints (autant que des pas de 
  141. c       temps sortis -> NPRES)
  142. c         M = M + max(NPRES,NRES)
  143. c       ENDIF
  144. c       maintenant, on sait !
  145.       NRESPO=IPORES(/1)
  146.       NRESLI=ILIRES(/1)
  147.       if(NRESPO.ne.0) M=M+NPRES 
  148.       if(NRESLI.ne.0) M=M+NRES 
  149.       SEGINI,MTABLE
  150.       MLOTAB = M
  151.  
  152. *
  153. *     Sous-typage de la table resultat:
  154. *
  155.       MTABTI(1) = 'MOT'
  156.       ICHA6 = LCHAIN.LECT(6)
  157.       MTABII(1) = ICHA6
  158.       MTABTV(1) = 'MOT'
  159.       ICHA1 = LCHAIN.LECT(1)
  160.       MTABIV(1) = ICHA1
  161.  
  162. *
  163. ************************************************************************
  164. *   ----------     CREATION DE LA LISTE DES TEMPS      ----------
  165. ************************************************************************
  166. *
  167.       IINS = 1
  168.       IF ( REPRIS ) IINS = NINS + 1
  169.       MLREEL = IPOLR(1)
  170.       segact mlreel*mod
  171.       DO 10 IRES = 1,NPRES
  172.          PROG(IRES) = XTEMPS(IINS)
  173.          IINS = IINS + NINS
  174.  10      CONTINUE
  175. *     end do
  176.       SEGDES,MLREEL
  177. *
  178. *     Ecriture de la liste des temps de sortie dans la table resultat
  179. *     MTABLE . 'TEMPS_DE_SORTIE' = MLREEL
  180.       MTABTI(2) = 'MOT'
  181.       ICHA3 = LCHAIN.LECT(3)
  182.       MTABII(2) = ICHA3
  183.       MTABTV(2) = 'LISTREEL'
  184.       MTABIV(2) = MLREEL
  185.  
  186.  
  187. ************************************************************************
  188. *   ----------     CREATION DU BLOC DE REPRISE :     ----------
  189. ************************************************************************
  190.  
  191. *+*   SOUSTYPE / TEMPS_DE_REPRISE  / variables "principales"
  192.       M = NREP + 2
  193.       IF (NLIAA.NE.0) THEN
  194.          IPOLY = 0
  195.          DO 180 I = 1,NLIAA
  196.             IF (ILPOLA(I,1).NE.0) IPOLY = IPOLY + 1
  197.  180     CONTINUE
  198.          IF (IPOLY.NE.0) M = M + 1
  199.       ENDIF
  200.       IF (NLIAB.NE.0) M = M + 1
  201.       SEGINI,MTAB2
  202.       MTAB2.MLOTAB = M
  203. *
  204. * --- Sous-typage du bloc de reprise:
  205. *
  206.       MTAB2.MTABTI(1) = 'MOT'
  207.       ICHA6 = LCHAIN.LECT(6)
  208.       MTAB2.MTABII(1) = ICHA6
  209.       MTAB2.MTABTV(1) = 'MOT'
  210.       ICHA5 = LCHAIN.LECT(5)
  211.       MTAB2.MTABIV(1) = ICHA5
  212. *
  213. * --- Ecriture du temps de reprise:
  214. *
  215.       TREPRI = XTEMPS(IINS-NINS)
  216.       MTAB2.MTABTI(2) = 'MOT'
  217.       ICHA4 = LCHAIN.LECT(4)
  218.       MTAB2.MTABII(2) = ICHA4
  219.       MTAB2.MTABTV(2) = 'FLOTTANT'
  220.       MTAB2.RMTABV(2) = TREPRI
  221. *
  222. * --- Ecriture des CHPOINTs de reprise:
  223. *
  224.       J2 = 2
  225.       DO 20 J = 1,NREP
  226.          J2 = J2 + 1
  227.          MTAB2.MTABTI(J2) = 'MOT'
  228.          ICHAR = LCHAIN.LECT(6+J)
  229. * chpoints des travaux
  230.           IF (J.GT.8) ICHAR = LCHAIN.LECT(74+J)
  231.  
  232.          MTAB2.MTABII(J2) = ICHAR
  233.          MTAB2.MTABTV(J2) = 'CHPOINT'
  234.          MTAB2.MTABIV(J2) = IPOREP(J)
  235.  20   CONTINUE
  236. *
  237. * --- Ecriture des variables de liaison en base A
  238. *
  239.       IF (NLIAA.NE.0) THEN
  240. *
  241.          IF (IIMPI.EQ.333) THEN
  242.            WRITE(IOIMP,*)'DEVSO4 : bloc reprise liaison base A '
  243.            WRITE(IOIMP,*)'Nombre de liaisons a sauver : ',IPOLY
  244.          ENDIF
  245.          IF (IPOLY.NE.0) THEN
  246.             M = IPOLY
  247.             SEGINI,MTAB1
  248.             MTAB1.MLOTAB = M            
  249. *           Boucle sur les liaisons en base A (I)
  250.             II = 0
  251.             DO 200 I = 1,NLIAA
  252.                IF (IIMPI.EQ.333) 
  253.      &         WRITE(IOIMP,*)'I = ',I,' ILPOLA = ',ILPOLA(I,1)
  254. *              indice du numero de liaison base A
  255. *              II = II + 1
  256.  
  257. *           -- liaisons COUPLAGE_DEPLACEMENT + CONVOLUTION --
  258.                IF (ILPOLA(I,1).EQ.2) THEN
  259.  
  260. *                 creation sous table a l'indice II
  261.                   II = II + 1
  262.                   M = 3
  263.                   SEGINI MTAB3
  264.                   MTAB3.MLOTAB = M
  265.                   MTAB1.MTABTI(II) = 'ENTIER'
  266.                   MTAB1.MTABII(II) = II
  267.                   MTAB1.MTABTV(II) = 'TABLE'
  268.                   MTAB1.MTABIV(II) = MTAB3
  269.  
  270. c                 MTAB3 . 'TYPE' = 5
  271.                   MTAB3.MTABTI(1) = 'MOT'
  272.                   ICHAR = LCHAIN.LECT(40)
  273.                   MTAB3.MTABII(1) = ICHAR
  274.                   MTAB3.MTABTV(1) = 'ENTIER'
  275.                   MTAB3.MTABIV(1) = 5
  276.  
  277.                   IFONC=IPALA(I,3)
  278. Cbp2017-12-21 : pour l'instant on sort aux meme indices 
  279. c               pour les 2 types de convolutions meme si pour le modele
  280. c               de granger_paidoussis il ne s'agit pas de deplacements !
  281.  
  282. c                 MTAB3 . 'DEPLACEMENT' = listreel
  283.                   MTAB3.MTABTI(2) = 'MOT'
  284.                   ICHAR = LCHAIN.LECT(7)
  285.                   MTAB3.MTABII(2) = ICHAR
  286.                   MTAB3.MTABTV(2) = 'LISTREEL'
  287. c                   IF (IFONC.EQ.100) THEN
  288.                     MTAB3.MTABIV(2) = IPALA(I,5)
  289. c                   ELSEIF(IFONC.EQ.101) THEN
  290. c                   --> optimisation : on retrouve les memes indices ...
  291. c                     MTAB3.MTABIV(2) = IPALA(I,6)
  292. c                   ENDIF
  293. *
  294. c                 MTAB3 . 'DEPLACEMENT_1/2' = listreel
  295.                   MTAB3.MTABTI(3) = 'MOT'
  296.                   ICHAR = LCHAIN.LECT(9)
  297.                   MTAB3.MTABII(3) = ICHAR
  298.                   MTAB3.MTABTV(3) = 'LISTREEL'
  299. c                   IF (IFONC.EQ.100) THEN
  300.                     MTAB3.MTABIV(3) = IPALA(I,6)
  301. c                   ELSEIF(IFONC.EQ.101) THEN
  302. c                   --> optimisation : on retrouve les memes indices ...
  303. c                     MTAB3.MTABIV(3) = IPALA(I,7)
  304. c                   ENDIF
  305.                   SEGDES MTAB3                  
  306.  
  307. c                   ENDIF
  308.  
  309. *           -- liaisons POLYNOMIALEs --
  310.                ELSEIF (ILPOLA(I,1).NE.0) THEN
  311.  
  312. *                 creation sous table a l'indice II
  313.                   II = II + 1
  314.                   M = 3
  315.                   SEGINI MTAB3
  316.                   MTAB3.MLOTAB = M
  317. *
  318.                   MTAB1.MTABTI(II) = 'ENTIER'
  319.                   MTAB1.MTABII(II) = II
  320.                   MTAB1.MTABTV(II) = 'TABLE'
  321.                   MTAB1.MTABIV(II) = MTAB3
  322. *
  323. c                 MTAB3 . 'TYPE' = 6
  324.                   MTAB3.MTABTI(1) = 'MOT'
  325.                   ICHAR = LCHAIN.LECT(40)
  326.                   MTAB3.MTABII(1) = ICHAR
  327.                   MTAB3.MTABTV(1) = 'ENTIER'
  328.                   MTAB3.MTABIV(1) = 6
  329. *
  330.                   MLENTI = ILPOLA(I,1)
  331.                   IPLEN1 = MLENTI
  332.                   DO 220 J = 1,NPLAA
  333.                      K = (J*2) - 1
  334.                      IPP = IPLIA(I,J)
  335.                      LECT(K) = JPLIA(IPP)
  336.                      K = J * 2
  337.                      LECT(K) = IPP
  338.  220              CONTINUE
  339.                   IF (IIMPI.EQ.333) THEN
  340.                    NPLA2 = NPLAA * 2
  341.                   ENDIF
  342.                   SEGDES MLENTI
  343. *
  344. c                 MTAB3 . 'POINTS_LIAISON_POLYNOMIALE' = listenti
  345.                   MTAB3.MTABTI(2) = 'MOT'
  346.                   ICHAR = LCHAIN.LECT(78)
  347.                   MTAB3.MTABII(2) = ICHAR
  348.                   MTAB3.MTABTV(2) = 'LISTENTI'
  349.                   MTAB3.MTABIV(2) = IPLEN1
  350. *
  351.                   MLREEL = ILPOLA(I,2)
  352.                   IPLRE1 = MLREEL
  353.                   DO 230 J = 1,NXPALA
  354.                      PROG(J) = XPALA(I,J)
  355.  230              CONTINUE
  356.                   IF (IIMPI.EQ.333) THEN
  357.                    WRITE(IOIMP,*)'DEVSO4 : PROG=',(PROG(j),j=1,NXPALA)
  358.                   ENDIF
  359.                   SEGDES MLREEL
  360. *
  361. c                 MTAB3 . 'VARIABLES_LIAISON_POLYNOMIALE' = listreel
  362.                   MTAB3.MTABTI(3) = 'MOT'
  363.                   ICHAR = LCHAIN.LECT(79)
  364.                   MTAB3.MTABII(3) = ICHAR
  365.                   MTAB3.MTABTV(3) = 'LISTREEL'
  366.                   MTAB3.MTABIV(3) = IPLRE1
  367.                   SEGDES MTAB3
  368.                ENDIF
  369.  
  370.  200        CONTINUE
  371.             SEGDES MTAB1
  372. *
  373. *           Bloc des variables internes liaison A ---> bloc de reprise
  374. *
  375.             J2 = J2 + 1
  376.             MTAB2.MTABTI(J2) = 'MOT'
  377.             ICHAR = LCHAIN.LECT(80)
  378.             MTAB2.MTABII(J2) = ICHAR
  379.             MTAB2.MTABTV(J2) = 'TABLE'
  380.             MTAB2.MTABIV(J2) = MTAB1
  381.          ENDIF
  382.       ENDIF
  383. * --- fin d'ecriture des variables de liaison en base A
  384. *
  385. * --- Ecriture des variables de liaison en base B
  386. *
  387.       IF (NLIAB.NE.0) THEN
  388.          M = NLIAB
  389.          SEGINI,MTAB1
  390.          MTAB1.MLOTAB = M
  391. *
  392.          DO 100 I = 1,NLIAB
  393.             ITYP = IMREP(I,1)
  394.             IF (ITYP.EQ.23 .OR.
  395.      &          ITYP.EQ.24 .OR. ITYP.EQ.3  .OR. ITYP.EQ.103  .OR.
  396.      &          ITYP.EQ.13 .OR. ITYP.EQ.113 .OR. ITYP.EQ.5  .OR.
  397.      &          ITYP.EQ.6  .OR. ITYP.EQ.33 .OR. ITYP.EQ.34
  398.      &         .OR.ITYP.EQ.-13) THEN
  399.                M = 5
  400.                SEGINI,MTAB3
  401.                MTAB3.MLOTAB = M
  402. *
  403.                MTAB1.MTABTI(I) = 'ENTIER'
  404.                MTAB1.MTABII(I) = I
  405.                MTAB1.MTABTV(I) = 'TABLE'
  406.                MTAB1.MTABIV(I) = MTAB3
  407. *
  408.                MTAB3.MTABTI(1) = 'MOT'
  409.                ICHAR = LCHAIN.LECT(40)
  410.                MTAB3.MTABII(1) = ICHAR
  411.                MTAB3.MTABTV(1) = 'ENTIER'
  412.                MTAB3.MTABIV(1) = ITYP
  413. *
  414.                MTAB3.MTABTI(2) = 'MOT'
  415.                ICHAR = LCHAIN.LECT(43)
  416.                MTAB3.MTABII(2) = ICHAR
  417.                MTAB3.MTABTV(2) = 'ENTIER'
  418.                MTAB3.MTABIV(2) = IMREP(I,2)
  419. *
  420.                MTAB3.MTABTI(3) = 'MOT'
  421.                ICHAR = LCHAIN.LECT(41)
  422.                MTAB3.MTABII(3) = ICHAR
  423.                MTAB3.MTABTV(3) = 'POINT'
  424.                MTAB3.MTABIV(3) = IPPREP(I,1)
  425. *
  426.                MTAB3.MTABTI(4) = 'MOT'
  427.                ICHAR = LCHAIN.LECT(42)
  428.                MTAB3.MTABII(4) = ICHAR
  429.                MTAB3.MTABTV(4) = 'POINT'
  430.                MTAB3.MTABIV(4) = IPPREP(I,2)
  431. *
  432.                MTAB3.MTABTI(5) = 'MOT'
  433.                ICHAR = LCHAIN.LECT(37)
  434.                MTAB3.MTABII(5) = ICHAR
  435.                MTAB3.MTABTV(5) = 'POINT'
  436.                MTAB3.MTABIV(5) = IPPREP(I,3)
  437.  
  438.        ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
  439.  
  440.                M = 6
  441.                SEGINI,MTAB3
  442.                MTAB3.MLOTAB = M
  443. *
  444.                MTAB1.MTABTI(I) = 'ENTIER'
  445.                MTAB1.MTABII(I) = I
  446.                MTAB1.MTABTV(I) = 'TABLE'
  447.                MTAB1.MTABIV(I) = MTAB3
  448. *
  449.                MTAB3.MTABTI(1) = 'MOT'
  450.                ICHAR = LCHAIN.LECT(40)
  451.                MTAB3.MTABII(1) = ICHAR
  452.                MTAB3.MTABTV(1) = 'ENTIER'
  453.                MTAB3.MTABIV(1) = ITYP
  454. *
  455.                MTAB3.MTABTI(2) = 'MOT'
  456.                ICHAR = LCHAIN.LECT(43)
  457.                MTAB3.MTABII(2) = ICHAR
  458.                MTAB3.MTABTV(2) = 'ENTIER'
  459.                MTAB3.MTABIV(2) = IMREP(I,2)
  460. *
  461.                MTAB3.MTABTI(3) = 'MOT'
  462.                ICHAR = LCHAIN.LECT(41)
  463.                MTAB3.MTABII(3) = ICHAR
  464.                MTAB3.MTABTV(3) = 'POINT'
  465.                MTAB3.MTABIV(3) = IPPREP(I,1)
  466. *
  467.                MTAB3.MTABTI(4) = 'MOT'
  468.                ICHAR = LCHAIN.LECT(42)
  469.                MTAB3.MTABII(4) = ICHAR
  470.                MTAB3.MTABTV(4) = 'POINT'
  471.                MTAB3.MTABIV(4) = IPPREP(I,2)
  472. *
  473.                MTAB3.MTABTI(5) = 'MOT'
  474.                ICHAR = LCHAIN.LECT(37)
  475.                MTAB3.MTABII(5) = ICHAR
  476.                MTAB3.MTABTV(5) = 'POINT'
  477.                MTAB3.MTABIV(5) = IPPREP(I,3)
  478.  
  479.                MTAB3.MTABTI(6) = 'MOT'
  480.                ICHAR = LCHAIN.LECT(120)
  481.                MTAB3.MTABII(6) = ICHAR
  482.                MTAB3.MTABTV(6) = 'POINT'
  483.                MTAB3.MTABIV(6) = IPPREP(I,4)
  484.  
  485.        ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36 .OR. ITYP.EQ.37
  486.      &.OR. ITYP.EQ.38 .OR. ITYP.EQ.39 .OR. ITYP.EQ.40 ) THEN
  487.                M = 3
  488.                SEGINI,MTAB3
  489.                MTAB3.MLOTAB = M
  490. *
  491.                MTAB1.MTABTI(I) = 'ENTIER'
  492.                MTAB1.MTABII(I) = I
  493.                MTAB1.MTABTV(I) = 'TABLE'
  494.                MTAB1.MTABIV(I) = MTAB3
  495. *
  496.                MTAB3.MTABTI(1) = 'MOT'
  497.                ICHAR = LCHAIN.LECT(40)
  498.                MTAB3.MTABII(1) = ICHAR
  499.                MTAB3.MTABTV(1) = 'ENTIER'
  500.                MTAB3.MTABIV(1) = ITYP
  501. *
  502.                MTAB3.MTABTI(2) = 'MOT'
  503.                ICHAR = LCHAIN.LECT(43)
  504.                MTAB3.MTABII(2) = ICHAR
  505.                MTAB3.MTABTV(2) = 'ENTIER'
  506.                MTAB3.MTABIV(2) = IMREP(I,2)
  507. *
  508. *
  509. *       noeud  voisin
  510. *   creation du list entier contenant les noeuds voisins
  511.                NNOEMA = IPALB(I,21)
  512.                NNOEES = IPALB(I,22)
  513.                JG = (NNOEMA+NNOEES)
  514.                SEGINI,MLENTI
  515.                DO 120 IVOIS=1,(NNOEMA+NNOEES)
  516.                   LECT(IVOIS)=IPALB(I,26+IVOIS)
  517.  120           CONTINUE
  518.                IVOIS1=MLENTI
  519.                SEGDES,MLENTI
  520.                MTAB3.MTABTI(3) = 'MOT'
  521.                ICHAR = LCHAIN.LECT(103)
  522.                MTAB3.MTABII(3) = ICHAR
  523.                MTAB3.MTABTV(3) = 'LISTENTI'
  524.                MTAB3.MTABIV(3) = IVOIS1
  525. *
  526.             ELSE IF (ITYP.EQ.7) THEN
  527.                M = 4
  528.                SEGINI,MTAB3
  529.                MTAB3.MLOTAB = M
  530. *
  531.                MTAB1.MTABTI(I) = 'ENTIER'
  532.                MTAB1.MTABII(I) = I
  533.                MTAB1.MTABTV(I) = 'TABLE'
  534.                MTAB1.MTABIV(I) = MTAB3
  535. *
  536.                MTAB3.MTABTI(1) = 'MOT'
  537.                ICHAR = LCHAIN.LECT(40)
  538.                MTAB3.MTABII(1) = ICHAR
  539.                MTAB3.MTABTV(1) = 'ENTIER'
  540.                MTAB3.MTABIV(1) = ITYP
  541. *
  542.                MTAB3.MTABTI(2) = 'MOT'
  543.                ICHAR = LCHAIN.LECT(9)
  544.                MTAB3.MTABII(2) = ICHAR
  545.                MTAB3.MTABTV(2) = 'POINT'
  546.                MTAB3.MTABIV(2) = IPPREP(I,1)
  547. *
  548.                MTAB3.MTABTI(3) = 'MOT'
  549.                ICHAR = LCHAIN.LECT(10)
  550.                MTAB3.MTABII(3) = ICHAR
  551.                MTAB3.MTABTV(3) = 'POINT'
  552.                MTAB3.MTABIV(3) = IPPREP(I,2)
  553. *
  554.                MTAB3.MTABTI(4) = 'MOT'
  555.                ICHAR = LCHAIN.LECT(12)
  556.                MTAB3.MTABII(4) = ICHAR
  557.                MTAB3.MTABTV(4) = 'POINT'
  558.                MTAB3.MTABIV(4) = IPPREP(I,3)
  559. **  ianis
  560.             ELSE IF (ITYP.EQ.100 .OR. ITYP.EQ.101) THEN
  561.                M = 2
  562.                SEGINI,MTAB3
  563.                MTAB3.MLOTAB = M
  564. *
  565.                MTAB1.MTABTI(I) = 'ENTIER'
  566.                MTAB1.MTABII(I) = I
  567.                MTAB1.MTABTV(I) = 'TABLE'
  568.                MTAB1.MTABIV(I) = MTAB3
  569. *
  570.                MTAB3.MTABTI(1) = 'MOT'
  571.                ICHAR = LCHAIN.LECT(40)
  572.                MTAB3.MTABII(1) = ICHAR
  573.                MTAB3.MTABTV(1) = 'ENTIER'
  574.                MTAB3.MTABIV(1) = ITYP
  575. *
  576.           IDIM   = IPALB(I,3)
  577.           id1 = 4
  578.                MTAB3.MTABTI(2) = 'MOT'
  579.                ICHAR = LCHAIN.LECT(82)
  580.                MTAB3.MTABII(2) = ICHAR
  581.                MTAB3.MTABTV(2) = 'FLOTTANT'
  582.                MTAB3.RMTABV(2) = XPALB(I,id1+idim+1)
  583. *
  584. C NW
  585.             ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17) THEN
  586.                M = 4
  587.                SEGINI,MTAB3
  588.                MTAB3.MLOTAB = M
  589. *
  590.                MTAB1.MTABTI(I) = 'ENTIER'
  591.                MTAB1.MTABII(I) = I
  592.                MTAB1.MTABTV(I) = 'TABLE'
  593.                MTAB1.MTABIV(I) = MTAB3
  594. *
  595.                MTAB3.MTABTI(1) = 'MOT'
  596.                ICHAR = LCHAIN.LECT(40)
  597.                MTAB3.MTABII(1) = ICHAR
  598.                MTAB3.MTABTV(1) = 'ENTIER'
  599.                MTAB3.MTABIV(1) = ITYP
  600.  
  601. *
  602.           idim =  IPALB(I,3)
  603.           if (ityp.eq.16) nn = 4 + idim
  604.           if (ityp.eq.17) nn = 5 + idim
  605.                MTAB3.MTABTI(2) = 'MOT'
  606.                ICHAR = LCHAIN.LECT(82)
  607.                MTAB3.MTABII(2) = ICHAR
  608.                MTAB3.MTABTV(2) = 'FLOTTANT'
  609.                MTAB3.RMTABV(2) = XPALB(I,NN-2)
  610.  
  611.                MTAB3.MTABTI(3) = 'MOT'
  612.                ICHAR = LCHAIN.LECT(100)
  613.                MTAB3.MTABII(3) = ICHAR
  614.                MTAB3.MTABTV(3) = 'FLOTTANT'
  615.                MTAB3.RMTABV(3) = XPALB(I,NN-1)
  616.  
  617.                MTAB3.MTABTI(4) = 'MOT'
  618.                ICHAR = LCHAIN.LECT(111)
  619.                MTAB3.MTABII(4) = ICHAR
  620.                MTAB3.MTABTV(4) = 'FLOTTANT'
  621.                MTAB3.RMTABV(4) = XPALB(I,NN)
  622.  
  623. *
  624.             ELSE IF (ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  625.                M = 4
  626.                SEGINI,MTAB3
  627.                MTAB3.MLOTAB = M
  628. *
  629.                MTAB1.MTABTI(I) = 'ENTIER'
  630.                MTAB1.MTABII(I) = I
  631.                MTAB1.MTABTV(I) = 'TABLE'
  632.                MTAB1.MTABIV(I) = MTAB3
  633. *
  634.                MTAB3.MTABTI(1) = 'MOT'
  635.                ICHAR = LCHAIN.LECT(40)
  636.                MTAB3.MTABII(1) = ICHAR
  637.                MTAB3.MTABTV(1) = 'ENTIER'
  638.                MTAB3.MTABIV(1) = ITYP
  639. *
  640.           idim =  IPALB(I,3)
  641.           if (ityp.eq.50) nn = 4 + idim
  642.           if (ityp.eq.51) nn = 5 + idim
  643.                MTAB3.MTABTI(2) = 'MOT'
  644.                ICHAR = LCHAIN.LECT(102)
  645.                MTAB3.MTABII(2) = ICHAR
  646.                MTAB3.MTABTV(2) = 'FLOTTANT'
  647.                MTAB3.RMTABV(2) = XPALB(I,NN-2)
  648.  
  649.                MTAB3.MTABTI(3) = 'MOT'
  650.                ICHAR = LCHAIN.LECT(99)
  651.                MTAB3.MTABII(3) = ICHAR
  652.                MTAB3.MTABTV(3) = 'FLOTTANT'
  653.                MTAB3.RMTABV(3) = XPALB(I,NN-1)
  654.  
  655.                MTAB3.MTABTI(4) = 'MOT'
  656.                ICHAR = LCHAIN.LECT(112)
  657.                MTAB3.MTABII(4) = ICHAR
  658.                MTAB3.MTABTV(4) = 'FLOTTANT'
  659.                MTAB3.RMTABV(4) = XPALB(I,NN)
  660. *
  661.             ELSE
  662.                M = 1
  663.                SEGINI,MTAB3
  664.                MTAB3.MLOTAB = M
  665. *
  666.                MTAB1.MTABTI(I) = 'ENTIER'
  667.                MTAB1.MTABII(I) = I
  668.                MTAB1.MTABTV(I) = 'TABLE'
  669.                MTAB1.MTABIV(I) = MTAB3
  670. *
  671.                MTAB3.MTABTI(1) = 'MOT'
  672.                ICHAR = LCHAIN.LECT(40)
  673.                MTAB3.MTABII(1) = ICHAR
  674.                MTAB3.MTABTV(1) = 'ENTIER'
  675.                MTAB3.MTABIV(1) = ITYP
  676.             ENDIF
  677. *
  678.             SEGDES,MTAB3
  679.  100     CONTINUE
  680.          SEGDES,MTAB1
  681. *
  682. *     Ecriture du bloc des variables de liaison dans le bloc reprise
  683. *
  684.          J2 = J2 + 1
  685.          MTAB2.MTABTI(J2) = 'MOT'
  686.          ICHAR = LCHAIN.LECT(44)
  687.          MTAB2.MTABII(J2) = ICHAR
  688.          MTAB2.MTABTV(J2) = 'TABLE'
  689.          MTAB2.MTABIV(J2) = MTAB1
  690.       ENDIF
  691. * --- fin d'ecriture des variables de liaison en base B
  692. *
  693.       SEGDES,MTAB2
  694. *
  695. * --- Ecriture du bloc de reprise dans la table resultat:
  696. *     MTABLE .'REPRISE' = MTAB2
  697. *
  698.       IF (LMODYN) THEN
  699.        iptlar = mtab2
  700.               CALL ECCTAB(ITDYN,'MOT',0,0.D0,'REPRISE_DYNE',.TRUE.,0,
  701.      #                   'TABLE',0,0.D0,CHARRE,.TRUE.,iptlar)
  702.       ELSE
  703.         MTABTI(3) = 'MOT'
  704.         ICHA5 = LCHAIN.LECT(5)
  705.         MTABII(3) = ICHA5
  706.         MTABTV(3) = 'TABLE'
  707.         MTABIV(3) = MTAB2
  708.       ENDIF
  709. *
  710.       IRE2 = 3
  711.  
  712. *
  713. ************************************************************************
  714. *----------     CREATION DES TABLES AUX PAS DE SORTIE     ----------
  715. ************************************************************************
  716. *
  717. * --- syntaxe table PASAPAS ---  
  718.       IF (LMODYN) THEN
  719. *
  720.          typobj = ' '
  721.          CALL ACCTAB(ITDYN,'MOT',IM,X0,'TEMPS',L0,IP0,
  722.      &                    typobj,np,X1,CHARRE,L1,IPTEMP)
  723.          M = 1
  724.          segini MTABU
  725.          MTABU.MLOTAB = 1
  726.          if (iptemp.gt.0.and.typobj(1:8).eq.'TABLE') then
  727.               call dimen7(iptemp,idimen)
  728.               indi1 = idimen - 1
  729.               DO  ISOR = 1 , 8
  730.                 IF (ICHRES(ISOR).EQ.1) THEN
  731.                  ICHAR = LCHAIN.LECT(6+ISOR)
  732.                  IF(ISOR.GT.6) ICHAR = LCHAIN.LECT(76+ISOR)
  733.                     segact MTABU*mod
  734.                  MTABU.MTABTI(1) = 'ENTIER'
  735.                  MTABU.MTABII(1) = 1
  736.                  MTABU.MTABTV(1) = 'MOT'
  737.                  MTABU.MTABIV(1) = ICHAR
  738.                  typret=' '
  739.                  CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0,
  740.      &                    typret,IUI,X1,CHARRE,L1,IP1)
  741.              if (CHARRE.EQ.'VITESSE') CHARRE = 'VITESSES'
  742.              if (CHARRE.EQ.'DEPLACEMENT') CHARRE = 'DEPLACEMENTS'
  743.               CALL ACCTAB(ITDYN,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  744.      #                   'TABLE',0,0.D0,CHARRI,.TRUE.,IPTCHP)
  745.                  ipotab(isor) = IPTCHP
  746.                ENDIF
  747.               ENDDO
  748.  
  749.          else
  750.  
  751.               CALL CRTABL(IPTEMP)
  752.               CALL ECCTAB(ITDYN,'MOT',0,0.D0,'TEMPS',.TRUE.,0,
  753.      #                   'TABLE',0,0.D0,CHARRE,.TRUE.,iptemp)
  754.               indi1 = -1
  755.               DO  ISOR = 1 , 8
  756.                 IF (ICHRES(ISOR).EQ.1) THEN
  757.                  CALL CRTABL(IPTCHP)
  758.                  ipotab(isor) = IPTCHP
  759.                  ICHAR = LCHAIN.LECT(6+ISOR)
  760.                  IF(ISOR.GT.6) ICHAR = LCHAIN.LECT(76+ISOR)
  761.                     segact MTABU*mod
  762.                  MTABU.MTABTI(1) = 'ENTIER'
  763.                  MTABU.MTABII(1) = 1
  764.                  MTABU.MTABTV(1) = 'MOT'
  765.                  MTABU.MTABIV(1) = ICHAR
  766.                  typret=' '
  767.                  CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0,
  768.      &                    typret,IUI,X1,CHARRE,L1,IP1)
  769.  
  770.              if (CHARRE.EQ.'VITESSE') CHARRE = 'VITESSES'
  771.              if (CHARRE.EQ.'DEPLACEMENT') CHARRE = 'DEPLACEMENTS'
  772.               CALL ECCTAB(ITDYN,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  773.      #                   'TABLE',0,0.D0,CHARRI,.TRUE.,IPTCHP)
  774.                ENDIF
  775.               ENDDO
  776.               segsup MTABU
  777.          endif
  778.          MLREEL = IPOLR(1)
  779.          segact mlreel
  780.          indi0 = indi1
  781.  
  782.          DO ires = 1,npres
  783.            indi1 = indi1 + 1
  784.            xtemp1 = prog(ires)
  785. *          temps calcules
  786.            CALL ECCTAB(IPTEMP,'ENTIER',INDI1,0.D0,CHARRI,.TRUE.,IP0,
  787.      #                   'FLOTTANT',0,xtemp1,CHARRE,.TRUE.,IP1)
  788.          ENDDO
  789.       ENDIF
  790. * --- fin syntaxe table PASAPAS ---  
  791.  
  792.  
  793. * === Cas ou l'on a demande une sortie ===
  794.       IF (NRES.NE.0) THEN
  795.  
  796. *   --- syntaxe table PASAPAS ---      
  797.         IF (LMODYN) THEN
  798.           indi1 = indi0
  799.           DO ires = 1,npres
  800.             indi1 = indi1 + 1
  801.             IVAR = 0
  802.             DO isor = 1,8
  803. * champs en sortie
  804.                IF (ICHRES(ISOR).EQ.1) THEN
  805.                   IVAR = IVAR + 1
  806.                   IPTCHP = ipotab(isor)
  807.                   ipch1 =  IPORES(IVAR,IRES)
  808.            CALL ECCTAB(IPTCHP,'ENTIER',INDI1,0.D0,CHARRI,.TRUE.,IP0,
  809.      #               'CHPOINT',0,0.D0,CHARRE,.TRUE.,ipch1)
  810.  
  811.                ENDIF
  812.             ENDDO
  813.           ENDDO
  814. *
  815. *   --- syntaxe tables DYNE normales ---      
  816.         ELSE
  817. *          
  818. *      *******************************************
  819. *       1.TRAITEMENT DES SORTIES DE TYPE LISTREEL 
  820. *      *******************************************
  821. *
  822.           IF(NRESLI.GT.0) THEN
  823.           IVAR = 0
  824.           DO 41 ISOR = 1,8
  825. c             IF(ICHRES(ISOR).NE.0) IVAR = IVAR + 1
  826. c             IF(ICHRES(ISOR).NE.2) GOTO 41
  827.             IF(ICHRES(ISOR).NE.2) GOTO 41
  828.             IVAR = IVAR + 1
  829. c           Creation de la table de sortie de la variable
  830.             M = NCRES
  831.             SEGINI,MTAB1
  832.             MTAB1.MLOTAB = M
  833. c           avec MTAB1 . point_ref_mode_i = prog x_i(t1) ... x_i(tfin)
  834.             DO INCO=1,NCRES
  835.               IPLREE = ILIRES(IVAR,INCO)
  836.               MTAB1.MTABTI(INCO) = 'POINT'
  837.               MTAB1.MTABII(INCO) = IPOREF(INCO)
  838.               MTAB1.MTABTV(INCO) = 'LISTREEL'
  839.               MTAB1.MTABIV(INCO) = IPLREE   
  840. c               write(*,*) 'devso4: IVAR',IVAR,' mode',INCO,
  841. c      #              ' listreel #',IPLREE
  842.             ENDDO
  843.             SEGDES,MTAB1
  844. c           on branche cette table dans la table de sortie principale
  845.             IRE2 = IRE2 + 1
  846.             ICHA6= LCHAIN.LECT(6+ISOR)
  847.             IF(ISOR.GT.6) ICHA6 = LCHAIN.LECT(76+ISOR)
  848.             MTABTI(IRE2) = 'MOT'
  849.             MTABII(IRE2) = ICHA6
  850.             MTABTV(IRE2) = 'TABLE'
  851.             MTABIV(IRE2) = MTAB1
  852.  
  853.  41       CONTINUE
  854.           ENDIF
  855. *          
  856. *      *******************************************
  857. *       2.TRAITEMENT DES SORTIES DE TYPE CHPOINT
  858. *      *******************************************
  859. *
  860.           IF(NRESPO.GT.0) THEN
  861. *         boucle sur les pas de sortie
  862.           DO 30 IRES = 1 , NPRES
  863. *
  864. *           Creation de la table au pas de sortie IRES:
  865.             M = NRES + 1
  866.             SEGINI,MTAB1
  867.             MTAB1.MLOTAB = M
  868. *
  869. *           Sous-typage de la table au pas de sortie IRES:
  870.             MTAB1.MTABTI(1) = 'MOT'
  871.             ICHA6 = LCHAIN.LECT(6)
  872.             MTAB1.MTABII(1) = ICHA6
  873.             MTAB1.MTABTV(1) = 'MOT'
  874.             ICHA2 = LCHAIN.LECT(2)
  875.             MTAB1.MTABIV(1) = ICHA2
  876. *
  877. *           Ecriture des CHPOINTs resultats:
  878.             IVAR = 0
  879.             DO 40 ISOR = 1 , 8
  880. c                IF (ICHRES(ISOR).NE.0) IVAR = IVAR + 1
  881. c                IF (ICHRES(ISOR).NE.1) GOTO 40
  882.                IF (ICHRES(ISOR).NE.1) GOTO 40
  883.                IVAR = IVAR + 1
  884.                MTAB1.MTABTI(IVAR) = 'MOT'
  885.                ICHAR = LCHAIN.LECT(6+ISOR)
  886. *              chpoints de travaux
  887.                IF(ISOR.GT.6) ICHAR = LCHAIN.LECT(76+ISOR)
  888.                MTAB1.MTABII(IVAR) = ICHAR
  889.                MTAB1.MTABTV(IVAR) = 'CHPOINT'
  890.                MTAB1.MTABIV(IVAR) = IPORES(IVAR,IRES)
  891.  40         CONTINUE
  892.             SEGDES,MTAB1
  893. *
  894. *           Ecriture de la table au pas IRES dans la table resultat:
  895.             IRE2 = IRE2 + 1
  896.             MTABTI(IRE2) = 'ENTIER'
  897.             MTABII(IRE2) = IRES
  898.             MTABTV(IRE2) = 'TABLE'
  899.             MTABIV(IRE2) = MTAB1
  900.  
  901.  30       CONTINUE
  902.           ENDIF
  903.  
  904.         ENDIF
  905. *   --- fin syntaxe table PASAPAS / tables DYNE normales ---      
  906.  
  907.       ENDIF
  908. * === Fin du Cas ou l'on a demande une sortie ===
  909.  
  910.  1234 CONTINUE
  911.  
  912. *
  913. ************************************************************************
  914. *-----     CREATION DES TABLES DE LIAISONS AUX PAS DE SORTIE     -----
  915. ************************************************************************
  916. *
  917.       IPTLA1 = 0
  918.       IF (LMODYN) THEN
  919.         IF (NLSA.NE.0.OR.NLSB.NE.0) THEN
  920.           typobj = ' '
  921.           CALL ACCTAB(ITDYN,'MOT',IM,X0,'LIAISONS',L0,IP0,
  922.      &                    typobj,np,X1,CHARRE,L1,IPTLA1)
  923.            if (iptla1.gt.0.and.typobj(1:8).eq.'TABLE') then
  924.               call dimen7(iptla1,idimen)
  925.               indi1 = idimen - 1
  926.            else
  927.               CALL CRTABL(IPTLA1)
  928. c*            idimen = 0
  929. c*            indi1 = -1
  930.               CALL ECCTAB(ITDYN,'MOT',0,0.D0,'LIAISONS',.TRUE.,0,
  931.      #                   'TABLE',0,0.D0,CHARRE,.TRUE.,IPTLA1)
  932.            ENDIF
  933.         ENDIF
  934.       ENDIF
  935. *
  936.       MTABU = 0
  937.       M = 1
  938.       segini MTABU
  939.       MTABU.MLOTAB = 1
  940.  
  941. *-----     LIAISONS_A     -----
  942.       IF (NLSA.NE.0) THEN
  943.  
  944. *        Boucle sur les liaisons A      
  945.          DO 50 IL = 1,NLSA
  946. *
  947. *           Creation de la table pour la liaison IL :
  948. *
  949.             NVAR = ICHRES(10 + IL)
  950.             M = NVAR + 1
  951.             SEGINI,MTAB3
  952.             MTAB3.MLOTAB = M
  953. *
  954. *           Sous-typage de la table pour la liaison IL :
  955. *
  956.             ID = 1
  957.             MTAB3.MTABTI(ID) = 'MOT'
  958.             ICHA6 = LCHAIN.LECT(6)
  959.             MTAB3.MTABII(ID) = ICHA6
  960.             MTAB3.MTABTV(ID) = 'MOT'
  961.             ICHA1 = LCHAIN.LECT(ID)
  962.             MTAB3.MTABIV(ID) = ICHA1
  963. *
  964.        IPTLA3 = 0
  965.        IF (LMODYN) THEN
  966.          itmodl = IPOLA(IL)
  967.          typobj = ' '
  968.          CALL ACCTAB(IPTLA1,'MMODEL ',IM,X0,CHARRE,L0,itmodl,
  969.      &                    typobj,np,X1,CHARRI,L1,IPTLA3)
  970.  
  971.          if (typobj.eq.'TABLE'.and.iptla3.gt.0) then
  972.            ipta3 = 0
  973.          else
  974.            iptla3 = 0
  975.            ipta3 = mtab3
  976.               CALL ECCTAB(IPTLA1,'MMODEL  ',0,0.D0,CHARRE,.TRUE.,itmodl,
  977.      #                   'TABLE',0,0.D0,CHARRI,.TRUE.,ipta3)
  978.          endif
  979.        ELSE
  980. *
  981. *           Ecriture de la table de liaison dans la table resultat:
  982. *
  983.             IRE2 = IRE2 + 1
  984.             MTABTI(IRE2) = 'TABLE'
  985.             MTABII(IRE2) = IPOLA(IL)
  986.             MTABTV(IRE2) = 'TABLE'
  987.             MTABIV(IRE2) = MTAB3
  988. *
  989.        ENDIF
  990. *
  991.             II = 0
  992.             IF (IIMPI.EQ.333) THEN
  993.             WRITE(IOIMP,*)'DEVSO4 : creation table liaison ',IL
  994.             WRITE(IOIMP,*)'DEVSO4 : longueur table = ',M
  995.             WRITE(IOIMP,*)'DEVSO4 : !!! NTVAR = ',NTVAR
  996.             ENDIF
  997.             DO 52 IV = 1,NTVAR
  998.                IF (ILIREA(IL,IV).EQ.1) THEN
  999.                   II = II + 1
  1000.                   ICHA = ILIRNA(IL,IV)
  1001.                   MLREEL = IPLRLA(IL,II)
  1002.                   DO 54 IRES = 1 , NPRES
  1003.                      PROG(IRES) = XRESLA(IL,IRES,II)
  1004.  54               CONTINUE
  1005.                   ipl2 = mlreel
  1006.                   SEGDES,MLREEL
  1007. *
  1008. *                 Ecriture de la liste de reels dans la table MTAB3 :
  1009. *
  1010.                   ID = ID + 1
  1011.                   MTAB3.MTABTI(ID) = 'MOT'
  1012.                   MTAB3.MTABII(ID) = LCHAIN.LECT(ICHA)
  1013.                   MTAB3.MTABTV(ID) = 'LISTREEL'
  1014.                   MTAB3.MTABIV(ID) = MLREEL
  1015.                ENDIF
  1016.  52         CONTINUE
  1017.             SEGDES,MTAB3
  1018.  
  1019. cbp,2020-03-24 : on ne comprend pas tres bien le fonctionnement de la  
  1020. *                partie ci-dessous ecrite par joel (kich)...
  1021. *                il s'agit bien du cas IPTLA3=MMODEL (syntaxe PASAPAS)
  1022. *                il ne semble pas y avoir de boucle sur IV?
  1023. *  --> on pose IV=1  (correction facile mais probablement fausse)
  1024.                IV=1
  1025.                if (IPTLA3.gt.0.and.ILIREA(IL,IV).EQ.1) then
  1026.                  ICHAR = LCHAIN.LECT(ICHA)
  1027.                     segact MTABU*mod
  1028.                  MTABU.MTABTI(1) = 'ENTIER'
  1029.                  MTABU.MTABII(1) = 1
  1030.                  MTABU.MTABTV(1) = 'MOT'
  1031.                  MTABU.MTABIV(1) = ICHAR
  1032.                  typret=' '
  1033.                  CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0,
  1034.      &                    typret,IUI,X1,CHARRE,L1,IP1)
  1035.                   typret=' '
  1036.              CALL ACCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  1037.      #                   typret,0,0.D0,CHARRI,.TRUE.,IPTC3)
  1038.                  if (typret.eq.'LISTREEL') then
  1039.                   call fuspro(iptc3,ipl2,ipl3)
  1040.               CALL ECCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  1041.      #                   typret,0,0.D0,CHARRI,.TRUE.,ipl3)
  1042.                  else if (typret.eq.'TABLE') then
  1043.                   MTAB4 = IPTC3
  1044.                   segact MTAB4,MTAB1
  1045.                   M4 = MTAB4.MLOTAB
  1046.                   do IRES = 1,NPRES
  1047.                     ipch3 =  MTAB1.MTABIV(IRES)
  1048.               CALL ECCTAB(IPTC3,'ENTIER',M4+IRES,0.D0,CHARRE,.TRUE.,0,
  1049.      #                 'CHPOINT ',0,0.D0,CHARRI,.TRUE.,ipch3)
  1050.  
  1051.                   enddo
  1052.                   segsup MTAB1
  1053.                   segdes MTAB4
  1054.                  else
  1055.                  endif
  1056.  
  1057.                endif               
  1058.                if (IPTLA3.gt.0) segsup MTAB3
  1059. *
  1060.  50      CONTINUE
  1061. *        Fin de Boucle sur les liaisons A      
  1062.       ENDIF
  1063.  
  1064. *-----     LIAISONS_B     -----
  1065.       IF (NLSB.NE.0) THEN
  1066.  
  1067. *        Boucle sur les liaisons B      
  1068.          DO 60 IL = 1,NLSB
  1069. *
  1070. *           Creation de la table pour la liaison IL :
  1071. *
  1072.             NVAR = ICHRES(10 + IL + NLSA)
  1073.             M = NVAR + 1
  1074.             SEGINI,MTAB3
  1075.             MTAB3.MLOTAB = M
  1076. *
  1077. *           Sous-typage de la table pour la liaison IL :
  1078. *
  1079.             ID = 1
  1080.             MTAB3.MTABTI(ID) = 'MOT'
  1081.             ICHA6 = LCHAIN.LECT(6)
  1082.             MTAB3.MTABII(ID) = ICHA6
  1083.             MTAB3.MTABTV(ID) = 'MOT'
  1084.             ICHA1 = LCHAIN.LECT(ID)
  1085.             MTAB3.MTABIV(ID) = ICHA1
  1086. *
  1087. *           Ecriture de la table de liaison dans la table resultat:
  1088. *
  1089.        IPTLA3 = 0
  1090.        IF (LMODYN) THEN
  1091.          itmodl = IPOLB(IL)
  1092.          typobj = ' '
  1093.          CALL ACCTAB(IPTLA1,'MMODEL ',IM,X0,CHARRE,L0,itmodl,
  1094.      &                    typobj,np,X1,CHARRI,L1,IPTLA3)
  1095.          ipta3 = mtab3
  1096.          if (typobj.eq.'TABLE'.and.iptla3.gt.0) then
  1097.          else
  1098.            iptla3 = 0
  1099.               CALL ECCTAB(IPTLA1,'MMODEL  ',0,0.D0,CHARRE,.TRUE.,itmodl,
  1100.      #                   'TABLE',0,0.D0,CHARRI,.TRUE.,ipta3)
  1101.          endif
  1102.        ELSE
  1103.             IRE2 = IRE2 + 1
  1104. c             write(*,*) MTABLE,'.',IRE2,' = ss-table',MTAB3,' de dim ',M
  1105. c             write(*,*) '  pour la LIAISON B',IL,IPOLB(IL)
  1106.             MTABTI(IRE2) = 'TABLE'
  1107.             MTABII(IRE2) = IPOLB(IL)
  1108.             MTABTV(IRE2) = 'TABLE'
  1109.             MTABIV(IRE2) = MTAB3
  1110. *
  1111.        ENDIF
  1112. *
  1113. c             write(*,*) 'ILIREB(',IL,',:)=',(ILIREB(IL,iou),iou=1,NTVAR))
  1114. *           Boucle sur les grandeurs a sortir pour la IL^eme liaison B
  1115.             II = 0
  1116.             DO 62 IV = 1,NTVAR
  1117. c                write(*,*) 'Loop 62 :',IV,'/',NTVAR,' II=',II
  1118. *             -Sortie d'un LISTREEL
  1119.                IF (ILIREB(IL,IV).EQ.1) THEN
  1120.                   II = II + 1
  1121. c  XRESLB(IL,ires,II) = II^eme grandeur de la IL^eme liaison au pas de sortie ires 
  1122.                   ICHA = ILIRNB(IL,IV)
  1123.                   MLREEL = IPLRLB(IL,II)
  1124.                   DO 64 IRES = 1 , NPRES
  1125.                      PROG(IRES) = XRESLB(IL,IRES,II)
  1126.  64                  CONTINUE
  1127. *                 end do
  1128.                   ipl2 = mlreel
  1129.                   SEGDES,MLREEL
  1130. *
  1131. *                 Ecriture de la liste de reels dans la table MTAB3 :
  1132. *
  1133.                   ID = ID + 1
  1134.                   MTAB3.MTABTI(ID) = 'MOT'
  1135.                   MTAB3.MTABII(ID) = LCHAIN.LECT(ICHA)
  1136.                   MTAB3.MTABTV(ID) = 'LISTREEL'
  1137.                   MTAB3.MTABIV(ID) = MLREEL
  1138.  
  1139. c *              ---bp : pour write ---
  1140. c                   IDEB1=IPCHAR(LCHAIN.LECT(ICHA))
  1141. c                   IFIN1=IPCHAR(LCHAIN.LECT(ICHA)+1)
  1142. c                   ILON1=MIN(72,IFIN1-IDEB1)
  1143. c                   CHARRE(1:ILON1)=ICHARA(IDEB1:IDEB1+ILON1-1)
  1144. c                   write(*,*) II,'eme indice',CHARRE(1:ILON1)
  1145. c *              --- --- --- --- --- ---
  1146.  
  1147. *             -Sortie d'un CHPOINT
  1148.                ELSEIF (ILIREB(IL,IV).EQ.2) THEN
  1149. *  Ecriture des chpoints dans la table MTAB1, puis de cette
  1150. *  table dans la table MTAB3
  1151.  
  1152.                     ICHA = ILIRNB(IL,IV)
  1153.                     MTAB1 = IPLRLB(IL,II+1)
  1154.                     SEGACT,MTAB1*MOD
  1155.                     MLENTI= IPLRLB(IL,II+2)
  1156.                     SEGACT,MLENTI
  1157.                     DO 65 IRES=1,NPRES
  1158.                         III=II
  1159.                         MCHPOI=LECT(IRES)
  1160.                         SEGACT MCHPOI
  1161.                         MSOUPO=IPCHP(1)
  1162.                         SEGACT,MSOUPO
  1163.                         MPOVAL=IPOVAL
  1164.                         SEGACT,MPOVAL*MOD
  1165.                         DO 66 IP=1,NPLB
  1166.                           DO 67 IDD=1,2
  1167.                             III=III+1
  1168.                             VPOCHA(IP,IDD)=XRESLB(IL,IRES,III)
  1169.  67                       CONTINUE
  1170.  66                     CONTINUE
  1171.                         SEGDES,MPOVAL,MSOUPO,MCHPOI
  1172.                         MTAB1.MTABIV(IRES)=MCHPOI
  1173.  65                 CONTINUE
  1174.                     SEGSUP,MLENTI
  1175.                     SEGDES,MTAB1
  1176.                     II=III
  1177.                     ID = ID + 1
  1178.                     MTAB3.MTABTI(ID) = 'MOT'
  1179.                     MTAB3.MTABII(ID) = LCHAIN.LECT(ICHA)
  1180.                     MTAB3.MTABTV(ID) = 'TABLE'
  1181.                     MTAB3.MTABIV(ID) =  MTAB1
  1182.                ENDIF
  1183.  
  1184.                if (IPTLA3.gt.0.and.
  1185.      &  (ILIREB(IL,IV).EQ.1.or.ILIREB(IL,IV).EQ.2)) then
  1186.                  ICHAR = LCHAIN.LECT(ICHA)
  1187.                     segact MTABU*mod
  1188.                  MTABU.MTABTI(1) = 'ENTIER'
  1189.                  MTABU.MTABII(1) = 1
  1190.                  MTABU.MTABTV(1) = 'MOT'
  1191.                  MTABU.MTABIV(1) = ICHAR
  1192.                  typret=' '
  1193.                  CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0,
  1194.      &                    typret,IUI,X1,CHARRE,L1,IP1)
  1195.                   typret=' '
  1196.              CALL ACCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  1197.      #                   typret,0,0.D0,CHARRI,.TRUE.,IPTC3)
  1198.                  if (typret.eq.'LISTREEL') then
  1199.                   call fuspro(iptc3,ipl2,ipl3)
  1200.               CALL ECCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0,
  1201.      #                   typret,0,0.D0,CHARRI,.TRUE.,ipl3)
  1202.                  else if (typret.eq.'TABLE') then
  1203.                   MTAB4 = IPTC3
  1204.                   segact MTAB4,MTAB1
  1205.                   M4 = MTAB4.MLOTAB
  1206.                   do IRES = 1,NPRES
  1207.                     ipch3 =  MTAB1.MTABIV(IRES)
  1208.               CALL ECCTAB(IPTC3,'ENTIER',M4+IRES,0.D0,CHARRE,.TRUE.,0,
  1209.      #                 'CHPOINT ',0,0.D0,CHARRI,.TRUE.,ipch3)
  1210.  
  1211.                   enddo
  1212.                   segsup MTAB1
  1213.                   segdes MTAB4
  1214.                  else
  1215.                  endif
  1216.  
  1217.                endif
  1218.  62            CONTINUE
  1219. *           end do
  1220.             SEGDES,MTAB3
  1221.                if (IPTLA3.gt.0) segsup MTAB3
  1222.  60         CONTINUE
  1223. *        end do
  1224.       ENDIF
  1225.  
  1226.       segsup MTABU
  1227.       IF (ITSORT.EQ.INDC10) THEN
  1228.          if (iptla1.gt.0) THEN
  1229.            MTAB1 = IPTLA1
  1230.            segsup MTAB1
  1231.          ENDIF
  1232.          if (itdyn.gt.0) THEN
  1233.            MTAB2 = ITDYN
  1234.            segsup MTAB2
  1235.            ITDYN = MTAB3
  1236.          ENDIF
  1237.          RETURN
  1238.       ENDIF
  1239.  
  1240. c     mise a jour de la taille de la table
  1241.       M=IRE2
  1242.       MLOTAB=IRE2
  1243.       SEGADJ,MTABLE
  1244.       SEGDES,MTABLE
  1245. *
  1246.       RETURN
  1247.       END
  1248.  
  1249.  
  1250.  
  1251.  
  1252.  
  1253.  
  1254.  
  1255.  
  1256.  
  1257.  
  1258.  

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