Télécharger evrec6.eso

Retour à la liste

Numérotation des lignes :

evrec6
  1. C EVREC6 SOURCE CB215821 20/11/25 13:28:19 10792
  2. SUBROUTINE EVREC6(itap,ipmode,ipcha1,mcha,nomco,ctype,iptu,ipevo)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8. -INC SMEVOLL
  9. -INC SMCHPOI
  10. -INC SMELEME
  11. -INC SMMODEL
  12. -INC SMTABLE
  13. -INC SMCHAML
  14. -INC SMLENTI
  15. -INC SMLREEL
  16. LOGICAL L0,LVAR,dix
  17. CHARACTER*8 CTYPE,ITYP1,CTYP,TYPRET,CHARRE
  18. CHARACTER*72 TI,MCHA,NOMCO
  19. CHARACTER*4 CMOT
  20.  
  21.  
  22. TYPRET = ' '
  23. CALL ACCTAB(ITAP,'MOT',I0,X0,'TEMPS',
  24. & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IPTEM)
  25.  
  26. if (mcha(1:4).eq.'DEPL') then
  27. TYPRET = ' '
  28. CALL ACCTAB(ITAP,'MOT',I0,X0,'DEPLACEMENTS',
  29. & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IP1)
  30. else if (mcha(1:4).eq.'VITE') then
  31. TYPRET = ' '
  32. CALL ACCTAB(ITAP,'MOT',I0,X0,'VITESSES',
  33. & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IP1)
  34. else if (mcha(1:4).eq.'ACCE') then
  35. TYPRET = ' '
  36. CALL ACCTAB(ITAP,'MOT',I0,X0,'ACCELERATIONS',
  37. & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IP1)
  38. else if (mcha(1:4).eq.'REAC') then
  39. TYPRET = ' '
  40. CALL ACCTAB(ITAP,'MOT',I0,X0,'REACTIONS',
  41. & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IP1)
  42. else if (mcha(1:4).eq.'CONT') then
  43. TYPRET = ' '
  44. CALL ACCTAB(ITAP,'MOT',I0,X0,'CONTRAINTES',
  45. & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IP1)
  46. else
  47. endif
  48.  
  49. IPX=0
  50. ITOUS=0
  51. ILX=0
  52. dix = .false.
  53. CALL LIROBJ('LISTREEL',IPX,0,IRETOU)
  54. IF(IRETOU.EQ.0) CALL LIROBJ('LISTENTI',ILX,0,IRETOU)
  55. IF(IRETOU.EQ.0) dix = .true.
  56. if (ilx.gt.0) then
  57. mlent3 = ilx
  58. segact mlent3
  59. endif
  60. if (ipx.gt.0) then
  61. mlree3 =ipx
  62. segact mlree3
  63. endif
  64. kix = 1
  65.  
  66. call dimen7(iptem, ntemps)
  67. CALL ACCTAB(IPTEM,'ENTIER',(ntemps - 1),X0,ITYP1,
  68. & L0,IP0,'FLOTTANT',I1,XTM,CHARRE,LVAR,IP2)
  69. if (dix) then
  70. jg = ntemps
  71. else if (ipx.gt.0) then
  72. jg = mlree3.prog(/1)
  73. elseif (ilx.gt.0) then
  74. jg = mlent3.lect(/1)
  75. endif
  76. segini mlree1
  77. jg0 = jg
  78.  
  79. IF (CTYPE.EQ.'POINT ') THEN
  80. JG=1
  81. N = JG
  82. SEGINI MLENTI,mlent1
  83. LECT(1)=IPTU
  84. jg = jg0
  85. segini mlreel
  86. mlent1.lect(1) = mlreel
  87. *
  88. ELSE IF (CTYPE.EQ.'MAILLAGE') THEN
  89. MELEME= IPTU
  90. SEGACT MELEME
  91. IF(ITYPEL.NE.1) CALL CHANGE (IRET,1)
  92. segdes meleme
  93. MELEME=IRET
  94. SEGACT MELEME
  95. JG=NUM(/2)
  96. N = JG
  97. SEGINI MLENTI,mlent1
  98. DO 10 I=1,JG
  99. LECT(I)=NUM(1,I)
  100. jg = jg0
  101. segini mlreel
  102. mlent1.lect(i) = mlreel
  103. 10 CONTINUE
  104. SEGSUP MELEME
  105. ELSE
  106. * cas vits
  107. call erreur(5)
  108. ENDIF
  109.  
  110. kite = 0
  111. do ite = 0,(ntemps - 1)
  112. if (ilx.gt.0) then
  113. do jko = kix, mlent3.lect(/1)
  114. if (mlent3.lect(jko).eq.ite) then
  115. kix = jko
  116. dix = .true.
  117. goto 30
  118. endif
  119. enddo
  120. endif
  121. CALL ACCTAB(IPTEM,'ENTIER',ite,X0,ITYP1,
  122. & L0,IP0,'FLOTTANT',I1,XT1,CHARRE,LVAR,IP2)
  123. if (ipx.gt.0) then
  124. if (kix.le.mlree3.prog(/1)) then
  125. do jko = kix, mlree3.prog(/1)
  126. c write(6,*) mlree3.prog(jko), xt1, 1.e-6*xtm,
  127. c &(ABS(mlree3.prog(jko) - xt1).le.1.e-6*xtm)
  128. if (ABS(mlree3.prog(jko) - xt1).le.1.e-6*xtm) then
  129. kix = jko + 1
  130. dix = .true.
  131. goto 30
  132. endif
  133. enddo
  134. endif
  135. endif
  136.  
  137. 30 if (dix) then
  138. kite = kite + 1
  139. CALL ACCTAB(IP1,'ENTIER',ite,X0,ITYP1,
  140. & L0,IP0,'CHPOINT',I1,X1,CHARRE,LVAR,IPCH1)
  141. * recombinaison
  142. call recof2(ipmode,ipcha1,ipch1,ipch2)
  143.  
  144. DO 41 IP=1,lect(/1)
  145. mpoint=lect(ip)
  146. CMOT=nomco(1:4)
  147. call EXTRA9(IPCH2,MPOINT,cmot,0,.FALSE.,XFLOT,IRET)
  148. mlreel = mlent1.lect(ip)
  149. prog(kite)=xflot
  150. 41 continue
  151.  
  152. mchpo2 = ipch2
  153. segsup mchpo2
  154.  
  155. mlree1.prog(kite) = XT1
  156. endif
  157. if (ipx.gt.0.or.ilx.gt.0) dix = .false.
  158. enddo
  159.  
  160. if (kite.gt.0) then
  161. segini mevoll
  162. ipevo = mevoll
  163. ityevo = 'REEL'
  164. ievtex(1:14) = 'RECOMBINAISON '
  165. ievtex(15:23) = nomco(1:8)
  166. do jv = 1,N
  167. segini kevoll
  168. ievoll(jv) = kevoll
  169. iprogx = mlree1
  170. iprogy = mlent1.lect(jv)
  171. numevx = jv
  172. typx = 'LISTREEL'
  173. typy= 'LISTREEL'
  174. nomevx = 'TEMPS'
  175. nomevy = nomco(1:12)
  176. segdes kevoll
  177.  
  178. enddo
  179. segdes mevoll
  180. else
  181. ipevo = 0
  182. endif
  183.  
  184. RETURN
  185. END
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  

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