Télécharger la plaquette Cast3M


fr en

Télécharger cyne72.eso

Retour à la liste

Numérotation des lignes : 

cyne72

  1. C CYNE72    SOURCE    CB215821  24/04/12    21:15:34     11897          
  2.       SUBROUTINE CYNE72(ITLB,IWRK52,ITRULI)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *        voir dyne72.eso                                             *
  7. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  8. *     ________________________________________________               *
  9. *                                                                    *
  10. *     Determination des parametres de liaison pour la base B.        *
  11. *                                                                    *
  12. *     Parametres:                                                    *
  13. *                                                                    *
  14. * e   ITLB    Modele decrivant les liaisons B                        *
  15. * e ITCARA    Caracteristiques                                       *
  16. * s   NLIAB   Nombre total de liaisons sur base B.                   *
  17. * s   NXPALB  Maxi du nombre de parametres definissant une liaison.  *
  18. * s   NPLBB   Maxi du nombre de points intervenant dans une liaison. *
  19. * s   NPLB    Nombre total de points.                                *
  20. * s   IDIMB   Dimension de travail des liaisons.                     *
  21. * s   KCPR    Segment de points.                                     *
  22. * s   NIPALB  Maxi du nombre de parametres definissant une liaison.  *
  23. * s   NIP     Nb de pts dans l'evolution de la loi de comportement   *
  24. *                                                                    *
  25. *     Auteur, date de creation: JK, a partir de DYNE22 et DYNE72     *
  26. *                                                                    *
  27. *--------------------------------------------------------------------*
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMCOORD
  32. -INC SMELEME
  33. -INC SMEVOLL
  34. -INC SMLREEL
  35. -INC SMMODEL
  36. -INC SMCHAML
  37. -INC DECHE
  38. ** segment sous-structures dynamiques
  39.       segment struli
  40.        integer itlia,itbmod,momoda, mostat,itmail,molia
  41.        integer ldefo(np1),lcgra(np1),lsstru(np1)
  42.        integer nsstru,nndefo,nliab,nsb,na2,idimb
  43.        integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas
  44.        INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib
  45. * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0)
  46.        INTEGER ICHAIN
  47.       endsegment
  48. *
  49.       SEGMENT,NCPR(nbpts)
  50. *
  51.       LOGICAL L0,L1
  52.       CHARACTER*8  TYPRET,MONSYM,MONESC,CMOT1,CHARRE
  53.       CHARACTER*8 CMOT
  54. *
  55.       IMODEL = ITLB
  56.       wrk52 = iwrk52
  57.       struli = itruli
  58.       SEGINI,NCPR
  59.  
  60.       KCPR = NCPR
  61.  
  62. * index des liaisons B. Utilise le fait qu il n y a qu un seul point local
  63.       jliaib = jliaib + 1
  64. *
  65.       NXPALB = 0
  66. c     c.a.d. 15 liaisons conditionelles (ca marche pas pour 'PROFIL..;')
  67.       NIPALB = 20
  68.       NPLBB  = 0
  69.       NPLB   = 0
  70.       IDIMB  = 0
  71. cc      NLIAB  = 0
  72. C NIP = 1 dans le cas ou la liaison n'est pas ITYP =16/17 ou ITYP=50/51
  73.       NIP = 1
  74.       IL = 0
  75.  10   CONTINUE
  76.  
  77.       segact imodel
  78.       cmot(1:8) = cmatee
  79.       meleme = imamod
  80.       segact meleme
  81.  
  82. cc       NLIAB = NLIAB + 1
  83.        ica = 0
  84.  
  85.        n2cham = valmat(/1)
  86.  
  87.  11     continue
  88. *
  89. * ------ choc elementaire POINT_PLAN_FLUIDE
  90. *
  91.         IF (CMOT.EQ.'PO_PL_FL') THEN
  92.            INOE = num(1,1)
  93.            IF (IERR.NE.0) RETURN
  94.            IF (NCPR(INOE).EQ.0) THEN
  95.               NPLB = NPLB + 1
  96.               NCPR(INOE) = NPLB
  97.            ENDIF
  98.            KPLBB  = 1
  99.            KDIMB = IDIM
  100.            KIPALB = 3
  101.            KXPALB = 9 + IDIM
  102.            NXPALB = MAX(NXPALB,KXPALB)
  103.            NIPALB = MAX(NIPALB,KIPALB)
  104.            NPLBB  = MAX(NPLBB,KPLBB)
  105.            IDIMB  = MAX(IDIMB,KDIMB)
  106. *
  107. * ------ choc elementaire POINT_PLAN_FROTTEMENT
  108. *
  109.         ELSE IF (CMOT.EQ.'PO_PL_FR') THEN
  110.            if (valmat(/1).gt.7) then
  111.             if (valmat(9).gt.0) goto 1021
  112.            endif
  113.            KNIP = 0
  114.            goto 1022
  115.  
  116.  1021      MEVOLL = int(valmat(9))
  117.            SEGACT MEVOLL
  118.            KEVOLL = IEVOLL(1)
  119.            SEGACT KEVOLL
  120.            MLREE1 = IPROGX
  121.            SEGACT MLREE1
  122.            KNIP = MLREE1.PROG(/1)
  123.            SEGDES MLREE1
  124. c*           MLREE2 = IPROGY
  125. c*           SEGACT MLREE2
  126. c*           SEGDES MLREE2
  127.            SEGDES KEVOLL
  128.            SEGDES MEVOLL
  129. *
  130.  1022      continue
  131.            INOE = num(1,1)
  132.            IF (NCPR(INOE).EQ.0) THEN
  133.               NPLB = NPLB + 1
  134.               NCPR(INOE) = NPLB
  135.            ENDIF
  136.            TYPRET = ' '
  137.            KPLBB  = 1
  138.            KDIMB = IDIM
  139.            KIPALB = 3
  140. cbp,2020           KXPALB = 7 + 7 * IDIM
  141.            KXPALB = 9 + 8 * IDIM
  142.            NXPALB = MAX(NXPALB,KXPALB)
  143.            NIPALB = MAX(NIPALB,KIPALB)
  144.            NPLBB  = MAX(NPLBB,KPLBB)
  145.            IDIMB  = MAX(IDIMB,KDIMB)
  146.            NIP    = MAX(NIP,KNIP)
  147. *
  148. * ------ choc elementaire POINT_PLAN
  149. *
  150.         ELSE IF (CMOT.EQ.'PO_PL') THEN
  151.            if (valmat(/1).gt.3) then
  152.              if (valmat(4).gt.0) goto 1031
  153.            endif
  154.            KNIP = 0
  155.            goto 1032
  156.  
  157.  1031      IPEVO  = int(valmat(4))
  158.            MEVOLL = IPEVO
  159.            SEGACT MEVOLL
  160.            KEVOLL = IEVOLL(1)
  161.            SEGACT KEVOLL
  162.            MLREE1 = IPROGX
  163.            SEGACT MLREE1
  164.            KNIP = MLREE1.PROG(/1)
  165.            SEGDES MLREE1
  166. c*           MLREE2 = IPROGY
  167. c*           SEGACT MLREE2
  168. c*           SEGDES MLREE2
  169.            SEGDES KEVOLL
  170.            SEGDES MEVOLL
  171. *
  172.  1032      continue
  173.            INOE = num(1,1)
  174.            IF (NCPR(INOE).EQ.0) THEN
  175.               NPLB = NPLB + 1
  176.               NCPR(INOE) = NPLB
  177.            ENDIF
  178.            TYPRET = ' '
  179.            KPLBB = 1
  180.            KDIMB = IDIM
  181.            KIPALB = 4
  182.            KXPALB = 3 + IDIM
  183. **  ianis
  184.            if (valmat(/1).gt.3) then
  185.              if (valmat(6).gt.0)  KXPALB = 3 + IDIM + 2
  186.            endif
  187. *
  188.            NXPALB = MAX(NXPALB,KXPALB)
  189.            NIPALB = MAX(NIPALB,KIPALB)
  190.            NPLBB  = MAX(NPLBB,KPLBB)
  191.            IDIMB  = MAX(IDIMB,KDIMB)
  192.            NIP    = MAX(NIP,KNIP)
  193. *
  194. * ----- choc elementaire POINT_POINT_FROTTEMENT
  195. *
  196.         ELSE IF (CMOT.EQ.'PO_PO_FR') THEN
  197.            INOA = num(1,1)
  198.            IF (NCPR(INOA).EQ.0) THEN
  199.               NPLB = NPLB + 1
  200.               NCPR(INOA) = NPLB
  201.            ENDIF
  202.            INOB = num(1,2)
  203.            IF (NCPR(INOB).EQ.0) THEN
  204.               NPLB = NPLB + 1
  205.               NCPR(INOB) = NPLB
  206.            ENDIF
  207.            if (valmat(/1).gt.11) then
  208.              if (valmat(10).gt.0) goto 1041
  209.            endif
  210.  
  211.            KNIP = 0
  212.            goto 1042
  213.  
  214.  1041      ipevo = int(valmat(10))
  215.            MEVOLL = IPEVO
  216.            SEGACT MEVOLL
  217.            KEVOLL = IEVOLL(1)
  218.            SEGACT KEVOLL
  219.            MLREE1 = IPROGX
  220.            SEGACT MLREE1
  221.            KNIP = MLREE1.PROG(/1)
  222.            SEGDES MLREE1
  223. c*           MLREE2 = IPROGY
  224. c*           SEGACT MLREE2
  225. c*           SEGDES MLREE2
  226.            SEGDES KEVOLL
  227.            SEGDES MEVOLL
  228.  
  229.  1042      continue
  230.            KPLBB = 2
  231.            KDIMB = IDIM
  232.            KIPALB = 3
  233.            KXPALB = 7 + 7 * IDIM
  234.            NXPALB = MAX(NXPALB,KXPALB)
  235.            NIPALB = MAX(NIPALB,KIPALB)
  236.            NPLBB  = MAX(NPLBB,KPLBB)
  237.            IDIMB  = MAX(IDIMB,KDIMB)
  238.            NIP    = MAX(NIP,KNIP)
  239. *
  240. * ----- choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE
  241. *
  242.         ELSE IF    (CMOT.EQ.'PO_PO_DP') THEN
  243.              if (valmat(6).gt.0) goto 1051
  244.  
  245.            call erreur(5)
  246.            return
  247.  1051      ipevo = int(valmat(7))
  248.            MEVOLL = IPEVO
  249.            SEGACT MEVOLL
  250.            KEVOLL = IEVOLL(1)
  251.            SEGACT KEVOLL
  252.            MLREE1 = IPROGX
  253.            SEGACT MLREE1
  254.            KNIP = MLREE1.PROG(/1)
  255.            SEGDES MLREE1
  256. c*           MLREE2 = IPROGY
  257. c*           SEGACT MLREE2
  258. c*           SEGDES MLREE2
  259.            SEGDES KEVOLL
  260.            SEGDES MEVOLL
  261. *
  262.            INOA = num(1,1)
  263.            IF (NCPR(INOA).EQ.0) THEN
  264.               NPLB = NPLB + 1
  265.               NCPR(INOA) = NPLB
  266.            ENDIF
  267.            INOB = num(1,2)
  268.            IF (NCPR(INOB).EQ.0) THEN
  269.               NPLB = NPLB + 1
  270.               NCPR(INOB) = NPLB
  271.            ENDIF
  272.            TYPRET = ' '
  273.            if (valmat(/1).gt.6) then
  274.              if (valmat(7).gt.0) then
  275.                typret='FLOTTANT'
  276.                 goto 1052
  277.              endif
  278.            endif
  279.  1052      continue
  280. *
  281.            KPLBB = 2
  282.            KDIMB = IDIM
  283. C
  284.            KIPALB = 5
  285.            IF (TYPRET.EQ.'FLOTTANT') THEN
  286.               KXPALB = 5 + IDIM
  287.            ELSE IF (TYPRET.EQ.'        ') THEN
  288.               KXPALB = 4 + IDIM
  289.            ELSE
  290.               CALL ERREUR(522)
  291.               RETURN
  292.            ENDIF
  293.            NXPALB = MAX(NXPALB,KXPALB)
  294.            NIPALB = MAX(NIPALB,KIPALB)
  295.            NPLBB  = MAX(NPLBB,KPLBB)
  296.            IDIMB  = MAX(IDIMB,KDIMB)
  297.            NIP    = MAX(NIP,KNIP)
  298. *
  299. * ----- choc elementaire POINT_POINT_ROTATION_PLASTIQUE
  300. *
  301.         ELSE IF  (CMOT.EQ.'PO_PO_RP') THEN
  302.            if (valmat(6).gt.0)  goto 1061
  303.            call erreur(5)
  304.            return
  305.  1061      ipevo = int(valmat(6))
  306. *
  307.            MEVOLL = IPEVO
  308.            SEGACT MEVOLL
  309.            KEVOLL = IEVOLL(1)
  310.            SEGACT KEVOLL
  311.            MLREE1 = IPROGX
  312.            SEGACT MLREE1
  313.            KNIP = MLREE1.PROG(/1)
  314.            SEGDES MLREE1
  315. c*           MLREE2 = IPROGY
  316. c*           SEGACT MLREE2
  317. c*           SEGDES MLREE2
  318.            SEGDES KEVOLL
  319.            SEGDES MEVOLL
  320. *
  321.            INOA = num(1,1)
  322.            IF (NCPR(INOA).EQ.0) THEN
  323.               NPLB = NPLB + 1
  324.               NCPR(INOA) = NPLB
  325.            ENDIF
  326.            INOB = num(1,2)
  327.            IF (NCPR(INOB).EQ.0) THEN
  328.               NPLB = NPLB + 1
  329.               NCPR(INOB) = NPLB
  330.            ENDIF
  331.            TYPRET = ' '
  332.            if (valmat(/1).gt.6) then
  333.              if (valmat(7).gt.0) then
  334.                typret='FLOTTANT'
  335.                 goto 1062
  336.              endif
  337.            endif
  338.  1062      continue
  339.            KPLBB = 2
  340. *
  341. * NW   Dans le cas de la rotule, on passe en dimension 6
  342. *      car on aura Ux,Uy,Uz,Rx,Ry,Rz
  343. *
  344.            KDIMB = 3+IDIM
  345. *
  346. *   KIPALB = 5 : nombre maxi de parametres pour la liaison
  347. *
  348.            KIPALB = 5
  349.            IF (TYPRET.EQ.'FLOTTANT') THEN
  350.               KXPALB = 5 + IDIM
  351.            ELSE IF (TYPRET.EQ.'        ') THEN
  352.               KXPALB = 4 + IDIM
  353.            ELSE
  354.               CALL ERREUR(522)
  355.               RETURN
  356.            ENDIF
  357.            NXPALB = MAX(NXPALB,KXPALB)
  358.            NIPALB = MAX(NIPALB,KIPALB)
  359.            NPLBB  = MAX(NPLBB,KPLBB)
  360.            IDIMB  = MAX(IDIMB,KDIMB)
  361.            NIP    = MAX(NIP,KNIP)
  362. *
  363. * ----- choc elementaire POINT_POINT
  364. *
  365.         ELSE IF (CMOT.EQ.'PO_PO') THEN
  366.            INOA = num(1,1)
  367.            IF (NCPR(INOA).EQ.0) THEN
  368.               NPLB = NPLB + 1
  369.               NCPR(INOA) = NPLB
  370.            ENDIF
  371.            INOB = num(1,2)
  372.            IF (NCPR(INOB).EQ.0) THEN
  373.               NPLB = NPLB + 1
  374.               NCPR(INOB) = NPLB
  375.            ENDIF
  376.  
  377.            TYPRET = ' '
  378.            if (valmat(/1).gt.5) then
  379.              if (valmat(7).gt.0) goto 1071
  380.            endif
  381.            KNIP = 0
  382.            goto 1072
  383.  
  384.  1071      ipevo = int(valmat(7))
  385.            MEVOLL = IPEVO
  386.            SEGACT MEVOLL
  387.            KEVOLL = IEVOLL(1)
  388.            SEGACT KEVOLL
  389.            MLREE1 = IPROGX
  390.            SEGACT MLREE1
  391.            KNIP = MLREE1.PROG(/1)
  392.            SEGDES MLREE1
  393. c*           MLREE2 = IPROGY
  394. c*           SEGACT MLREE2
  395. c*           SEGDES MLREE2
  396.            SEGDES KEVOLL
  397.            SEGDES MEVOLL
  398.  
  399.  1072      continue
  400.            KPLBB = 2
  401.            KDIMB = IDIM
  402.            KIPALB = 4
  403.            KXPALB = 3 + IDIM
  404.            NXPALB = MAX(NXPALB,KXPALB)
  405.            NIPALB = MAX(NIPALB,KIPALB)
  406.            NPLBB  = MAX(NPLBB,KPLBB)
  407.            IDIMB  = MAX(IDIMB,KDIMB)
  408.            NIP    = MAX(NIP,KNIP)
  409. *
  410. * ianis
  411. *
  412. * ----- choc elementaire POINT_CERCLE_MOBILE
  413. *
  414.         ELSE IF (CMOT.EQ.'PO_CE_MO') THEN
  415.            INOA = num(1,1)
  416.            IF (NCPR(INOA).EQ.0) THEN
  417.               NPLB = NPLB + 1
  418.               NCPR(INOA) = NPLB
  419.            ENDIF
  420. *
  421.            if (valmat(3).gt.0) goto 1081
  422.            interr(1) = inoa
  423.            moterr(1:4) = 'PCER'
  424.            moterr(5:8) = 'CARA'
  425.            call erreur(65)
  426.  1081      inob = int(valmat(3))
  427.            IF (NCPR(INOB).EQ.0) THEN
  428.               NPLB = NPLB + 1
  429.               NCPR(INOB) = NPLB
  430.            ENDIF
  431.            TYPRET = ' '
  432.            if (valmat(/1).gt.8) then
  433.              if (valmat(10).gt.0) then
  434.                typret='FLOTTANT'
  435.                 goto 1082
  436.              endif
  437.            endif
  438.  1082      continue
  439.            KPLBB = 2
  440. * on neglige les rotations
  441.            KDIMB = IDIM
  442.            KIPALB = 4
  443.            IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER  ') THEN
  444.               KXPALB = 7 + 9 * IDIM
  445.            ELSE IF (TYPRET.EQ.' ') THEN
  446.               KXPALB = 6 + 9 * IDIM
  447.            ELSE
  448.               CALL ERREUR(522)
  449.               RETURN
  450.            ENDIF
  451.            NXPALB = MAX(NXPALB,KXPALB)
  452.            NIPALB = MAX(NIPALB,KIPALB)
  453.            NPLBB  = MAX(NPLBB,KPLBB)
  454.            IDIMB  = MAX(IDIMB,KDIMB)
  455. *
  456. * ----- choc elementaire POINT_CERCLE_FROTTEMENT
  457. *
  458.         ELSE IF (CMOT.EQ.'PO_CE_FR') THEN
  459.            INOE=num(1,1)
  460.            IF (NCPR(INOE).EQ.0) THEN
  461.               NPLB = NPLB + 1
  462.               NCPR(INOE) = NPLB
  463.            ENDIF
  464. c            TYPRET = ' '
  465. c            if (valmat(/1).gt.8) then
  466. c              if (valmat(10).gt.0) then
  467. c                typret='FLOTTANT'
  468. c                 goto 1092
  469. c              endif
  470. c            endif
  471. c  1092      continue
  472. cbp,2020 : ci-dessus inutile car on met toujours l'amortissement
  473.            KPLBB = 1
  474.            KDIMB = IDIM
  475.            KIPALB = 4
  476. cbp,2020           IF (TYPRET.EQ.'FLOTTANT') THEN
  477. cbp,2020              KXPALB = 7 + 9 * IDIM
  478. cbp,2020 : ajout 2 reels pour la regularisation + 1*idim pour Ventrainement
  479.            KXPALB = 10 + 9*IDIM
  480. cbp,2020           ELSE IF (TYPRET.EQ.' ') THEN
  481. cbp,2020              KXPALB = 6 + 9 * IDIM
  482. cbp,2020           ELSE
  483. cbp,2020              CALL ERREUR(522)
  484. cbp,2020              RETURN
  485. cbp,2020           ENDIF
  486.            NXPALB = MAX(NXPALB,KXPALB)
  487.            NIPALB = MAX(NIPALB,KIPALB)
  488.            NPLBB  = MAX(NPLBB,KPLBB)
  489.            IDIMB  = MAX(IDIMB,KDIMB)
  490. *
  491. * ----- choc elementaire POINT_CERCLE
  492. *
  493.         ELSE IF (CMOT.EQ.'PO_CE') THEN
  494.            INOE = num(1,1)
  495.            IF (NCPR(INOE).EQ.0) THEN
  496.               NPLB = NPLB + 1
  497.               NCPR(INOE) = NPLB
  498.            ENDIF
  499.            TYPRET = ' '
  500.            if (valmat(/1).gt.4) then
  501.              if (valmat(5).gt.0) then
  502.                typret='FLOTTANT'
  503.                 goto 1102
  504.              endif
  505.            endif
  506.  
  507.  1102      continue
  508.            KPLBB = 1
  509.            KDIMB = IDIM
  510.            KIPALB = 3
  511.            IF (TYPRET.EQ.'FLOTTANT') THEN
  512.               KXPALB = 3 + 2 * IDIM
  513.            ELSE IF (TYPRET.EQ.' ') THEN
  514.               KXPALB = 2 + 2 * IDIM
  515.            ELSE
  516.               CALL ERREUR(522)
  517.               RETURN
  518.            ENDIF
  519.            NXPALB = MAX(NXPALB,KXPALB)
  520.            NIPALB = MAX(NIPALB,KIPALB)
  521.            NPLBB  = MAX(NPLBB,KPLBB)
  522.            IDIMB  = MAX(IDIMB,KDIMB)
  523. *
  524. * ----- choc elementaire CERCLE_PLAN_FROTTEMENT
  525. *
  526.         ELSE IF (CMOT.EQ.'CE_PL_FR') THEN
  527.            INOE = num(1,1)
  528.            IF (NCPR(INOE).EQ.0) THEN
  529.               NPLB = NPLB + 1
  530.               NCPR(INOE) = NPLB
  531.            ENDIF
  532.            TYPRET = ' '
  533.            if (valmat(/1).gt.8) then
  534.              if (valmat(9).gt.0) then
  535.                typret='FLOTTANT'
  536.                 goto 1112
  537.              endif
  538.            endif
  539.  1112      continue
  540.            KPLBB = 1
  541.            KDIMB = 2 * IDIM
  542.            KIPALB = 3
  543.            IF (TYPRET.EQ.'FLOTTANT') THEN
  544.               KXPALB = 8 + 7 * IDIM
  545.            ELSE IF (TYPRET.EQ.' ') THEN
  546.               KXPALB = 7 + 7 * IDIM
  547.            ELSE
  548.               CALL ERREUR(522)
  549.               RETURN
  550.            ENDIF
  551.            NXPALB = MAX(NXPALB,KXPALB)
  552.            NIPALB = MAX(NIPALB,KIPALB)
  553.            NPLBB  = MAX(NPLBB,KPLBB)
  554.            IDIMB  = MAX(IDIMB,KDIMB)
  555. *
  556. * ----- choc elementaire CERCLE_CERCLE_FROTTEMENT
  557. *
  558.         ELSE IF (CMOT.EQ.'CE_CE_FR') THEN
  559.            INOE = num(1,1)
  560.            IF (NCPR(INOE).EQ.0) THEN
  561.               NPLB = NPLB + 1
  562.               NCPR(INOE) = NPLB
  563.            ENDIF
  564.            TYPRET = ' '
  565.            if (valmat(/1).gt.9) then
  566.              if (valmat(10).gt.0) then
  567.                typret='FLOTTANT'
  568.                 goto 1122
  569.              endif
  570.            endif
  571.  1122      continue
  572.            KPLBB = 1
  573.            KDIMB = 2 * IDIM
  574.            KIPALB = 4
  575.            IF (TYPRET.EQ.'FLOTTANT') THEN
  576.               KXPALB = 8 + 9*IDIM
  577.            ELSE IF (TYPRET.EQ.' ') THEN
  578.               KXPALB = 7 + 9*IDIM
  579.            ELSE
  580.               CALL ERREUR(522)
  581.               RETURN
  582.            ENDIF
  583.            NXPALB = MAX(NXPALB,KXPALB)
  584.            NIPALB = MAX(NIPALB,KIPALB)
  585.            NPLBB  = MAX(NPLBB,KPLBB)
  586.            IDIMB  = MAX(IDIMB,KDIMB)
  587. *
  588. * ----- choc elementaire PROFIL_PROFIL_INTERIEUR
  589. * ----- choc elementaire PROFIL_PROFIL_EXTERIEUR
  590. *
  591.          ELSE IF (CMOT.EQ.'PR_PR_IN'.OR.
  592.      &            CMOT.EQ.'PR_PR_EX') THEN
  593.                  ima1 = int(valmat(3))
  594.                  ima2 = int(valmat(4))
  595.             INOE = num(1,1)
  596.             IF (NCPR(INOE).EQ.0) THEN
  597.                NPLB = NPLB + 1
  598.                NCPR(INOE) = NPLB
  599.             ENDIF
  600.             KPLBB = 1
  601.             KDIMB = 3
  602.             CALL CHANGE(IMA1,1)
  603.             CALL CHANGE(IMA2,1)
  604.             MELEME = IMA1
  605.             SEGACT MELEME
  606.             NOMBN1 = NUM(/2)
  607.             MELEME = IMA2
  608.             SEGACT MELEME
  609.             NOMBN2 = NUM(/2)
  610.             KXPALB = 3 + 5*IDIM + 5*NOMBN1 + 3*NOMBN2
  611.             KIPALB = 5 + NOMBN1 + 2*NOMBN1*NOMBN2
  612.             NXPALB = MAX(NXPALB,KXPALB)
  613.             NIPALB = MAX(NIPALB,KIPALB)
  614.             NPLBB  = MAX(NPLBB,KPLBB)
  615.             IDIMB  = MAX(IDIMB,KDIMB)
  616. *
  617. * ----- choc elementaire LIGNE_LIGNE_FROTTEMENT
  618. *
  619.          ELSE IF   (CMOT.EQ.'LI_LI_FR') THEN
  620.             MONESC= ' '
  621.             TYPRET = ' '
  622.                 imai = int(valmat(2))
  623.  
  624.                  MONESC = tyval(3)(9:16)
  625.                  iesc = int(valmat(3))
  626.           MELEME = IESC
  627.           SEGACT MELEME
  628.           if (num(/2).eq.1) then
  629.            MONESC = 'POINT'
  630.            IESC = num(1,1)
  631.           endif
  632.  
  633.              if (valmat(/1).ge.10) then
  634.                typret=tyval(10)(1:8)
  635.                if (typret.eq.'POINTEUR') typret=tyval(10)(9:16)
  636.              endif
  637. *
  638.             MELEME = IMAI
  639.             SEGACT MELEME
  640.             NELEMA = NUM(/2)
  641.             IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  642.                 NNOEMA = NELEMA
  643.             ELSE
  644.                 NNOEMA = NELEMA+1
  645.             ENDIF
  646.             INOE = NUM(1,1)
  647.             IF (NCPR(INOE).EQ.0) THEN
  648.                NPLB = NPLB + 1
  649.                NCPR(INOE) = NPLB
  650.             ENDIF
  651.             DO 20 IE = 1,(NNOEMA-1)
  652.                 INOE = NUM(2,IE)
  653.                 IF (NCPR(INOE).EQ.0) THEN
  654.                     NPLB = NPLB + 1
  655.                     NCPR(INOE) = NPLB
  656.                 ENDIF
  657.  20             CONTINUE
  658. *  Maillage_esclave
  659.             IF (MONESC.EQ.'POINT') THEN
  660. *  La ligne-esclave est un point
  661.                IF (NCPR(IESC).EQ.0) THEN
  662.                   NPLB = NPLB + 1
  663.                   NCPR(IESC) = NPLB
  664.                ENDIF
  665.                NNOEES=1
  666.             ELSE
  667.                IF (MONESC.EQ.'MAILLAGE') THEN
  668. *  La ligne-esclave est un MAILLAGE
  669.                   MELEME = IESC
  670.                   SEGACT MELEME
  671.                   NELEES = NUM(/2)
  672.                   IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  673.                      NNOEES = NELEES
  674.                   ELSE
  675.                      NNOEES = NELEES+1
  676.                   ENDIF
  677.                   INOE = NUM(1,1)
  678.                   IF (NCPR(INOE).EQ.0) THEN
  679.                      NPLB = NPLB + 1
  680.                      NCPR(INOE) = NPLB
  681.                   ENDIF
  682.                   DO 30 IE = 1,(NNOEES-1)
  683.                      INOE = NUM(2,IE)
  684.                      IF (NCPR(INOE).EQ.0) THEN
  685.                         NPLB = NPLB + 1
  686.                         NCPR(INOE) = NPLB
  687.                      ENDIF
  688.  30               CONTINUE
  689.                 ENDIF
  690.             ENDIF
  691.             KPLBB  = NNOEMA + NNOEES
  692.             IF (IDIM.EQ.3) THEN
  693.                KDIMB  = 6
  694.             ELSE
  695.                KDIMB = 3
  696.             ENDIF
  697. *   Pour le nombre maxi de parametres entiers on prend
  698. *   en compte les 16 espaces dus aux liaisons conditionnelles
  699. *   + nos 10 autres propres parametres
  700. *   + la place pour les noeuds voisins
  701. *   + la place pour les indicateurs de choc
  702.             KIPALB = 16 + 10 +3*(NNOEMA+NNOEES)
  703. *
  704.             IF (TYPRET.EQ.'CHPOINT') THEN
  705.                KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+
  706.      &NNOEES)
  707.             ELSE IF (TYPRET.EQ.'REAL*8') THEN
  708.                KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  709.      &NNOEES)
  710.             ELSE IF (TYPRET.EQ.' ') THEN
  711.                KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  712.      &NNOEES)
  713.             ELSE
  714.                CALL ERREUR(522)
  715.                RETURN
  716.             ENDIF
  717. *
  718.             NXPALB = MAX(NXPALB,KXPALB)
  719.             NIPALB = MAX(NIPALB,KIPALB)
  720.             NPLBB  = MAX(NPLBB,KPLBB)
  721.             IDIMB  = MAX(IDIMB,KDIMB)
  722. *
  723. * ----- choc elementaire LIGNE_CERCLE_FROTTEMENT
  724.  
  725.          ELSE IF  (CMOT.EQ.'LI_CE_FR') THEN
  726.             MONESC= ' '
  727.             TYPRET = ' '
  728.                imai = int(valmat(2))
  729.                MONESC = tyval(3)(9:16)
  730.                iesc = int(valmat(3))
  731.           MELEME = IESC
  732.           SEGACT MELEME
  733.           if (num(/2).eq.1) then
  734.            MONESC = 'POINT'
  735.            IESC = num(1,1)
  736.           endif
  737.  
  738.              if (valmat(/1).gt.8) then
  739.               if (valmat(9).gt.0) then
  740.                typret=tyval(9)(1:8)
  741.                if (typret.eq.'POINTEUR') typret=tyval(9)(9:16)
  742.                endif
  743.              endif
  744. *
  745.             MELEME = IMAI
  746.             SEGACT MELEME
  747.             NELEMA = NUM(/2)
  748.             IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  749.                 NNOEMA = NELEMA
  750.             ELSE
  751.                 NNOEMA = NELEMA+1
  752.             ENDIF
  753.             INOE = NUM(1,1)
  754.             IF (NCPR(INOE).EQ.0) THEN
  755.                NPLB = NPLB + 1
  756.                NCPR(INOE) = NPLB
  757.             ENDIF
  758.             DO 40 IE = 1,(NNOEMA-1)
  759.                 INOE = NUM(2,IE)
  760.                 IF (NCPR(INOE).EQ.0) THEN
  761.                     NPLB = NPLB + 1
  762.                     NCPR(INOE) = NPLB
  763.                 ENDIF
  764.  40             CONTINUE
  765. *  Maillage_esclave
  766.             IF (MONESC.EQ.'POINT') THEN
  767. *  La ligne-esclave est un point
  768.                IF (NCPR(IESC).EQ.0) THEN
  769.                   NPLB = NPLB + 1
  770.                   NCPR(IESC) = NPLB
  771.                ENDIF
  772.                NNOEES=1
  773.             ELSE
  774.                IF (MONESC.EQ.'MAILLAGE') THEN
  775. *  La ligne-esclave est un MAILLAGE
  776.                   MELEME = IESC
  777.                   SEGACT MELEME
  778.                   NELEES = NUM(/2)
  779.                   IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  780.                      NNOEES = NELEES
  781.                   ELSE
  782.                      NNOEES = NELEES+1
  783.                   ENDIF
  784.                   INOE = NUM(1,1)
  785.                   IF (NCPR(INOE).EQ.0) THEN
  786.                      NPLB = NPLB + 1
  787.                      NCPR(INOE) = NPLB
  788.                   ENDIF
  789.                   DO 50 IE = 1,(NNOEES-1)
  790.                      INOE = NUM(2,IE)
  791.                      IF (NCPR(INOE).EQ.0) THEN
  792.                         NPLB = NPLB + 1
  793.                         NCPR(INOE) = NPLB
  794.                      ENDIF
  795.  50               CONTINUE
  796.                 ENDIF
  797.             ENDIF
  798.             KPLBB  = NNOEMA + NNOEES
  799.             IF (IDIM.EQ.3) THEN
  800.                KDIMB  = 6
  801.             ELSE
  802.                KDIMB = 3
  803.             ENDIF
  804. *   Pour le nombre maxi de parametres entiers on prend
  805. *   en compte les 16 espaces dus aux liaisons conditionnelles
  806. *   + nos 10 autres propres parametres
  807. *   + la place pour les noeuds voisins
  808. *   + la place pour les indicateurs de choc
  809.             KIPALB = 16 + 10 +3*(NNOEMA+NNOEES)
  810. *
  811.             IF (TYPRET.EQ.'CHPOINT') THEN
  812.                KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+
  813.      &NNOEES)
  814.             ELSE IF (TYPRET.EQ.'REAL*8') THEN
  815.                KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  816.      &NNOEES)
  817.             ELSE
  818.                CALL ERREUR(522)
  819.                RETURN
  820.             ENDIF
  821. *
  822.             NXPALB = MAX(NXPALB,KXPALB)
  823.             NIPALB = MAX(NIPALB,KIPALB)
  824.             NPLBB  = MAX(NPLBB,KPLBB)
  825.             IDIMB  = MAX(IDIMB,KDIMB)
  826.  
  827. *
  828. * ------ liaison PALIER_FLUIDE
  829. *
  830.         ELSE IF (CMOT.EQ.'PA_FL_RO') THEN
  831. *
  832. cbp           KPLBB = 1
  833.            KPLBB = 2
  834.            KDIMB = IDIM
  835. *
  836. C I) Gestion du point support
  837. *
  838.            INOE = num(1,1)
  839.            IF (NCPR(INOE).EQ.0) THEN
  840.               NPLB = NPLB + 1
  841.               NCPR(INOE) = NPLB
  842.            ENDIF
  843. cbp : si + tard on souhaite avoir une compatibilite entre la table DYNE
  844. c     et la table PASAPAS, il faudra ecrire des choses ici... cf DYNE22
  845. *
  846. C II) Decompte du nombre de parametres entiers et reels
  847. *
  848. c           CALL ACCTAB(ITLIAI,'MOT',I0,X0,'MODELE_PALIER',L0,IP0,
  849. c     &                        'MOT',I1,X0,CMOT,L1,IP1)
  850.            IF (IERR.NE.0) RETURN
  851. *
  852. C II.1) Decompte du nombre de parametres propres aux differents types
  853. C       de paliers (KIPLB2 pour les entiers, LXPLB2 pour les reels) :
  854. *
  855. *
  856. C -- Cas du palier cylindrique ou e lobes, avec modele de Rhode et Li :
  857. *
  858.            NLOB = 0
  859.            itgeom = int(valmat(10))
  860.            if (itgeom.gt.0) then
  861.                 CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  862.      &                        'ENTIER',NLOB,X0,'  ',L1,IP1)
  863.                 IF (IERR.NE.0) RETURN
  864.                 KIPLB2 = 2 + NLOB
  865.                 KXPLB2 = 1 + (6*NLOB)
  866.            endif
  867. *
  868. C II.2) Nombres totaux de parametres entiers et reels :
  869. *
  870.            KIPALB = 5 + KIPLB2
  871. cbp           KXPALB = 7 + KXPLB2 + 4
  872.            KXPALB = 9 + KXPLB2
  873. *
  874. C Dimensionnement des variables de sortie :
  875. *
  876.            NXPALB = MAX(NXPALB,KXPALB)
  877.            NIPALB = MAX(NIPALB,KIPALB)
  878.            NPLBB  = MAX(NPLBB,KPLBB)
  879.            IDIMB  = MAX(IDIMB,KDIMB)
  880. *
  881. * --> fin liaison PALIER
  882. *
  883.         ELSE
  884.             CALL ERREUR(490)
  885.             RETURN
  886.         ENDIF
  887.  
  888.       END
  889.  
  890.  
  891.  
  892.  
  893.  
  894.  

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