Télécharger la plaquette Cast3M


fr en

Télécharger dyne72.eso

Retour à la liste

Numérotation des lignes : 

dyne72

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

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