Télécharger la plaquette Cast3M


fr en

Télécharger dypol1.eso

Retour à la liste

Numérotation des lignes : 

dypol1

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

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