Télécharger dyn204.eso

Retour à la liste

Numérotation des lignes :

  1. C DYN204 SOURCE CHAT 05/01/12 23:10:37 5004
  2. SUBROUTINE DYN204(I,ITLB,ITYP,KTLIAB,NPLB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * Remplissage des tableaux de description des liaisons sur *
  11. * la base @ partir des informations contenues dans la *
  12. * table ITLB (liaison de type PROFIL_PROFIL_...) *
  13. * Liaison PROFIL_PROFIL_INTERIEUR *
  14. * Liaison PROFIL_PROFIL_EXTERIEUR *
  15. * *
  16. * Param}tres: *
  17. * *
  18. * e I Num{ro de la liaison. *
  19. * e ITLB Table rassemblant la description d'une liaison. *
  20. * e ITYP Type de la liaison. *
  21. * s KTLIAB Segment descriptif des liaisons sur base B. *
  22. * e NPLB Nombre total de points. *
  23. * *
  24. * *
  25. * Auteur, date de cr{ation: *
  26. * *
  27. * Lionel VIVAN, le 1 f{vrier 1991. *
  28. * *
  29. *--------------------------------------------------------------------*
  30. -INC CCOPTIO
  31. -INC SMCOORD
  32. -INC SMELEME
  33. *
  34. SEGMENT MTLIAB
  35. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  36. REAL*8 XPALB(NLIAB,NXPALB)
  37. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  38. ENDSEGMENT
  39. *
  40. LOGICAL L1,L0
  41. *
  42. MTLIAB = KTLIAB
  43. NLIAB = XPALB(/1)
  44. *
  45. * --- choc {l{mentaire PROFIL_PROFIL_INTERIEUR
  46. * --- choc {l{mentaire PROFIL_PROFIL_EXTERIEUR
  47. *
  48. IF (ITYP.EQ.31 .OR. ITYP.EQ.32) THEN
  49. CALL ACCTAB(ITLB,'MOT',I0,X0,'PROFIL_FIXE',L0,IP0,
  50. & 'MAILLAGE',I1,X1,' ',L1,IMA1)
  51. IF (IERR.NE.0) RETURN
  52. CALL ACCTAB(ITLB,'MOT',I0,X0,'PROFIL_MOBILE',L0,IP0,
  53. & 'MAILLAGE',I1,X1,' ',L1,IMA2)
  54. IF (IERR.NE.0) RETURN
  55. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  56. & 'POINT',I1,X1,' ',L1,INOR)
  57. IF (IERR.NE.0) RETURN
  58. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  59. & 'FLOTTANT',I0,XRAID,' ',L1,IP1)
  60. IF (IERR.NE.0) RETURN
  61. CALL ACCTAB(ITLB,'MOT',I1,X0,'SUPPORT',L0,IP0,
  62. & 'POINT',I0,X1,' ',L1,ISUP)
  63. IF (IERR.NE.0) RETURN
  64. CALL ACCTAB(ITLB,'MOT',I1,X0,'EXPOSANT_RAIDEUR',L0,IP0,
  65. & 'FLOTTANT',I0,XPUIS,' ',L1,IP1)
  66. IF (IERR.NE.0) RETURN
  67. *
  68. IPALB(I,1) = ITYP
  69. IPALB(I,3) = IDIM
  70. XPALB(I,1) = XRAID
  71. XPALB(I,3) = XPUIS
  72. ID1 = 3
  73. IP1 = 5
  74. *
  75. * le maillage IMA1 est en {l{ment de type POI1
  76. MELEME = IMA1
  77. SEGACT MELEME
  78. NOMBN1 = NUM(/2)
  79. IPALB(I,4) = NOMBN1
  80. IDP = ID1 + 5*IDIM
  81. DO 12 IE = 1,NOMBN1
  82. IPT = NUM(1,IE)
  83. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  84. DO 14 ID = 1,IDIM
  85. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  86. 14 CONTINUE
  87. * end do
  88. IDP = IDP + IDIM
  89. 12 CONTINUE
  90. * end do
  91. SEGDES MELEME
  92. *
  93. * le maillage IMA2 est en {l{ment de type POI1
  94. MELEME = IMA2
  95. SEGACT MELEME
  96. NOMBN2 = NUM(/2)
  97. IPALB(I,5) = NOMBN2
  98. DO 16 IE = 1,NOMBN2
  99. IPT = NUM(1,IE)
  100. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  101. DO 18 ID = 1,IDIM
  102. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  103. 18 CONTINUE
  104. * end do
  105. IDP = IDP + IDIM
  106. 16 CONTINUE
  107. * end do
  108. SEGDES MELEME
  109. CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP)
  110. IPLIB(I,1) = IPLAC
  111. *
  112. * cr{ation d'un rep}re orthonorm{ dans le plan des maillages
  113. * le point origine est le premier point de IMA1
  114. CALL DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1)
  115. IF (IERR.NE.0) RETURN
  116. *
  117. * coefficient des droites form{es par les {l{ments de IMA1
  118. CALL DYNE29(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  119. *
  120. * position initiale de IMA2 par rapport @ IMA1
  121. CALL DYNE30(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  122. *
  123. * calcul de la section du profil mobile
  124. CALL DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
  125. XPALB(I,2) = XSECT
  126. *
  127. * --- choc {l{mentaire PROFIL_...
  128. *
  129. * ELSE IF (ITYP.EQ. ) THEN
  130. * ...
  131. * ...
  132. ENDIF
  133. *
  134. END
  135.  
  136.  
  137.  

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