Télécharger ricroi.eso

Retour à la liste

Numérotation des lignes :

  1. C RICROI SOURCE CB215821 16/04/21 21:18:19 8920
  2. SUBROUTINE RICROI(modsta,ir2,irig)
  3. *--calcul termes croisés 'STATIQUE' et/ou 'MODAL'
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. -INC CCOPTIO
  7. -INC CCREEL
  8. -INC SMRIGID
  9. -INC SMCHAML
  10. -INC SMELEME
  11. -INC SMLMOTS
  12. -INC SMMODEL
  13. c
  14. segment modsta
  15. integer pimoda(nmoda),pistat(nstat)
  16. integer ivmoda(nmoda),ivstat(nstat)
  17. endsegment
  18. CHARACTER*4 lesinc(7),lesdua(7),mot2
  19. DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR'/
  20. DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR'/
  21.  
  22. ir2 = 0
  23. nstat = pistat(/1)
  24. nmoda = pimoda(/1)
  25.  
  26. jgn = 4
  27. jgm = 6
  28. segini mlmots
  29. iinc = mlmots
  30. do igm = 1,jgm
  31. mots(igm) = lesinc(igm)
  32. enddo
  33. segini mlmots
  34. idua = mlmots
  35. do igm= 1,jgm
  36. mots(igm) = lesdua(igm)
  37. enddo
  38.  
  39. nelrig = 100
  40. * 'STATIQUE'/'STATIQUE' : 1 * 'STATIQUE'/'MODAL' : 2
  41. nelri1 = nelrig
  42. nelri2 = nelrig
  43. kelri1 = 0
  44. kelri2 = 0
  45. nligrd = 2
  46. nligrp = 2
  47. segini xmatr1,xmatr2
  48. NBELEM = nelrig
  49. NBNN = 2
  50. NBSOUS = 0
  51. NBREF = 0
  52. SEGINI IPT1,IPT2
  53. IPT1.ITYPEL=27
  54. IPT2.ITYPEL=27
  55. NBELE1 = NELRI1
  56. NBELE2 = NELRI2
  57. *
  58. *
  59. DO is = 1,nstat
  60.  
  61. imodel = pistat(is)
  62. segact imodel
  63. ipt4 = imamod
  64. segact ipt4
  65. if (ipt4.num(/1).ne.1) call erreur(5)
  66. nbelem = ipt4.num(/2)
  67. * en principe on ne devrait pas trop boucler
  68. do ib = 1,nbelem
  69. if (nbelem.gt.1) then
  70. do ib1 = ib+1 , nbelem
  71. iv1 = ivstat(is)
  72. iv2 = ivstat(is)
  73. call ricro1(iv1,iv2,ib,ib1,'STAT',irig,iinc,idua,xr1)
  74. if (ABS(xr1).lt.xspeti) goto 21
  75. kelri1 = kelri1 + 1
  76. * segini xmatri
  77. xmatr1.re(2,1,kelri1) = xr1
  78. xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1)
  79. * imatr1.imattt(kelri1) = xmatri
  80. * cree segment ib- ib1
  81. ipt1.num(1,kelri1) = ipt4.num(1,ib)
  82. ipt1.num(2,kelri1) = ipt4.num(1,ib1)
  83. if (kelri1.eq.nelri1) then
  84. nelrig = nelri1 + 100
  85. nelri1 = nelrig
  86. segadj xmatr1
  87. nbelem = nelrig
  88. segadj ipt1
  89. NBELE1 = NELRI1
  90. endif
  91. 21 continue
  92. enddo
  93. endif
  94.  
  95.  
  96. IF (IS.LT.NSTAT) THEN
  97. DO is2 = is + 1 ,nstat
  98. imode2 = pistat(is2)
  99. segact imode2
  100. ipt5 = imode2.imamod
  101. segact ipt5
  102. if (ipt5.num(/1).ne.1) call erreur(6)
  103. nbele2 = ipt5.num(/2)
  104. do ib2 = 1,nbele2
  105. iv1 = ivstat(is)
  106. iv2 = ivstat(is2)
  107. call ricro1(iv1,iv2,ib,ib2,'STAT',irig,iinc,idua,xr1)
  108. if (ABS(xr1).lt.xspeti) goto 22
  109. kelri1 = kelri1 + 1
  110. * segini xmatri
  111. xmatr1.re(2,1,kelri1) = xr1
  112. xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1)
  113. * imatr1.imattt(kelri1) = xmatri
  114. * cree segment ib- ib2
  115. ipt1.num(1,kelri1) = ipt4.num(1,ib)
  116. ipt1.num(2,kelri1) = ipt5.num(1,ib2)
  117. if (kelri1.eq.nelri1) then
  118. nelrig = nelri1 + 100
  119. nelri1 = nelrig
  120. segadj xmatr1
  121. nbelem = nelrig
  122. segadj ipt1
  123. NBELE1 = NELRI1
  124. endif
  125. 22 continue
  126. enddo
  127. segdes ipt5,imode2
  128. ENDDO
  129. ENDIF
  130.  
  131. *
  132.  
  133. DO im = 1, nmoda
  134. imode1 = pimoda(im)
  135. segact imode1
  136. ipt3 = imode1.imamod
  137. segact ipt3
  138. if (ipt3.num(/1).ne.1) call erreur(7)
  139. nbele3 = ipt3.num(/2)
  140. do ib3 = 1,nbele3
  141. iv1 = ivstat(is)
  142. iv2 = ivmoda(im)
  143. call ricro1(iv1,iv2,ib,ib3,'MODA',irig,iinc,idua,xr1)
  144. if (ABS(xr1).lt.xspeti) goto 23
  145. kelri2 = kelri2 + 1
  146. * segini xmatri
  147. xmatr2.re(2,1,kelri2) = xr1
  148. xmatr2.re(1,2,kelri2) = xmatr2.re(2,1,kelri2)
  149. * imatr2.imattt(kelri2) = xmatri
  150. * cree segment ib- ib3
  151. ipt2.num(1,kelri2) = ipt3.num(1,ib3)
  152. ipt2.num(2,kelri2) = ipt4.num(1,ib)
  153. if (kelri2.eq.nelri2) then
  154. nelrig = nelri2 + 100
  155. nelri2 = nelrig
  156. segadj xmatr2
  157. nbelem = nelrig
  158. segadj ipt2
  159. NBELE2 = NELRI2
  160. endif
  161. 23 continue
  162. enddo
  163. segdes ipt3,imode1
  164.  
  165. ENDDO
  166. enddo
  167.  
  168. segdes ipt4,imodel
  169. ENDDO
  170.  
  171. 100 continue
  172. NRIGE = 8
  173. NRIGEL = 1
  174. irstat = 0
  175. irmoda = 0
  176. if (nstat.gt.1) then
  177. nbelem = kelri1
  178. SEGADJ IPT1
  179. NELRIG=NBELEM
  180. SEGADJ xMATR1
  181. SEGINI DESCR
  182. NOELEP(1)=1
  183. NOELEP(2)=2
  184. NOELED(1)=1
  185. NOELED(2)=2
  186. LISINC(1)='BETA'
  187. LISINC(2)='BETA'
  188. LISDUA(1)='FBET'
  189. LISDUA(2)='FBET'
  190. SEGDES DESCR
  191. segini mrigid
  192. irstat = mrigid
  193. irigel(1,1) = ipt1
  194. irigel(3,1) = descr
  195. IRIGEL(4,1) = xMATR1
  196. IFORIG = IFOMOD
  197. COERIG(1) = 1.D0
  198. IMGEO1 = 0
  199. IMGEO2 = 0
  200. ICHOLE = 0
  201. ISUPEQ = 0
  202. if (irig.eq.1) then
  203. MTYMAT = 'MASSE '
  204. elseif (irig.eq.2) then
  205. MTYMAT = 'RIGIDITE'
  206. elseif (irig.eq.3) then
  207. MTYMAT = 'AMORTISS'
  208. endif
  209. *
  210. IRIGEL(2,1) = 0
  211. IRIGEL(5,1) = NIFOUR
  212. IRIGEL(6,1) = 0
  213. endif
  214.  
  215. if (nmoda.gt.0) then
  216. nbelem = kelri2
  217. SEGADJ IPT2
  218. NELRIG=NBELEM
  219. SEGADJ xMATR2
  220. SEGINI DESCR
  221. NOELEP(1)=1
  222. NOELEP(2)=2
  223. NOELED(1)=1
  224. NOELED(2)=2
  225. LISINC(1)='ALFA'
  226. LISINC(2)='BETA'
  227. LISDUA(1)='FALF'
  228. LISDUA(2)='FBET'
  229. SEGDES DESCR
  230. segini mrigid
  231. irmoda = mrigid
  232. irigel(1,1) = ipt2
  233. irigel(3,1) = descr
  234. IRIGEL(4,1) = xMATR2
  235. IFORIG = IFOMOD
  236. COERIG(1) = 1.D0
  237. IMGEO1 = 0
  238. IMGEO2 = 0
  239. ICHOLE = 0
  240. ISUPEQ = 0
  241. if (irig.eq.1) then
  242. MTYMAT = 'MASSE '
  243. elseif (irig.eq.2) then
  244. MTYMAT = 'RIGIDITE'
  245. endif
  246. *
  247. IRIGEL(2,1) = 0
  248. IRIGEL(5,1) = NIFOUR
  249. IRIGEL(6,1) = 0
  250. endif
  251.  
  252. if (irmoda.eq.0) then
  253. ir2 = irstat
  254. else if (irstat.eq.0) then
  255. ir2 = irmoda
  256. else
  257. call fusrig(irstat,irmoda, ir2)
  258. endif
  259.  
  260. mlmots = iinc
  261. segsup mlmots
  262. mlmots = idua
  263. segsup mlmots
  264.  
  265. RETURN
  266. END
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  

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