Télécharger la plaquette Cast3M


fr en

Télécharger dyn203.eso

Retour à la liste

Numérotation des lignes : 

dyn203

  1. C DYN203    SOURCE    BP208322  20/03/26    21:15:50     10562          
  2.       SUBROUTINE DYN203(I,ITLB,ITYP,KTLIAB,NPLB)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Operateur DYNE :                                               *
  8. *     Remplissage des tableaux de description des liaisons sur       *
  9. *     la base des informations contenues dans la table ILIB          *
  10. *     pour les liaisons de type :                                    *
  11. *     - POINT_CERCLE avec ou sans amortissement                      *
  12. *     - POINT_CERCLE_FROTTEMENT avec ou sans amortissement           *
  13. *     - POINT_CERCLE_MOBILE avec ou sans amortissement               *
  14. *     - CERCLE_CERCLE_FROTTEMENT                                     *
  15. *                                                                    *
  16. *--------------------------------------------------------------------*
  17. *                                                                    *
  18. *     Parametres:                                                    *
  19. *                                                                    *
  20. * e   I       Numero de la liaison.                                  *
  21. * e   ITLB    Table rassemblant la description d'une liaison.        *
  22. * e   ITYP    Type de la liaison.                                    *
  23. *  s  KTLIAB  Segment descriptif des liaisons sur base B.            *
  24. * e   NPLB    Nombre total de points.                                *
  25. *                                                                    *
  26. *--------------------------------------------------------------------*
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMCOORD
  31. *
  32.       SEGMENT MTLIAB
  33.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  34.          REAL*8 XPALB(NLIAB,NXPALB)
  35.          REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  36.       ENDSEGMENT
  37. *
  38.       LOGICAL L1,L0,LINTER
  39.       CHARACTER*8 MONAMO,MONINTER,CHARRE,TYPRET
  40. *
  41.       LINTER=.TRUE.
  42.       PS=0.D0
  43.       MTLIAB = KTLIAB
  44. *
  45. *--------------------------------------------------------------------*
  46. * --- choc elementaire POINT_CERCLE avec ou sans amortissement
  47. *--------------------------------------------------------------------*
  48. *
  49.       IF (ITYP.EQ.21) THEN
  50.          CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  51.      &                    'POINT',I1,X1,CHARRE,L1,IMOD)
  52.          IF (IERR.NE.0) RETURN
  53.          CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
  54.      &                    'POINT',I1,X1,CHARRE,L1,IEXC)
  55.          IF (IERR.NE.0) RETURN
  56.          CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  57.      &                    'POINT',I1,X1,CHARRE,L1,IPOI)
  58.          IF (IERR.NE.0) RETURN
  59.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  60.      &                    'FLOTTANT',I0,XRAID,CHARRE,L1,IP1)
  61.          IF (IERR.NE.0) RETURN
  62.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
  63.      &                    'FLOTTANT',I0,XRAYO,CHARRE,L1,IP1)
  64.          IF (IERR.NE.0) RETURN
  65. *
  66.          MONAMO = ' '
  67.          CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
  68.      &                    MONAMO,I0,XAMON,CHARRE,L1,IP1)
  69.          IF (IERR.NE.0) RETURN
  70. *
  71.          IPALB(I,1) = ITYP
  72.          IPALB(I,3) = IDIM
  73.          XPALB(I,1) = XRAID
  74.          XPALB(I,2) = XRAYO
  75. *
  76. *        normalisation de la normale
  77. *
  78.          IPNV  = (IDIM + 1) * (IPOI - 1)
  79.          IPEX  = (IDIM + 1) * (IEXC - 1)
  80.          PS = 0.D0
  81.          DO 10 ID = 1,IDIM
  82.             XC = XCOOR(IPNV + ID)
  83.             PS = PS + XC * XC
  84.  10         CONTINUE
  85. ***      write (6,*) ' ps ',ps
  86. *        end do
  87.          IF (PS.LE.0.D0) THEN
  88.             CALL ERREUR(162)
  89.             RETURN
  90.          ENDIF
  91.          IF (MONAMO.EQ.'FLOTTANT') THEN
  92.             IPALB(I,1) = 22
  93.             XPALB(I,3) = XAMON
  94.             ID1 = 3
  95.          ELSE
  96.             ID1 = 2
  97.          ENDIF
  98.          ID2 = ID1 + IDIM
  99.          DO 12 ID = 1,IDIM
  100.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  101.             XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  102.  12         CONTINUE
  103. *        end do
  104.          CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  105.          IPLIB(I,1) = IPLAC
  106. *
  107. *--------------------------------------------------------------------*
  108. * --- choc elementaire POINT_CERCLE_FROTTEMENT
  109. *                      avec ou sans amortissement
  110. *--------------------------------------------------------------------*
  111. *
  112.       ELSE IF (ITYP.EQ.23) THEN
  113.  
  114.          CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  115.      &                    'POINT',I1,X1,CHARRE,L1,IMOD)
  116.          IF (IERR.NE.0) RETURN
  117.          CALL ACCTAB(ITLB,'MOT',I0,X0,'RAIDEUR',L0,IP0,
  118.      &                    'FLOTTANT',I1,XRAIN,CHARRE,L1,IP1)
  119.          IF (IERR.NE.0) RETURN
  120.          CALL ACCTAB(ITLB,'MOT',I0,X0,'RAYON',L0,IP0,
  121.      &                    'FLOTTANT',I1,XRAYO,CHARRE,L1,IP1)
  122.          IF (IERR.NE.0) RETURN
  123.          CALL ACCTAB(ITLB,'MOT',I0,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  124.      &                    'FLOTTANT',I1,XGLIS,CHARRE,L1,IP1)
  125.          IF (IERR.NE.0) RETURN
  126.          CALL ACCTAB(ITLB,'MOT',I0,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  127.      &                    'FLOTTANT',I1,XADHE,CHARRE,L1,IP1)
  128.          IF (IERR.NE.0) RETURN
  129.          CALL ACCTAB(ITLB,'MOT',I0,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  130.      &                    'FLOTTANT',I1,XRAIT,CHARRE,L1,IP1)
  131.          IF (IERR.NE.0) RETURN
  132.          CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  133.      &                    IP0,'FLOTTANT',I1,XAMOT,CHARRE,L1,IP1)
  134.          IF (IERR.NE.0) RETURN
  135.  
  136.          MONINTER = ' '
  137.          CALL ACCTAB(ITLB,'MOT',I0,X0,'CONTACT_INTERIEUR',L0,
  138.      &                    IP0,MONINTER,I1,X1,CHARRE,LINTER,IP1)
  139.          IF (IERR.NE.0) RETURN
  140. *        amortissement (facultatif)
  141.          MONAMO = ' '
  142.          CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  143.      &                    MONAMO,I1,XAMON,CHARRE,L1,IP1)
  144.          IF (IERR.NE.0) RETURN
  145.          IF (MONAMO .EQ. 'ENTIER  ') THEN
  146.            XAMON = DBLE(I1)
  147.            MONAMO = 'FLOTTANT'
  148. c        bp,2020 : ajout pour simplifier la suite           
  149.          ELSEIF(MONAMO.NE.'FLOTTANT') THEN
  150.            XAMON=0.D0
  151.          ENDIF
  152. *
  153. *        bp,2016 petit message informatif pour ceux qui, comme moi,  
  154. *        n'auraient pas lu la notice jusqu'au bout :
  155.          IF(XRAIT.LT.0.D0) THEN
  156.            IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  157.            WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  158.            WRITE(IOIMP,*) 
  159.      &      'utilisation du modele de frottement regularise d ODEN'
  160.            ENDIF
  161.            IF(XAMOT.LE.0D0) THEN
  162. c             ERREUR:  %m1:8 = %r1 inferieur a %r2
  163.               MOTERR(1:8)='AMOR*_T*'
  164.               REAERR(1)=XAMOT
  165.               REAERR(2)=0.D0
  166.               CALL ERREUR(41)
  167.               RETURN
  168.            ENDIF
  169.          ENDIF
  170. *        bp,2020 : lecture eventuelle des regularisations (n et t)
  171.          TYPRET='        '
  172.          CALL ACCTAB(ITLB,'MOT',I1,X0,'REGULARISATION',L0,IP0,
  173.      &                    TYPRET,IREG,XREG,CHARRE,L1,IP1)
  174.          IF (IERR.NE.0) RETURN
  175.          IF (TYPRET .EQ. 'ENTIER  ') THEN
  176.            XREG=DBLE(IREG)
  177.          ELSEIF (TYPRET.NE.'FLOTTANT') THEN
  178.            XREG=0.D0
  179.          ENDIF
  180.          TYPRET='        '
  181.          CALL ACCTAB(ITLB,'MOT',I1,X0,'REGULARISATION_TANGENTIELLE',
  182.      &               L0,IP0,TYPRET,IREGT,XREGT,CHARRE,L1,IP1)
  183.          IF (IERR.NE.0) RETURN
  184.          IF (TYPRET .EQ. 'ENTIER  ') THEN
  185.            XREGT=DBLE(IREGT)
  186.          ELSEIF (TYPRET.NE.'FLOTTANT') THEN
  187.            XREGT=0.D0
  188.          ENDIF
  189. c        NORMALE et EXCENTREMENT (TYPE POINT)
  190.          CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
  191.      &                    'POINT',I1,X1,CHARRE,L1,IEXC)
  192.          IF (IERR.NE.0) RETURN
  193. c        rem : il s'agit de la normale au Cercle qu'on note nCercle
  194.          CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  195.      &                    'POINT',I1,X1,CHARRE,L1,IPOI)
  196.          IF (IERR.NE.0) RETURN
  197.          IPNV  = (IDIM + 1) * (IPOI - 1)
  198.          IPEX  = (IDIM + 1) * (IEXC - 1)
  199.          PS2 = 0.D0
  200.          DO 20 ID = 1,IDIM
  201.             XC = XCOOR(IPNV + ID)
  202.             PS2 = PS2 + XC * XC
  203.  20      CONTINUE
  204.          IF (PS2.LE.0.D0) THEN
  205.             CALL ERREUR(162)
  206.             RETURN
  207.          ENDIF  
  208.          PS=SQRT(PS2)
  209. *        bp,2020 : lecture eventuelle d'une vitesse d'entrainement
  210.          TYPRET='        '
  211.          CALL ACCTAB(ITLB,'MOT',I1,X0,'VITESSE_ENTRAINEMENT',L0,IP0,
  212.      &                    TYPRET,I1,XVE,CHARRE,L1,IPVE)
  213.          IF (IERR.NE.0) RETURN
  214. c        cas particulier : \vect{Ve} = Ve *\vect{nCercle}
  215. c       -cas d'un POINT : Ve = \vect{Ve}*\vect{nCercle}
  216.          IF(TYPRET.EQ.'POINT   ') THEN
  217.            IDVE=(IDIM + 1) * (IPVE - 1)
  218.            XVE=0.D0
  219.            DO ID=1,IDIM
  220.              XVE=XVE+XCOOR(IDVE + ID)*XCOOR(IPNV + ID)/PS
  221.            ENDDO
  222.          ELSEIF (TYPRET.NE.'FLOTTANT') THEN
  223.            XVE=0.D0
  224.          ENDIF
  225.  
  226. *     -- STOCKAGE --         
  227.          IPALB(I,1) = ITYP
  228.          IPALB(I,3) = IDIM
  229.          IF (.NOT.LINTER) THEN
  230.             ITYP=ITYP+100
  231.             IPALB(I,1) = ITYP           
  232.          ENDIF
  233.          XPALB(I,1) = XRAIN
  234.          XPALB(I,2) = XRAYO
  235.          XPALB(I,3) = XGLIS
  236.          XPALB(I,4) = XADHE
  237.          XPALB(I,5) = XRAIT
  238.          XPALB(I,6) = XAMOT
  239. cbp,2020         IF (MONAMO.EQ.'FLOTTANT') THEN
  240. cbp,2020            ITYP=ITYP+1
  241. cbp,2020            IPALB(I,1) = ITYP           
  242.          XPALB(I,7) = XAMON
  243. cbp,2020            ID1 = 7
  244. cbp,2020         ELSE
  245. cbp,2020            ID1 = 6
  246. cbp,2020         ENDIF
  247.          XPALB(I,8) = XREG
  248.          XPALB(I,9) = XREGT
  249.          XPALB(I,10) = XVE
  250. c        NORMALE et EXCENTREMENT
  251.          ID2 = 10 + IDIM
  252.          DO 22 ID = 1,IDIM
  253.             XPALB(I,10+ID)  = XCOOR(IPNV + ID) / PS
  254.             XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  255.  22      CONTINUE
  256.          CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  257.          IPLIB(I,1) = IPLAC
  258.  
  259. *
  260. *--------------------------------------------------------------------*
  261. * --- choc elementaire POINT_CERCLE_MOBILE
  262. *                      avec ou sans amortissement
  263. *--------------------------------------------------------------------*
  264. *
  265.       ELSE IF (ITYP.EQ.33) THEN
  266.  
  267.          CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT',L0,IP0,
  268.      &                    'POINT',I1,X1,CHARRE,L1,INOA)
  269.          IF (IERR.NE.0) RETURN
  270.          CALL ACCTAB(ITLB,'MOT',I0,X0,'CERCLE',L0,IP0,
  271.      &                    'POINT',I1,X1,CHARRE,L1,INOB)
  272.          IF (IERR.NE.0) RETURN
  273.          CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  274.      &                    'POINT',I1,X1,CHARRE,L1,IPOI)
  275.          IF (IERR.NE.0) RETURN
  276.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  277.      &                    'FLOTTANT',I0,XRAIN,CHARRE,L1,IP1)
  278.          IF (IERR.NE.0) RETURN
  279.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
  280.      &                    'FLOTTANT',I0,XRAYO,CHARRE,L1,IP1)
  281.          IF (IERR.NE.0) RETURN
  282.          CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  283.      &                    'FLOTTANT',I0,XGLIS,CHARRE,L1,IP1)
  284.          IF (IERR.NE.0) RETURN
  285.          CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  286.      &                    'FLOTTANT',I0,XADHE,CHARRE,L1,IP1)
  287.          IF (IERR.NE.0) RETURN
  288.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  289.      &                    'FLOTTANT',I0,XRAIT,CHARRE,L1,IP1)
  290.          IF (IERR.NE.0) RETURN
  291.          CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  292.      &                    IP0,'FLOTTANT',I0,XAMOT,CHARRE,L1,IP1)
  293.          IF (IERR.NE.0) RETURN
  294.          MONINTER = ' '
  295.          CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
  296.      &                    IP0,MONINTER,I0,X1,CHARRE,LINTER,IP1)
  297.          IF (IERR.NE.0) RETURN
  298. *
  299.          MONAMO = ' '
  300.          CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
  301.      &                    MONAMO,I0,XAMON,CHARRE,L1,IP1)
  302.          IF (IERR.NE.0) RETURN
  303. *
  304.          IPALB(I,1) = ITYP
  305.          IPALB(I,3) = IDIM
  306. cbp         IPALB(I,4) = 1
  307.          IF (.NOT.LINTER) THEN
  308. cbp           IPALB(I,4) = 0
  309.             ITYP=ITYP+100
  310.             IPALB(I,1) = ITYP           
  311.          ENDIF
  312.          XPALB(I,1) = XRAIN
  313.          XPALB(I,2) = XRAYO
  314.          XPALB(I,3) = XGLIS
  315.          XPALB(I,4) = XADHE
  316.          XPALB(I,5) = XRAIT
  317.          XPALB(I,6) = XAMOT
  318. *
  319. *        normalisation de la normale
  320. *
  321.          IPNV  = (IDIM + 1) * (IPOI - 1)
  322.          IPNOA  = (IDIM + 1) * (INOA - 1)
  323.          IPNOB  = (IDIM + 1) * (INOB - 1)
  324.          PS = 0.D0
  325.          DO 202 ID = 1,IDIM
  326.             XC = XCOOR(IPNV + ID)
  327.             PS = PS + XC * XC
  328.  202         CONTINUE
  329. ***      write (6,*) ' ps - 3 ',ps
  330.          IF (PS.LE.0.D0) THEN
  331.             CALL ERREUR(162)
  332.             RETURN
  333.          ENDIF
  334.          IF (MONAMO.EQ.'FLOTTANT') THEN
  335. cbp         IPALB(I,1) = 34
  336.             ITYP=ITYP+1
  337.             IPALB(I,1) = ITYP           
  338.             XPALB(I,7) = XAMON
  339.             ID1 = 7
  340.          ELSE
  341.             ID1 = 6
  342.          ENDIF
  343.          ID2 = ID1 + IDIM
  344. c        stockage de la normale et du vecteur POINT -> Centre_du_Cercle
  345.          DO 222 ID = 1,IDIM
  346.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  347.             XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID)
  348.  222        CONTINUE
  349.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  350.          IPLIB(I,1) = IPLAC
  351.          CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  352.          IPLIB(I,2) = IPLAC
  353. *
  354. *--------------------------------------------------------------------*
  355. * --- choc elementaire CERCLE_CERCLE_FROTTEMENT
  356. *                      avec ou sans amortissement
  357. *--------------------------------------------------------------------*
  358. *
  359.       ELSE IF (ITYP.EQ.25) THEN
  360.          CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  361.      &                    'POINT',I1,X1,CHARRE,L1,IMOD)
  362.          IF (IERR.NE.0) RETURN
  363.          CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
  364.      &                    'POINT',I1,X1,CHARRE,L1,IEXC)
  365.          IF (IERR.NE.0) RETURN
  366.          CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  367.      &                    'POINT',I1,X1,CHARRE,L1,IPOI)
  368.          IF (IERR.NE.0) RETURN
  369.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  370.      &                    'FLOTTANT',I0,XRAIN,CHARRE,L1,IP1)
  371.          IF (IERR.NE.0) RETURN
  372.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_BUTEE',L0,IP0,
  373.      &                    'FLOTTANT',I0,XRAYB,CHARRE,L1,IP1)
  374.          IF (IERR.NE.0) RETURN
  375.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_SUPPORT',L0,IP0,
  376.      &                    'FLOTTANT',I0,XRAYP,CHARRE,L1,IP1)
  377.          IF (IERR.NE.0) RETURN
  378.          CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  379.      &                    'FLOTTANT',I0,XGLIS,CHARRE,L1,IP1)
  380.          IF (IERR.NE.0) RETURN
  381.          CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  382.      &                    'FLOTTANT',I0,XADHE,CHARRE,L1,IP1)
  383.          IF (IERR.NE.0) RETURN
  384.          CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  385.      &                    'FLOTTANT',I0,XRAIT,CHARRE,L1,IP1)
  386.          IF (IERR.NE.0) RETURN
  387.          CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  388.      &                    IP0,'FLOTTANT',I0,XAMOT,CHARRE,L1,IP1)
  389.          IF (IERR.NE.0) RETURN
  390.          MONINTER = ' '
  391.          CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
  392.      &                    IP0,MONINTER,I0,X1,CHARRE,LINTER,IP1)
  393.          IF (IERR.NE.0) RETURN
  394. *
  395.          MONAMO = ' '
  396.          CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
  397.      &                    MONAMO,I0,XAMON,CHARRE,L1,IP1)
  398.          IF (IERR.NE.0) RETURN
  399. *
  400. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient 
  401. *        pas lu la notice jusqu'au bout :
  402.          IF(XRAIT.LT.0.D0) THEN
  403.            IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  404.            WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  405.            WRITE(IOIMP,*) 
  406.      &      'utilisation du modele de frottement regularise d ODEN'
  407.            ENDIF
  408.            IF(XAMOT.LE.0D0) THEN
  409. c             ERREUR:  %m1:8 = %r1 inferieur a %r2
  410.               MOTERR(1:8)='AMOR*_T*'
  411.               REAERR(1)=XAMOT
  412.               REAERR(2)=0.D0
  413.               CALL ERREUR(41)
  414.               RETURN
  415.            ENDIF
  416.          ENDIF
  417.  
  418.          IPALB(I,1) = ITYP
  419.          IPALB(I,3) = IDIM
  420. cbp         IPALB(I,4) = 1
  421.          IF (.NOT.LINTER) THEN
  422. cbp           IPALB(I,4) = 0
  423. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  424.             ITYP=ITYP+100
  425.             IPALB(I,1) = ITYP           
  426.          ENDIF
  427.          XPALB(I,1) = XRAIN
  428.          XPALB(I,2) = XRAYB
  429.          XPALB(I,3) = XGLIS
  430.          XPALB(I,4) = XADHE
  431.          XPALB(I,5) = XRAIT
  432.          XPALB(I,6) = XAMOT
  433. *
  434. *        normalisation de la normale
  435. *
  436.          IPNV  = (IDIM + 1) * (IPOI - 1)
  437.          IPEX  = (IDIM + 1) * (IEXC - 1)
  438.          PS = 0.D0
  439.          DO 30 ID = 1,IDIM
  440.             XC = XCOOR(IPNV + ID)
  441.             PS = PS + XC * XC
  442.  30         CONTINUE
  443. *        end do
  444. ***      write (6,*) ' ps - 4 ',ps
  445.          IF (PS.LE.0.D0) THEN
  446.             CALL ERREUR(162)
  447.             RETURN
  448.          ENDIF
  449.          IF (MONAMO.EQ.'FLOTTANT') THEN
  450.             ID1 = 7
  451. cbp         IPALB(I,1) = 26
  452.             ITYP=ITYP+1
  453.             IPALB(I,1) = ITYP           
  454.             XPALB(I,7) = XAMON
  455.          ELSE
  456.             ID1 = 6
  457.          ENDIF
  458.          ID10 = ID1 + 9*IDIM
  459.          XPALB(I,ID10+1) = XRAYP
  460.          ID2  = ID1 + IDIM
  461. cbp         ID3  = ID1 + 2*IDIM
  462.          DO 32 ID = 1,IDIM
  463.             XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  464.             XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  465.  32         CONTINUE
  466. *        end do
  467.          CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  468.          IPLIB(I,1) = IPLAC
  469. *
  470. *--------------------------------------------------------------------*
  471. * --- choc elementaire ..._CERCLE...
  472. *--------------------------------------------------------------------*
  473. *
  474. *     ELSE IF (ITYP.EQ.  ) THEN
  475. *        ...
  476. *        ...
  477.       ENDIF
  478. *
  479.       END
  480.  
  481.  
  482.  
  483.  
  484.  
  485.  
  486.  
  487.  
  488.  
  489.  
  490.  
  491.  

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