Télécharger la plaquette Cast3M


fr en

Télécharger d2pol1.eso

Retour à la liste

Numérotation des lignes : 

d2pol1

  1. C D2POL1    SOURCE    BP208322  18/01/05    21:15:08     9672           
  2. C DYPOL1    SOURCE    IANIS     96/08/08    21:16:04     2249
  3.       SUBROUTINE D2POL1(Q1,Q2,NA1,IPLIA,XPALA,XVALA,NLIAA,IND,XPDT,
  4.      &                  NPAS,NUMLIA,NMOD,FTOTA,IVINIT,IANNUL)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. *                                                                    *
  9. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  10. *     ________________________________________________               *
  11. *                                                                    *
  12. *     Calcul de la force elementaire pour la liaison POLYNOMIALE     *
  13. *                                                                    *
  14. *     Parametres:                                                    *
  15. *                                                                    *
  16. * e   Q1        Vecteur des deplacements generalises                 *
  17. * e   Q2        Vecteur des vitesses generalisees                    *
  18. * e   NA1       Nombre total d'inconnues en base A                   *
  19. * e   IPLIA     Tableau des points de types support et origine       *
  20. * es  XPALA     Tableau des parametres de la liaison                 *
  21. * es  XVALA     Tableau des variables internes de la liaison         *
  22. * e   NLIAA     Nombre de liaisons sur la base A                     *
  23. * e   IND       Indice du demi-pas                                   *
  24. * e   XPDT      pas de temps                                         *
  25. * e   NPAS      Numero du pas de temps                               *
  26. * e   NUMLIA    Numero de la liaison consideree                      *
  27. * e   NMOD      Nombre de modes "origine" de la liaison              *
  28. * es  FTOTA     Forces exterieures totalisees sur la base A          *
  29. * e   IVINIT    =1 si vitesses initiales, =0 sinon                   *
  30. *                                                                    *
  31. *     Auteur, date de creation:                                      *
  32. *                                                                    *
  33. *     Denis ROBERT, le 30 avril 1992.                                *
  34. *                                                                    *
  35. *--------------------------------------------------------------------*
  36. *
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. *
  41.       INTEGER IPLIA(NLIAA,*)
  42.       REAL*8 XPALA(NLIAA,*),XVALA(NLIAA,4,*),Q1(NA1,*),FTOTA(NA1,*)
  43.       REAL*8 Q2(NA1,*)
  44.       PARAMETER (XZERO = 0.D0)
  45.       PARAMETER (XUN = 1.D0 )
  46. *
  47. c       XPDT = XDT(NPAS)
  48.  
  49. c      XPDTS2 = 0.5 * XPDT
  50.       XPDTS2 = XPDT
  51. *
  52. *     Boucle sur les modes "origine"
  53. *     Organisation de XPALA et indices :
  54. *     COEF [ ED / RD / XJD / EV / RV / XJV / ... NMAX val de depl ... ]
  55. * i=    1   IDEB                            IDEB+6
  56. *
  57.       IF (IIMPI.EQ.666) THEN
  58.          WRITE(IOIMP,*)'       '
  59.          WRITE(IOIMP,*)'NPAS   = ',NPAS
  60.          WRITE(IOIMP,*)'IVINIT = ',IVINIT
  61.          WRITE(IOIMP,*)'IND    = ',IND
  62.       ENDIF
  63.       XCOEF = XPALA(NUMLIA,1)
  64.       IF (IANNUL.EQ.1) XCOEF = 0.D0
  65.       FX = 1.D0
  66.       IDEB = 2
  67.       DO 10 I = 1,NMOD
  68.          INA2  = IPLIA(NUMLIA,I+1)
  69.          RD    = XPALA(NUMLIA,IDEB+1)
  70. *        NRD : decalage pour trouver le deplacement lie au retard RD
  71.          NRD   = INT(RD/XPDTS2) + 1
  72.          RV    = XPALA(NUMLIA,IDEB+4)
  73. *        NRV : decalage pour trouver la vitesse liee au retard RV
  74.          NRV   = INT(RV/XPDTS2) + 1
  75. *        NRV2 : un deplacement de plus pour calculer la vitesse
  76.          NRV2  = NRV + 1
  77.          NMAX  = MAX(NRD,NRV2)
  78.          ED    = XPALA(NUMLIA,IDEB)
  79.          EV    = XPALA(NUMLIA,IDEB+3)
  80.          XJD   = XPALA(NUMLIA,IDEB+2)
  81.          XJV   = XPALA(NUMLIA,IDEB+5)
  82. *
  83. *        Les deplacements sont reactualises en First In Last Out
  84. *
  85.          XDNEW = Q1(INA2,IND)
  86.          J1 = IDEB + 6
  87.          J2 = IDEB + NMAX + 5
  88.          DO 15 J = J1,J2
  89.             XAUX = XPALA(NUMLIA,J)
  90.             XPALA(NUMLIA,J) = XDNEW
  91.             XDNEW = XAUX
  92.  15      CONTINUE
  93. *
  94. *        Boucle d'impression de XPALA
  95. *
  96.          IF (IIMPI.EQ.666) THEN
  97.             WRITE(IOIMP,*)'DYPOL1 : IMOD = ',I
  98.             DO 200 II = IDEB,J2
  99.                WRITE(IOIMP,*)'XPALA(',NUMLIA,',',II,')='                )
  100.      &                                ,XPALA(NUMLIA,II  )               )
  101.  200        CONTINUE
  102.             WRITE(IOIMP,*)'NRD = ',NRD
  103.             WRITE(IOIMP,*)'NRV = ',NRV
  104.          ENDIF
  105. *
  106. *          faut-il calculer ( cad t > tau)
  107. *
  108.          jmax =  ideb + 5+Nmax
  109.          Xtest = XPALA(NUMLIA,jmax)
  110.          itest = int (xtest)
  111.        IF ( itest .eq. 123456) then
  112. *           on n'a pas ce qu'il faut pour calculer : on met zero
  113.             fx = 0d0
  114.        ELSE
  115.  
  116.          XDEPL = XPALA(NUMLIA,IDEB+5+NRD)
  117. *
  118. *            Calcul de la vitesse
  119. *
  120.          IF ((IND.EQ.3).AND.(IVINIT.EQ.1).and. (nrd.eq.1)) THEN
  121.             XVIT = Q2(INA2,IND)
  122.          ELSE
  123.             XD1   = XPALA(NUMLIA,IDEB+5+NRV)
  124.             XD2   = XPALA(NUMLIA,IDEB+5+NRV2)
  125.                XVIT = (XD1 - XD2) / XPDTS2
  126.          ENDIF
  127.          IF (IIMPI.EQ.666) THEN
  128.             WRITE(IOIMP,*)'---> XVIT = ',XVIT
  129.          ENDIF
  130. *
  131.          IF ((XJD.NE.XZERO).AND.(ED.EQ.XZERO)) THEN
  132.             ISEUIL = 1
  133.          ELSE
  134.             ISEUIL = 0
  135.          ENDIF
  136.          IF (XJD.GE.XZERO) THEN
  137. *
  138. *           partie positive de (XDEPL - XJD)
  139. *
  140.             IF (XDEPL.GE.XJD) THEN
  141.                XD = ABS(XDEPL-XJD)
  142.             ELSE
  143.                XD = XZERO
  144.             ENDIF
  145.          ELSE
  146.             IF (XDEPL.LT.XJD) THEN
  147.                XD = ABS(XJD-XDEPL)
  148.             ELSE
  149.                XD = XZERO
  150.             ENDIF
  151.          ENDIF
  152.          IF (IIMPI.EQ.666) THEN
  153.             WRITE(IOIMP,*)'XD = ',XD
  154.          ENDIF
  155.          IF (XJV.GE.XZERO) THEN
  156.             IF (XVIT.GE.XJV) THEN
  157.                XV = ABS(XVIT-XJV)
  158.             ELSE
  159.                XV = XZERO
  160.             ENDIF
  161.          ELSE
  162.             IF (XVIT.LT.XJV) THEN
  163.                XV = ABS(XJV-XVIT)
  164.             ELSE
  165.                XV = XZERO
  166.             ENDIF
  167.          ENDIF
  168.          IF (IIMPI.EQ.666) THEN
  169.             WRITE(IOIMP,*)'XV = ',XV
  170.          ENDIF
  171.          IF (XD.GT.XZERO) THEN
  172.             FXD = EXP(ED*LOG(XD))
  173.          ELSE
  174.             IF (ED.EQ.XZERO) THEN
  175.                FXD = XUN
  176.             ELSE
  177.                FXD = XZERO
  178.             ENDIF
  179.          ENDIF
  180.          IF (XV.GT.XZERO) THEN
  181.             IF (ISEUIL.EQ.0) THEN
  182.                FXV = EXP(EV*LOG(XV))
  183.             ELSE
  184.                IF (XD.GT.XZERO) THEN
  185.                FXV = EXP(EV*LOG(XV))
  186.                ELSE
  187.                   FXV = XZERO
  188.                ENDIF
  189.             ENDIF
  190.          ELSE
  191.             IF (EV.EQ.XZERO) THEN
  192.                FXV = XUN
  193.             ELSE
  194.                FXV = XZERO
  195.             ENDIF
  196.          ENDIF
  197.          FX = FX * FXV * FXD
  198.          IF (IIMPI.EQ.666) THEN
  199.             WRITE(IOIMP,*)'FXD = ',FXD
  200.             WRITE(IOIMP,*)'FXV = ',FXV
  201.             WRITE(IOIMP,*)'FX  = ',FX
  202.          ENDIF
  203.          IDEB = IDEB + 6 + NMAX
  204.       endif
  205.  10   CONTINUE
  206.       INA1 = IPLIA(NUMLIA,1)
  207.       FXTOT = XCOEF * FX
  208.       XVALA(NUMLIA,IND,1) = FXTOT
  209.       FTOTA(INA1,IND) = FTOTA(INA1,IND) + FXTOT
  210. *
  211.       END
  212.  
  213.  
  214.  
  215.  
  216.  

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