Télécharger dyna14.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNA14 SOURCE PV 09/09/11 21:18:02 6504
  2. SUBROUTINE DYNA14(ITREFR,KTLIAA)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * Remplissage du tableau contenant les parametres de liaison en *
  11. * cas de reprise (liaison POLYNOMIALE en base A) *
  12. * *
  13. * Parametres: *
  14. * *
  15. * ITREFR Table contenant les variables internes des liaisons *
  16. * sauvegardees dans la table de reprise *
  17. * KTLIAA Description des liaisons en base A *
  18. * *
  19. * Auteur, date de creation: *
  20. * *
  21. * Denis ROBERT-MOUGIN : le 14 mai 1992 *
  22. * *
  23. *--------------------------------------------------------------------*
  24. *
  25. -INC CCOPTIO
  26. -INC SMLENTI
  27. -INC SMTABLE
  28. -INC SMLREEL
  29. -INC SMCOORD
  30. *
  31. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  32. SEGMENT,MTLIAA
  33. INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  34. REAL*8 XPALA(NLIAA,NXPALA)
  35. ENDSEGMENT
  36. *
  37. LOGICAL L0,L1
  38. CHARACTER*(8) TYPIND
  39. *
  40. MTLIAA = KTLIAA
  41. NLIAA = XPALA(/1)
  42. IF (IIMPI.EQ.333) THEN
  43. WRITE(IOIMP,*)'Entree dans DYNA14'
  44. WRITE(IOIMP,*)'NLIAA = ',NLIAA
  45. ENDIF
  46. *
  47. * Boucle sur les liaisons en base A sauvegardees
  48. *
  49. IPOLY = 0
  50. DO 10 I = 1,NLIAA
  51. ITYP = IPALA(I,1)
  52. IF (IIMPI.EQ.333) THEN
  53. WRITE(IOIMP,*)'ITYP = ',ITYP,' I = ',I
  54. ENDIF
  55. IF (ITYP.EQ.6) THEN
  56. IPOLY = IPOLY + 1
  57. CALL ACCTAB(ITREFR,'ENTIER',IPOLY,X0,' ',L0,IP0,
  58. & 'TABLE',I1,X1,' ',L1,ITREFI)
  59. IF (IERR.NE.0) RETURN
  60. CALL ACCTAB(ITREFI,'MOT',I0,X0,'TYPE',L0,IP0,
  61. & 'ENTIER',ITYPR,X1,' ',L1,ITR)
  62. IF (IERR.NE.0) RETURN
  63. IF (ITYP.NE.ITYPR) THEN
  64. call erreur(21)
  65. RETURN
  66. ENDIF
  67. *
  68. * Liaison de type force POLYNOMIALE
  69. *
  70. IF (ITYPR.EQ.6) THEN
  71. CALL ACCTAB(ITREFI,'MOT',I0,X0,
  72. & 'POINTS_LIAISON_POLYNOMIALE',
  73. & L0,IP0,'LISTENTI',I1,X1,' ',L1,IPLEN1)
  74. IF (IERR.NE.0) RETURN
  75. CALL ACCTAB(ITREFI,'MOT',I0,X0,
  76. & 'VARIABLES_LIAISON_POLYNOMIALE',
  77. & L0,IP0,'LISTREEL',I1,X1,' ',L1,IPLRE1)
  78. IF (IERR.NE.0) RETURN
  79. *
  80. IF (IIMPI.EQ.333) THEN
  81. WRITE(IOIMP,*)'Lecture des points / liaison ',I
  82. ENDIF
  83. MLENTI = IPLEN1
  84. SEGACT MLENTI
  85. NP = LECT(/1)
  86. NPJ = NP / 2
  87. DO 20 J=1,NPJ
  88. K = J * 2
  89. IKX = LECT(K)
  90. IPLIA(I,J) = IKX
  91. K = (J * 2) - 1
  92. JPLIA(IKX) = LECT(K)
  93. 20 CONTINUE
  94. *****PV SEGSUP MLENTI
  95. *
  96. IF (IIMPI.EQ.333) THEN
  97. WRITE(IOIMP,*)'Lecture des deplacements / liaison ',I
  98. ENDIF
  99. MLREEL = IPLRE1
  100. SEGACT MLREEL
  101. NV = PROG(/1)
  102. DO 30 J=1,NV
  103. XPALA(I,J) = PROG(J)
  104. 30 CONTINUE
  105. *****PV SEGSUP MLREEL
  106. ENDIF
  107. ENDIF
  108. 10 CONTINUE
  109. * end do
  110. *
  111. END
  112.  
  113.  
  114.  
  115.  

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