Télécharger evol23.eso

Retour à la liste

Numérotation des lignes :

  1. C EVOL23 SOURCE BP208322 19/04/03 21:15:12 10174
  2. C
  3. SUBROUTINE EVOL23(IBOO,ILEX,ILEN1,ILEN3)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. C=======================================================================
  7. C ILEX CONTIENT LA SUITE DES CHPOINTS DES CONTRIBUTIONS MODALES.
  8. C POUR LES COUPLES POINTS COMPOSANTES CONTENUS DANS NUMOO,
  9. C ON RECOMBINE LES MODES dont les deformee sont CONTENUeS DANS ILEN1
  10. C RESULTAT DANS LE(S) LISTREEL KLIST.
  11. C APPELE PAR EVRECO
  12. C APPELLE : ERREUR(61,243,18) IANUL PROSC1
  13. C CREATION:BP, 2017-07-18 : inspire de EVOL22
  14. C=======================================================================
  15. C
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC SMCHPOI
  20. -INC SMLREEL
  21. -INC SMLENTI
  22. -INC SMELEME
  23. -INC SMTABLE
  24. -INC SMCOORD
  25. SEGMENT/ITRAV1/(TRAV(LDEPL,N)*D)
  26. SEGMENT/ITRAV2/(TRAVV(LDEPL,LTEMP)*D)
  27. SEGMENT NUMOO
  28. INTEGER NUMO(N),KLIST(N)
  29. CHARACTER*4 NUDDL(N)
  30. ENDSEGMENT
  31. CHARACTER*4 NUJ
  32. C
  33. LDEPL=0
  34. NUMOO=IBOO
  35. SEGACT NUMOO*MOD
  36. N=NUMO(/1)
  37.  
  38. C MLENT1 = LISTE DES DEFORMEES MODALES
  39. C MLENT3 = LISTE DES LISTREEL alpha_i(t)
  40. MLENT1=ILEN1
  41. MLENT3=ILEN3
  42. SEGACT MLENT1,MLENT3
  43.  
  44. C ---------------------------------------------------------------------
  45. C FABRICATION DU TABLEAU ITRAV1.TRAV(LDEPL,N)
  46. C DES MODES REDUITS AUX POINTS DE SORTIE
  47. C ---------------------------------------------------------------------
  48.  
  49. LDEPL=MLENT1.LECT(/1)
  50. SEGINI ITRAV1
  51.  
  52. C --- BOUCLE SUR LES MODES ----------------------------------
  53. LDEP=MLENT1.LECT(/1)
  54. DO 40 I=1,LDEP
  55.  
  56. ICHP=MLENT1.LECT(I)
  57.  
  58. C --- BOUCLE SUR LES DDL ----------------------------------
  59. DO 41 IP=1,N
  60. c recup du noeud et du nom de composante
  61. MPOINT=NUMO(IP)
  62. NUJ=NUDDL(IP)
  63. call EXTRA9(ICHP,MPOINT,NUJ,0,.FALSE.,XFLOT,IRET)
  64. c TRAV(I^eme mode,IP^eme ddl)=[ \phi_I(x_IP) ]_{I=1...LDEP}
  65. TRAV(I,IP)=XFLOT
  66. 41 CONTINUE
  67.  
  68. 40 CONTINUE
  69.  
  70. C ---------------------------------------------------------------------
  71. C CREATION DE N LISREELS (OU N=NOMBRE DE DDLS A SORTIR)
  72. C DE TAILLE LTEM = NOMBRE DE PAS DE TEMPS A SORTIR
  73. C ---------------------------------------------------------------------
  74. C
  75. MLENTI=ILEX
  76. SEGACT MLENTI
  77. LTEM=LECT(/1)
  78. JG=LTEM
  79. DO 99 IP=1,N
  80. SEGINI MLREEL
  81. KLIST(IP)=MLREEL
  82. 99 CONTINUE
  83.  
  84. C ---------------------------------------------------------------------
  85. C FABRICATION DU TABLEAU ITRAV2.TRAVV(LDEPL)
  86. C DES ALPHA_I AUX TEMPS DE SORTIE
  87. C ---------------------------------------------------------------------
  88. LTEMP=LTEM
  89. SEGINI ITRAV2
  90.  
  91. C --- BOUCLE SUR LES MODES ----------------------------------
  92. DO 60 I=1,LDEP
  93.  
  94. c alpha_i(t)
  95. MLREEL=MLENT3.LECT(I)
  96. segact,MLREEL
  97.  
  98. c --- BOUCLE SUR LES PAS DE TEMPS ------------------------
  99. DO 62 JL=1,LTEM
  100. J=LECT(JL)
  101. TRAVV(I,JL)=PROG(J)
  102. 62 CONTINUE
  103.  
  104. segdes,MLREEL
  105.  
  106. 60 CONTINUE
  107.  
  108. C ---------------------------------------------------------------------
  109. C CALCUL DE x(t) DEMANDE
  110. C ---------------------------------------------------------------------
  111.  
  112. c --- BOUCLE SUR LES DDL -----------------------------------
  113. DO 51 IP=1,N
  114.  
  115. MLREEL=KLIST(IP)
  116.  
  117. C --- BOUCLE SUR LES PAS DE TEMPS A SORTIR ------------------------
  118. DO 52 JL=1,LTEM
  119.  
  120. c x_ip(t_J) = \sum_I alpha_I(t_J) * \phi_I(x_IP)
  121. CALL PROSC1(TRAVV(1,JL),TRAV(1,IP),X,LDEP)
  122. PROG(JL)=X
  123.  
  124. 52 CONTINUE
  125.  
  126. 51 CONTINUE
  127.  
  128.  
  129. C ---------------------------------------------------------------------
  130. c SUPPRESSION ET FERMETURE DES SEGMENTS
  131. C ---------------------------------------------------------------------
  132. C
  133. SEGSUP ITRAV1,ITRAV2
  134. SEGDES MLENT1,MLENT3
  135. DO 98 JJ=1,N
  136. MLREEL=KLIST(JJ)
  137. SEGDES MLREEL
  138. 98 CONTINUE
  139. SEGDES MLENTI
  140.  
  141. 5000 CONTINUE
  142. RETURN
  143. END
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  

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