Télécharger evol22.eso

Retour à la liste

Numérotation des lignes :

  1. C EVOL22 SOURCE BP208322 17/07/25 21:15:05 9518
  2. SUBROUTINE EVOL22(IBOO,ILEX,ILEN1,ILEN2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C ILEX CONTIENT LA SUITE DES CHPOINTS DES CONTRIBUTIONS MODALES.
  7. C POUR LES COUPLES POINTS COMPOSANTES CONTENUS DANS NUMOO,
  8. C ON RECOMBINE LES MODES dont les deformee sont CONTENUeS DANS ILEN1
  9. C RESULTAT DANS LE(S) LISTREEL KLIST.
  10. C APPELE PAR EVRECO
  11. C APPELLE : ERREUR(61,243,18) IANUL PROSC1
  12. C CREATION:12/10/89, PROGRAMMEUR:LENA
  13. C BP, 2017-07-18 : gros menage de la subroutine
  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 ICPR1(XCOOR(/1)/(IDIM+1))
  24. SEGMENT/ITRAV1/(TRAV(LDEPL,N)*D)
  25. SEGMENT/ITRAV2/(TRAVV(LDEPL)*D)
  26. SEGMENT IPOS(NSOUP1)
  27. SEGMENT ITRAV(2,LDEPL)
  28. SEGMENT NUMOO
  29. INTEGER NUMO(N),KLIST(N)
  30. CHARACTER*4 NUDDL(N)
  31. ENDSEGMENT
  32. CHARACTER*4 NUJ
  33. CHARACTER*8 IBASMO
  34. DATA IBASMO/'BASE-MOD'/
  35. C
  36. LDEPL=0
  37. NUMOO=IBOO
  38. SEGACT NUMOO*MOD
  39. N=NUMO(/1)
  40.  
  41. C MLENT1 = LISTE DES DEFORMEES MODALES
  42. C MLENT2 = LISTE DES POINTS REPERES
  43. MLENT1=ILEN1
  44. MLENT2=ILEN2
  45. SEGACT MLENT1,MLENT2
  46. LDEPL=MLENT1.LECT(/1)
  47.  
  48. LICPR=XCOOR(/1)/(IDIM+1)
  49. SEGINI ICPR1
  50. SEGINI ITRAV1
  51.  
  52. C ---------------------------------------------------------------------
  53. C FABRICATION DU TABLEAU ITRAV1.TRAV(LDEPL,N)
  54. C DES MODES REDUITS AUX POINTS DE SORTIE
  55. C ---------------------------------------------------------------------
  56.  
  57. C --- BOUCLE SUR LES MODES ----------------------------------
  58. LDEP=MLENT1.LECT(/1)
  59. DO 40 I=1,LDEP
  60.  
  61. NUMPP=MLENT2.LECT(I)
  62. ICPR1(NUMPP)=I
  63. ichp=MLENT1.LECT(I)
  64.  
  65. C --- BOUCLE SUR LES DDL DEMANDES ----------------------------------
  66. DO 41 IP=1,N
  67. c recup du noeud et du nom de composante
  68. mpoint=numo(ip)
  69. NUJ=NUDDL(IP)
  70. call EXTRA9(ICHP,MPOINT,nuj,KERRE,XFLOT)
  71. c TRAV(I^eme mode,IP^eme ddl)=[ \phi_I(x_IP) ]_{I=1...LDEP}
  72. TRAV(I,IP)=xflot
  73. 41 continue
  74.  
  75. 40 CONTINUE
  76. C
  77. C ---------------------------------------------------------------------
  78. C FABRICATION DE ITRAV(2,LDEPL) ET DE IPOS(NSOUP+1)
  79. C ---------------------------------------------------------------------
  80. C ITRAV(1,kk) = I le kk^eme noeud du chpoint est le I^eme noeud
  81. c de la isou^eme zone du chpoint \phi_1
  82. C ITRAV(1,kk) = J le kk^eme noeud du chpoint est le noeud #J
  83. C IPOS : la isou^eme zone du chpoint \phi_1 s'etend des noeuds
  84. c kk_debut=IPOS(isou)+1 a kk_fin=IPOS(isou+1)
  85. MLENTI=ILEX
  86. SEGACT MLENTI
  87. MCHPOI=LECT(1)
  88. SEGACT MCHPOI
  89. NSOUP=IPCHP(/1)
  90. NSOUP1=NSOUP+1
  91. SEGINI IPOS
  92. SEGINI ITRAV
  93. KK=0
  94. IPOS(1)=0
  95. DO 1 ISOU=1,NSOUP
  96. MSOUPO=IPCHP(ISOU)
  97. SEGACT MSOUPO
  98. MELEME=IGEOC
  99. SEGACT MELEME
  100. DO 2 I=1,NUM(/2)
  101. J=ICPR1(NUM(1,I))
  102. IF (J.NE.0) THEN
  103. KK=KK+1
  104. ITRAV(1,KK)=I
  105. ITRAV(2,KK)=J
  106. ENDIF
  107. 2 CONTINUE
  108. SEGDES MELEME,MSOUPO
  109. IPOS(ISOU+1)=KK
  110. 1 CONTINUE
  111. SEGSUP ICPR1
  112. C
  113. C ---------------------------------------------------------------------
  114. C CREATION DE N LISREELS (OU N=NOMBRE DE DDLS A SORTIR)
  115. C DE TAILLE LTEM = NOMBRE DE PAS DE TEMPS A SORTIR
  116. C ---------------------------------------------------------------------
  117. C
  118. MLENTI=ILEX
  119. SEGACT MLENTI
  120. LTEM=LECT(/1)
  121. JG=LTEM
  122. DO 99 JJ=1,N
  123. SEGINI MLREEL
  124. KLIST(JJ)=MLREEL
  125. 99 CONTINUE
  126. C
  127. C ---------------------------------------------------------------------
  128. C FABRICATION DE ITRAV2.TRAVV ET CALCUL DE x(t) DEMANDE
  129. C ---------------------------------------------------------------------
  130. C
  131. SEGINI,ITRAV2
  132. c --- BOUCLE SUR LES PAS DE TEMPS t_l ---
  133. DO 90 L=1,LTEM
  134. MCHPOI=LECT(L)
  135. SEGACT MCHPOI
  136. DO 70 I=1,NSOUP
  137. IF (IPOS(I+1).NE.IPOS(I)) THEN
  138. MSOUPO=IPCHP(I)
  139. SEGACT MSOUPO
  140. MPOVAL=IPOVAL
  141. SEGACT MPOVAL
  142. DO 160 NB=IPOS(I)+1,IPOS(I+1)
  143. TRAVV(ITRAV(2,NB))=VPOCHA(ITRAV(1,NB),1)
  144. 160 CONTINUE
  145. SEGDES,MPOVAL,MSOUPO
  146. ENDIF
  147. 70 CONTINUE
  148. SEGDES MCHPOI
  149. c TRAVV(point repere du mode k = noeud j)=\alpha_k(t_l)
  150. DO 162 IP=1,N
  151. c x_IP(t_l) = [ \alpha_1(t_l) ... \alpha_kmax(t_l) ]^T
  152. c * [ \phi_1(x_IP) ... \phi_kmax((x_IP) ]
  153. CALL PROSC1(TRAVV,TRAV(1,IP),RET,LDEPL)
  154. MLREEL=KLIST(IP)
  155. PROG(L)=RET
  156. 162 CONTINUE
  157. 90 CONTINUE
  158. C
  159. C ---------------------------------------------------------------------
  160. c SUPPRESSION ET FERMETURE DES SEGMENTS
  161. C ---------------------------------------------------------------------
  162. C
  163. SEGSUP ITRAV
  164. SEGSUP IPOS
  165. SEGSUP ITRAV1,ITRAV2
  166. DO 98 JJ=1,N
  167. MLREEL=KLIST(JJ)
  168. SEGDES MLREEL
  169. 98 CONTINUE
  170. C
  171. SEGDES MLENTI
  172. 5000 CONTINUE
  173. RETURN
  174. END
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  

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