Télécharger react1.eso

Retour à la liste

Numérotation des lignes :

  1. C REACT1 SOURCE PV 13/04/16 21:15:23 7765
  2. SUBROUTINE REACT1(MRIGID,MCHPOI,MCHPO1)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. -INC SMRIGID
  6. -INC SMELEME
  7. -INC SMCHPOI
  8. -INC CCOPTIO
  9. CHARACTER*72 CTEXT
  10. SEGMENT IGARD(NNOL)
  11. C
  12. C ** ON VERIFIE QUE LE CHPOINT CONTIENT DES MULTIPLICATEURS
  13. C ** EN LEUR ABSENCE ON CREE UN CHPOINT VIDE
  14. C
  15. SEGACT MCHPOI
  16. CTEXT = MOCHDE
  17. ITRUC = IFOPOI
  18. DO 500 K=1,IPCHP(/1)
  19. MSOUPO=IPCHP(K)
  20. SEGACT MSOUPO
  21. DO 501 J=1,NOCOMP(/2)
  22. IF(NOCOMP(J).EQ.'LX ') GO TO 502
  23. 501 CONTINUE
  24. SEGDES MSOUPO
  25. 500 CONTINUE
  26. SEGDES MCHPOI
  27. GO TO 288
  28. *
  29. 502 CONTINUE
  30. C DANS UN CHPOINT IL NE PEUT Y AVOIR Q'UNE SEULE PARTIE QUI CONTIENT
  31. C DES MULTIPLICATEURS , ON CREE UN CHPOIN LE CONTENANT
  32. SEGDES MSOUPO
  33. SEGDES MCHPOI
  34. NSOUPO=1
  35. NAT=1
  36. SEGINI MCHPOI
  37. JATTRI(1)=2
  38. IPCHP(1)=MSOUPO
  39. SEGDES MCHPOI
  40. C
  41. C ** TERMINE POUR LE CHPOINT ON PASSE A LA RIGIDITE . ON VEUT
  42. C ** MAINTENANT FABRIQUER UN OBJET RIGIDITE CONTENANT UNIQUEMENT
  43. C ** LES MATRICES DE BLOQUAGE.
  44. C
  45. NRIGEL=0
  46. SEGACT MRIGID
  47. NNR=IRIGEL(/2)
  48. C
  49. C ** BOUCLE 1 SUR LES SOUS OBJETS RIGIDITES POUR COMPTER COMBIEN
  50. C ** DE MATRICES DE BLOQUAGES
  51. C
  52. DO 1 I=1,NNR
  53. DESCR= IRIGEL(3,I)
  54. SEGACT DESCR
  55. NINC=LISINC(/2)
  56. DO 2 J = 1,NINC
  57. IF(LISINC(J).EQ.'LX ') GO TO 3
  58. 2 CONTINUE
  59. SEGDES DESCR
  60. GO TO 1
  61. 3 CONTINUE
  62. NRIGEL=NRIGEL+1
  63. SEGDES DESCR
  64. 1 CONTINUE
  65. C
  66. C ** INITIALISATION DE L'OBJET RIGIDITE
  67. C
  68. IF(NRIGEL.NE.0) GO TO 4
  69. C
  70. C SI RIGIDITE VIDE , ON CREE UN CHPOINT VIDE
  71. C
  72. SEGSUP MCHPOI
  73. SEGDES MRIGID
  74. 288 NSOUPO=0
  75. NAT=1
  76. SEGINI MCHPO1
  77. MCHPO1.JATTRI(1)=2
  78. MCHPO1.IFOPOI=ITRUC
  79. MCHPO1.MOCHDE=CTEXT
  80. MCHPO1.MTYPOI=' '
  81. SEGDES MCHPO1
  82. RETURN
  83. C
  84. 4 CONTINUE
  85. IA=1
  86. NRIGE= IRIGEL(/1)
  87. SEGINI RI1
  88. DO 10 I=1,NNR
  89. DESCR= IRIGEL(3,I)
  90. SEGACT DESCR
  91. NINC=LISINC(/2)
  92. DO 20 J = 1,NINC
  93. IF(LISINC(J).EQ.'LX ') GO TO 30
  94. 20 CONTINUE
  95. SEGDES DESCR
  96. GO TO 10
  97. 30 CONTINUE
  98. DO 31 L=1,NRIGE
  99. RI1.IRIGEL(L,IA)=IRIGEL(L,I)
  100. 31 CONTINUE
  101. RI1.COERIG(IA)=-COERIG(I)
  102. IA=IA+1
  103. SEGDES DESCR
  104. 10 CONTINUE
  105. SEGDES MRIGID,RI1
  106. CALL MUCPRI(MCHPOI,RI1,IRET)
  107. C
  108. C ** IL FAUT ENLEVER DU CHPOINT LA PARTIE CONCERNANT FLX
  109. C
  110. C ** ON VERIFIE AU PREALABLE QU'IL N'Y A PAS DE MULTIPLICATEURS
  111. C ** DE MULTIPLICATEUR
  112. C
  113. SEGACT RI1
  114. INON=1
  115. DO 40 I=1,RI1.IRIGEL(/2)
  116. DESCR=RI1.IRIGEL(3,I)
  117. SEGACT DESCR
  118. DO 41 J=3,LISINC(/2)
  119. IF( LISINC(J).EQ.'LX ') THEN
  120. INON=0
  121. SEGDES DESCR
  122. GO TO 45
  123. ENDIF
  124. 41 CONTINUE
  125. SEGDES DESCR
  126. 40 CONTINUE
  127. 45 CONTINUE
  128. MCHPOI=IRET
  129. SEGACT MCHPOI
  130. NSOUPO=IPCHP(/1) -INON
  131. NAT=1
  132. SEGINI MCHPO1
  133. MCHPO1.IFOPOI=ITRUC
  134. MCHPO1.MOCHDE=CTEXT
  135. MCHPO1.MTYPOI=' '
  136. MCHPO1.JATTRI(1)=2
  137. IA=1
  138. DO 60 I=1,NSOUPO+INON
  139. MSOUPO=IPCHP(I)
  140. SEGACT MSOUPO
  141. IF(NOCOMP(1).EQ.'FLX ') THEN
  142. IF(INON.EQ.0) THEN
  143. MELEME=IGEOC
  144. SEGACT MELEME
  145. NNOL=NUM(/2)
  146. SEGINI IGARD
  147. DO 61 J=1,RI1.IRIGEL(/2)
  148. DESCR= RI1.IRIGEL(3,J)
  149. SEGACT DESCR
  150. DO 62 K=3,LISINC(/2)
  151. IF(LISINC(K).EQ.'LX ') THEN
  152. IPT1=RI1.IRIGEL(1,J)
  153. SEGACT IPT1
  154. DO 63 L=1,IPT1.NUM(/2)
  155. IP=IPT1.NUM(NOELEP(K),L)
  156. DO 64 M=1,NNOL
  157. IF( NUM(1,M).EQ.IP) THEN
  158. IGARD(M)=1
  159. GO TO 63
  160. ENDIF
  161. 64 CONTINUE
  162. 63 CONTINUE
  163. SEGDES IPT1
  164. ENDIF
  165. 62 CONTINUE
  166. SEGDES DESCR
  167. 61 CONTINUE
  168. NBELEM=0
  169. DO 65 J=1,NNOL
  170. NBELEM=NBELEM+IGARD(J)
  171. 65 CONTINUE
  172. NBNN=1
  173. NBSOUS=0
  174. NBREF=0
  175. SEGINI IPT2
  176. IGEOC=IPT2
  177. IB=1
  178. N=NBELEM
  179. NC=1
  180. SEGINI MPOVA1
  181. MPOVAL=IPOVAL
  182. SEGACT MPOVAL
  183. DO 66 J=1,NNOL
  184. IF(IGARD(J).EQ.0) GO TO 66
  185. IPT2.NUM(1,IB)=NUM(1,J)
  186. MPOVA1.VPOCHA(IB,1)=VPOCHA(J,1)
  187. IB=IB+1
  188. 66 CONTINUE
  189. SEGSUP MPOVAL
  190. IPOVAL=MPOVA1
  191. call crech1(ipt2,1)
  192. SEGDES MSOUPO,IPT2,MPOVA1
  193. MCHPO1.IPCHP(IA)=MSOUPO
  194. IA=IA+1
  195. SEGSUP IGARD
  196. ELSE
  197. MELEME=IGEOC
  198. MPOVAL=IPOVAL
  199. SEGSUP MPOVAL,MSOUPO
  200. ENDIF
  201. ELSE
  202. SEGDES MSOUPO
  203. MCHPO1.IPCHP(IA)=MSOUPO
  204. IA=IA+1
  205. ENDIF
  206. 60 CONTINUE
  207. NSOUPO=IA-1
  208. SEGADJ MCHPO1
  209. SEGDES MCHPO1
  210. SEGSUP MCHPOI,RI1
  211. RETURN
  212. END
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  

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