Télécharger evol22.eso

Retour à la liste

Numérotation des lignes :

  1. C EVOL22 SOURCE CHAT 05/01/12 23:47:08 5004
  2. SUBROUTINE EVOL22(IBOO,ILEX,IBOBAS,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 DESCONTRIBUTIONS MODALES.
  7. CPOUR LES COUPLES POINTS COMPOSANTES CONTENUS DANS NUMOO,
  8. C ON RECOMBINE LES MODES CONTENUS DANS
  9. C UNE TABLE RESULTAT DE TRADUIRE
  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:12/10/89
  14. C PROGRAMMEUR:LENA
  15. C=======================================================================
  16. C
  17. -INC CCOPTIO
  18. -INC SMCHPOI
  19. -INC SMLREEL
  20. -INC SMLENTI
  21. -INC SMELEME
  22. -INC SMTABLE
  23. -INC SMCOORD
  24. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  25. SEGMENT ICPR1(XCOOR(/1)/(IDIM+1))
  26. SEGMENT/ITRAV1/(TRAV(LDEPL,N)*D)
  27. SEGMENT/ITRAV2/(TRAVV(LDEPL)*D)
  28. SEGMENT/ITRAV3/(ICC(N),ISS(N),IPP(N),NBB(N))
  29. SEGMENT IPOS(NSOUP1)
  30. SEGMENT ITRAV(2,LDEPL)
  31. SEGMENT NUMOO
  32. INTEGER NUMO(N),KLIST(N)
  33. CHARACTER*4 NUDDL(N)
  34. ENDSEGMENT
  35. DIMENSION IMEL(2)
  36. CHARACTER*4 NUJ
  37. CHARACTER*8 IBASMO
  38. DATA IBASMO/'BASE-MOD'/
  39. C
  40. LDEPL=0
  41. NUMOO=IBOO
  42. SEGACT NUMOO*MOD
  43. N=NUMO(/1)
  44. C MLENT1=LISTE DES P.DEFMODALES,MLENT2 = LISTE DES P.POINTS REPERES
  45. MLENT1=ILEN1
  46. MLENT2=ILEN2
  47. SEGACT MLENT1,MLENT2
  48. MTAB1=IBOBAS
  49. SEGACT MTAB1
  50. ITOTO=1
  51. IMEL(1)=0
  52. IMEL(1)=MLENT2.LECT(1)
  53. LDEPL=MLENT1.LECT(/1)
  54. SEGDES MTAB1
  55. LICPR=XCOOR(/1)/(IDIM+1)
  56. SEGINI ICPR,ICPR1
  57. C
  58. JJJ=0
  59. SEGINI ITRAV1
  60. SEGINI ITRAV3
  61. KK=0
  62. DO 61 I=1,N
  63. KK=KK+1
  64. C ICC(KK)=IC
  65. IPP(KK)=I
  66. 61 CONTINUE
  67.  
  68. C ***** ON REPART SUR LES MODES
  69. LDEP=MLENT1.LECT(/1)
  70. DO 40 I=1,LDEP
  71. JJJ=JJJ+1
  72. NUMPP=MLENT2.LECT(I)
  73. C ICPR1(NUM(1,I))=JJJ
  74. ICPR1(NUMPP)=JJJ
  75.  
  76. C **** FABRICATION DU TABLEAU TRAV(LDEPL,N) DES MODES REDUITS AUX
  77. C **** POINTS DE SORTIE (BOUCLE 40)
  78.  
  79. ichp=MLENT1.LECT(I)
  80. DO 41 IP=1,N
  81. mpoint=numo(ip)
  82. NUJ=NUDDL(IP)
  83. call EXTRA9(ICHP,MPOINT,nuj,KERRE,XFLOT)
  84. TRAV(JJJ,IPP(IP))=xflot
  85. 41 continue
  86.  
  87. 40 CONTINUE
  88. SEGSUP ITRAV3
  89. SEGSUP ICPR
  90. C
  91. C **** FABRICATION DEITRAV(2,LDEPL),ET DE IPOS(NSOUP+1)
  92. C
  93. MLENTI=ILEX
  94. SEGACT MLENTI
  95. MCHPOI=LECT(1)
  96. SEGACT MCHPOI
  97. NSOUP=IPCHP(/1)
  98. NSOUP1=NSOUP+1
  99. SEGINI IPOS
  100. SEGINI ITRAV
  101. KK=0
  102. IPOS(1)=0
  103. DO 1 ISOU=1,NSOUP
  104. MSOUPO=IPCHP(ISOU)
  105. SEGACT MSOUPO
  106. MELEME=IGEOC
  107. SEGACT MELEME
  108. DO 2 I=1,NUM(/2)
  109. J=ICPR1(NUM(1,I))
  110. IF (J.NE.0) THEN
  111. KK=KK+1
  112. ITRAV(1,KK)=I
  113. ITRAV(2,KK)=J
  114. ENDIF
  115. 2 CONTINUE
  116. SEGDES MELEME,MSOUPO
  117. IPOS(ISOU+1)=KK
  118. 1 CONTINUE
  119. SEGSUP ICPR1
  120. C
  121. C **** BOUCLE SUR LES INSTANTS DE LA TABLE
  122. C
  123. MLENTI=ILEX
  124. SEGACT MLENTI
  125. LTEM=LECT(/1)
  126. JG=LTEM
  127. DO 99 JJ=1,N
  128. SEGINI MLREEL
  129. KLIST(JJ)=MLREEL
  130. 99 CONTINUE
  131. C
  132. SEGINIITRAV2
  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. SEGDESMPOVAL,MSOUPO
  146. ENDIF
  147. 70 CONTINUE
  148. SEGDES MCHPOI
  149. DO 162 IP=1,N
  150. CALL PROSC1(TRAVV,TRAV(1,IP),RET,LDEPL)
  151. MLREEL=KLIST(IP)
  152. PROG(L)=RET
  153. 162 CONTINUE
  154. 90 CONTINUE
  155. C
  156. SEGSUP ITRAV
  157. SEGSUP IPOS
  158. SEGSUP ITRAV1,ITRAV2
  159. DO 98 JJ=1,N
  160. MLREEL=KLIST(JJ)
  161. SEGDES MLREEL
  162. 98 CONTINUE
  163. C
  164. SEGDES MLENTI
  165. 5000 CONTINUE
  166. RETURN
  167. END
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  

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