Télécharger d2pol1.eso

Retour à la liste

Numérotation des lignes :

  1. C D2POL1 SOURCE CHAT 05/01/12 22:35:02 5004
  2. C DYPOL1 SOURCE IANIS 96/08/08 21:16:04 2249
  3. SUBROUTINE D2POL1(Q1,Q2,NA1,IPLIA,XPALA,XVALA,NLIAA,IND,XDT,
  4. & NPAS,NUMLIA,NMOD,FTOTA,IVINIT,IANNUL)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. * *
  9. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  10. * ________________________________________________ *
  11. * *
  12. * Calcul de la force elementaire pour la liaison POLYNOMIALE *
  13. * *
  14. * Parametres: *
  15. * *
  16. * e Q1 Vecteur des deplacements generalises *
  17. * e Q2 Vecteur des vitesses generalisees *
  18. * e NA1 Nombre total d'inconnues en base A *
  19. * e IPLIA Tableau des points de types support et origine *
  20. * es XPALA Tableau des parametres de la liaison *
  21. * es XVALA Tableau des variables internes de la liaison *
  22. * e NLIAA Nombre de liaisons sur la base A *
  23. * e IND Indice du demi-pas *
  24. * e XDT Valeurs des pas de temps *
  25. * e NPAS Numero du pas de temps *
  26. * e NUMLIA Numero de la liaison consideree *
  27. * e NMOD Nombre de modes "origine" de la liaison *
  28. * es FTOTA Forces exterieures totalisees sur la base A *
  29. * e IVINIT =1 si vitesses initiales, =0 sinon *
  30. * *
  31. * Auteur, date de creation: *
  32. * *
  33. * Denis ROBERT, le 30 avril 1992. *
  34. * *
  35. *--------------------------------------------------------------------*
  36. *
  37. -INC CCOPTIO
  38. *
  39. INTEGER IPLIA(NLIAA,*)
  40. REAL*8 XPALA(NLIAA,*),XVALA(NLIAA,4,*),Q1(NA1,*),FTOTA(NA1,*)
  41. REAL*8 XDT(*),Q2(NA1,*)
  42. PARAMETER (XZERO = 0.D0)
  43. PARAMETER (XUN = 1.D0 )
  44. *
  45. XPDT = XDT(NPAS)
  46.  
  47. c XPDTS2 = 0.5 * XPDT
  48. XPDTS2 = XPDT
  49. *
  50. * Boucle sur les modes "origine"
  51. * Organisation de XPALA et indices :
  52. * COEF [ ED / RD / XJD / EV / RV / XJV / ... NMAX val de depl ... ]
  53. * i= 1 IDEB IDEB+6
  54. *
  55. IF (IIMPI.EQ.666) THEN
  56. WRITE(IOIMP,*)' '
  57. WRITE(IOIMP,*)'NPAS = ',NPAS
  58. WRITE(IOIMP,*)'IVINIT = ',IVINIT
  59. WRITE(IOIMP,*)'IND = ',IND
  60. ENDIF
  61. XCOEF = XPALA(NUMLIA,1)
  62. IF (IANNUL.EQ.1) XCOEF = 0.D0
  63. FX = 1.D0
  64. IDEB = 2
  65. DO 10 I = 1,NMOD
  66. INA2 = IPLIA(NUMLIA,I+1)
  67. RD = XPALA(NUMLIA,IDEB+1)
  68. * NRD : decalage pour trouver le deplacement lie au retard RD
  69. NRD = INT(RD/XPDTS2) + 1
  70. RV = XPALA(NUMLIA,IDEB+4)
  71. * NRV : decalage pour trouver la vitesse liee au retard RV
  72. NRV = INT(RV/XPDTS2) + 1
  73. * NRV2 : un deplacement de plus pour calculer la vitesse
  74. NRV2 = NRV + 1
  75. NMAX = MAX(NRD,NRV2)
  76. ED = XPALA(NUMLIA,IDEB)
  77. EV = XPALA(NUMLIA,IDEB+3)
  78. XJD = XPALA(NUMLIA,IDEB+2)
  79. XJV = XPALA(NUMLIA,IDEB+5)
  80. *
  81. * Les deplacements sont reactualises en First In Last Out
  82. *
  83. XDNEW = Q1(INA2,IND)
  84. J1 = IDEB + 6
  85. J2 = IDEB + NMAX + 5
  86. DO 15 J = J1,J2
  87. XAUX = XPALA(NUMLIA,J)
  88. XPALA(NUMLIA,J) = XDNEW
  89. XDNEW = XAUX
  90. 15 CONTINUE
  91. *
  92. * Boucle d'impression de XPALA
  93. *
  94. IF (IIMPI.EQ.666) THEN
  95. WRITE(IOIMP,*)'DYPOL1 : IMOD = ',I
  96. DO 200 II = IDEB,J2
  97. WRITE(IOIMP,*)'XPALA(',NUMLIA,',',II,')=' )
  98. & ,XPALA(NUMLIA,II ) )
  99. 200 CONTINUE
  100. WRITE(IOIMP,*)'NRD = ',NRD
  101. WRITE(IOIMP,*)'NRV = ',NRV
  102. ENDIF
  103. *
  104. * faut-il calculer ( cad t > tau)
  105. *
  106. jmax = ideb + 5+Nmax
  107. Xtest = XPALA(NUMLIA,jmax)
  108. itest = int (xtest)
  109. IF ( itest .eq. 123456) then
  110. * on n'a pas ce qu'il faut pour calculer : on met zero
  111. fx = 0d0
  112. ELSE
  113.  
  114. XDEPL = XPALA(NUMLIA,IDEB+5+NRD)
  115. *
  116. * Calcul de la vitesse
  117. *
  118. IF ((IND.EQ.3).AND.(IVINIT.EQ.1).and. (nrd.eq.1)) THEN
  119. XVIT = Q2(INA2,IND)
  120. ELSE
  121. XD1 = XPALA(NUMLIA,IDEB+5+NRV)
  122. XD2 = XPALA(NUMLIA,IDEB+5+NRV2)
  123. XVIT = (XD1 - XD2) / XPDTS2
  124. ENDIF
  125. IF (IIMPI.EQ.666) THEN
  126. WRITE(IOIMP,*)'---> XVIT = ',XVIT
  127. ENDIF
  128. *
  129. IF ((XJD.NE.XZERO).AND.(ED.EQ.XZERO)) THEN
  130. ISEUIL = 1
  131. ELSE
  132. ISEUIL = 0
  133. ENDIF
  134. IF (XJD.GE.XZERO) THEN
  135. *
  136. * partie positive de (XDEPL - XJD)
  137. *
  138. IF (XDEPL.GE.XJD) THEN
  139. XD = ABS(XDEPL-XJD)
  140. ELSE
  141. XD = XZERO
  142. ENDIF
  143. ELSE
  144. IF (XDEPL.LT.XJD) THEN
  145. XD = ABS(XJD-XDEPL)
  146. ELSE
  147. XD = XZERO
  148. ENDIF
  149. ENDIF
  150. IF (IIMPI.EQ.666) THEN
  151. WRITE(IOIMP,*)'XD = ',XD
  152. ENDIF
  153. IF (XJV.GE.XZERO) THEN
  154. IF (XVIT.GE.XJV) THEN
  155. XV = ABS(XVIT-XJV)
  156. ELSE
  157. XV = XZERO
  158. ENDIF
  159. ELSE
  160. IF (XVIT.LT.XJV) THEN
  161. XV = ABS(XJV-XVIT)
  162. ELSE
  163. XV = XZERO
  164. ENDIF
  165. ENDIF
  166. IF (IIMPI.EQ.666) THEN
  167. WRITE(IOIMP,*)'XV = ',XV
  168. ENDIF
  169. IF (XD.GT.XZERO) THEN
  170. FXD = EXP(ED*LOG(XD))
  171. ELSE
  172. IF (ED.EQ.XZERO) THEN
  173. FXD = XUN
  174. ELSE
  175. FXD = XZERO
  176. ENDIF
  177. ENDIF
  178. IF (XV.GT.XZERO) THEN
  179. IF (ISEUIL.EQ.0) THEN
  180. FXV = EXP(EV*LOG(XV))
  181. ELSE
  182. IF (XD.GT.XZERO) THEN
  183. FXV = EXP(EV*LOG(XV))
  184. ELSE
  185. FXV = XZERO
  186. ENDIF
  187. ENDIF
  188. ELSE
  189. IF (EV.EQ.XZERO) THEN
  190. FXV = XUN
  191. ELSE
  192. FXV = XZERO
  193. ENDIF
  194. ENDIF
  195. FX = FX * FXV * FXD
  196. IF (IIMPI.EQ.666) THEN
  197. WRITE(IOIMP,*)'FXD = ',FXD
  198. WRITE(IOIMP,*)'FXV = ',FXV
  199. WRITE(IOIMP,*)'FX = ',FX
  200. ENDIF
  201. IDEB = IDEB + 6 + NMAX
  202. endif
  203. 10 CONTINUE
  204. INA1 = IPLIA(NUMLIA,1)
  205. FXTOT = XCOEF * FX
  206. XVALA(NUMLIA,IND,1) = FXTOT
  207. FTOTA(INA1,IND) = FTOTA(INA1,IND) + FXTOT
  208. *
  209. END
  210.  
  211.  
  212.  
  213.  

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