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

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