Télécharger la plaquette Cast3M


fr en

Télécharger dyne22.eso

Retour à la liste

Numérotation des lignes : 

dyne22

  1. C DYNE22    SOURCE    PV        20/03/30    21:18:13     10567          
  2.       SUBROUTINE DYNE22(ITLB, NLIAB,NXPALB,NPLBB,NPLB,IDIMB,KCPR,
  3.      &                  NIPALB,NIP)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Operateur DYNE :                                               *
  9. *     Determination des parametres de liaison pour la base B.        *
  10. *                                                                    *
  11. *--------------------------------------------------------------------*
  12. *                                                                    *
  13. *     Parametres:                                                    *
  14. *                                                                    *
  15. * e   ITLB    Table rassemblant la description des liaisons          *
  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. *--------------------------------------------------------------------*
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC SMCOORD
  30. -INC SMELEME
  31. -INC SMEVOLL
  32. -INC SMLREEL
  33. *
  34.       SEGMENT,NCPR(nbpts)
  35. *
  36.       LOGICAL L0,L1
  37.       CHARACTER*8  TYPRET,MONSYM,MONESC,CMOT1,CHARRE
  38.       CHARACTER*40 CMOT
  39. *
  40.       SEGINI,NCPR
  41.       KCPR = NCPR
  42. *
  43.       NXPALB = 0
  44.       NIPALB = 20
  45. cbp, indices NIPALB=4,20 reserves pour liaisons conditionelles
  46. c     c.a.d. 15 liaisons conditionelles (ca marche pas pour 'PROFIL..;')
  47.       NPLBB  = 0
  48.       NPLB   = 0
  49.       IDIMB  = 0
  50.       NLIAB  = 0
  51. C NIP = 1 dans le cas ou la liaison n'est pas ITYP = 16/17 ou ITYP = 50/51
  52.       NIP = 1
  53. *
  54. *--------------------------------------------------------------------*
  55. *     Boucle sur le nombre de liaisons
  56. *--------------------------------------------------------------------*
  57.       IL = 0
  58.  10   CONTINUE
  59.       IL = IL+ 1
  60.       TYPRET = ' '
  61.       CALL ACCTAB(ITLB,'ENTIER',IL,X0,'  ',L0,IP0,
  62.      &                   TYPRET,I0,X0,CHARRE,L1,ITLIAI)
  63.       IF (IERR.NE.0) RETURN
  64.  
  65. *-----Cas ou la  IL ieme liaison existe ------------------------------
  66.       IF (ITLIAI.NE.0) THEN
  67.          NLIAB = NLIAB + 1
  68.          CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0,
  69.      &                      'MOT',I1,X0,CMOT,L1,IP1)
  70.          IF (IERR.NE.0) RETURN
  71. *
  72. * ------ choc elementaire POINT_PLAN_FLUIDE
  73. *
  74.         IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN
  75.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  76.      &                        'POINT',I1,X0,'  ',L1,INOE)
  77.            IF (IERR.NE.0) RETURN
  78.            IF (NCPR(INOE).EQ.0) THEN
  79.               NPLB = NPLB + 1
  80.               NCPR(INOE) = NPLB
  81.            ENDIF
  82.            KPLBB  = 1
  83.            KDIMB = IDIM
  84.            KIPALB = 3
  85.            KXPALB = 9 + IDIM
  86.            NXPALB = MAX(NXPALB,KXPALB)
  87.            NIPALB = MAX(NIPALB,KIPALB)
  88.            NPLBB  = MAX(NPLBB,KPLBB)
  89.            IDIMB  = MAX(IDIMB,KDIMB)
  90. *
  91. * ------ choc elementaire POINT_PLAN_FROTTEMENT
  92. *
  93.         ELSE IF (CMOT(1:21).EQ.'POINT_PLAN_FROTTEMENT') THEN
  94.            TYPRET = ' '
  95.            CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  96.      &                 IP0,TYPRET,I1,X1,'  ',L1,IPEVO)
  97.            IF (IERR.NE.0) RETURN
  98. *
  99.            IF (TYPRET.EQ.'EVOLUTIO')THEN
  100.            MEVOLL = IPEVO
  101.            SEGACT MEVOLL
  102.            KEVOLL = IEVOLL(1)
  103.            SEGACT KEVOLL
  104.            MLREE1 = IPROGX
  105.            MLREE2 = IPROGY
  106.            SEGACT MLREE1
  107.            SEGACT MLREE2
  108.            KNIP = MLREE1.PROG(/1)
  109.            SEGDES MLREE1
  110.            SEGDES MLREE2
  111.            SEGDES KEVOLL
  112.            SEGDES MEVOLL
  113.            ELSE
  114.            KNIP = 0
  115.            ENDIF
  116. *
  117.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  118.      &                        'POINT',I1,X0,'  ',L1,INOE)
  119.            IF (IERR.NE.0) RETURN
  120.            IF (NCPR(INOE).EQ.0) THEN
  121.               NPLB = NPLB + 1
  122.               NCPR(INOE) = NPLB
  123.            ENDIF
  124.            TYPRET = ' '
  125.            KPLBB  = 1
  126.            KDIMB = IDIM
  127.            KIPALB = 3
  128. cbp,2020 : ajout Ve(idim) et regul(n et t)    KXPALB = 7 + 7 * IDIM
  129.            KXPALB = 9 + 8 * IDIM
  130.            NXPALB = MAX(NXPALB,KXPALB)
  131.            NIPALB = MAX(NIPALB,KIPALB)
  132.            NPLBB  = MAX(NPLBB,KPLBB)
  133.            IDIMB  = MAX(IDIMB,KDIMB)
  134.            NIP    = MAX(NIP,KNIP)
  135. *
  136. * ------ choc elementaire POINT_PLAN
  137. *
  138.         ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN
  139.            TYPRET = ' '
  140.            CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  141.      &                 IP0,TYPRET,I1,X1,'  ',L1,IPEVO)
  142.            IF (IERR.NE.0) RETURN
  143. *
  144.            IF (TYPRET.EQ.'EVOLUTIO')THEN
  145.            MEVOLL = IPEVO
  146.            SEGACT MEVOLL
  147.            KEVOLL = IEVOLL(1)
  148.            SEGACT KEVOLL
  149.            MLREE1 = IPROGX
  150.            MLREE2 = IPROGY
  151.            SEGACT MLREE1
  152.            SEGACT MLREE2
  153.            KNIP = MLREE1.PROG(/1)
  154.            SEGDES MLREE1
  155.            SEGDES MLREE2
  156.            SEGDES KEVOLL
  157.            SEGDES MEVOLL
  158.            ELSE
  159.            KNIP = 0
  160.            ENDIF
  161. *
  162.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  163.      &                        'POINT',I1,X0,'  ',L1,INOE)
  164.            IF (IERR.NE.0) RETURN
  165.            IF (NCPR(INOE).EQ.0) THEN
  166.               NPLB = NPLB + 1
  167.               NCPR(INOE) = NPLB
  168.            ENDIF
  169.            TYPRET = ' '
  170.            KPLBB = 1
  171.            KDIMB = IDIM
  172.            KIPALB = 4
  173.            KXPALB = 3 + IDIM
  174. **  ianis
  175.            TYPRET = ' '
  176.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SEUIL_PLASTIQUE',
  177.      &                 L0,IP0,TYPRET,I1,XSEUIL,CHARRE,L1,IP1)
  178.            IF (IERR.NE.0) RETURN
  179.            IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER  ')THEN
  180.                    KXPALB = 3 + IDIM + 2
  181.            ENDIF
  182. *
  183.  
  184.            NXPALB = MAX(NXPALB,KXPALB)
  185.            NIPALB = MAX(NIPALB,KIPALB)
  186.            NPLBB  = MAX(NPLBB,KPLBB)
  187.            IDIMB  = MAX(IDIMB,KDIMB)
  188.            NIP    = MAX(NIP,KNIP)
  189. *
  190. * ----- choc elementaire POINT_POINT_FROTTEMENT
  191. *
  192.         ELSE IF (CMOT(1:22).EQ.'POINT_POINT_FROTTEMENT') THEN
  193.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0,
  194.      &                        'POINT',I1,X0,'  ',L1,INOA)
  195.            IF (IERR.NE.0) RETURN
  196.            IF (NCPR(INOA).EQ.0) THEN
  197.               NPLB = NPLB + 1
  198.               NCPR(INOA) = NPLB
  199.            ENDIF
  200.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0,
  201.      &                        'POINT',I1,X0,'  ',L1,INOB)
  202.            IF (IERR.NE.0) RETURN
  203.            IF (NCPR(INOB).EQ.0) THEN
  204.               NPLB = NPLB + 1
  205.               NCPR(INOB) = NPLB
  206.            ENDIF
  207.            TYPRET = ' '
  208.            CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  209.      &                 IP0,TYPRET,I1,X1,'  ',L1,IPEVO)
  210.            IF (IERR.NE.0) RETURN
  211. *
  212.            IF (TYPRET.EQ.'EVOLUTIO')THEN
  213.            MEVOLL = IPEVO
  214.            SEGACT MEVOLL
  215.            KEVOLL = IEVOLL(1)
  216.            SEGACT KEVOLL
  217.            MLREE1 = IPROGX
  218.            MLREE2 = IPROGY
  219.            SEGACT MLREE1
  220.            SEGACT MLREE2
  221.            KNIP = MLREE1.PROG(/1)
  222.            SEGDES MLREE1
  223.            SEGDES MLREE2
  224.            SEGDES KEVOLL
  225.            SEGDES MEVOLL
  226.            ELSE
  227.            KNIP = 0
  228.            ENDIF
  229.  
  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
  243.      &    (CMOT(1:33).EQ.'POINT_POINT_DEPLACEMENT_PLASTIQUE') THEN
  244.            CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  245.      &                 IP0,'EVOLUTIO',I1,X1,'  ',L1,IPEVO)
  246.            IF (IERR.NE.0) RETURN
  247. *
  248.            MEVOLL = IPEVO
  249.            SEGACT MEVOLL
  250.            KEVOLL = IEVOLL(1)
  251.            SEGACT KEVOLL
  252.            MLREE1 = IPROGX
  253.            MLREE2 = IPROGY
  254.            SEGACT MLREE1
  255.            SEGACT MLREE2
  256.            KNIP = MLREE1.PROG(/1)
  257.            SEGDES MLREE1
  258.            SEGDES MLREE2
  259.            SEGDES KEVOLL
  260.            SEGDES MEVOLL
  261. *
  262.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0,
  263.      &                        'POINT',I1,X0,'  ',L1,INOA)
  264.            IF (IERR.NE.0) RETURN
  265.            IF (NCPR(INOA).EQ.0) THEN
  266.               NPLB = NPLB + 1
  267.               NCPR(INOA) = NPLB
  268.            ENDIF
  269.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0,
  270.      &                        'POINT',I1,X0,'  ',L1,INOB)
  271.            IF (IERR.NE.0) RETURN
  272.            IF (NCPR(INOB).EQ.0) THEN
  273.               NPLB = NPLB + 1
  274.               NCPR(INOB) = NPLB
  275.            ENDIF
  276.            TYPRET = ' '
  277.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',
  278.      &                 L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  279.            IF (IERR.NE.0) RETURN
  280.            KPLBB = 2
  281.            KDIMB = IDIM
  282. C
  283.            KIPALB = 5
  284.            IF (TYPRET.EQ.'FLOTTANT') THEN
  285.               KXPALB = 5 + IDIM
  286.            ELSE IF (TYPRET.EQ.'        ') THEN
  287.               KXPALB = 4 + IDIM
  288.            ELSE
  289.               CALL ERREUR(522)
  290.               RETURN
  291.            ENDIF
  292.            NXPALB = MAX(NXPALB,KXPALB)
  293.            NIPALB = MAX(NIPALB,KIPALB)
  294.            NPLBB  = MAX(NPLBB,KPLBB)
  295.            IDIMB  = MAX(IDIMB,KDIMB)
  296.            NIP    = MAX(NIP,KNIP)
  297. *
  298. * ----- choc elementaire POINT_POINT_ROTATION_PLASTIQUE
  299. *
  300.         ELSE IF
  301.      &  (CMOT(1:30).EQ.'POINT_POINT_ROTATION_PLASTIQUE') THEN
  302.            CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  303.      &                 IP0,'EVOLUTIO',I1,X1,'  ',L1,IPEVO)
  304.            IF (IERR.NE.0) RETURN
  305. *
  306.            MEVOLL = IPEVO
  307.            SEGACT MEVOLL
  308.            KEVOLL = IEVOLL(1)
  309.            SEGACT KEVOLL
  310.            MLREE1 = IPROGX
  311.            MLREE2 = IPROGY
  312.            SEGACT MLREE1
  313.            SEGACT MLREE2
  314.            KNIP = MLREE1.PROG(/1)
  315.            SEGDES MLREE1
  316.            SEGDES MLREE2
  317.            SEGDES KEVOLL
  318.            SEGDES MEVOLL
  319. *
  320.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0,
  321.      &                        'POINT',I1,X0,'  ',L1,INOA)
  322.            IF (IERR.NE.0) RETURN
  323.            IF (NCPR(INOA).EQ.0) THEN
  324.               NPLB = NPLB + 1
  325.               NCPR(INOA) = NPLB
  326.            ENDIF
  327.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0,
  328.      &                        'POINT',I1,X0,'  ',L1,INOB)
  329.            IF (IERR.NE.0) RETURN
  330.            IF (NCPR(INOB).EQ.0) THEN
  331.               NPLB = NPLB + 1
  332.               NCPR(INOB) = NPLB
  333.            ENDIF
  334.            TYPRET = ' '
  335.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',
  336.      &                 L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  337.            IF (IERR.NE.0) RETURN
  338.            KPLBB = 2
  339. *
  340. * NW   Dans le cas de la rotule, on passe en dimension 6
  341. *      car on aura Ux,Uy,Uz,Rx,Ry,Rz
  342. *
  343.            KDIMB = 3+IDIM
  344. *
  345. *   KIPALB = 5 : nombre maxi de parametres pour la liaison
  346. *
  347.            KIPALB = 5
  348.            IF (TYPRET.EQ.'FLOTTANT') THEN
  349.               KXPALB = 5 + IDIM
  350.            ELSE IF (TYPRET.EQ.'        ') THEN
  351.               KXPALB = 4 + IDIM
  352.            ELSE
  353.               CALL ERREUR(522)
  354.               RETURN
  355.            ENDIF
  356.            NXPALB = MAX(NXPALB,KXPALB)
  357.            NIPALB = MAX(NIPALB,KIPALB)
  358.            NPLBB  = MAX(NPLBB,KPLBB)
  359.            IDIMB  = MAX(IDIMB,KDIMB)
  360.            NIP    = MAX(NIP,KNIP)
  361. *
  362. * ----- choc elementaire POINT_POINT
  363. *
  364.         ELSE IF (CMOT(1:11).EQ.'POINT_POINT') THEN
  365.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0,
  366.      &                        'POINT',I1,X0,'  ',L1,INOA)
  367.            IF (IERR.NE.0) RETURN
  368.            IF (NCPR(INOA).EQ.0) THEN
  369.               NPLB = NPLB + 1
  370.               NCPR(INOA) = NPLB
  371.            ENDIF
  372.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0,
  373.      &                        'POINT',I1,X0,'  ',L1,INOB)
  374.            IF (IERR.NE.0) RETURN
  375.            IF (NCPR(INOB).EQ.0) THEN
  376.               NPLB = NPLB + 1
  377.               NCPR(INOB) = NPLB
  378.            ENDIF
  379.  
  380.            TYPRET = ' '
  381.            CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  382.      &                 IP0,TYPRET,I1,X1,'  ',L1,IPEVO)
  383.            IF (IERR.NE.0) RETURN
  384. *
  385.            IF (TYPRET.EQ.'EVOLUTIO')THEN
  386.            MEVOLL = IPEVO
  387.            SEGACT MEVOLL
  388.            KEVOLL = IEVOLL(1)
  389.            SEGACT KEVOLL
  390.            MLREE1 = IPROGX
  391.            MLREE2 = IPROGY
  392.            SEGACT MLREE1
  393.            SEGACT MLREE2
  394.            KNIP = MLREE1.PROG(/1)
  395.            SEGDES MLREE1
  396.            SEGDES MLREE2
  397.            SEGDES KEVOLL
  398.            SEGDES MEVOLL
  399.            ELSE
  400.            KNIP = 0
  401.            ENDIF
  402.  
  403.            KPLBB = 2
  404.            KDIMB = IDIM
  405.            KIPALB = 4
  406.            KXPALB = 3 + IDIM
  407.            NXPALB = MAX(NXPALB,KXPALB)
  408.            NIPALB = MAX(NIPALB,KIPALB)
  409.            NPLBB  = MAX(NPLBB,KPLBB)
  410.            IDIMB  = MAX(IDIMB,KDIMB)
  411.            NIP    = MAX(NIP,KNIP)
  412. *
  413. * ianis
  414. *
  415. * ----- choc elementaire POINT_CERCLE_MOBILE
  416. *
  417.         ELSE IF (CMOT(1:19).EQ.'POINT_CERCLE_MOBILE') THEN
  418.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT',L0,IP0,
  419.      &                        'POINT',I1,X0,'  ',L1,INOA)
  420.            IF (IERR.NE.0) RETURN
  421.            IF (NCPR(INOA).EQ.0) THEN
  422.               NPLB = NPLB + 1
  423.               NCPR(INOA) = NPLB
  424.            ENDIF
  425.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'CERCLE',L0,IP0,
  426.      &                        'POINT',I1,X0,'  ',L1,INOB)
  427.            IF (IERR.NE.0) RETURN
  428.            IF (NCPR(INOB).EQ.0) THEN
  429.               NPLB = NPLB + 1
  430.               NCPR(INOB) = NPLB
  431.            ENDIF
  432.            TYPRET = ' '
  433.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,
  434.      &                 IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  435.            IF (IERR.NE.0) RETURN
  436.            KPLBB = 2
  437. * on neglige les rotations
  438.            KDIMB = IDIM
  439.            KIPALB = 4
  440.            IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER  ') THEN
  441.               KXPALB = 7 + 9 * IDIM
  442.            ELSE IF (TYPRET.EQ.'        ') THEN
  443.               KXPALB = 6 + 9 * IDIM
  444.            ELSE
  445.               CALL ERREUR(522)
  446.               RETURN
  447.            ENDIF
  448.            NXPALB = MAX(NXPALB,KXPALB)
  449.            NIPALB = MAX(NIPALB,KIPALB)
  450.            NPLBB  = MAX(NPLBB,KPLBB)
  451.            IDIMB  = MAX(IDIMB,KDIMB)
  452. *
  453. *
  454. * ----- choc elementaire POINT_CERCLE_FROTTEMENT
  455. *
  456.         ELSE IF (CMOT(1:23).EQ.'POINT_CERCLE_FROTTEMENT') THEN
  457.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  458.      &                        'POINT',I1,X0,'  ',L1,INOE)
  459.            IF (IERR.NE.0) RETURN
  460.            IF (NCPR(INOE).EQ.0) THEN
  461.               NPLB = NPLB + 1
  462.               NCPR(INOE) = NPLB
  463.            ENDIF
  464.            KPLBB = 1
  465.            KDIMB = IDIM
  466.            KIPALB = 4
  467. c            TYPRET = ' '
  468. c            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,
  469. c      &                 IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  470. c            IF (IERR.NE.0) RETURN
  471. c            IF (TYPRET.EQ.'FLOTTANT') THEN
  472. c               KXPALB = 7 + 9 * IDIM
  473. c            ELSE IF (TYPRET.EQ.'        ') THEN
  474. c               KXPALB = 6 + 9 * IDIM
  475. c            ELSE
  476. c               CALL ERREUR(522)
  477. c               RETURN
  478. c            ENDIF
  479. cbp,2020 : tjrs amortissement + ajout Ve et regul(n et t)
  480.            KXPALB = 10 + 9 * IDIM
  481.            NXPALB = MAX(NXPALB,KXPALB)
  482.            NIPALB = MAX(NIPALB,KIPALB)
  483.            NPLBB  = MAX(NPLBB,KPLBB)
  484.            IDIMB  = MAX(IDIMB,KDIMB)
  485. *
  486. * ----- choc elementaire POINT_CERCLE
  487. *
  488.         ELSE IF (CMOT(1:12).EQ.'POINT_CERCLE') THEN
  489.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  490.      &                        'POINT',I1,X0,'  ',L1,INOE)
  491.            IF (IERR.NE.0) RETURN
  492.            IF (NCPR(INOE).EQ.0) THEN
  493.               NPLB = NPLB + 1
  494.               NCPR(INOE) = NPLB
  495.            ENDIF
  496.            TYPRET = ' '
  497.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',
  498.      &                 L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  499.            IF (IERR.NE.0) RETURN
  500.            KPLBB = 1
  501.            KDIMB = IDIM
  502.            KIPALB = 3
  503.            IF (TYPRET.EQ.'FLOTTANT') THEN
  504.               KXPALB = 3 + 2 * IDIM
  505.            ELSE IF (TYPRET.EQ.'        ') THEN
  506.               KXPALB = 2 + 2 * IDIM
  507.            ELSE
  508.               CALL ERREUR(522)
  509.               RETURN
  510.            ENDIF
  511.            NXPALB = MAX(NXPALB,KXPALB)
  512.            NIPALB = MAX(NIPALB,KIPALB)
  513.            NPLBB  = MAX(NPLBB,KPLBB)
  514.            IDIMB  = MAX(IDIMB,KDIMB)
  515. *
  516. * ----- choc elementaire CERCLE_PLAN_FROTTEMENT
  517. *
  518.         ELSE IF (CMOT(1:22).EQ.'CERCLE_PLAN_FROTTEMENT') THEN
  519.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  520.      &                        'POINT',I1,X0,'  ',L1,INOE)
  521.            IF (IERR.NE.0) RETURN
  522.            IF (NCPR(INOE).EQ.0) THEN
  523.               NPLB = NPLB + 1
  524.               NCPR(INOE) = NPLB
  525.            ENDIF
  526.            TYPRET = ' '
  527.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,
  528.      &                 IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  529.            IF (IERR.NE.0) RETURN
  530.            KPLBB = 1
  531.            KDIMB = 2 * IDIM
  532.            KIPALB = 3
  533.            IF (TYPRET.EQ.'FLOTTANT') THEN
  534.               KXPALB = 8 + 7 * IDIM
  535.            ELSE IF (TYPRET.EQ.'        ') THEN
  536.               KXPALB = 7 + 7 * IDIM
  537.            ELSE
  538.               CALL ERREUR(522)
  539.               RETURN
  540.            ENDIF
  541.            NXPALB = MAX(NXPALB,KXPALB)
  542.            NIPALB = MAX(NIPALB,KIPALB)
  543.            NPLBB  = MAX(NPLBB,KPLBB)
  544.            IDIMB  = MAX(IDIMB,KDIMB)
  545. *
  546. * ----- choc elementaire CERCLE_CERCLE_FROTTEMENT
  547. *
  548.         ELSE IF (CMOT(1:24).EQ.'CERCLE_CERCLE_FROTTEMENT') THEN
  549.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  550.      &                        'POINT',I1,X0,'  ',L1,INOE)
  551.            IF (IERR.NE.0) RETURN
  552.            IF (NCPR(INOE).EQ.0) THEN
  553.               NPLB = NPLB + 1
  554.               NCPR(INOE) = NPLB
  555.            ENDIF
  556.            TYPRET = ' '
  557.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,
  558.      &                 IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  559.            IF (IERR.NE.0) RETURN
  560.            KPLBB = 1
  561.            KDIMB = 2 * IDIM
  562.            KIPALB = 4
  563.            IF (TYPRET.EQ.'FLOTTANT') THEN
  564.               KXPALB = 8 + 9*IDIM
  565.            ELSE IF (TYPRET.EQ.'        ') THEN
  566.               KXPALB = 7 + 9*IDIM
  567.            ELSE
  568.               CALL ERREUR(522)
  569.               RETURN
  570.            ENDIF
  571.            NXPALB = MAX(NXPALB,KXPALB)
  572.            NIPALB = MAX(NIPALB,KIPALB)
  573.            NPLBB  = MAX(NPLBB,KPLBB)
  574.            IDIMB  = MAX(IDIMB,KDIMB)
  575. *
  576. * ----- choc elementaire PROFIL_PROFIL_INTERIEUR
  577. * ----- choc elementaire PROFIL_PROFIL_EXTERIEUR
  578. *
  579.          ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_INTERIEUR' .OR.
  580.      &            CMOT(1:23).EQ.'PROFIL_PROFIL_EXTERIEUR') THEN
  581.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'PROFIL_FIXE',L0,IP0,
  582.      &                         'MAILLAGE',I1,X0,'  ',L1,IMA1)
  583.             IF (IERR.NE.0) RETURN
  584.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'PROFIL_MOBILE',L0,IP0,
  585.      &                         'MAILLAGE',I1,X0,'  ',L1,IMA2)
  586.             IF (IERR.NE.0) RETURN
  587.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  588.      &                         'POINT',I1,X0,'  ',L1,INOE)
  589.             IF (IERR.NE.0) RETURN
  590.             IF (NCPR(INOE).EQ.0) THEN
  591.                NPLB = NPLB + 1
  592.                NCPR(INOE) = NPLB
  593.             ENDIF
  594.             KPLBB = 1
  595.             KDIMB = 3
  596.             CALL CHANGE(IMA1,1)
  597.             CALL CHANGE(IMA2,1)
  598.             MELEME = IMA1
  599.             SEGACT MELEME
  600.             NOMBN1 = NUM(/2)
  601.             SEGDES MELEME
  602.             MELEME = IMA2
  603.             SEGACT MELEME
  604.             NOMBN2 = NUM(/2)
  605.             SEGDES MELEME
  606.             KXPALB = 3 + 5*IDIM + 5*NOMBN1 + 3*NOMBN2
  607.             KIPALB = 5 + NOMBN1 + 2*NOMBN1*NOMBN2
  608.             NXPALB = MAX(NXPALB,KXPALB)
  609.             NIPALB = MAX(NIPALB,KIPALB)
  610.             NPLBB  = MAX(NPLBB,KPLBB)
  611.             IDIMB  = MAX(IDIMB,KDIMB)
  612. *
  613. * ----- choc elementaire LIGNE_LIGNE_FROTTEMENT
  614. *
  615.          ELSE IF
  616.      &   (CMOT(1:22).EQ.'LIGNE_LIGNE_FROTTEMENT') THEN
  617.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0,
  618.      &                    'MAILLAGE',I1,X1,'  ',L1,IMAI)
  619.             IF (IERR.NE.0) RETURN
  620.             MONESC= ' '
  621.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0,
  622.      &                    MONESC,I1,X1,CHARRE,L1,IESC)
  623.             TYPRET = ' '
  624.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENTS',
  625.      &                 L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  626.             IF (IERR.NE.0) RETURN
  627. *
  628.             MELEME = IMAI
  629.             SEGACT MELEME
  630.             NELEMA = NUM(/2)
  631.             IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  632.                 NNOEMA = NELEMA
  633.             ELSE
  634.                 NNOEMA = NELEMA+1
  635.             ENDIF
  636.             INOE = NUM(1,1)
  637.             IF (NCPR(INOE).EQ.0) THEN
  638.                NPLB = NPLB + 1
  639.                NCPR(INOE) = NPLB
  640.             ENDIF
  641.             DO 20 IE = 1,(NNOEMA-1)
  642.                 INOE = NUM(2,IE)
  643.                 IF (NCPR(INOE).EQ.0) THEN
  644.                     NPLB = NPLB + 1
  645.                     NCPR(INOE) = NPLB
  646.                 ENDIF
  647.  20             CONTINUE
  648.             SEGDES MELEME
  649. *  Maillage_esclave
  650.             IF (MONESC.EQ.'POINT') THEN
  651. *  La ligne-esclave est un point
  652.                IF (NCPR(IESC).EQ.0) THEN
  653.                   NPLB = NPLB + 1
  654.                   NCPR(IESC) = NPLB
  655.                ENDIF
  656.                NNOEES=1
  657.             ELSE
  658.                IF (MONESC.EQ.'MAILLAGE') THEN
  659. *  La ligne-esclave est un MAILLAGE
  660.                   MELEME = IESC
  661.                   SEGACT MELEME
  662.                   NELEES = NUM(/2)
  663.                   IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  664.                      NNOEES = NELEES
  665.                   ELSE
  666.                      NNOEES = NELEES+1
  667.                   ENDIF
  668.                   INOE = NUM(1,1)
  669.                   IF (NCPR(INOE).EQ.0) THEN
  670.                      NPLB = NPLB + 1
  671.                      NCPR(INOE) = NPLB
  672.                   ENDIF
  673.                   DO 30 IE = 1,(NNOEES-1)
  674.                      INOE = NUM(2,IE)
  675.                      IF (NCPR(INOE).EQ.0) THEN
  676.                         NPLB = NPLB + 1
  677.                         NCPR(INOE) = NPLB
  678.                      ENDIF
  679.  30               CONTINUE
  680.                   SEGDES MELEME
  681.                 ENDIF
  682.             ENDIF
  683.             KPLBB  = NNOEMA + NNOEES
  684.             IF (IDIM.EQ.3) THEN
  685.                KDIMB  = 6
  686.             ELSE
  687.                KDIMB = 3
  688.             ENDIF
  689. *   Pour le nombre maxi de parametres entiers on prend
  690. *   en compte les 16 espaces dus aux liaisons conditionnelles
  691. *   + nos 10 autres propres parametres
  692. *   + la place pour les noeuds voisins
  693. *   + la place pour les indicateurs de choc
  694.             KIPALB = 16 + 10 +3*(NNOEMA+NNOEES)
  695. *
  696.             IF (TYPRET.EQ.'CHPOINT') THEN
  697.                KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+
  698.      &NNOEES)
  699.             ELSE IF (TYPRET.EQ.'        ') THEN
  700.                KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  701.      &NNOEES)
  702.             ELSE
  703.                CALL ERREUR(522)
  704.                RETURN
  705.             ENDIF
  706. *
  707.             NXPALB = MAX(NXPALB,KXPALB)
  708.             NIPALB = MAX(NIPALB,KIPALB)
  709.             NPLBB  = MAX(NPLBB,KPLBB)
  710.             IDIMB  = MAX(IDIMB,KDIMB)
  711.  
  712.  
  713.  
  714. *
  715. * ----- choc elementaire LIGNE_CERCLE_FROTTEMENT
  716.  
  717.  
  718.          ELSE IF
  719.      &   (CMOT(1:23).EQ.'LIGNE_CERCLE_FROTTEMENT') THEN
  720.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0,
  721.      &                    'MAILLAGE',I1,X1,'  ',L1,IMAI)
  722.             IF (IERR.NE.0) RETURN
  723.             MONESC= ' '
  724.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0,
  725.      &                    MONESC,I1,X1,CHARRE,L1,IESC)
  726.             TYPRET = ' '
  727.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENTS',
  728.      &                 L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  729.             IF (IERR.NE.0) RETURN
  730. *
  731.             MELEME = IMAI
  732.             SEGACT MELEME
  733.             NELEMA = NUM(/2)
  734.             IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  735.                 NNOEMA = NELEMA
  736.             ELSE
  737.                 NNOEMA = NELEMA+1
  738.             ENDIF
  739.             INOE = NUM(1,1)
  740.             IF (NCPR(INOE).EQ.0) THEN
  741.                NPLB = NPLB + 1
  742.                NCPR(INOE) = NPLB
  743.             ENDIF
  744.             DO 40 IE = 1,(NNOEMA-1)
  745.                 INOE = NUM(2,IE)
  746.                 IF (NCPR(INOE).EQ.0) THEN
  747.                     NPLB = NPLB + 1
  748.                     NCPR(INOE) = NPLB
  749.                 ENDIF
  750.  40             CONTINUE
  751.             SEGDES MELEME
  752. *  Maillage_esclave
  753.             IF (MONESC.EQ.'POINT') THEN
  754. *  La ligne-esclave est un point
  755.                IF (NCPR(IESC).EQ.0) THEN
  756.                   NPLB = NPLB + 1
  757.                   NCPR(IESC) = NPLB
  758.                ENDIF
  759.                NNOEES=1
  760.             ELSE
  761.                IF (MONESC.EQ.'MAILLAGE') THEN
  762. *  La ligne-esclave est un MAILLAGE
  763.                   MELEME = IESC
  764.                   SEGACT MELEME
  765.                   NELEES = NUM(/2)
  766.                   IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  767.                      NNOEES = NELEES
  768.                   ELSE
  769.                      NNOEES = NELEES+1
  770.                   ENDIF
  771.                   INOE = NUM(1,1)
  772.                   IF (NCPR(INOE).EQ.0) THEN
  773.                      NPLB = NPLB + 1
  774.                      NCPR(INOE) = NPLB
  775.                   ENDIF
  776.                   DO 50 IE = 1,(NNOEES-1)
  777.                      INOE = NUM(2,IE)
  778.                      IF (NCPR(INOE).EQ.0) THEN
  779.                         NPLB = NPLB + 1
  780.                         NCPR(INOE) = NPLB
  781.                      ENDIF
  782.  50               CONTINUE
  783.                   SEGDES MELEME
  784.                 ENDIF
  785.             ENDIF
  786.             KPLBB  = NNOEMA + NNOEES
  787.             IF (IDIM.EQ.3) THEN
  788.                KDIMB  = 6
  789.             ELSE
  790.                KDIMB = 3
  791.             ENDIF
  792. *   Pour le nombre maxi de parametres entiers on prend
  793. *   en compte les 16 espaces dus aux liaisons conditionnelles
  794. *   + nos 10 autres propres parametres
  795. *   + la place pour les noeuds voisins
  796. *   + la place pour les indicateurs de choc
  797.             KIPALB = 16 + 10 +3*(NNOEMA+NNOEES)
  798. *
  799.             IF (TYPRET.EQ.'CHPOINT') THEN
  800.                KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+
  801.      &NNOEES)
  802.             ELSE IF (TYPRET.EQ.'        ') THEN
  803.                KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  804.      &NNOEES)
  805.             ELSE
  806.                CALL ERREUR(522)
  807.                RETURN
  808.             ENDIF
  809. *
  810.             NXPALB = MAX(NXPALB,KXPALB)
  811.             NIPALB = MAX(NIPALB,KIPALB)
  812.             NPLBB  = MAX(NPLBB,KPLBB)
  813.             IDIMB  = MAX(IDIMB,KDIMB)
  814.  
  815. *
  816. * ------ liaison PALIER_FLUIDE
  817. *
  818.         ELSE IF (CMOT(1:13).EQ.'PALIER_FLUIDE') THEN
  819. *
  820. cbp            KPLBB = 1
  821.            KPLBB = 2
  822. cbp           KDIMB = IDIM  : on est necessairement en 3D ou 2D Fourier
  823.            KDIMB = 3
  824. *
  825. C I) Gestion du(des) point(s) support(s)
  826. *
  827.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_SUPPORT',L0,IP0,
  828.      &                        'POINT',I1,X0,'  ',L1,INOE)
  829.            IF (IERR.NE.0) RETURN
  830.            IF (NCPR(INOE).EQ.0) THEN
  831.               NPLB = NPLB + 1
  832.               NCPR(INOE) = NPLB
  833.            ENDIF
  834. *
  835.            TYPRET='        '
  836.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_ORIGINE',L0,IP0,
  837.      &                        TYPRET,I1,X0,'  ',L1,INOE)
  838.            IF (IERR.NE.0) RETURN
  839.            IF(TYPRET.EQ.'POINT') THEN
  840. cbp            KPLBB = 2
  841.              IF (NCPR(INOE).EQ.0) THEN
  842.                 NPLB = NPLB + 1
  843.                 NCPR(INOE) = NPLB
  844.              ENDIF
  845.            ENDIF
  846. *
  847. C II) Decompte du nombre de parametres entiers et reels
  848. *
  849.            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'MODELE_PALIER',L0,IP0,
  850.      &                        'MOT',I1,X0,CMOT,L1,IP1)
  851.            IF (IERR.NE.0) RETURN
  852. *
  853. C II.1) Decompte du nombre de parametres propres aux differents types
  854. C       de paliers (KIPLB2 pour les entiers, LXPLB2 pour les reels) :
  855. *
  856.            IF (CMOT.EQ.'RODELI') THEN
  857. *
  858. C -- Cas du palier cylindrique ou à lobes, avec modele de Rhode et Li :
  859. *
  860.                 CALL ACCTAB(ITLIAI,'MOT',I0,X0,'GEOMETRIE_PALIER',
  861.      &                   L0,IP0,'TABLE',I0,X0,'  ',L1,ITGEOM)
  862.                 IF (IERR.NE.0) RETURN
  863.                 CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  864.      &                        'ENTIER',NLOB,X0,'  ',L1,IP1)
  865.                 IF (IERR.NE.0) RETURN
  866.                 KIPLB2 = 2 + NLOB
  867.                 KXPLB2 = 1 + (6*NLOB)
  868. *
  869. C -- Cas du palier cylindrique court (ajout BP, 2015) :
  870.            ELSEIF (CMOT.EQ.'PALIER_COURT') THEN
  871.                 KIPLB2 = 1
  872.                 KXPLB2 = 1
  873. *
  874. C -- Cas du palier cylindrique long (ajout BP, 2015) :
  875.            ELSEIF (CMOT.EQ.'PALIER_LONG') THEN
  876.                 KIPLB2 = 1
  877.                 KXPLB2 = 1
  878. *
  879. C -- Cas des autres types de paliers (à definir si necessaire)
  880. *
  881. C           ELSE IF (CMOT.EQ.'...') THEN
  882. C               KIPLB2 = ...
  883. C               KXPLB2 = ...
  884.            ELSE
  885.               WRITE(IOIMP,*) 'MODELE_PALIER non reconnu !'
  886.               CALL ERREUR(490)
  887.               RETURN
  888.            ENDIF
  889. *
  890. C II.2) Nombres totaux de parametres entiers et reels :
  891. *
  892.            KIPALB = 6 + KIPLB2
  893. cbp           KXPALB = 7 + KXPLB2 + 4
  894. cbp , 2015 pourquoi pas :
  895.            KXPALB = 9 + KXPLB2
  896. *
  897. C Dimensionnement des variables de sortie :
  898. *
  899.            NXPALB = MAX(NXPALB,KXPALB)
  900.            NIPALB = MAX(NIPALB,KIPALB)
  901.            NPLBB  = MAX(NPLBB,KPLBB)
  902.            IDIMB  = MAX(IDIMB,KDIMB)
  903. *
  904. * --> fin liaison PALIER
  905. *
  906.  
  907. * -----  ERREUR : Le TYPE d'une liaison est incorrect
  908.          ELSE
  909.             CALL ERREUR(490)
  910.             RETURN
  911.          ENDIF
  912.  
  913.          GOTO 10
  914. *        On Boucle sur les liaisons
  915.  
  916.       ENDIF
  917. *-----Fin de Cas ou la  IL ieme liaison existe -------------------------
  918. *
  919.       END
  920.  
  921.  
  922.  
  923.  
  924.  
  925.  
  926.  
  927.  
  928.  
  929.  
  930.  
  931.  
  932.  
  933.  
  934.  
  935.  
  936.  

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