Télécharger evol23.eso

Retour à la liste

Numérotation des lignes :

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

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