Télécharger dyna14.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNA14 SOURCE BP208322 17/07/10 21:15:10 9488
  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 convolutionen 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. 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. IF(IFONC.NE.100) GOTO 10
  59. ELSEIF(ITYP.NE.6) THEN
  60. GOTO 10
  61. ENDIF
  62.  
  63. * Attention : les liaisons doivent etre dans le meme ordre
  64. * dans la table ITREFI que la table des liaisons !
  65. IPOLY = IPOLY + 1
  66. CALL ACCTAB(ITREFR,'ENTIER',IPOLY,X0,' ',L0,IP0,
  67. & 'TABLE',I1,X1,' ',L1,ITREFI)
  68. IF (IERR.NE.0) RETURN
  69. CALL ACCTAB(ITREFI,'MOT',I0,X0,'TYPE',L0,IP0,
  70. & 'ENTIER',ITYPR,X1,' ',L1,ITR)
  71. IF (IERR.NE.0) RETURN
  72. IF (ITYPR.NE.ITYP) THEN
  73. WRITE(ioimp,*) 'Incoherence table de reprise liaison',I
  74. CALL ERREUR(21)
  75. RETURN
  76. ENDIF
  77.  
  78. * -- Cas des liaisons couplage deplacement avec convolution --
  79. IF (ITYP.EQ.5) THEN
  80.  
  81. CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT',
  82. & L0,IP0,'LISTREEL',I1,X1,' ',L1,IPLR2)
  83. IF (IERR.NE.0) RETURN
  84. c IPALA(I,5)=IPLR2
  85. c On recopie dans le nouveau listreel les deplacements deja
  86. c calcules avant reprise
  87. MLREE2=IPALA(I,5)
  88. MLREEL=IPLR2
  89. segact,MLREEL
  90. JG=PROG(/1)
  91. do i2=1,JG
  92. MLREE2.PROG(i2)=PROG(i2)
  93. enddo
  94. CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_1/2',
  95. & L0,IP0,'LISTREEL',I1,X1,' ',L1,IPLR3)
  96. IF (IERR.NE.0) RETURN
  97. c IPALA(I,6)=IPLR3
  98. c On recopie dans le nouveau listreel les deplacements deja
  99. c calcules avant reprise
  100. MLREE3=IPALA(I,6)
  101. MLREEL=IPLR3
  102. segact,MLREEL
  103. JG=PROG(/1)
  104. do i3=1,JG
  105. MLREE3.PROG(i3)=PROG(i3)
  106. enddo
  107.  
  108. * -- Cas des liaisons polynomiales --
  109. ELSEIF (ITYP.EQ.6) THEN
  110.  
  111. CALL ACCTAB(ITREFI,'MOT',I0,X0,
  112. & 'POINTS_LIAISON_POLYNOMIALE',
  113. & L0,IP0,'LISTENTI',I1,X1,' ',L1,IPLEN1)
  114. IF (IERR.NE.0) RETURN
  115. CALL ACCTAB(ITREFI,'MOT',I0,X0,
  116. & 'VARIABLES_LIAISON_POLYNOMIALE',
  117. & L0,IP0,'LISTREEL',I1,X1,' ',L1,IPLRE1)
  118. IF (IERR.NE.0) RETURN
  119. *
  120. IF(IIMPI.EQ.333) WRITE(IOIMP,*)'Lecture des points'
  121. MLENTI = IPLEN1
  122. SEGACT MLENTI
  123. NP = LECT(/1)
  124. NPJ = NP / 2
  125. DO 20 J=1,NPJ
  126. K = J * 2
  127. IKX = LECT(K)
  128. IPLIA(I,J) = IKX
  129. K = (J * 2) - 1
  130. JPLIA(IKX) = LECT(K)
  131. 20 CONTINUE
  132. *****PV SEGSUP MLENTI
  133. *
  134. IF(IIMPI.EQ.333) WRITE(IOIMP,*)'Lecture des deplacements'
  135. MLREEL = IPLRE1
  136. SEGACT MLREEL
  137. NV = PROG(/1)
  138. DO 30 J=1,NV
  139. XPALA(I,J) = PROG(J)
  140. 30 CONTINUE
  141. *****PV SEGSUP MLREEL
  142.  
  143. ENDIF
  144.  
  145. 10 CONTINUE
  146. *
  147. END
  148.  
  149.  
  150.  
  151.  
  152.  

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