Télécharger la plaquette Cast3M


fr en

Télécharger dyne70.eso

Retour à la liste

Numérotation des lignes : 

dyne70

  1. C DYNE70    SOURCE    CB215821  24/04/12    21:15:39     11897          
  2. C 
  3. C DYNE20    SOURCE    AM        15/12/16    21:15:08     8752
  4.       SUBROUTINE DYNE70(ILIB,KTLIAB,ITCARA)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. *                                                                    *
  9. *     Operateur DYNE :                                               *
  10. *     Remplissage des tableaux de description des liaisons sur       *
  11. *     la base a partir des informations contenues dans la            *
  12. *     table ILIB.                                                    *
  13. *                                                                    *
  14. *--------------------------------------------------------------------*
  15. *                                                                    *
  16. *     Parametres:                                                    *
  17. *                                                                    *
  18. * e   ILIB    Table rassemblant la description des liaisons          *
  19. * es  KTLIAB  Segment descriptif des liaisons sur la base B.         *
  20. *                                                                    *
  21. *                                                                    *
  22. *     Parametres de dimensionnement pour une liaison sur base:       *
  23. *                                                                    *
  24. *     NIPALB : nombre de parametres pour definir le type des         *
  25. *              liaisons (NIPALB est fixe a 3).                       *
  26. *     NXPALB : nombre maxi de parametres internes definissant les    *
  27. *              liaisons.                                             *
  28. *     NPLBB  : nombre maxi de points intervenant dans une liaison.   *
  29. *                                                                    *
  30. *     NPLB   : nombre total de points.                               *
  31. *     NLIAB  : nombre total de liaisons.                             *
  32. *                                                                    *
  33. *                                                                    *
  34. *     Tableaux fortran pour les liaisons sur base B :                *
  35. *                                                                    *
  36. *     XPALB(NLIAB,NXPALB) : parametres de la liaison.                *
  37. *     IPALB(NLIAB,NIPALB) : renseigne sur le type de liaison.        *
  38. *                          et les eventuelles conditions             *
  39. *     XABSCI  Tableau contenant les abscisses de la loi plastique    *
  40. *             pour les liaisons point-point- ... -plastique          *
  41. *     XORDON  Tableau contenant les ordonnees de la loi plastique    *
  42. *             pour les liaisons point-point- ... -plastique          *
  43. *                                                                    *
  44. *     JPLIB(NPLB)         : numero global des points.                *
  45. *     IPLIB(NLIAB,NPLBB)  : numeros locaux des points concernes par  *
  46. *                           la liaison.                              *
  47. *                                                                    *
  48. *     Icorres  Pour garder le numero du pointeur des tables de       *
  49. *            liaison                                                 *
  50. *                                                                    *
  51. *                                                                    *
  52. *     Auteur, date de creation:                                      *
  53. *                                                                    *
  54. *     kich, 2007, #5994, d'abord dans dyne20.eso                     *
  55. *     BP, 2018, creation de dyne70.eso pour une meilleure lisibilite *
  56. *                                                                    *
  57. *--------------------------------------------------------------------*
  58.  
  59. -INC PPARAM
  60. -INC CCOPTIO
  61. -INC SMCOORD
  62. -INC SMEVOLL
  63. -INC SMLREEL
  64. -INC SMMODEL
  65. -INC SMCHAML
  66. -INC SMELEME
  67. -INC SMCHPOI
  68. *
  69.       SEGMENT MTLIAB
  70.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  71.          REAL*8 XPALB(NLIAB,NXPALB)
  72.          REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  73.       ENDSEGMENT
  74. *
  75.       SEGMENT MLIGNE
  76.          INTEGER KPLIB(NPLB)
  77.       ENDSEGMENT
  78. *
  79.       SEGMENT icorres( nliab)
  80. *
  81.       LOGICAL L1,L0, log1, lmodyn,LPERM,LINTER,LECRO,LELAS
  82.       CHARACTER*40 CMOT,MONMOT,CHARRE  ,CMOT1 ,MONECR
  83.       CHARACTER*8 MONAMO,MONSEUIL,CHARRE2,TYPRET,MARAID,MONPER
  84.       CHARACTER*8 TYPREG,MONREC,MONJEU,MONSYM,MONELA,MONINTER
  85.       CHARACTER*8 MONESC
  86.  
  87.       CHARACTER*4 MO4
  88.  
  89.       mchelm = itcara
  90.       MTLIAB = KTLIAB
  91.       NPLB = JPLIB(/1)
  92.       NLIAB = IPALB(/1)
  93.         segini icorres
  94. *
  95. *     Boucle sur le nombre de liaisons
  96. *
  97.       II = 0
  98. *
  99.        mmodel = ilib
  100.        segact mchelm
  101.        n1 = imache(/1)
  102.        do I = 1, kmodel(/1)
  103.         imodel = kmodel(I)
  104.         segact imodel
  105.         ipt8 = imamod
  106.         segact ipt8
  107.         imod = ipt8.num(1,1)
  108.         inoa = ipt8.num(1,1)
  109.         isup = ipt8.num(1,1)
  110.  
  111.         do 46  in = 1,n1
  112.           meleme = imache(in)
  113.           if (meleme.ne.imamod) goto 46
  114.           if (conche(in).ne.conmod) goto 46
  115.           segact meleme
  116.           mchaml = ichaml(in)
  117.           segact mchaml
  118.           n2 = ielval(/1)
  119.           goto 51
  120.  46     continue
  121.         write(6,*) 'pas de caracteristique liaison' , i, conmod
  122.         return
  123.  
  124.  51     continue
  125.         TYPRET = ' '
  126.         MONSEUIL = ' '
  127.         if (cmatee.eq.'PO_PL_FL') then
  128.                ITYP = 7
  129.           do io = 1,n2
  130.             MO4=nomche(io)(1:4)
  131.             if (MO4.eq.'NORM') then
  132.               melval = ielval(io)
  133.               segact melval
  134.               IPOI = ielche(1,1)
  135.             else if  (MO4.eq.'INER') then
  136.               melval = ielval(io)
  137.               segact melval
  138.               XINER = velche(1,1)
  139.             else if  (MO4.eq.'CONV') then
  140.               melval = ielval(io)
  141.               segact melval
  142.               XCONV = velche(1,1)
  143.             else if  (MO4.eq.'VISC') then
  144.               melval = ielval(io)
  145.               segact melval
  146.               XVISC = velche(1,1)
  147.             else if  (MO4.eq.'PELO') then
  148.               melval = ielval(io)
  149.               segact melval
  150.               XPCEL = velche(1,1)
  151.             else if  (MO4.eq.'PRAP') then
  152.               melval = ielval(io)
  153.               segact melval
  154.               XPCRA = velche(1,1)
  155.             else if  (MO4.eq.'JFLU') then
  156.               melval = ielval(io)
  157.               segact melval
  158.               XJEU = velche(1,1)
  159.             else
  160.             endif
  161.           enddo
  162.  
  163.          IPALB(I,1) = ITYP
  164.          IPALB(I,3) = IDIM
  165.          XPALB(I,1) = XINER
  166.          XPALB(I,2) = XCONV
  167.          XPALB(I,3) = XVISC
  168.          XPALB(I,4) = XPCEL
  169.          XPALB(I,5) = XPCRA
  170.          XPALB(I,6) = XJEU
  171. *
  172.          IPNV  = (IDIM + 1) * (IPOI - 1)
  173.          PS = 0.D0
  174.          DO 70 ID = 1,IDIM
  175.             XC = XCOOR(IPNV + ID)
  176.             PS = PS + XC * XC
  177.  70         CONTINUE
  178. *        end do
  179.          IF (PS.LE.0.D0) THEN
  180.             CALL ERREUR(162)
  181.             RETURN
  182.          ENDIF
  183.          ID1 = 6
  184.          DO 72 ID = 1,IDIM
  185.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  186.  72         CONTINUE
  187. *        end do
  188.          CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  189.          IPLIB(I,1) = IPLAC
  190. *
  191.         else if(cmatee.eq.'PO_PL_FR') then
  192.                ITYP = 3
  193.                MARAID = ' '
  194.                TYPRET = ' '
  195.                MONAMO = ' '
  196.           do io = 1,n2
  197.             MO4=nomche(io)(1:4)
  198.             if (MO4.eq.'NORM') then
  199.               melval = ielval(io)
  200.               segact melval
  201.               IPOI = ielche(1,1)
  202.             else if  (MO4.eq.'RAID') then
  203.               melval = ielval(io)
  204.               segact melval
  205.               xrain = velche(1,1)
  206.               MARAID = 'FLOTTANT'
  207.             else if  (MO4.eq.'JEU') then
  208.               melval = ielval(io)
  209.               segact melval
  210.               XJEU = velche(1,1)
  211.             else if  (MO4.eq.'GLIS') then
  212.               melval = ielval(io)
  213.               segact melval
  214.               XGLIS = velche(1,1)
  215.             else if  (MO4.eq.'ADHE') then
  216.               melval = ielval(io)
  217.               segact melval
  218.               XADHE = velche(1,1)
  219.             else if  (MO4.eq.'RTAN') then
  220.               melval = ielval(io)
  221.               segact melval
  222.               XRAIT = velche(1,1)
  223.             else if  (MO4.eq.'ATAN') then
  224.               melval = ielval(io)
  225.               segact melval
  226.               XAMOT = velche(1,1)
  227.             else if (MO4.eq.'AMOR') then
  228.               melval = ielval(io)
  229.               segact melval
  230.               xamon = velche(1,1)
  231.               MONAMO = 'FLOTTANT'
  232.             else if (MO4.eq.'LOIC') then
  233.               melval = ielval(io)
  234.               segact melval
  235.               ipevo = ielche(1,1)
  236.               TYPRET = 'EVOLUTIO'
  237.             else
  238.             endif
  239.           enddo
  240.  
  241.          IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  242.             CALL ERREUR(891)
  243.             RETURN
  244.          ENDIF
  245.          IF (TYPRET.EQ.'EVOLUTIO') THEN
  246.             ITYP = 103
  247.             XRAIN = 0.d0
  248.          ENDIF
  249.          IPALB(I,1) = ITYP
  250.          IPALB(I,3) = IDIM
  251.          XPALB(I,1) = XRAIN
  252.          XPALB(I,2) = XJEU
  253.          XPALB(I,3) = XGLIS
  254.          XPALB(I,4) = XADHE
  255.          XPALB(I,5) = XRAIT
  256.          XPALB(I,6) = XAMOT
  257.          IF (MONAMO.EQ.'FLOTTANT') THEN
  258.             XPALB(I,7) = XAMON
  259.          ELSE
  260.             XPALB(I,7) = 0.D0
  261.          ENDIF
  262. *        NORMALE
  263.          IPNV  = (IDIM + 1) * (IPOI - 1)
  264.          PS = 0.D0
  265.          DO 20 ID = 1,IDIM
  266.             XC = XCOOR(IPNV + ID)
  267.             PS = PS + XC * XC
  268.  20         CONTINUE
  269. *        end do
  270.          IF (PS.LE.0.D0) THEN
  271.             CALL ERREUR(162)
  272.             RETURN
  273.          ENDIF
  274. cbp,2020         ID1 = 7
  275.          ID1 = 9
  276.          DO 22 ID = 1,IDIM
  277.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  278.  22      CONTINUE
  279.  
  280.          IF (IPALB(I,1) .EQ. 103) THEN
  281.          MEVOLL = IPEVO
  282. *
  283. *  si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  284. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  285. * des tableaux xabsci et xordon
  286. *
  287.          SEGACT MEVOLL
  288.          KEVOLL = IEVOLL(1)
  289.          SEGACT KEVOLL
  290.          MLREE1 = IPROGX
  291.          MLREE2 = IPROGY
  292.          SEGACT MLREE1
  293.          SEGACT MLREE2
  294.          NIP = XABSCI(/2)
  295. *
  296.           DO 26 MM=1,NIP
  297.             XABSCI (I,MM) = MLREE1.PROG(MM)
  298.             XORDON (I,MM) = MLREE2.PROG(MM)
  299.  26       CONTINUE
  300.          SEGDES MLREE1
  301.          SEGDES MLREE2
  302.          SEGDES KEVOLL
  303.          SEGDES MEVOLL
  304.          ENDIF
  305. *
  306.          CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  307.          IPLIB(I,1) = IPLAC
  308. *
  309.         else if(cmatee.eq.'PO_PL') then
  310.                ITYP = 1
  311.                IPERM = 0
  312.                XPALB(I,3) = 0.D0
  313.           do io = 1,n2
  314.             MO4=nomche(io)(1:4)
  315.             if (MO4.eq.'NORM') then
  316.               melval = ielval(io)
  317.               segact melval
  318.               IPOI = ielche(1,1)
  319.             else if  (MO4.eq.'RAID') then
  320.               melval = ielval(io)
  321.               segact melval
  322.               xraid = velche(1,1)
  323.             else if (MO4.eq.'JEU') then
  324.               melval = ielval(io)
  325.               segact melval
  326.               xjeu = velche(1,1)
  327.             else if (MO4.eq.'SPLA') then
  328.               melval = ielval(io)
  329.               segact melval
  330.               xseuil = velche(1,1)
  331.               MONSEUIL ='FLOTTANT'
  332.             else if (MO4.eq.'AMOR') then
  333.               melval = ielval(io)
  334.               segact melval
  335.               xamon = velche(1,1)
  336.               XPALB(I,3) = XAMON
  337.             else if (MO4.eq.'LOIC') then
  338.               melval = ielval(io)
  339.               segact melval
  340.               ipevo = ielche(1,1)
  341.               TYPRET = 'EVOLUTIO'
  342.             else if (MO4.eq.'PERM') then
  343.               melval = ielval(io)
  344.               segact melval
  345.               IPERM = 1
  346.             else
  347.             endif
  348.           enddo
  349.  
  350.          IPALB(I,1) = ITYP
  351.          IPALB(I,3) = IDIM
  352.          IPALB(I,4) = IPERM
  353.          XPALB(I,1) = XRAID
  354.          XPALB(I,2) = XJEU
  355. *
  356.          IPNV  = (IDIM + 1) * (IPOI - 1)
  357.          PS = 0.D0
  358.          DO 17 ID = 1,IDIM
  359.             XC = XCOOR(IPNV + ID)
  360.             PS = PS + XC * XC
  361.  17      CONTINUE
  362. *
  363.          IF (PS.LE.0.D0) THEN
  364.             CALL ERREUR(162)
  365.             RETURN
  366.          ENDIF
  367.          ID1 = 3
  368.  
  369.          IF (MONSEUIL .EQ.'FLOTTANT') THEN
  370.              IF (TYPRET .EQ. 'EVOLUTIO') THEN
  371.                 IPALB(I,1) = 101
  372.              ELSE
  373.                 IPALB(I,1) = 100
  374.              ENDIF
  375.              ID1 = 4
  376.              XPALB(I,ID1) = XSEUIL
  377.          ELSE
  378.              IF (TYPRET .EQ. 'EVOLUTIO') THEN
  379.                 IPALB(I,1) = 102
  380.              ENDIF
  381.          ENDIF
  382.  
  383. *
  384.          DO 12 ID = 1,IDIM
  385.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  386.  12         CONTINUE
  387. *
  388.          IF (IPALB(I,1) .EQ. 101 .OR. IPALB(I,1) .EQ. 102) THEN
  389.          MEVOLL = IPEVO
  390. *
  391. *  si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  392. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  393. * des tableaux xabsci et xordon
  394. *
  395.          SEGACT MEVOLL
  396.          KEVOLL = IEVOLL(1)
  397.          SEGACT KEVOLL
  398.          MLREE1 = IPROGX
  399.          MLREE2 = IPROGY
  400.          SEGACT MLREE1
  401.          SEGACT MLREE2
  402.          NIP = XABSCI(/2)
  403. *
  404.           DO 16 MM=1,NIP
  405.             XABSCI (I,MM) = MLREE1.PROG(MM)
  406.             XORDON (I,MM) = MLREE2.PROG(MM)
  407.  16       CONTINUE
  408. *
  409.          SEGDES MLREE1
  410.          SEGDES MLREE2
  411.          SEGDES KEVOLL
  412.          SEGDES MEVOLL
  413.          ENDIF
  414. *
  415.          IMOD = num(1,1)
  416.          CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  417.          IPLIB(I,1) = IPLAC
  418. *
  419.         else if (cmatee.eq.'PO_PO_FR') then
  420.           ITYP = 13
  421.           MARAID = ' '
  422.           MONPER = ' '
  423.           MONAMO = ' '
  424.           TYPRET = ' '
  425.           TYPREG = ' '
  426.           CHARRE = ' '
  427.           do io = 1,n2
  428.             MO4=nomche(io)(1:4)
  429.             if (MO4.eq.'NORM') then
  430.               melval = ielval(io)
  431.               segact melval
  432.               IPOI = ielche(1,1)
  433.             else if  (MO4.eq.'RAID') then
  434.               melval = ielval(io)
  435.               segact melval
  436.               xraid = velche(1,1)
  437.             else if (MO4.eq.'JEU') then
  438.               melval = ielval(io)
  439.               segact melval
  440.               xjeu = velche(1,1)
  441.             else if (MO4.eq.'POIB') then
  442.               melval = ielval(io)
  443.               segact melval
  444.               INOB = ielche(1,1)
  445.             else if (MO4.eq.'AMOR') then
  446.               melval = ielval(io)
  447.               segact melval
  448.               xamon = velche(1,1)
  449.               MONAMO='FLOTTANT'
  450.             else if (MO4.eq.'LOIC') then
  451.               melval = ielval(io)
  452.               segact melval
  453.               ipevo = ielche(1,1)
  454.               TYPRET = 'EVOLUTIO'
  455.             else if (MO4.eq.'MODE') then
  456.               melval = ielval(io)
  457.               segact melval
  458.               igibe = ielche(1,1)
  459.               TYPREG = 'MOT'
  460.               CHARRE = 'NEDJAI-GIBERT'
  461.             else if  (MO4.eq.'GLIS') then
  462.               melval = ielval(io)
  463.               segact melval
  464.               XGLIS = velche(1,1)
  465.             else if  (MO4.eq.'ADHE') then
  466.               melval = ielval(io)
  467.               segact melval
  468.               XADHE = velche(1,1)
  469.             else if  (MO4.eq.'RTAN') then
  470.               melval = ielval(io)
  471.               segact melval
  472.               XRAIT = velche(1,1)
  473.             else if  (MO4.eq.'ATAN') then
  474.               melval = ielval(io)
  475.               segact melval
  476.               XAMOT = velche(1,1)
  477.             else
  478.             endif
  479.           enddo
  480.  
  481.           IF (IERR.NE.0) RETURN
  482. ** dans quel cas monamo est il entier?   PV
  483. **       IF (MONAMO .EQ. 'ENTIER  ') THEN
  484. **         XAMON = 1.D0*I0
  485. **         MONAMO = 'FLOTTANT'
  486. **       ENDIF
  487.          IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  488.             CALL ERREUR(891)
  489.             RETURN
  490.          ENDIF
  491.          IF (TYPRET.EQ.'EVOLUTIO') THEN
  492.             ITYP = 113
  493.             XRAID = 0.d0
  494.          ENDIF
  495. *
  496.          IPALB(I,1) = ITYP
  497.          IPALB(I,3) = IDIM
  498.          XPALB(I,1) = XRAID
  499.          XPALB(I,2) = XJEU
  500.          XPALB(I,3) = XGLIS
  501.          XPALB(I,4) = XADHE
  502.          XPALB(I,5) = XRAIT
  503.          XPALB(I,6) = XAMOT
  504.          IF (MONAMO.EQ.'FLOTTANT') THEN
  505.             XPALB(I,7) = XAMON
  506.          ELSE
  507.             XPALB(I,7) = 0.D0
  508.          ENDIF
  509.  
  510. * cas particulier pas tres orthodoxe pour Gibert
  511. * on passe a ityp = -13 et on modifie et ajoute
  512. * devlb2, devlb1-->devfb2--->dgcha4--->dgchfr--->dgchgl, devso4
  513.          IF (TYPREG.EQ.'MOT') THEN
  514.             IF (CHARRE.EQ.'NEDJAI-GIBERT') THEN
  515.               IPALB(I,1) = -13
  516.             ELSE
  517.              CALL ERREUR(891)
  518.              RETURN
  519.             ENDIF
  520.          ELSEIF (IGIBE.NE.0) THEN
  521.              CALL ERREUR(891)
  522.              RETURN
  523.          ENDIF
  524.  
  525. *
  526. *        normalisation de la normale
  527. *
  528.          IPNV  = (IDIM + 1) * (IPOI - 1)
  529.          PS = 0.D0
  530.          DO 420 ID = 1,IDIM
  531.             XC = XCOOR(IPNV + ID)
  532.             PS = PS + XC * XC
  533.  420        CONTINUE
  534. *        end do
  535.          IF (PS.LE.0.D0) THEN
  536.             CALL ERREUR(162)
  537.             RETURN
  538.          ENDIF
  539.          DO 422 ID = 1,IDIM
  540.                ID2 = 7 + ID
  541.                XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  542.  422           CONTINUE
  543. *        end do
  544. *
  545.          IF (IPALB(I,1) .EQ. 113) THEN
  546.          MEVOLL = IPEVO
  547. *
  548. *  si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  549. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  550. * des tableaux xabsci et xordon
  551. *
  552.          SEGACT MEVOLL
  553.          KEVOLL = IEVOLL(1)
  554.          SEGACT KEVOLL
  555.          MLREE1 = IPROGX
  556.          MLREE2 = IPROGY
  557.          SEGACT MLREE1
  558.          SEGACT MLREE2
  559.          NIP = XABSCI(/2)
  560. *
  561.           DO 424 MM=1,NIP
  562.             XABSCI (I,MM) = MLREE1.PROG(MM)
  563.             XORDON (I,MM) = MLREE2.PROG(MM)
  564.  424      CONTINUE
  565. *
  566.          SEGDES MLREE1
  567.          SEGDES MLREE2
  568.          SEGDES KEVOLL
  569.          SEGDES MEVOLL
  570.          ENDIF
  571. *
  572.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  573.          IPLIB(I,1) = IPLAC
  574.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  575.          IPLIB(I,2) = IPLAC
  576.  
  577. *
  578.         else if(cmatee.eq.'PO_PO_DP') then
  579.           ITYP = 16
  580.           MARAID = ' '
  581.           MONPER = ' '
  582.           LPERM = .false.
  583.           IPERM = 0
  584.           MONAMO = ' '
  585.           TYPRET = ' '
  586.           do io = 1,n2
  587.             MO4=nomche(io)(1:4)
  588.             if (MO4.eq.'NORM') then
  589.               melval = ielval(io)
  590.               segact melval
  591.               IPOI = ielche(1,1)
  592.             else if  (MO4.eq.'ECRO') then
  593.               melval = ielval(io)
  594.               segact melval
  595. * IPERM = 2 <= isotrope , IPERM = 3 <= cinematique
  596.               IPERM =  ielche(1,1)
  597.             else if (MO4.eq.'JEU') then
  598.               melval = ielval(io)
  599.               segact melval
  600.               xjeu = velche(1,1)
  601.             else if (MO4.eq.'POIB') then
  602.               melval = ielval(io)
  603.               segact melval
  604.               INOB = ielche(1,1)
  605.             else if (MO4.eq.'AMOR') then
  606.               melval = ielval(io)
  607.               segact melval
  608.               xamon = velche(1,1)
  609.               MONAMO='FLOTTANT'
  610.             else if (MO4.eq.'LOIC') then
  611.               melval = ielval(io)
  612.               segact melval
  613.               ipevo = ielche(1,1)
  614.               TYPRET = 'EVOLUTIO'
  615.             else if (MO4.eq.'PERM') then
  616.               melval = ielval(io)
  617.               segact melval
  618.               LPERM = .true.
  619.             else
  620.             endif
  621.           enddo
  622.  
  623.          IF (IERR.NE.0) RETURN
  624.  
  625.          IF (LPERM) THEN
  626.            IF (.NOT.(XJEU.EQ.0.D0)) THEN
  627. *             WRITE (*,*) 'Liaison permanente, mise a zero du jeu.'
  628.              XJEU = 0.D0
  629.            ENDIF
  630.  
  631.            IF (IPERM.ne.3.and.IPERM.ne.2) THEN
  632.              call erreur(21)
  633.              RETURN
  634.            ENDIF
  635.          ENDIF
  636. *
  637.          MEVOLL = IPEVO
  638. *
  639. *  si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  640. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  641. * des tableaux xabsci et xordon
  642. *
  643.          SEGACT MEVOLL
  644.          KEVOLL = IEVOLL(1)
  645.          SEGACT KEVOLL
  646.          MLREE1 = IPROGX
  647.          MLREE2 = IPROGY
  648.          SEGACT MLREE1
  649.          SEGACT MLREE2
  650.          NIP = XABSCI(/2)
  651. *
  652.           DO 426 MM=1,NIP
  653.             XABSCI (I,MM) = MLREE1.PROG(MM)
  654.             XORDON (I,MM) = MLREE2.PROG(MM)
  655.  426      CONTINUE
  656. *
  657.          SEGDES MLREE1
  658.          SEGDES MLREE2
  659.          SEGDES KEVOLL
  660.          SEGDES MEVOLL
  661. *
  662.          IPALB(I,1) = ITYP
  663.          IPALB(I,3) = IDIM
  664.          XPALB(I,1) = XJEU
  665.          IPALB(I,5) = IPERM
  666. *
  667. *        normalisation de la normale
  668. *
  669.          IPNV  = (IDIM + 1) * (IPOI - 1)
  670.          PS = 0.D0
  671.          DO 30 ID = 1,IDIM
  672.             XC = XCOOR(IPNV + ID)
  673.             PS = PS + XC * XC
  674.  30         CONTINUE
  675. *        end do
  676.          IF (PS.LE.0.D0) THEN
  677.             CALL ERREUR(162)
  678.             RETURN
  679.          ENDIF
  680.          IF (MONAMO.EQ.'FLOTTANT') THEN
  681.             IPALB(I,1) = 17
  682.             XPALB(I,2) = XAMON
  683.             DO 32 ID = 1,IDIM
  684.                ID2 = 2 + ID
  685.                XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  686.  32            CONTINUE
  687. *           end do
  688.          ELSE
  689.             DO 34 ID = 1,IDIM
  690.                ID2 = 1 + ID
  691.                XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  692.  34            CONTINUE
  693. *           end do
  694.          ENDIF
  695. *
  696.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  697.          IPLIB(I,1) = IPLAC
  698.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  699.          IPLIB(I,2) = IPLAC
  700. *
  701.         else if(cmatee.eq.'PO_PO_RP') then
  702.           ITYP = 50
  703.           MARAID = ' '
  704.           MONPER = ' '
  705.           MONELA = ' '
  706.           LPERM = .FALSE.
  707.           LELAS = .FALSE.
  708.           LECRO = .FALSE.
  709.           IPERM = 0
  710.           MONAMO = ' '
  711.           TYPRET = ' '
  712.           do io = 1,n2
  713.             MO4=nomche(io)(1:4)
  714.             if (MO4.eq.'AXRO') then
  715.               melval = ielval(io)
  716.               segact melval
  717.               IPOI = ielche(1,1)
  718.             else if (MO4.eq.'JEU') then
  719.               melval = ielval(io)
  720.               segact melval
  721.               xjeu = velche(1,1)
  722.             else if (MO4.eq.'POIB') then
  723.               melval = ielval(io)
  724.               segact melval
  725.               INOB = ielche(1,1)
  726.             else if (MO4.eq.'AMOR') then
  727.               melval = ielval(io)
  728.               segact melval
  729.               xamon = velche(1,1)
  730.               MONAMO='FLOTTANT'
  731.             else if (MO4.eq.'LOIC') then
  732.               melval = ielval(io)
  733.               segact melval
  734.               ipevo = ielche(1,1)
  735.               TYPRET = 'EVOLUTIO'
  736.             else if (MO4.eq.'PERM') then
  737.               melval = ielval(io)
  738.               segact melval
  739.               LPERM = .true.
  740.             else if (MO4.eq.'ELAS') then
  741.               melval = ielval(io)
  742.               segact melval
  743.               LELAS = .true.
  744.             else if  (MO4.eq.'ECRO') then
  745.               melval = ielval(io)
  746.               segact melval
  747. * IECRO = 1 <= isotrope , IECRO = 2 <= cinematique
  748.               LECRO = .true.
  749.               iecro = ielche(1,1)
  750.               if (iecro.eq.1) monecr = 'ISOTROPE'
  751.               if (iecro.eq.2) monecr = 'CINEMATIQUE'
  752.             else
  753.             endif
  754.           enddo
  755.  
  756.          IF (IERR.NE.0) RETURN
  757. *
  758. * iperm = -2 : liaison elastique permanente
  759. * iperm = -1 : choc elastique
  760. * iperm =  0 : donnees incoherentes ou insuffisantes
  761. * iperm =  1 : choc plastique
  762. * iperm =  2 : liaison plastique isotrope
  763. * iperm =  3 : liaison plastique cinematique
  764. *
  765.  
  766.          IF (LPERM) THEN
  767.            IF (LELAS.AND.(.NOT.LECRO)) IPERM = -2
  768.            IF (MONECR.EQ.'ISOTROPE'.AND.(.NOT.LELAS)) IPERM = 2
  769.            IF (MONECR.EQ.'CINEMATIQUE'.AND.(.NOT.LELAS)) IPERM = 3
  770.            IF (.NOT.(XJEU.EQ.0.)) THEN
  771. *             WRITE(*,*) 'Liaison permanente, mise a zero du jeu.'
  772.               XJEU = 0.D0
  773.            ENDIF
  774.          ELSE
  775.            IF (.NOT.LECRO) THEN
  776.                IF (LELAS) THEN
  777.                      IPERM = -1
  778.                ELSE
  779.                      IPERM = 1
  780.                ENDIF
  781.            ENDIF
  782.          ENDIF
  783.          IF (IPERM.EQ.0) THEN
  784.              CALL ERREUR(905)
  785.              RETURN
  786.          ENDIF
  787. *
  788.          MEVOLL = IPEVO
  789. *
  790. *  si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  791. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  792. * des tableaux xabsci et xordon
  793. *
  794.          SEGACT MEVOLL
  795.          KEVOLL = IEVOLL(1)
  796.          SEGACT KEVOLL
  797.          MLREE1 = IPROGX
  798.          MLREE2 = IPROGY
  799.          SEGACT MLREE1
  800.          SEGACT MLREE2
  801. *         NIP = MLREE1.PROG(/1)
  802.           NIP = XABSCI(/2)
  803. *
  804.           DO 110 MM=1,NIP
  805.             XABSCI (I,MM) = MLREE1.PROG(MM)
  806.             XORDON (I,MM) = MLREE2.PROG(MM)
  807.  110      CONTINUE
  808. *
  809.          SEGDES MLREE1
  810.          SEGDES MLREE2
  811.          SEGDES KEVOLL
  812.          SEGDES MEVOLL
  813. *
  814.          IPALB(I,1) = ITYP
  815.          IPALB(I,3) = IDIM
  816.          IPALB(I,5) = IPERM
  817.          XPALB(I,1) = XJEU
  818. *
  819. *        normalisation de l'axe de rotation
  820. *
  821.          IPNV  = (IDIM + 1) * (IPOI - 1)
  822.          PS = 0.D0
  823.          DO 120 ID = 1,IDIM
  824.             XC = XCOOR(IPNV + ID)
  825.             PS = PS + XC * XC
  826.  120        CONTINUE
  827. *        end do
  828.          IF (PS.LE.0.D0) THEN
  829.             CALL ERREUR(162)
  830.             RETURN
  831.          ENDIF
  832.          IF (MONAMO.EQ.'FLOTTANT') THEN
  833.             IPALB(I,1) = 51
  834.             XPALB(I,2) = XAMON
  835.             DO 122 ID = 1,IDIM
  836.                ID2 = 2 + ID
  837.                XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  838.  122           CONTINUE
  839. *           end do
  840.          ELSE
  841.             DO 124  ID = 1,IDIM
  842.                ID2 = 1 + ID
  843.                XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  844.  124            CONTINUE
  845. *           end do
  846.          ENDIF
  847. *
  848.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  849.          IPLIB(I,1) = IPLAC
  850.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  851.          IPLIB(I,2) = IPLAC
  852. *
  853. *
  854.         else if(cmatee.eq.'PO_PO') then
  855.           ITYP = 11
  856.           MARAID = ' '
  857.           MONPER = ' '
  858.           LPERM = .FALSE.
  859.           IPERM = 0
  860.           MONAMO = ' '
  861.           TYPRET = ' '
  862.           do io = 1,n2
  863.             MO4=nomche(io)(1:4)
  864.             if (MO4.eq.'NORM') then
  865.               melval = ielval(io)
  866.               segact melval
  867.               IPOI = ielche(1,1)
  868.             else if  (MO4.eq.'RAID') then
  869.               melval = ielval(io)
  870.               segact melval
  871.               xraid = velche(1,1)
  872.             else if (MO4.eq.'JEU') then
  873.               melval = ielval(io)
  874.               segact melval
  875.               xjeu = velche(1,1)
  876.             else if (MO4.eq.'POIB') then
  877.               melval = ielval(io)
  878.               segact melval
  879.               INOB = ielche(1,1)
  880.             else if (MO4.eq.'AMOR') then
  881.               melval = ielval(io)
  882.               segact melval
  883.               xamon = velche(1,1)
  884.               MONAMO='FLOTTANT'
  885.             else if (MO4.eq.'LOIC') then
  886.               melval = ielval(io)
  887.               segact melval
  888.               ipevo = ielche(1,1)
  889.               TYPRET = 'EVOLUTIO'
  890.             else if (MO4.eq.'PERM') then
  891.               melval = ielval(io)
  892.               segact melval
  893.               IPERM =  ielche(1,1)
  894.               LPERM = .true.
  895.             else
  896.             endif
  897.           enddo
  898.  
  899.          IF (IERR.NE.0) RETURN
  900.  
  901.          IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  902.             CALL ERREUR(891)
  903.             RETURN
  904.          ENDIF
  905. *
  906.          IF (TYPRET.EQ.'EVOLUTIO') THEN
  907.             ITYP = 111
  908.             XRAID = 0.d0
  909.          ENDIF
  910.  
  911.          IPALB(I,1) = ITYP
  912.          IPALB(I,3) = IDIM
  913.          IPALB(I,4) = IPERM
  914.          XPALB(I,1) = XRAID
  915.          XPALB(I,2) = XJEU
  916. *
  917. *        normalisation de la normale
  918. *
  919.          IPNV  = (IDIM + 1) * (IPOI - 1)
  920.          PS = 0.D0
  921.          DO 111 ID = 1,IDIM
  922.             XC = XCOOR(IPNV + ID)
  923.             PS = PS + XC * XC
  924.  111     CONTINUE
  925. *        end do
  926.          IF (PS.LE.0.D0) THEN
  927.             CALL ERREUR(162)
  928.             RETURN
  929.          ENDIF
  930.          IF (MONAMO.EQ.'FLOTTANT') THEN
  931.             XPALB(I,3) = XAMON
  932.          ELSE
  933.             XPALB(I,3) = 0.d0
  934.          ENDIF
  935.             DO 112 ID = 1,IDIM
  936.                ID2 = 3 + ID
  937.                XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  938.  112           CONTINUE
  939. *           end do
  940. *
  941.          IF (IPALB(I,1) .EQ. 111) THEN
  942.          MEVOLL = IPEVO
  943. *
  944. *  si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  945. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  946. * des tableaux xabsci et xordon
  947. *
  948.          SEGACT MEVOLL
  949.          KEVOLL = IEVOLL(1)
  950.          SEGACT KEVOLL
  951.          MLREE1 = IPROGX
  952.          MLREE2 = IPROGY
  953.          SEGACT MLREE1
  954.          SEGACT MLREE2
  955.          NIP = XABSCI(/2)
  956. *
  957.           DO 116 MM=1,NIP
  958.             XABSCI (I,MM) = MLREE1.PROG(MM)
  959.             XORDON (I,MM) = MLREE2.PROG(MM)
  960.  116      CONTINUE
  961. *
  962.          SEGDES MLREE1
  963.          SEGDES MLREE2
  964.          SEGDES KEVOLL
  965.          SEGDES MEVOLL
  966.          ENDIF
  967. *
  968.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  969.          IPLIB(I,1) = IPLAC
  970.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  971.          IPLIB(I,2) = IPLAC
  972. *
  973.         else if(cmatee.eq.'PO_CE_MO') then
  974.           ITYP = 33
  975.                MONAMO = ' '
  976.                MARAID = ' '
  977.                MONINTER = ' '
  978.                LINTER = .true.
  979.           do io = 1,n2
  980.             MO4=nomche(io)(1:4)
  981.             if (MO4.eq.'NORM') then
  982.               melval = ielval(io)
  983.               segact melval
  984.               IPOI = ielche(1,1)
  985.             elseif (MO4.eq.'PCER') then
  986.               melval = ielval(io)
  987.               segact melval
  988.               INOB = ielche(1,1)
  989.             else if  (MO4.eq.'RAID') then
  990.               melval = ielval(io)
  991.               segact melval
  992.               xrain = velche(1,1)
  993.               MARAID = 'FLOTTANT'
  994.             else if  (MO4.eq.'RAYO') then
  995.               melval = ielval(io)
  996.               segact melval
  997.               XRAYO = velche(1,1)
  998.             else if  (MO4.eq.'GLIS') then
  999.               melval = ielval(io)
  1000.               segact melval
  1001.               XGLIS = velche(1,1)
  1002.             else if  (MO4.eq.'ADHE') then
  1003.               melval = ielval(io)
  1004.               segact melval
  1005.               XADHE = velche(1,1)
  1006.             else if  (MO4.eq.'RTAN') then
  1007.               melval = ielval(io)
  1008.               segact melval
  1009.               XRAIT = velche(1,1)
  1010.             else if  (MO4.eq.'ATAN') then
  1011.               melval = ielval(io)
  1012.               segact melval
  1013.               XAMOT = velche(1,1)
  1014.             else if  (MO4.eq.'CINT') then
  1015.               melval = ielval(io)
  1016.               segact melval
  1017.               LINTER = .FALSE.
  1018.             else if (MO4.eq.'AMOR') then
  1019.               melval = ielval(io)
  1020.               segact melval
  1021.               xamon = velche(1,1)
  1022.               MONAMO = 'FLOTTANT'
  1023.             else
  1024.             endif
  1025.           enddo
  1026.  
  1027.          IF (IERR.NE.0) RETURN
  1028.          IPALB(I,1) = ITYP
  1029.          IPALB(I,3) = IDIM
  1030. cbp         IPALB(I,4) = 1
  1031.          IF (.NOT.LINTER) THEN
  1032. cbp           IPALB(I,4) = 0
  1033. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  1034.             ITYP=ITYP+100
  1035.             IPALB(I,1) = ITYP           
  1036.          ENDIF
  1037.          XPALB(I,1) = XRAIN
  1038.          XPALB(I,2) = XRAYO
  1039.          XPALB(I,3) = XGLIS
  1040.          XPALB(I,4) = XADHE
  1041.          XPALB(I,5) = XRAIT
  1042.          XPALB(I,6) = XAMOT
  1043. *
  1044. *        normalisation de la normale
  1045. *
  1046.          IPNV  = (IDIM + 1) * (IPOI - 1)
  1047.          IPNOA  = (IDIM + 1) * (INOA - 1)
  1048.          IPNOB  = (IDIM + 1) * (INOB - 1)
  1049.          PS = 0.D0
  1050.          DO 202 ID = 1,IDIM
  1051.             XC = XCOOR(IPNV + ID)
  1052.             PS = PS + XC * XC
  1053.  202         CONTINUE
  1054. ***      write (6,*) ' ps - 3 ',ps
  1055.          IF (PS.LE.0.D0) THEN
  1056.             CALL ERREUR(162)
  1057.             RETURN
  1058.          ENDIF
  1059.          IF (MONAMO.EQ.'FLOTTANT') THEN
  1060. cbp            IPALB(I,1) = 34
  1061.             ITYP=ITYP+1
  1062.             IPALB(I,1) = ITYP           
  1063.             XPALB(I,7) = XAMON
  1064.             ID1 = 7
  1065.          ELSE
  1066.             ID1 = 6
  1067.          ENDIF
  1068.          ID2 = ID1 + IDIM
  1069.          DO 222 ID = 1,IDIM
  1070.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1071.             XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID)
  1072.  222        CONTINUE
  1073.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  1074.          IPLIB(I,1) = IPLAC
  1075.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  1076.          IPLIB(I,2) = IPLAC
  1077. *
  1078.         else if(cmatee.eq.'PO_CE_FR') then
  1079.           ITYP = 23
  1080.                MONAMO = ' '
  1081.                xamon=0.D0
  1082.                MARAID = ' '
  1083.                MONINTER = ' '
  1084.                LINTER = .true.
  1085.           do io = 1,n2
  1086.             MO4=nomche(io)(1:4)
  1087.             if (MO4.eq.'NORM') then
  1088.               melval = ielval(io)
  1089.               segact melval
  1090.               IPOI = ielche(1,1)
  1091.             elseif (MO4.eq.'EXCE') then
  1092.               melval = ielval(io)
  1093.               segact melval
  1094.               IEXC = ielche(1,1)
  1095.             else if  (MO4.eq.'RAID') then
  1096.               melval = ielval(io)
  1097.               segact melval
  1098.               xrain = velche(1,1)
  1099.               MARAID = 'FLOTTANT'
  1100.             else if  (MO4.eq.'RAYO') then
  1101.               melval = ielval(io)
  1102.               segact melval
  1103.               XRAYO = velche(1,1)
  1104.             else if  (MO4.eq.'GLIS') then
  1105.               melval = ielval(io)
  1106.               segact melval
  1107.               XGLIS = velche(1,1)
  1108.             else if  (MO4.eq.'ADHE') then
  1109.               melval = ielval(io)
  1110.               segact melval
  1111.               XADHE = velche(1,1)
  1112.             else if  (MO4.eq.'RTAN') then
  1113.               melval = ielval(io)
  1114.               segact melval
  1115.               XRAIT = velche(1,1)
  1116.             else if  (MO4.eq.'ATAN') then
  1117.               melval = ielval(io)
  1118.               segact melval
  1119.               XAMOT = velche(1,1)
  1120.             else if  (MO4.eq.'CINT') then
  1121.               melval = ielval(io)
  1122.               segact melval
  1123.               LINTER = .false.
  1124.             else if (MO4.eq.'AMOR') then
  1125.               melval = ielval(io)
  1126.               segact melval
  1127.               xamon = velche(1,1)
  1128.               MONAMO = 'FLOTTANT'
  1129.             else
  1130.             endif
  1131.           enddo
  1132.          IF (IERR.NE.0) RETURN
  1133. *
  1134.          IPALB(I,1) = ITYP
  1135.          IPALB(I,3) = IDIM
  1136.          IF (.NOT.LINTER) THEN
  1137.             ITYP=ITYP+100
  1138.             IPALB(I,1) = ITYP           
  1139.          ENDIF
  1140.          XPALB(I,1) = XRAIN
  1141.          XPALB(I,2) = XRAYO
  1142.          XPALB(I,3) = XGLIS
  1143.          XPALB(I,4) = XADHE
  1144.          XPALB(I,5) = XRAIT
  1145.          XPALB(I,6) = XAMOT
  1146. *
  1147. c        NORMALE et EXCENTREMENT (TYPE POINT)
  1148.          IPNV  = (IDIM + 1) * (IPOI - 1)
  1149.          IPEX  = (IDIM + 1) * (IEXC - 1)
  1150.          PS = 0.D0
  1151.          DO 320 ID = 1,IDIM
  1152.             XC = XCOOR(IPNV + ID)
  1153.             PS = PS + XC * XC
  1154.  320     CONTINUE
  1155.          IF (PS.LE.0.D0) THEN
  1156.             CALL ERREUR(162)
  1157.             RETURN
  1158.          ENDIF
  1159. c          IF (MONAMO.EQ.'FLOTTANT') THEN
  1160. c cbp            IPALB(I,1) = 24
  1161. c             ITYP=ITYP+1
  1162. c             IPALB(I,1) = ITYP           
  1163.             XPALB(I,7) = XAMON
  1164. c             ID1 = 7
  1165. c          ELSE
  1166. c             ID1 = 6
  1167. c          ENDIF
  1168. cbp,2020 : on suppose toujours l'amortissement + ajout regul n et t
  1169.          ID1=10
  1170.          ID2 = ID1 + IDIM
  1171.          DO 322 ID = 1,IDIM
  1172.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1173.             XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1174.  322        CONTINUE
  1175. *        end do
  1176.          CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1177.          IPLIB(I,1) = IPLAC
  1178. *
  1179.         else if(cmatee.eq.'PO_CE') then
  1180.           ITYP = 21
  1181.           MARAID = ' '
  1182.           MONPER = ' '
  1183.           MONAMO = ' '
  1184.           TYPRET = ' '
  1185.           do io = 1,n2
  1186.             MO4=nomche(io)(1:4)
  1187.             if (MO4.eq.'NORM') then
  1188.               melval = ielval(io)
  1189.               segact melval
  1190.               IPOI = ielche(1,1)
  1191.             else if  (MO4.eq.'RAID') then
  1192.               melval = ielval(io)
  1193.               segact melval
  1194.               xraid = velche(1,1)
  1195.             else if (MO4.eq.'EXCE') then
  1196.               melval = ielval(io)
  1197.               segact melval
  1198.               IEXC = ielche(1,1)
  1199.             else if  (MO4.eq.'RAYO') then
  1200.               melval = ielval(io)
  1201.               segact melval
  1202.               xrayo = velche(1,1)
  1203.             else if (MO4.eq.'AMOR') then
  1204.               melval = ielval(io)
  1205.               segact melval
  1206.               xamon = velche(1,1)
  1207.               MONAMO='FLOTTANT'
  1208.             else
  1209.             endif
  1210.           enddo
  1211.  
  1212.          IF (IERR.NE.0) RETURN
  1213.          IPALB(I,1) = ITYP
  1214.          IPALB(I,3) = IDIM
  1215.          XPALB(I,1) = XRAID
  1216.          XPALB(I,2) = XRAYO
  1217. *
  1218. *        normalisation de la normale
  1219. *
  1220.          IPNV  = (IDIM + 1) * (IPOI - 1)
  1221.          IPEX  = (IDIM + 1) * (IEXC - 1)
  1222.          PS = 0.D0
  1223.          DO 210 ID = 1,IDIM
  1224.             XC = XCOOR(IPNV + ID)
  1225.             PS = PS + XC * XC
  1226.  210        CONTINUE
  1227. ***      write (6,*) ' ps ',ps
  1228. *        end do
  1229.          IF (PS.LE.0.D0) THEN
  1230.             CALL ERREUR(162)
  1231.             RETURN
  1232.          ENDIF
  1233.          IF (MONAMO.EQ.'FLOTTANT') THEN
  1234.             IPALB(I,1) = 22
  1235.             XPALB(I,3) = XAMON
  1236.             ID1 = 3
  1237.          ELSE
  1238.             ID1 = 2
  1239.          ENDIF
  1240.          ID2 = ID1 + IDIM
  1241.          DO 212 ID = 1,IDIM
  1242.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1243.             XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1244.  212        CONTINUE
  1245. *        end do
  1246.          CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1247.          IPLIB(I,1) = IPLAC
  1248. *
  1249.         else if(cmatee.eq.'CE_PL_FR') then
  1250.           ITYP = 5
  1251.                MONAMO = ' '
  1252.           do io = 1,n2
  1253.             if (MO4.eq.'NORM') then
  1254.               melval = ielval(io)
  1255.               segact melval
  1256.               IPOI = ielche(1,1)
  1257.             else if  (MO4.eq.'RAID') then
  1258.               melval = ielval(io)
  1259.               segact melval
  1260.               xrain = velche(1,1)
  1261.               MARAID = 'FLOTTANT'
  1262.             else if  (MO4.eq.'JEU') then
  1263.               melval = ielval(io)
  1264.               segact melval
  1265.               XJEU = velche(1,1)
  1266.              else if  (MO4.eq.'RAYS') then
  1267.               melval = ielval(io)
  1268.               segact melval
  1269.               XRAYP = velche(1,1)
  1270.            else if  (MO4.eq.'GLIS') then
  1271.               melval = ielval(io)
  1272.               segact melval
  1273.               XGLIS = velche(1,1)
  1274.             else if  (MO4.eq.'ADHE') then
  1275.               melval = ielval(io)
  1276.               segact melval
  1277.               XADHE = velche(1,1)
  1278.             else if  (MO4.eq.'RTAN') then
  1279.               melval = ielval(io)
  1280.               segact melval
  1281.               XRAIT = velche(1,1)
  1282.             else if  (MO4.eq.'ATAN') then
  1283.               melval = ielval(io)
  1284.               segact melval
  1285.               XAMOT = velche(1,1)
  1286.             else if (MO4.eq.'AMOR') then
  1287.               melval = ielval(io)
  1288.               segact melval
  1289.               xamon = velche(1,1)
  1290.               MONAMO = 'FLOTTANT'
  1291.             else
  1292.             endif
  1293.           enddo
  1294.  
  1295.          IPALB(I,1) = ITYP
  1296.          IPALB(I,3) = IDIM
  1297.          XPALB(I,1) = XRAIN
  1298.          XPALB(I,2) = XJEU
  1299.          XPALB(I,3) = XGLIS
  1300.          XPALB(I,4) = XADHE
  1301.          XPALB(I,5) = XRAIT
  1302.          XPALB(I,6) = XAMOT
  1303. *
  1304.          IPNV  = (IDIM + 1) * (IPOI - 1)
  1305.          PS = 0.D0
  1306.          DO 230 ID = 1,IDIM
  1307.             XC = XCOOR(IPNV + ID)
  1308.             PS = PS + XC * XC
  1309.  230        CONTINUE
  1310. *        end do
  1311.          IF (PS.LE.0.D0) THEN
  1312.             CALL ERREUR(162)
  1313.             RETURN
  1314.          ENDIF
  1315.          IF (MONAMO.EQ.'FLOTTANT') THEN
  1316.             IPALB(I,1) = 6
  1317.             XPALB(I,7) = XAMON
  1318.             ID1 = 7
  1319.          ELSE
  1320.             ID1 = 6
  1321.          ENDIF
  1322.          ID8 = ID1 + 7*IDIM
  1323.          XPALB(I,ID8+1) = XRAYP
  1324.          DO 232 ID = 1,IDIM
  1325.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1326.  232     CONTINUE
  1327. *       end do
  1328.          CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1329.          IPLIB(I,1) = IPLAC
  1330. *
  1331.         else if(cmatee.eq.'CE_CE_FR') then
  1332.            ITYP = 25
  1333.            MONAMO = ' '
  1334.            MARAID = ' '
  1335.            MONINTER = ' '
  1336.            LINTER = .true.
  1337.           do io = 1,n2
  1338.             MO4=nomche(io)(1:4)
  1339.             if (MO4.eq.'NORM') then
  1340.               melval = ielval(io)
  1341.               segact melval
  1342.               IPOI = ielche(1,1)
  1343.             else if  (MO4.eq.'RAID') then
  1344.               melval = ielval(io)
  1345.               segact melval
  1346.               xrain = velche(1,1)
  1347.               MARAID = 'FLOTTANT'
  1348.             else if  (MO4.eq.'EXCE') then
  1349.               melval = ielval(io)
  1350.               segact melval
  1351.               IEXC = ielche(1,1)
  1352.             else if  (MO4.eq.'RAYS') then
  1353.               melval = ielval(io)
  1354.               segact melval
  1355.               XRAYP = velche(1,1)
  1356.             else if  (MO4.eq.'RAYB') then
  1357.               melval = ielval(io)
  1358.               segact melval
  1359.               XRAYB = velche(1,1)
  1360.             else if  (MO4.eq.'GLIS') then
  1361.               melval = ielval(io)
  1362.               segact melval
  1363.               XGLIS = velche(1,1)
  1364.             else if  (MO4.eq.'ADHE') then
  1365.               melval = ielval(io)
  1366.               segact melval
  1367.               XADHE = velche(1,1)
  1368.             else if  (MO4.eq.'RTAN') then
  1369.               melval = ielval(io)
  1370.               segact melval
  1371.               XRAIT = velche(1,1)
  1372.             else if  (MO4.eq.'ATAN') then
  1373.               melval = ielval(io)
  1374.               segact melval
  1375.               XAMOT = velche(1,1)
  1376.             else if  (MO4.eq.'CINT') then
  1377.               melval = ielval(io)
  1378.               segact melval
  1379.               LINTER = .false.
  1380.             else if (MO4.eq.'AMOR') then
  1381.               melval = ielval(io)
  1382.               segact melval
  1383.               xamon = velche(1,1)
  1384.               MONAMO = 'FLOTTANT'
  1385.             else
  1386.             endif
  1387.           enddo
  1388.  
  1389.          IF (IERR.NE.0) RETURN
  1390. *
  1391.          IPALB(I,1) = ITYP
  1392.          IPALB(I,3) = IDIM
  1393. cbp         IPALB(I,4) = 1
  1394.          IF (.NOT.LINTER) THEN
  1395. cbp           IPALB(I,4) = 0
  1396. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  1397.             ITYP=ITYP+100
  1398.             IPALB(I,1) = ITYP           
  1399.          ENDIF
  1400.          XPALB(I,1) = XRAIN
  1401.          XPALB(I,2) = XRAYB
  1402.          XPALB(I,3) = XGLIS
  1403.          XPALB(I,4) = XADHE
  1404.          XPALB(I,5) = XRAIT
  1405.          XPALB(I,6) = XAMOT
  1406. *
  1407. *        normalisation de la normale
  1408. *
  1409.          IPNV  = (IDIM + 1) * (IPOI - 1)
  1410.          IPEX  = (IDIM + 1) * (IEXC - 1)
  1411.          PS = 0.D0
  1412.          DO 330 ID = 1,IDIM
  1413.             XC = XCOOR(IPNV + ID)
  1414.             PS = PS + XC * XC
  1415.  330     CONTINUE
  1416. *        end do
  1417. ***      write (6,*) ' ps - 4 ',ps
  1418.          IF (PS.LE.0.D0) THEN
  1419.             CALL ERREUR(162)
  1420.             RETURN
  1421.          ENDIF
  1422.          IF (MONAMO.EQ.'FLOTTANT') THEN
  1423.             ID1 = 7
  1424. cbp            IPALB(I,1) = 26
  1425.             ITYP=ITYP+1
  1426.             IPALB(I,1) = ITYP           
  1427.             XPALB(I,7) = XAMON
  1428.          ELSE
  1429.             ID1 = 6
  1430.          ENDIF
  1431.          ID10 = ID1 + 9*IDIM
  1432.          XPALB(I,ID10+1) = XRAYP
  1433.          ID2  = ID1 + IDIM
  1434.          ID3  = ID1 + 2*IDIM
  1435.          DO 332 ID = 1,IDIM
  1436.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1437.             XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1438.  332     CONTINUE
  1439. *        end do
  1440.         CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1441.          IPLIB(I,1) = IPLAC
  1442. *
  1443.         else if(cmatee.eq.'PR_PR_IN'.OR.cmatee.eq.'PR_PR_EX') then
  1444.            if(cmatee.eq.'PR_PR_IN') ityp = 31
  1445.            IF(cmatee.eq.'PR_PR_EX') ITYP = 32
  1446.  
  1447.           do io = 1,n2
  1448.             MO4=nomche(io)(1:4)
  1449.             if (MO4.eq.'NORM') then
  1450.               melval = ielval(io)
  1451.               segact melval
  1452.               INOR = ielche(1,1)
  1453.             else if  (MO4.eq.'RAID') then
  1454.               melval = ielval(io)
  1455.               segact melval
  1456.               xraid = velche(1,1)
  1457.               MARAID = 'FLOTTANT'
  1458.             else if  (MO4.eq.'PFIX') then
  1459.               melval = ielval(io)
  1460.               segact melval
  1461.               IMA1 = ielche(1,1)
  1462.             else if  (MO4.eq.'PMOB') then
  1463.               melval = ielval(io)
  1464.               segact melval
  1465.               IMA2 = ielche(1,1)
  1466.             else if  (MO4.eq.'ERAI') then
  1467.               melval = ielval(io)
  1468.               segact melval
  1469.               xpuis = velche(1,1)
  1470.             else
  1471.             endif
  1472.           enddo
  1473.          IF (IERR.NE.0) RETURN
  1474. *
  1475.          IPALB(I,1) = ITYP
  1476.          IPALB(I,3) = IDIM
  1477.          XPALB(I,1) = XRAID
  1478.          XPALB(I,3) = XPUIS
  1479.          ID1 = 3
  1480.          IP1 = 5
  1481. *
  1482. *        le maillage IMA1 est en element de type POI1
  1483.          MELEME = IMA1
  1484.          SEGACT MELEME
  1485.          NOMBN1 = NUM(/2)
  1486.          IPALB(I,4) = NOMBN1
  1487.          IDP = ID1 + 5*IDIM
  1488.          DO 512  IE = 1,NOMBN1
  1489.             IPT = NUM(1,IE)
  1490.             INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1491.             DO 514 ID = 1,IDIM
  1492.                XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1493.  514        CONTINUE
  1494. *           end do
  1495.             IDP = IDP + IDIM
  1496.  512      CONTINUE
  1497. *        end do
  1498.          SEGDES MELEME
  1499. *
  1500. *        le maillage IMA2 est en element de type POI1
  1501.          MELEME = IMA2
  1502.          SEGACT MELEME
  1503.          NOMBN2 = NUM(/2)
  1504.          IPALB(I,5) = NOMBN2
  1505.          DO 516  IE = 1,NOMBN2
  1506.             IPT = NUM(1,IE)
  1507.             INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1508.             DO 518 ID = 1,IDIM
  1509.                XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1510.  518        CONTINUE
  1511. *           end do
  1512.             IDP = IDP + IDIM
  1513.  516      CONTINUE
  1514. *        end do
  1515.          SEGDES MELEME
  1516.          CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP)
  1517.          IPLIB(I,1) = IPLAC
  1518. *
  1519. *        creation d'un rep}re orthonorme dans le plan des maillages
  1520. *        le point origine est le premier point de IMA1
  1521.          CALL DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1)
  1522.          IF (IERR.NE.0) RETURN
  1523. *
  1524. *        coefficient des droites formees par les elements de IMA1
  1525.          CALL DYNE29(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  1526. *
  1527. *        position initiale de IMA2 par rapport a IMA1
  1528.          CALL DYNE30(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  1529. *
  1530. *        calcul de la section du profil mobile
  1531.          CALL DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
  1532.          XPALB(I,2) = XSECT
  1533. *
  1534. *
  1535.         else if(cmatee.eq.'LI_LI_FR') then
  1536.            ITYP = 35
  1537.            MONJEU = ' '
  1538.            MONAMO = ' '
  1539.            MARAID = ' '
  1540.            CMOT = ' '
  1541.            MONESC = ' '
  1542.            MONSYM = ' '
  1543.            MONREC = ' '
  1544.            INOR = 0
  1545.            SEGINI MLIGNE
  1546.           do io = 1,n2
  1547.             MO4=nomche(io)(1:4)
  1548.             if (MO4.eq.'NORM') then
  1549.               melval = ielval(io)
  1550.               segact melval
  1551.               INOR = ielche(1,1)
  1552.             else if  (MO4.eq.'RAID') then
  1553.               melval = ielval(io)
  1554.               segact melval
  1555.               typret=typche(io)(1:8)
  1556.                 if (typret.eq.'POINTEUR') then
  1557.                  IRAIES = ielche(1,1)
  1558.                  MARAID = 'CHPOINT'
  1559.                 else
  1560.                  xraide = velche(1,1)
  1561.                  MARAID = 'FLOTTANT'
  1562.                 endif
  1563.             else if  (MO4.eq.'LIMA') then
  1564.               melval = ielval(io)
  1565.               segact melval
  1566.               IMAI = ielche(1,1)
  1567.             else if  (MO4.eq.'LIES') then
  1568.               melval = ielval(io)
  1569.               segact melval
  1570.                MONESC = typche(io)(9:16)
  1571.               IESC = ielche(1,1)
  1572.             else if  (MO4.eq.'JEU') then
  1573.               melval = ielval(io)
  1574.               segact melval
  1575.               MONJEU = 'FLOTTANT'
  1576.               xjeu = velche(1,1)
  1577.             else if  (MO4.eq.'RAYB') then
  1578.               melval = ielval(io)
  1579.               segact melval
  1580.               XRAYB = velche(1,1)
  1581.             else if  (MO4.eq.'GLIS') then
  1582.               melval = ielval(io)
  1583.               segact melval
  1584.               XGLIS = velche(1,1)
  1585.             else if  (MO4.eq.'ADHE') then
  1586.               melval = ielval(io)
  1587.               segact melval
  1588.               XADHE = velche(1,1)
  1589.             else if  (MO4.eq.'RTAN') then
  1590.               melval = ielval(io)
  1591.               segact melval
  1592.               XRAIT = velche(1,1)
  1593.             else if  (MO4.eq.'ATAN') then
  1594.               melval = ielval(io)
  1595.               segact melval
  1596.               XAMOT = velche(1,1)
  1597.             else if (MO4.eq.'AMOR') then
  1598.               melval = ielval(io)
  1599.               segact melval
  1600.                typret=typche(io)(1:8)
  1601.                if (typret.eq.'POINTEUR') then
  1602.                  typret=typche(io)(9:16)
  1603.                  iamoes = ielche(1,1)
  1604.                  MONAMO = 'CHPOINT'
  1605.                else
  1606.                  XAMO = velche(1,1)
  1607.                  MONAMO = 'FLOTTANT'
  1608.                endif
  1609.             else if (MO4.eq.'SYME') then
  1610.               melval = ielval(io)
  1611.               segact melval
  1612.               isyme = ielche(1,1)
  1613.               MONSYM = 'MOT'
  1614.               if (isyme.eq.1) CMOT1(1:7)='LOCALE'
  1615.               if (isyme.eq.2) CMOT1(1:4)='VRAI'
  1616.               if (isyme.eq.3) CMOT1(1:7)='GLOBALE'
  1617.             else if (MO4.eq.'RECH') then
  1618.               melval = ielval(io)
  1619.               segact melval
  1620.               irchec = ielche(1,1)
  1621.               MONREC = 'MOT'
  1622.               if (irchec.eq.1) CMOT(1:7)= 'GLOBALE'
  1623.             else
  1624.             endif
  1625.           enddo
  1626. *         IF (IERR.NE.0) RETURN
  1627. *
  1628.          IPALB(I,1) = ITYP
  1629.          IPALB(I,3) = IDIM
  1630.          XPALB(I,3) = XGLIS
  1631.          XPALB(I,4) = XADHE
  1632.          XPALB(I,5) = XRAIT
  1633.          XPALB(I,6) = XAMOT
  1634. *
  1635.          IF (MONAMO.EQ.'CHPOINT') THEN
  1636.             IPALB(I,1) = 36
  1637.             ID1 = 7
  1638.          ELSE
  1639.             ID1 = 6
  1640.          ENDIF
  1641. *   Normale au plan
  1642.          IF (IDIM.EQ.3) THEN
  1643.            if (inor.eq.0) call erreur(5)
  1644.             IPNO  = (IDIM + 1) * (INOR - 1)
  1645.             PS = 0.D0
  1646.             DO 80 ID = 1,IDIM
  1647.                XC = XCOOR(IPNO + ID)
  1648.                PS = PS + XC * XC
  1649.  80         CONTINUE
  1650. *        end do
  1651.             IF (PS.LE.0.D0) THEN
  1652.                CALL ERREUR(162)
  1653.                RETURN
  1654.             ENDIF
  1655.             DO 81 ID=1,IDIM
  1656.                XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  1657.  81         CONTINUE
  1658.          ELSE
  1659.             DO 82 ID=1,IDIM
  1660.                XPALB(I,ID1+ID) = 0.D0
  1661.  82         CONTINUE
  1662.          ENDIF
  1663.          IF (MONJEU.EQ.'FLOTTANT') THEN
  1664.             XPALB(I,2) = XJEU
  1665.          ELSE
  1666.             XPALB(I,2) = 0.D0
  1667.          ENDIF
  1668. *   La recherche s'effectue par defaut localement
  1669.          IF (MONREC.EQ.'MOT') THEN
  1670.             IF (CMOT(1:7).EQ.'GLOBALE') THEN
  1671.                 IPALB(I,23) = 1
  1672.             ELSE
  1673.                 IPALB(I,23) = 0
  1674.             ENDIF
  1675.          ELSE
  1676.             IPALB(I,23) = 0
  1677.          ENDIF
  1678. *   Coordonnees du maillage_maitre
  1679.          MELEME = IMAI
  1680.          SEGACT MELEME
  1681. *   Pour savoir si le contour est ferme
  1682.          NELEMA = NUM(/2)
  1683.          IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  1684.             NNOEMA = NELEMA
  1685.             IFERMA = 1
  1686.          ELSE
  1687.             NNOEMA = NELEMA +1
  1688.             IFERMA = 0
  1689.          ENDIF
  1690.          IPALB(I,21) = NNOEMA
  1691.          IPALB(I,24) = IFERMA
  1692.          ID2 = ID1 + 4*IDIM
  1693.          IPT = NUM(1,1)
  1694.          INPT = (IDIM+1)*(IPT-1)
  1695.          CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1696.          IPLIB(I,1) = IPLAC
  1697.          KPLIB(1) = IPT
  1698.          DO 84 ID=1,IDIM
  1699.             XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  1700.  84         CONTINUE
  1701.          DO 85 IE=1,(NNOEMA-1)
  1702.             IPT = NUM(2,IE)
  1703.             INPT = (IDIM+1)*(IPT-1)
  1704.             CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1705.             IPLIB(I,IE+1) = IPLAC
  1706.             KPLIB(IE+1) = IPT
  1707.             IDIE = ID2 + IE*IDIM
  1708.             DO 86 ID=1,IDIM
  1709.                 XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1710.  86             CONTINUE
  1711.  85         CONTINUE
  1712.          SEGDES MELEME
  1713. *   Maillage_esclave
  1714.          ID3 = ID2 + NNOEMA*IDIM
  1715.          IF (MONESC.EQ.'POINT') THEN
  1716. * La ligne esclave est un point
  1717.             NNOEES=1
  1718.             IFERES=0
  1719.             ISYMET=-1
  1720. * Lecture des coordonnees
  1721.             IPESC = (IDIM+1)*(IESC-1)
  1722.             CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  1723.             IPLIB(I,NNOEMA+1)  = IPLAC
  1724.             KPLIB(NNOEMA+1) = IESC
  1725.             DO 90 ID = 1,IDIM
  1726.                XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  1727.  90         CONTINUE
  1728. *
  1729.             IPALB(I,22) = NNOEES
  1730.             IPALB(I,25) = IFERES
  1731.             IPALB(I,26) = ISYMET
  1732.          ELSE
  1733.          IF (MONESC.EQ.'MAILLAGE') THEN
  1734. *    La ligne esclave est un maillage
  1735.             MELEME = IESC
  1736.             SEGACT MELEME
  1737. *   Pour savoir si le contour est ferme
  1738.             NELEES = NUM(/2)
  1739.             IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  1740.                NNOEES = NELEES
  1741.                IFERES = 1
  1742.             ELSE
  1743.                NNOEES = NELEES +1
  1744.                IFERES = 0
  1745.             ENDIF
  1746.             IPALB(I,22) = NNOEES
  1747.             IPALB(I,25) = IFERES
  1748. *   Coordonnees du maillage_esclave
  1749.             IPT = NUM(1,1)
  1750.             INPT = (IDIM+1)*(IPT-1)
  1751.             CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1752.             IPLIB(I,NNOEMA+1) = IPLAC
  1753.             KPLIB(NNOEMA+1) = IPT
  1754.             DO 94 ID=1,IDIM
  1755.                XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  1756.  94         CONTINUE
  1757.             DO 95 IE=1,(NNOEES-1)
  1758.                IPT = NUM(2,IE)
  1759.                INPT = (IDIM+1)*(IPT-1)
  1760.                CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1761.                IPLIB(I,NNOEMA+IE+1) = IPLAC
  1762.                KPLIB(NNOEMA+IE+1) = IPT
  1763.                IDIE = ID3 + IE*IDIM
  1764.                DO 96 ID=1,IDIM
  1765.                   XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1766.  96            CONTINUE
  1767.  95         CONTINUE
  1768.             SEGDES MELEME
  1769. *   Le traitement symetrique par defaut ne s'effectue pas
  1770.             IF (MONSYM.EQ.'MOT') THEN
  1771.                IF (CMOT1(1:7).EQ.'LOCALE') THEN
  1772.                   IPALB(I,26) = 1
  1773.                ELSE
  1774.                   IF (CMOT1(1:4).EQ.'VRAI'.OR.
  1775.      & CMOT1(1:7).EQ.'GLOBALE') THEN
  1776.                      IPALB(I,26) = 0
  1777.                   ELSE
  1778.                      IPALB(I,26) = -1
  1779.                   ENDIF
  1780.                ENDIF
  1781.             ELSE
  1782.                IPALB(I,26) = -1
  1783.             ENDIF
  1784.          ELSE
  1785. * La ligne esclave n'est ni un point ni un maillage
  1786. *           CALL ERREUR(...)
  1787.             RETURN
  1788.          ENDIF
  1789.          ENDIF
  1790. * Lecture des chpoints de raideur et d amortissement
  1791. * Raideurs des noeuds esclaves  et maitres
  1792.          ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  1793.          MCHPOI=IRAIES
  1794.          SEGACT,MCHPOI
  1795.          NSOUP=IPCHP(/1)
  1796.          DO 700 IPC=1,NSOUP
  1797.              MSOUPO=IPCHP(IPC)
  1798.              SEGACT,MSOUPO
  1799.              MELEME = IGEOC
  1800.              SEGACT,MELEME
  1801.              MPOVAL = IPOVAL
  1802.              SEGACT,MPOVAL
  1803.              NNN = NUM(/2)
  1804.              DO 711 INN=1,NNN
  1805.                IPT = NUM(1,INN)
  1806.                CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1807.                IF (IPLAC.NE.0) THEN
  1808.                   XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  1809.                ENDIF
  1810.  711         CONTINUE
  1811.              SEGDES,MPOVAL,MELEME
  1812.              SEGDES MSOUPO
  1813.  700     CONTINUE
  1814.          SEGDES,MCHPOI
  1815. *  Amortissement des noeuds esclaves et maitres
  1816.          ID5=ID4+NNOEMA+NNOEES
  1817.          IF (IPALB(I,1).EQ.36) THEN
  1818.               MCHPOI=IAMOES
  1819.               SEGACT,MCHPOI
  1820.               NSOUP = IPCHP(/1)
  1821.               DO 121 IPC=1,NSOUP
  1822.                  MSOUPO=IPCHP(IPC)
  1823.                  SEGACT,MSOUPO
  1824.                  MELEME = IGEOC
  1825.                  SEGACT,MELEME
  1826.                  MPOVAL = IPOVAL
  1827.                  SEGACT,MPOVAL
  1828.                  NNN=NUM(/2)
  1829.                  DO 130 INN=1,NNN
  1830.                     IPT = NUM(1,INN)
  1831.                     CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1832.                     IF (IPLAC.NE.0) THEN
  1833.                         XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  1834.                     ENDIF
  1835.  130             CONTINUE
  1836.                  SEGDES MPOVAL,MELEME
  1837.                  SEGDES MSOUPO
  1838.  121          CONTINUE
  1839.                SEGDES MCHPOI
  1840.          ENDIF
  1841.          SEGSUP MLIGNE
  1842.  
  1843.         else if(cmatee.eq.'LI_CE_FR') then
  1844.  
  1845.  
  1846.         else if(cmatee.eq.'PA_FL_RO') then
  1847.          ITYP = 60
  1848.          MONMOT='RODELI'
  1849.       MTLIAB = KTLIAB
  1850. *
  1851.       NUML = I
  1852.       IP1 = imod
  1853.       IF (IERR.NE.0) RETURN
  1854.          CALL PLACE2(JPLIB,NPLB,IPLAC,IP1)
  1855.          IPLIB(NUML,1) = IPLAC
  1856. *
  1857. * Valeurs de IPALB et XPALB communes a tous les types de
  1858. *    paliers fluides :
  1859. *
  1860.       IPALB(NUML,1) = ITYP
  1861.       IPALB(NUML,2) = 0
  1862.       IPALB(NUML,3) = 3
  1863.       IPALB(NUML,4) = 0
  1864. *
  1865.           do io = 1,n2
  1866.             MO4=nomche(io)(1:4)
  1867.             if (MO4.eq.'VISC') then
  1868.               melval = ielval(io)
  1869.               segact melval
  1870.               X1 = velche(1,1)
  1871.               XPALB(NUML,1) = X1
  1872.             else if  (MO4.eq.'RHOF') then
  1873.              melval = ielval(io)
  1874.               segact melval
  1875.               X1 = velche(1,1)
  1876.               XPALB(NUML,2) = X1
  1877.             else if  (MO4.eq.'PADM') then
  1878.              melval = ielval(io)
  1879.               segact melval
  1880.               X1 = velche(1,1)
  1881.               XPALB(NUML,3) = X1
  1882.             else if  (MO4.eq.'LONG') then
  1883.              melval = ielval(io)
  1884.               segact melval
  1885.               X1 = velche(1,1)
  1886.               XPALB(NUML,4) = X1
  1887.             else if  (MO4.eq.'AFFI') then
  1888.              melval = ielval(io)
  1889.               segact melval
  1890.               X1 = velche(1,1)
  1891.               XPALB(NUML,5) = X1
  1892.             else if  (MO4.eq.'RAYO') then
  1893.              melval = ielval(io)
  1894.               segact melval
  1895.               X1 = velche(1,1)
  1896.               XPALB(NUML,6) = X1
  1897.             else if  (MO4.eq.'VROT') then
  1898.              melval = ielval(io)
  1899.               segact melval
  1900.               X1 = velche(1,1)
  1901.               XPALB(NUML,7) = X1
  1902.             else if  (MO4.eq.'EPSI') then
  1903.              melval = ielval(io)
  1904.               segact melval
  1905.               X1 = velche(1,1)
  1906.               XPALB(NUML,8) = X1
  1907.             else if  (MO4.eq.'PHII') then
  1908.              melval = ielval(io)
  1909.               segact melval
  1910.               X1 = velche(1,1)
  1911.               XPALB(NUML,9) = X1
  1912.             else if  (MO4.eq.'TLOB') then
  1913.              melval = ielval(io)
  1914.               segact melval
  1915.               itgeom = ielche(1,1)
  1916.              else
  1917.             endif
  1918.           enddo
  1919. *
  1920.       IF (MONMOT.EQ.'RODELI'.and.itgeom.gt.0) THEN
  1921. * ----- Cas du palier cylindrique ou a lobes, avec modele de Rhode et Li
  1922. *
  1923.        IPALB(NUML,5) = 1
  1924.        CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  1925.      &                    'ENTIER',NLOB,X1,' ',L1,IP1)
  1926.  
  1927.        IF (IERR.NE.0) RETURN
  1928.        IPALB(NUML,6) = NLOB
  1929.  
  1930. C Nombre de parametres reels :
  1931.        NBPR = 6
  1932.        IPALB(NUML,7) = NBPR
  1933.  
  1934.        CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0,
  1935.      &                    'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1936.        XPALB(NUML,10) = X1
  1937.  
  1938.        IF (IERR.NE.0) RETURN
  1939.        DO 610 ILOB = 1, NLOB
  1940. *
  1941.           CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,MONMOT,L0,IP0,
  1942.      &                    'TABLE',I1,X1,' ',L1,ITLOB)
  1943.  
  1944.           IF (IERR.NE.0) RETURN
  1945.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0,
  1946.      &              'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1947.           XPALB(NUML,11+NBPR*(ILOB-1)) = X1
  1948.  
  1949.           IF (IERR.NE.0) RETURN
  1950.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0,
  1951.      &              'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1952.           XPALB(NUML,12+NBPR*(ILOB-1)) = X1
  1953.  
  1954.           IF (IERR.NE.0) RETURN
  1955.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0,
  1956.      &              'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1957.           XPALB(NUML,13+NBPR*(ILOB-1)) = X1
  1958.  
  1959.           IF (IERR.NE.0) RETURN
  1960.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0,
  1961.      &              'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1962.           XPALB(NUML,14+NBPR*(ILOB-1)) = X1
  1963.           ANGDEB = X1
  1964.  
  1965.           IF (IERR.NE.0) RETURN
  1966.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0,
  1967.      &              'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1968.           XPALB(NUML,15+NBPR*(ILOB-1)) = X1
  1969.           AMPLIT=X1
  1970.  
  1971.           IF (IERR.NE.0) RETURN
  1972.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0,
  1973.      &              'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1974.           XPALB(NUML,16+NBPR*(ILOB-1)) = X1
  1975.  
  1976.           IF (IERR.NE.0) RETURN
  1977.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0,
  1978.      &                    'ENTIER',I1,X1,' ',L1,IP1)
  1979. cbp2018          IPALB(NUML,7+ILOB) = I1
  1980.           NMAIL=I1
  1981.           CALL COS208(ANGDEB,AMPLIT,NMAIL,KLREEL)
  1982.           IPALB(NUML,7+ILOB) = KLREEL
  1983.  
  1984.           IF (IERR.NE.0) RETURN
  1985.  610     CONTINUE
  1986.         ENDIF
  1987. *
  1988.         else
  1989.          write(6,*) 'verifier nom liaison', cmatee
  1990.          call erreur(5)
  1991.          return
  1992.         endif
  1993.        enddo
  1994. *
  1995. * traiter liaisons conditionnelles
  1996. *
  1997.        DO I = 1,kmodel(/1)
  1998.          ksi = 0
  1999.          imodel = kmodel(I)
  2000.          segact imodel
  2001.          if (tymode(/2).gt.0) then
  2002.            do 722 ilc = 1,tymode(/2)
  2003.              do j =1,kmodel(/1)
  2004.                 if (kmodel(j).eq.ivamod(ilc)) then
  2005.               ksi = ksi + 1
  2006.               ipalb(i,4) = 1
  2007.               IF (tymode(ilc).EQ.'CONDINFE' ) THEN
  2008.                 ipalb (i,4+ksi) = j
  2009.               ELSE IF (tymode(ilc).EQ.'CONDSUPE' ) THEN
  2010.                 ipalb (i,4+ksi) = -1 * j
  2011.               ENDIF
  2012.                 endif
  2013.                 goto 722
  2014.              enddo
  2015.  722       continue
  2016.          endif
  2017.  723     continue
  2018.        ENDDO
  2019.  
  2020. * ranger
  2021.        do I = 1, kmodel(/1)
  2022.         imodel = kmodel(I)
  2023.         ipt8 = imamod
  2024.         segdes imodel,ipt8
  2025.        enddo
  2026.         do in = 1,n1
  2027.           meleme = imache(in)
  2028.           mchaml = ichaml(in)
  2029.           segact mchaml
  2030.           n2 = ielval(/1)
  2031.           do io = 1,n2
  2032.               melval = ielval(io)
  2033.               segdes melval
  2034.           enddo
  2035.           segdes meleme,mchaml
  2036.         enddo
  2037.        segdes mchelm
  2038.  
  2039.  
  2040. ***** eventuel message ****
  2041.  
  2042.       IF (IIMPI.EQ.333) THEN
  2043.          NLIAB  = IPALB(/1)
  2044.          NIPALB = IPALB(/2)
  2045.          NXPALB = XPALB(/2)
  2046.          NPLBB  = IPLIB(/2)
  2047.          NPLB   = JPLIB(/1)
  2048.        DO 1000 IN = 1,NLIAB
  2049.           DO 1002 II = 1,NIPALB
  2050.           WRITE(IOIMP,*)'DYNE70 : IPALB(',IN,',',II,') =',IPALB(IN,II)
  2051.  1002     CONTINUE
  2052.           DO 1004 IX = 1,NXPALB
  2053.           WRITE(IOIMP,*)'DYNE70 : XPALB(',IN,',',IX,') =',XPALB(IN,IX)
  2054.  1004     CONTINUE
  2055.           DO 1006 IP = 1,NPLBB
  2056.           WRITE(IOIMP,*)'DYNE70 : IPLIB(',IN,',',IP,') =',IPLIB(IN,IP)
  2057.  1006     CONTINUE
  2058.  1000  CONTINUE
  2059.        DO 1008 IP = 1,NPLB
  2060.           WRITE(IOIMP,*)'DYNE70 : JPLIB(',IP,') =',JPLIB(IP)
  2061.  1008  CONTINUE
  2062.       ENDIF
  2063.  
  2064. *
  2065.       RETURN
  2066.       END
  2067.  
  2068.  
  2069.  
  2070.  
  2071.  
  2072.  
  2073.  
  2074.  
  2075.  
  2076.  
  2077.  
  2078.  
  2079.  
  2080.  
  2081.  
  2082.  
  2083.  
  2084.  
  2085.  
  2086.  
  2087.  
  2088.  
  2089.  
  2090.  

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