Télécharger d2vlb1.eso

Retour à la liste

Numérotation des lignes :

  1. C D2VLB1 SOURCE BP208322 19/02/25 21:15:20 10120
  2. c
  3. SUBROUTINE D2VLB1(FTOTB,XPTB,IPALB,IPLIB,JPLIB,XPALB,XVALB,NLIAB,
  4. & NPLB,IDIMB,PDT,NPAS,IND,FEXPSM,NPC1,IERRD,
  5. & FTEST,XABSCI,XORDON,NIP,XCHPFB)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-H,O-Z)
  8. *--------------------------------------------------------------------*
  9. * *
  10. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  11. * ________________________________________________ *
  12. * *
  13. * Calcul des forces de choc sur base B. *
  14. * *
  15. * Paramètres: *
  16. * *
  17. * es FTOTB Forces extérieures totalisées sur la base B. *
  18. * e XPTB Tableau des déplacements des points *
  19. * e IPALB Renseigne sur la liaison. *
  20. * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. *
  21. * e JPLIB Tableau contenant les numéros "GIBI" de la liaison. *
  22. * e XPALB Tableau contenant les paramètres de la liaison. *
  23. * es XVALB Tableau contenant les variables internes de liaisons. *
  24. * e NLIAB Nombre de liaisons sur la base B. *
  25. * e NPLB Nombre total de points intervenant dans les liaisons. *
  26. * e IDIMB Nombre de directions. *
  27. * e PDT pas de temps. *
  28. * e NPAS Numéro du pas de temps. *
  29. * e IND Indice du pas. *
  30. * e FEXPSM Tableau contenant les pseudo-modes. *
  31. * e NPC1 *
  32. * e XABSCI Tableau contenant les abscisses de la loi plastique *
  33. * pour la liaison point-point- ... -plastique *
  34. * e XORDON Tableau contenant les ordonnees de la loi plastique *
  35. * pour la liaison point-point- ... -plastique *
  36. * *
  37. * - FTEST Pour tester la force qui sert a enclencher *
  38. * les liaisons conditionnelles *
  39. * *
  40. * Auteur, date de création: *
  41. * *
  42. * Lionel VIVAN : le 22 Septembre 1989 : Création *
  43. * Bertrand BEAUFILS : le 31 Mai 1990 : Ajout frottement sec*
  44. * E de LANGRE : le 25 Aout1994 : liaison conditionnelle *
  45. * Ibrahim Pinto, 05/97 , liaisons ligne_cercle *
  46. *--------------------------------------------------------------------*
  47. *
  48. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*),JPLIB(*)
  49. REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)
  50. REAL*8 XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
  51. REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*)
  52. REAL*8 FTest(nplb,6)
  53. REAL*8 XCHPFB(2,NLIAB,4,*)
  54.  
  55. *--------------------------------------------------------------------*
  56. * IND ,IND2 : indice courant et precedent
  57. * NPA ,IND1 : pas et indice courant pour les pseudo-modes
  58. * NPAM1,INDM1 : pas et indice precedent pour les pseudo-modes
  59. * |_______________ pas de temps _______________|
  60. * ____ algorithme ____|__ ind=1 __|__ ind=2 __|_ind=3_|__ ind=4 __|
  61. * Differences_Centrees | t_{n+1} | t_n | - | - |
  62. *--------------------------------------------------------------------*
  63. * d'ou les commentaires de Iannis :
  64. ** npa, npam1, ind1, indm1 ne sevent que pour les modes negligés;
  65. ** mais comme de toute façon c'est mal fait car on ne tient pas compte des
  66. ** forces nl lors de la contribution des pseudomodes on s'en fiche
  67. NPA = NPAS
  68. NPAM1 = NPAS
  69. IND1 = 1
  70. INDM1 = 2
  71. * ind = 1 et ind2 = 2 sauf pour l'initialisation où ind = 2 et ind2 = 3
  72. IND2 = IND + 1
  73. PDTS2 = pdt
  74.  
  75.  
  76. *--------------------------------------------------------------------*
  77. *
  78. * Boucle sur le nombre de liaisons
  79. *
  80. *--------------------------------------------------------------------*
  81. DO 10 I = 1,NLIAB
  82. ITYP = IPALB(I,1)
  83. icond= IPALB(I,4)
  84. iannul= 0
  85.  
  86. * --- cas des liaisons conditionnelles
  87. if (icond .eq. 1 ) then
  88. c 20 car on a defini nipalb = 20 dans dyne22
  89. DO 101 j = 5,20
  90. jliai = ipalb(i,j)
  91. jpliai = abs ( jliai)
  92. if ( jliai . EQ. 0 ) then
  93. goto 101
  94. else
  95. jtyp = ipalb(jpliai,1)
  96. do 102 ik = 1,nplb
  97. do 103 jk = 1,idimb
  98. ftest(ik,jk) = 0d0
  99. cbp, supprime le 2019-01-15 ftotb0 (ik,jk) = ftotb(ik,jk)
  100. 103 continue
  101. 102 continue
  102. IF (jTYP.EQ.1 .OR. jTYP.EQ.3 .OR. jTYP.EQ.103
  103. & .OR. jTYP.EQ.5 .OR. jTYP.EQ.6 .OR. jTYP.EQ.7
  104. & .OR. jTYP.EQ.100 .OR. jTYP.EQ.101 .OR. jTYP.EQ.102) THEN
  105. CALL DEVFB1(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
  106. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  107. & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul)
  108. ELSEIF (jTYP.EQ.11 .or. jTYP.EQ.111
  109. & .or. (abs(jTYP)).EQ.13 .OR. jTYP.EQ.113) THEN
  110. CALL DEVFB2(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
  111. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  112. & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul)
  113. ELSEIF (jTYP.EQ.21 .OR. jTYP.EQ.22 .OR. jTYP.EQ.23
  114. & .OR. jTYP.EQ.24 .OR. jTYP.EQ.25 .OR. jTYP.EQ.26
  115. & .OR. jTYP.EQ.33 .OR. jTYP.EQ.34 .OR. jTYP.EQ.123
  116. & .OR. jTYP.EQ.124 .OR. jTYP.EQ.125 .OR. jTYP.EQ.126
  117. & .OR. jTYP.EQ.133 .OR. jTYP.EQ.134 ) THEN
  118. CALL DEVFB3(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
  119. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  120. & FEXPSM,NPC1,jpliai,iannul)
  121. ELSEIF (jTYP.EQ.31 .OR. jTYP.EQ.32) THEN
  122. CALL DEVFB4(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
  123. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  124. & FEXPSM,NPC1,jpliai,IERRD,iannul)
  125. ELSEIF (ITYP.EQ.16 .OR. ITYP.EQ.17
  126. & .OR. ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  127. CALL DEVFB5(jTYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  128. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  129. & FEXPSM,NPC1,I,XABSCI,XORDON,NIP,iannul)
  130. ELSEIF (jTYP.EQ.35 .OR. jTYP.EQ.36) THEN
  131. CALL DEVFB6(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
  132. & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB)
  133. ELSEIF (jTYP.EQ.37 .OR. jTYP.EQ.38
  134. & .OR. jTYP.EQ.39 .OR. JTYP.EQ.40) THEN
  135. CALL DEVFB7(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
  136. & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB)
  137. IF (IERRD.NE.0) RETURN
  138. ENDIF
  139.  
  140. xff = 0.d0
  141. do 104 ik = 1,nplb
  142. do 105 jk = 1,idimb
  143. xff = xff + ( ftest(ik,jk) ** 2)
  144. 105 continue
  145. 104 continue
  146. xff = xff ** .5
  147. if ( ((xff .le. 1e-20 ) .and. ( jliai .gt. 0) )
  148. & .OR. ((xff .gt. 1e-20 ) .and. ( jliai .lt. 0) ) )
  149. & then
  150. iannul = 1
  151. endif
  152.  
  153. endif
  154. 101 continue
  155. endif
  156. * --- fin du cas des liaisons conditionnelles
  157.  
  158. *
  159. * ------ choc ..._PLAN
  160. *
  161. IF (ITYP.EQ.1 .OR. ITYP.EQ.3 .OR. ITYP.EQ.103
  162. & .OR. ITYP.EQ.5 .OR. ITYP.EQ.6 .OR. ITYP.EQ.7
  163. & .OR. ITYP.EQ.100 .OR. ITYP.EQ.101 .OR. ITYP.EQ.102) THEN
  164. *
  165. CALL DEVFB1(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  166. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  167. & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul)
  168. *
  169. * ------ choc ..._POINT
  170. *
  171. ELSEIF (ITYP.EQ.11 .or. ITYP.EQ.111
  172. & .or. (abs(ITYP)).EQ.13 .OR. ITYP.EQ.113) THEN
  173. CALL DEVFB2(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  174. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  175. & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul)
  176. *
  177. * ------ choc POINT_POINT_ ... _PLASTIQUE
  178. *
  179. ELSEIF (ITYP.EQ.16 .OR. ITYP.EQ.17 .OR.
  180. & ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  181. *
  182. CALL DEVFB5(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,NPLB,
  183. & IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,FEXPSM,NPC1,
  184. & I,XABSCI,XORDON,NIP,iannul)
  185. *
  186. * ------ choc ..._CERCLE(sauf ligne_cercle)
  187. *
  188. ELSEIF (ITYP.EQ.21 .OR. ITYP.EQ.22 .OR. ITYP.EQ.23
  189. & .OR. ITYP.EQ.24 .OR. ITYP.EQ.25 .OR. ITYP.EQ.26
  190. & .OR. ITYP.EQ.33 .OR. ITYP.EQ.34 .OR. jTYP.EQ.123
  191. & .OR. jTYP.EQ.124 .OR. jTYP.EQ.125 .OR. jTYP.EQ.126
  192. & .OR. jTYP.EQ.133 .OR. jTYP.EQ.134 ) THEN
  193.  
  194. CALL DEVFB3(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  195. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  196. & FEXPSM,NPC1,I,iannul)
  197. *
  198. * ------ choc PROFIL_PROFIL_...
  199. *
  200. ELSEIF (ITYP.EQ.31 .OR. ITYP.EQ.32) THEN
  201. CALL DEVFB4(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  202. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  203. & FEXPSM,NPC1,I,IERRD,iannul)
  204. IF (IERRD.NE.0) RETURN
  205. *
  206. * ------ choc LIGNE_LIGNE
  207. *
  208. ELSEIF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN
  209. CALL DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  210. & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
  211. *
  212. *---------choc LIGNE_CERCLE
  213. *
  214. ELSEIF (ITYP.EQ.37 .OR. ITYP.EQ.38
  215. & .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN
  216. CALL DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  217. & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
  218. *
  219. * ------ liaison PALIER_FLUIDE
  220.  
  221. ELSEIF (ITYP.EQ.60) THEN
  222. CALL DEVFB8 (ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  223. & NPLB,IND,IND2,PDTS2,I,iannul)
  224.  
  225.  
  226. *
  227. * ------ choc ...........
  228. *
  229. * ELSEIF (ITYP.EQ. ) THEN
  230. * CALL DEVFB (ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  231. * & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  232. * & FEXPSM,NPC1,I,iannul)
  233. ENDIF
  234.  
  235.  
  236. 10 CONTINUE
  237.  
  238.  
  239. END
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  

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