Télécharger la plaquette Cast3M


fr en

Télécharger dyne18.eso

Retour à la liste

Numérotation des lignes : 

dyne18

  1. C DYNE18    SOURCE    CB215821  20/11/25    13:26:25     10792          
  2.       SUBROUTINE DYNE18(ICHP,KTQ,I1,I2,KCPR)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
  8. *     ________________________________________________               *
  9. *                                                                    *
  10. *     Remplissage du tableau des variables g{n{ralis{es.             *
  11. *                                                                    *
  12. *     Param}tres:                                                    *
  13. *                                                                    *
  14. * e   ICHP  : CHPOINT dans lequel on va chercher les valeurs         *
  15. * es  ITQ   : Segment des variables de mouvement g{n{ralis{es        *
  16. * e   I1    : Indique si l'on travaille sur les d{placements,        *
  17. *             sur les vitesses, ou les acc{l{rations                 *
  18. * e   I2    : Indice du pas                                          *
  19. * e   KCPR  : Segment des points                                     *
  20. *                                                                    *
  21. *     Auteur, date de cr{ation:                                      *
  22. *                                                                    *
  23. *     Lionel VIVAN, le 26 Juillet 1989.                              *
  24. *                                                                    *
  25. *--------------------------------------------------------------------*
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC SMCHPOI
  30. -INC SMCOORD
  31. -INC SMELEME
  32. *
  33.       SEGMENT,ICPR(nbpts)
  34.       SEGMENT,ICOR(NP1)
  35.       SEGMENT,MTQ
  36.          REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
  37.          REAL*8 WEXT(NA1,2),WINT(NA1,2)
  38.       ENDSEGMENT
  39. *
  40.       MTQ  = KTQ
  41.       ICPR = KCPR
  42. *
  43.       MCHPOI = ICHP
  44.       SEGACT,MCHPOI
  45.       NSOUPO = IPCHP(/1)
  46.       DO 10 II1=1,NSOUPO
  47.          MSOUPO = IPCHP(II1)
  48.          SEGACT,MSOUPO
  49.          MELEME = IGEOC
  50.          SEGACT,MELEME
  51.          NP = NUM(/2)
  52.          NP1 = NP
  53.          SEGINI,ICOR
  54.          DO 2 IP = 1,NP
  55.             KNOE = ICPR(NUM(1,IP))
  56.             IF (KNOE.NE.0) ICOR(IP) = KNOE
  57.  2          CONTINUE
  58. *        end do
  59.          SEGDES,MELEME
  60.          NC = NOCOMP(/2)
  61.          MPOVAL = IPOVAL
  62.          SEGACT,MPOVAL
  63.          N = VPOCHA(/1)
  64.          IF (I1.EQ.1) THEN
  65.             DO 20 J=1,N
  66.                DO 20 K=1,NC
  67.                   IA = ICOR(J)
  68.                   IF (IA.NE.0) Q1(IA,I2) = VPOCHA(J,K)
  69.  20            CONTINUE
  70.  
  71.          ELSE IF (I1.EQ.2) THEN
  72.             DO 30 J=1,N
  73.                DO 30 K=1,NC
  74.                   IA = ICOR(J)
  75.                   IF (IA.NE.0) Q2(IA,I2) = VPOCHA(J,K)
  76.  30            CONTINUE
  77.  
  78.          ELSE IF (I1.EQ.3) THEN
  79.             DO 40 J=1,N
  80.                DO 40 K=1,NC
  81.                   IA = ICOR(J)
  82.                   IF (IA.NE.0) Q3(IA,I2) = VPOCHA(J,K)
  83.  40            CONTINUE
  84.  
  85.          ELSE IF (I1.EQ.4) THEN
  86.             DO 50 J=1,N
  87.                DO 50 K=1,NC
  88.                   IA = ICOR(J)
  89.                   IF (IA.NE.0) WEXT(IA,I2) = VPOCHA(J,K)
  90.  50            CONTINUE
  91.  
  92.          ELSE IF (I1.EQ.5) THEN
  93.             DO 60 J=1,N
  94.                DO 60 K=1,NC
  95.                   IA = ICOR(J)
  96.                   IF (IA.NE.0) WINT(IA,I2) = VPOCHA(J,K)
  97.  60            CONTINUE
  98.  
  99.          ENDIF
  100.          SEGDES,MPOVAL,MSOUPO
  101.          SEGSUP,ICOR
  102.  10      CONTINUE
  103. *     end do
  104.       SEGDES,MCHPOI
  105. *
  106.       END
  107.  
  108.  
  109.  
  110.  
  111.  

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