Télécharger dypol1.eso

Retour à la liste

Numérotation des lignes :

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

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