Télécharger probas.eso

Retour à la liste

Numérotation des lignes :

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

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