Télécharger probas.eso

Retour à la liste

Numérotation des lignes :

  1. C PROBAS SOURCE GOUNAND 14/05/28 21:15:15 8056
  2. SUBROUTINE PROBAS(IRIIN,itmod,IRIOUT)
  3. IMPLICIT REAL*8(a-h,o-z)
  4. IMPLICIT INTEGER(I-N)
  5. CHARACTER*4 motinc,motddl
  6. -INC SMCOORD
  7. -INC CCOPTIO
  8. -INC SMTABLE
  9. -INC SMRIGID
  10. -INC SMELEME
  11. PARAMETER(ZERO=0.D0)
  12. segment icpr(xcoor(/1)/(idim + 1))
  13.  
  14. MRIGID = IRIIN
  15. mtable = itmod
  16. segact mtable
  17. im1 = mlotab
  18. ima = mlotab - 1
  19. * pour chaque noeud implique dans une liason on fait intervenir toutes
  20. * les solutions statiques associées
  21. *
  22. * on les recense donc
  23. segini icpr
  24. do im = 1,ima
  25. CALL ACCTAB(ITMOD,'ENTIER',IM,X0,' ',.true.,IP0,
  26. & 'TABLE',I1,X1,' ',.true.,ITAB2)
  27. CALL ACCTAB(ITAB2,'MOT',I0,X0,'POINT_LIAISON',.true.,IP0,
  28. & 'POINT',I1,X1,' ',.true.,IPL1)
  29. icpr(ipl1) = icpr(ipl1) + 1
  30. enddo
  31.  
  32. KRIGEL = 0
  33. segact mrigid
  34. nrigel = irigel(/2)
  35. nrige = irigel(/1)
  36. segini ri1
  37. ri1.mtymat = mtymat
  38. nrige0 = nrigel
  39.  
  40. kige = 0
  41. nrigel = kige
  42. segini ri2
  43. ri2.mtymat = mtymat
  44.  
  45. DO ire = 1,nrige0
  46. meleme = irigel (1,ire)
  47. segact meleme
  48. if (itypel.ne.22) then
  49. call erreur(977)
  50. return
  51. endif
  52. nbelem = num(/2)
  53. nbele0 = nbelem
  54. descr = irigel(3,ire)
  55. segact descr
  56. nligrp0 = noelep(/1)
  57. nligrd0 = noeled(/1)
  58. nligrp = nligrp0
  59. nligrd = nligrp
  60. segini des1
  61. des1.lisinc(1) = 'LX'
  62. des1.lisdua(1) = 'FLX'
  63. des1.noelep(1) = 1
  64. des1.noeled(1) = 1
  65. do ig =2,nligrp
  66. des1.lisinc(ig) = 'BETA'
  67. des1.lisdua(ig) = 'FBET'
  68. des1.noelep(ig) = ig
  69. des1.noeled(ig) = ig
  70. enddo
  71. segini,des2=des1
  72.  
  73. nbnn = nligrp0
  74. nbsous = 0
  75. nbref = 0
  76. segini ipt2
  77. ipt2.itypel = itypel
  78. nbelem = 1
  79. segini ipt1
  80. ipt1.itypel = itypel
  81. ri1.coerig(ire) = coerig(ire)
  82. kele = 0
  83.  
  84. DO iele = 1,nbele0
  85.  
  86. * le premier point correspond aux multiplicateurs
  87. CALL CREPO1 (ZERO, ZERO, ZERO, IPTS)
  88. ipt1.num(1,1) = ipts
  89. koel = 1
  90. do igrp = 2,nligrp0
  91. jno = noelep(igrp)
  92. motinc = lisinc(igrp)
  93. IP1 = num(jno,iele)
  94. do im = 1,ima
  95. CALL ACCTAB(ITMOD,'ENTIER',IM,X0,' ',.true.,IP0,
  96. & 'TABLE',I1,X1,' ',.true.,ITAB2)
  97. CALL ACCTAB(ITAB2,'MOT',I0,X0,'POINT_LIAISON',.true.,IP0,
  98. & 'POINT',I1,X1,' ',.true.,IPL1)
  99. CALL ACCTAB(ITAB2,'MOT',I0,X0,'DDL_LIAISON',.true.,IP0,
  100. & 'MOT',I1,X1,motddl,.true.,I1)
  101. if (motinc.eq.motddl.and.IPL1.eq.IP1) then
  102. CALL ACCTAB(ITAB2,'MOT',I0,X0,'POINT_REPERE',.true.,IP0,
  103. & 'POINT',I1,X1,' ',.true.,IPTS)
  104. ipt1.num(igrp,1) = ipts
  105. koel = koel + 1
  106. goto 16
  107. endif
  108. enddo
  109. c point-liaison et ddl non trouvés
  110. ipt1.num(igrp,1) = ip1
  111. des2.lisinc(igrp) = lisinc(igrp)
  112. des2.lisdua(igrp) = lisdua(igrp)
  113. des2.noelep(igrp) = noelep(igrp)
  114. des2.noeled(igrp) = noeled(igrp)
  115. *
  116. 16 continue
  117. enddo
  118. *
  119. c creation d'un irigel
  120. if (koel.ne.nligrp0) then
  121. c call erreur(978)
  122. c return
  123. kige = kige + 1
  124. nrigel = kige
  125. segadj ri2
  126. segini,ipt3=ipt1
  127. segini,des3=des2
  128. RI2.IRIGEL(1,kige) = IPT3
  129. RI2.IRIGEL(3,kige) = DES3
  130. RI2.IRIGEL(4,kige) = irigel(4,ire)
  131. RI2.IRIGEL(2,kige) = 0
  132. RI2.IRIGEL(5,kige) = irigel(5,ire)
  133. RI2.IRIGEL(6,kige) = irigel(6,ire)
  134. ri2.coerig(kige) = coerig(ire)
  135. do ig =2,nligrp
  136. des2.lisinc(ig) = 'BETA'
  137. des2.lisdua(ig) = 'FBET'
  138. des2.noelep(ig) = ig
  139. des2.noeled(ig) = ig
  140. enddo
  141. else
  142. * toutes les inconnues sont des BETA
  143. kele = kele + 1
  144. do ig = 1,nligrp0
  145. ipt2.num(ig,kele) = ipt1.num(ig,1)
  146. enddo
  147. endif
  148. ENDDO
  149.  
  150. nbelem = kele
  151. if (nbelem.gt.0) then
  152. segadj ipt2
  153. krigel = krigel + 1
  154. RI1.IRIGEL(1,krigel) = IPT2
  155. RI1.IRIGEL(3,krigel) = DES1
  156. RI1.IRIGEL(4,krigel) = irigel(4,ire)
  157. RI1.IRIGEL(2,krigel) = 0
  158. RI1.IRIGEL(5,krigel) = irigel(5,ire)
  159. RI1.IRIGEL(6,krigel) = irigel(6,ire)
  160. segdes des1, ipt2
  161. else
  162. segsup des1, ipt2
  163. endif
  164. segsup ipt1
  165. ENDDO
  166.  
  167. iriout = 0
  168. nrigel = krigel
  169. segadj ri1
  170. c WRITE(6,*) 'ri1', ri1.irigel(/2), ' ri2',ri2.irigel(/2)
  171. segdes mrigid,ri1,mtable,ri2
  172. if (kige.eq.0) segsup ri2
  173. if (krigel.eq.0) segsup ri1
  174. if (kige.gt.0.and.krigel.gt.0) then
  175. c WRITE(6,*) 'fus', ri1,ri2,kige,krigel
  176. call fusrig(ri1,ri2,iriout)
  177. segsup ri1, ri2
  178. return
  179. endif
  180. if (kige.gt.0) iriout = ri2
  181. if (krigel.gt.0) iriout = ri1
  182. if (iriout.eq.0) call erreur(-5)
  183. return
  184. END
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  

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