Télécharger idlia1.eso

Retour à la liste

Numérotation des lignes :

  1. C IDLIA1 SOURCE BP208322 14/09/15 21:16:39 8150
  2. SUBROUTINE IDLIA1(ipm,ipr,ipt)
  3.  
  4. c identifie les liaisons : point + ddl d'un objet rigidite
  5. c vis-à-vis d'un maillage
  6. c range dans une table
  7.  
  8. IMPLICIT REAL*8 (A-H,O-Z)
  9. IMPLICIT INTEGER(I-N)
  10.  
  11. -INC CCOPTIO
  12. -INC SMRIGID
  13. -INC SMTABLE
  14. -INC SMELEME
  15.  
  16. c on autorise les ddl mecanique + thermique + liquide
  17. c rem : on pourrait utiliser lnomdd de bdata sans les alfa, beta
  18. PARAMETER (NPRIN=15)
  19. CHARACTER*4 MOPRIN(NPRIN)
  20. DATA MOPRIN / 'UX ','UY ','UZ ','UR ','UT ',
  21. & 'RX ','RY ','RZ ','RT ','P ','PI ',
  22. & 'T ','RR ','TINF','TSUP'/
  23. CHARACTER*4 MOTINC
  24.  
  25. INTEGER lpilmo(NPRIN)
  26. segment pilmpoi(0)
  27.  
  28. c Recup des donnees d'entree + passage en POI1 du maillage entre
  29. meleme = ipm
  30. segact meleme
  31. if (itypel.ne.1) call change(ipm,1)
  32. meleme = ipm
  33. mrigid = ipr
  34. segact meleme,mrigid
  35.  
  36. c creation de la table de sortie d'indice IM
  37. CALL CRTABL(ipt)
  38. CALL ECCTAB(ipt,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0,
  39. & 'MOT',0,0.0D0,'LIAISONS_STATIQUES',.TRUE.,0)
  40. IM = 0
  41.  
  42. c creation segment local des noeuds par inconnue
  43. do l= 1,NPRIN
  44. segini pilmpoi
  45. lpilmo(l) = pilmpoi
  46. enddo
  47.  
  48. c---- boucle sur les rigidites elementaires ----------------------------
  49. nrigel = coerig(/1)
  50. DO 1 ire = 1,nrigel
  51. IPT1 = irigel(1,ire)
  52. segact ipt1
  53. c on va demarrer a leun=2 si multiplicateur LX en 1ere position
  54. leun = 1
  55. if (ipt1.itypel.eq.22) leun = 2
  56. nbelem = ipt1.num(/2)
  57. descr = irigel(3,ire)
  58. segact descr
  59. NLIGRP = noelep(/1)
  60. IF(IIMPI.GE.333) WRITE(IOIMP,*) 'IDLI: zone ',ire,leun
  61.  
  62. c ---- boucle sur les inconnues (primales) ---------------------
  63. DO 10 igrp = leun,NLIGRP
  64. MOTINC = lisinc(igrp)
  65. ino = noelep(igrp)
  66.  
  67. IF(IIMPI.GE.333) WRITE(IOIMP,*) 'IDLI: inconnue',igrp,MOTINC,ino
  68.  
  69. c recherche dans la liste l inconnue MOTINC
  70. do 11 l = 1,NPRIN
  71. if (MOTINC.eq.MOPRIN(l)) goto 12
  72. 11 continue
  73. c ici, on n'a pas trouve MOTINC
  74. c bp : soit on fait une erreur, soit on continue avec un avertissement
  75. c mais il ne faut pas s'arreter au milieu ...
  76. c MOTERR(1:4) = 'IDLI'
  77. c MOTERR(5:8) = MOTINC
  78. c CALL ERREUR(335)
  79. WRITE(IOIMP,*) 'IDLI: DDL NON TRAITE ', MOTINC
  80. goto 10
  81. c ici, on a trouve MOTINC --> l
  82. IF(IIMPI.GE.333) WRITE(IOIMP,*) 'IDLI: retrouvee en position',l
  83. 12 continue
  84. pilmpoi = lpilmo(l)
  85.  
  86. c ---- boucle sur les elements ----------------
  87. DO 20 iele = 1,nbelem
  88. IPOI = ipt1.num(ino,iele)
  89.  
  90. c recherche dans le maillage POI1 du noeud IPOI
  91. do 21 jn = 1,num(/2)
  92. if (IPOI.eq.num(1,jn)) goto 22
  93. 21 continue
  94. c ici, on n'a pas trouve IPOI :
  95. c on passe au noeud suivant sans mot dire
  96. goto 20
  97. c ici, on a trouve IPOI -> jn et MOTINC -> l
  98. 22 continue
  99. IF(IIMPI.GE.333) WRITE(IOIMP,*) 'IDLI: et noeud',IPOI,' en',jn
  100.  
  101. c IPOI a t'il deja ete vu pour l inconnue MOTINC(=l) ?
  102. do ip = 1,pilmpoi(/1)
  103. c si le couple IPOI + MOTINC deja vu => on ne retraite pas
  104. if (pilmpoi(ip).eq.IPOI) goto 10
  105. enddo
  106. pilmpoi(**) = IPOI
  107.  
  108. c on ecrit la table IPT . IM . POINT_LIAISON = IPOI
  109. c IPT . IM . DDL_LIAISON = MOTINC
  110. IM = IM + 1
  111. CALL CRTABL(iptab2)
  112. CALL ECCTAB(iptab2,'MOT',0,0.0D0,'POINT_LIAISON',.TRUE.,0,
  113. & 'POINT',0,0.0D0,' ',.TRUE.,IPOI)
  114. CALL ECCTAB(iptab2,'MOT',0,0.0D0,'DDL_LIAISON',.TRUE.,0,
  115. & 'MOT',0,0.0D0,MOTINC,.TRUE.,0)
  116. CALL ECCTAB(IPT,'ENTIER',IM,0.0D0,' ',.TRUE.,0,
  117. & 'TABLE',0,0.0D0,' ',.TRUE.,iptab2)
  118.  
  119.  
  120. 20 continue
  121. c ---- fin de boucle sur les elements ----------------
  122.  
  123. 10 continue
  124. c ---- fin de boucle sur les inconnues (primales) ---------------------
  125.  
  126. segdes ipt1,descr
  127.  
  128. 1 CONTINUE
  129. c---- fin de boucle sur les rigidites elementaires ---------------------
  130.  
  131. c suppression segment local avant de partir
  132. do io = 1,NPRIN
  133. pilmpoi = lpilmo(io)
  134. segsup pilmpoi
  135. enddo
  136.  
  137. RETURN
  138. END
  139.  
  140.  
  141.  
  142.  
  143.  

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