Télécharger react1.eso

Retour à la liste

Numérotation des lignes :

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

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