Télécharger dyna14.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNA14 SOURCE BP208322 18/01/10 21:15:36 9684
  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 ou COUPLAGE_DEPLACEMENT *
  12. * avec convolution en base A) *
  13. * *
  14. * Parametres: *
  15. * *
  16. * ITREFR Table contenant les variables internes des liaisons *
  17. * sauvegardees dans la table de reprise *
  18. * KTLIAA Description des liaisons en base A *
  19. * *
  20. * Auteur, date de creation: *
  21. * *
  22. * Denis ROBERT-MOUGIN : le 14 mai 1992 *
  23. * *
  24. *--------------------------------------------------------------------*
  25. *
  26. -INC CCOPTIO
  27. -INC SMLENTI
  28. -INC SMTABLE
  29. -INC SMLREEL
  30. -INC SMCOORD
  31. *
  32. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  33. SEGMENT,MTLIAA
  34. INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  35. REAL*8 XPALA(NLIAA,NXPALA)
  36. ENDSEGMENT
  37. *
  38. LOGICAL L0,L1
  39. CHARACTER*(8) TYPIND
  40. *
  41. MTLIAA = KTLIAA
  42. NLIAA = XPALA(/1)
  43. IF (IIMPI.EQ.333) THEN
  44. WRITE(IOIMP,*)'Entree dans DYNA14'
  45. WRITE(IOIMP,*)'NLIAA = ',NLIAA
  46. ENDIF
  47. *
  48. * Boucle sur les liaisons en base A (I) sauvegardees (IPOLY)
  49. *
  50. IPOLY = 0
  51. DO 10 I = 1,NLIAA
  52. ITYP = IPALA(I,1)
  53. c IF(IIMPI.EQ.333) WRITE(IOIMP,*)'Liaison ',I,': ITYP = ',ITYP
  54.  
  55. * Liaison acceptees = 5 (avec convolution) et 6
  56. IF(ITYP.EQ.5) THEN
  57. IFONC=IPALA(I,3)
  58. c WRITE(IOIMP,*)'dyna14: Liaison ',I,': ITYP = ',ITYP,IFONC
  59. IF(IFONC.NE.100.AND.IFONC.NE.101) GOTO 10
  60. ELSEIF(ITYP.NE.6) THEN
  61. c WRITE(IOIMP,*)'dyna14: Liaison ',I,': ITYP = ',ITYP
  62. GOTO 10
  63. ENDIF
  64.  
  65. * Attention : les liaisons doivent etre dans le meme ordre
  66. * dans la table ITREFI que la table des liaisons !
  67. IPOLY = IPOLY + 1
  68. CALL ACCTAB(ITREFR,'ENTIER',IPOLY,X0,' ',L0,IP0,
  69. & 'TABLE',I1,X1,' ',L1,ITREFI)
  70. IF (IERR.NE.0) RETURN
  71. CALL ACCTAB(ITREFI,'MOT',I0,X0,'TYPE',L0,IP0,
  72. & 'ENTIER',ITYPR,X1,' ',L1,ITR)
  73. IF (IERR.NE.0) RETURN
  74. IF (ITYPR.NE.ITYP) THEN
  75. WRITE(ioimp,*) 'Incoherence table de reprise liaison',I
  76. CALL ERREUR(21)
  77. RETURN
  78. ENDIF
  79.  
  80. * -- Cas des liaisons couplage deplacement avec convolution --
  81. IF (ITYP.EQ.5) THEN
  82.  
  83. CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT',
  84. & L0,IP0,'LISTREEL',I1,X1,' ',L1,IPLR2)
  85. IF (IERR.NE.0) RETURN
  86. c IPALA(I,5)=IPLR2
  87. c On recopie dans le nouveau listreel les deplacements deja
  88. c calcules avant reprise
  89. c IFONC=100 : convolution generale via un listreel fourni
  90. c IF(IFONC.EQ.100) THEN
  91. MLREE2=IPALA(I,5)
  92. c IFONC=101 : convolution via le modele de granger_paidoussis
  93. c --> optimisation : on retrouve les memes indices ...
  94. c ELSEIF(IFONC.EQ.101) THEN
  95. c MLREE2=IPALA(I,6)
  96. c ENDIF
  97. MLREEL=IPLR2
  98. segact,MLREEL
  99. JG2=PROG(/1)
  100. do i2=1,JG2
  101. MLREE2.PROG(i2)=PROG(i2)
  102. enddo
  103. CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_1/2',
  104. & L0,IP0,'LISTREEL',I1,X1,' ',L1,IPLR3)
  105. IF (IERR.NE.0) RETURN
  106. c IPALA(I,6)=IPLR3
  107. c On recopie dans le nouveau listreel les deplacements deja
  108. c calcules avant reprise
  109. c IF(IFONC.EQ.100) THEN
  110. MLREE3=IPALA(I,6)
  111. c IFONC=101 : convolution via le modele de granger_paidoussis
  112. c --> optimisation : on retrouve les memes indices ...
  113. c ELSEIF(IFONC.EQ.101) THEN
  114. c MLREE3=IPALA(I,7)
  115. c ENDIF
  116. MLREEL=IPLR3
  117. segact,MLREEL
  118. JG3=PROG(/1)
  119. do i3=1,JG3
  120. MLREE3.PROG(i3)=PROG(i3)
  121. enddo
  122.  
  123.  
  124. * -- Cas des liaisons polynomiales --
  125. ELSEIF (ITYP.EQ.6) THEN
  126.  
  127. CALL ACCTAB(ITREFI,'MOT',I0,X0,
  128. & 'POINTS_LIAISON_POLYNOMIALE',
  129. & L0,IP0,'LISTENTI',I1,X1,' ',L1,IPLEN1)
  130. IF (IERR.NE.0) RETURN
  131. CALL ACCTAB(ITREFI,'MOT',I0,X0,
  132. & 'VARIABLES_LIAISON_POLYNOMIALE',
  133. & L0,IP0,'LISTREEL',I1,X1,' ',L1,IPLRE1)
  134. IF (IERR.NE.0) RETURN
  135. *
  136. IF(IIMPI.EQ.333) WRITE(IOIMP,*)'Lecture des points'
  137. MLENTI = IPLEN1
  138. SEGACT MLENTI
  139. NP = LECT(/1)
  140. NPJ = NP / 2
  141. DO 20 J=1,NPJ
  142. K = J * 2
  143. IKX = LECT(K)
  144. IPLIA(I,J) = IKX
  145. K = (J * 2) - 1
  146. JPLIA(IKX) = LECT(K)
  147. 20 CONTINUE
  148. *****PV SEGSUP MLENTI
  149. *
  150. IF(IIMPI.EQ.333) WRITE(IOIMP,*)'Lecture des deplacements'
  151. MLREEL = IPLRE1
  152. SEGACT MLREEL
  153. NV = PROG(/1)
  154. DO 30 J=1,NV
  155. XPALA(I,J) = PROG(J)
  156. 30 CONTINUE
  157. *****PV SEGSUP MLREEL
  158.  
  159. ENDIF
  160.  
  161. 10 CONTINUE
  162. *
  163. END
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  

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