Télécharger d2vlb1.eso

Retour à la liste

Numérotation des lignes :

  1. C D2VLB1 SOURCE BP208322 15/07/22 21:15:09 8586
  2. C DEVLB1 SOURCE PETR 97/06/03 21:15:24 2709
  3. SUBROUTINE D2VLB1(FTOTB,XPTB,IPALB,IPLIB,JPLIB,XPALB,XVALB,NLIAB,
  4. & NPLB,IDIMB,XDT,NPAS,IND,FEXPSM,NPC1,IERRD,
  5. & FTEST,FTOTB0,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 XDT Tableau des 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. * - FTOTB0 Pour conserver l'etat de FTOTB au cas ou l'increment *
  41. * est à annuler *
  42. * *
  43. * Auteur, date de création: *
  44. * *
  45. * Lionel VIVAN : le 22 Septembre 1989 : Création *
  46. * Bertrand BEAUFILS : le 31 Mai 1990 : Ajout frottement sec*
  47. * E de LANGRE : le 25 Aout1994 : liaison conditionnelle *
  48. * Ibrahim Pinto, 05/97 , liaisons ligne_cercle *
  49. *--------------------------------------------------------------------*
  50. *
  51. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*),JPLIB(*)
  52. REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)
  53. REAL*8 XVALB(NLIAB,4,*),XDT(*),FEXPSM(NPLB,NPC1,2,*)
  54. REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*)
  55. REAL*8 FTest(nplb,6)
  56. REAL*8 ftOTB0(NPLB,6),XCHPFB(2,NLIAB,4,*)
  57.  
  58.  
  59. ** npa, npam1, ind1, indm1 ne sevent que pour les modes negligés;
  60. ** mais comme de toute façon c'est mal fait car on ne tient pas compte des
  61. ** forces nl lors de la contribution des pseudomodes on s'en fiche
  62.  
  63. NPA = NPAS
  64. NPAM1 = NPAS
  65. IND1 = 1
  66. INDM1 = 2
  67.  
  68. * ind = 1 et ind2 = 2 sauf pour l'initialisation où ind = 2 et ind2 = 3
  69. IND2 = IND + 1
  70. PDT = XDT(NPAS)
  71.  
  72. c PDTS2 = 0.5D0 * PDT
  73. PDTS2 = pdt
  74.  
  75. *
  76. * Boucle sur le nombre de liaisons
  77. *
  78. DO 10 I = 1,NLIAB
  79. ITYP = IPALB(I,1)
  80. icond= IPALB(I,4)
  81. iannul= 0
  82.  
  83. * --- cas des liaisons conditionnelles
  84. if (icond .eq. 1 ) then
  85. c 20 car on a defini nipalb = 20 dans dyne22
  86. DO 101 j = 5,20
  87. jliai = ipalb(i,j)
  88. jpliai = abs ( jliai)
  89. if ( jliai . EQ. 0 ) then
  90. goto 101
  91. else
  92. jtyp = ipalb(jpliai,1)
  93. do 102 ik = 1,nplb
  94. do 103 jk = 1,idimb
  95. ftest(ik,jk) = 0d0
  96. ftotb0 (ik,jk) = ftotb(ik,jk)
  97. 103 continue
  98. 102 continue
  99. IF (jTYP.EQ.1 .OR. jTYP.EQ.3 .OR. jTYP.EQ.103
  100. & .OR. jTYP.EQ.5 .OR. jTYP.EQ.6 .OR. jTYP.EQ.7
  101. & .OR. jTYP.EQ.100 .OR. jTYP.EQ.101 .OR. jTYP.EQ.102) THEN
  102. CALL DEVFB1(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
  103. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  104. & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul)
  105. ELSE IF (jTYP.EQ.11 .or. jTYP.EQ.111
  106. & .or. (abs(jTYP)).EQ.13 .OR. jTYP.EQ.113) THEN
  107. CALL DEVFB2(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
  108. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  109. & FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul)
  110. ELSE IF (jTYP.EQ.21 .OR. jTYP.EQ.22 .OR. jTYP.EQ.23 .OR.
  111. & jTYP.EQ.24 .OR. jTYP.EQ.25 .OR. jTYP.EQ.26.OR.jTYP.EQ.33
  112. + .OR. jTYP.EQ.34 ) THEN
  113. CALL DEVFB3(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
  114. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  115. & FEXPSM,NPC1,jpliai,iannul)
  116. ELSE IF (jTYP.EQ.31 .OR. jTYP.EQ.32) THEN
  117. CALL DEVFB4(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
  118. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  119. & FEXPSM,NPC1,jpliai,IERRD,iannul)
  120. ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17 .OR.
  121. & ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  122. CALL DEVFB5(jTYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  123. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  124. & FEXPSM,NPC1,I,XABSCI,XORDON,NIP,iannul)
  125. ELSE IF (jTYP.EQ.35 .OR. jTYP.EQ.36) THEN
  126. CALL DEVFB6(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
  127. & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB)
  128. ELSE IF
  129. &(jTYP.EQ.37 .OR. jTYP.EQ.38 .OR. jTYP.EQ.39 .OR. JTYP.EQ.40) THEN
  130. CALL DEVFB7(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
  131. & NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB)
  132. IF (IERRD.NE.0) RETURN
  133. ENDIF
  134.  
  135. xff = 0.d0
  136. do 104 ik = 1,nplb
  137. do 105 jk = 1,idimb
  138. xff = xff + ( ftest(ik,jk) ** 2)
  139. 105 continue
  140. 104 continue
  141. xff = xff ** .5
  142. if ( ((xff .le. 1e-20 ) .and. ( jliai .gt. 0) )
  143. & .OR. ((xff .gt. 1e-20 ) .and. ( jliai .lt. 0) ) )
  144. & then
  145. iannul = 1
  146. endif
  147.  
  148. endif
  149. 101 continue
  150. * --- fin du cas des liaisons conditionnelles
  151. endif
  152. *
  153. * ------ choc ..._PLAN
  154. *
  155. ** ianis
  156. IF (ITYP.EQ.1 .OR. ITYP.EQ.3 .OR. ITYP.EQ.103
  157. & .OR. ITYP.EQ.5 .OR. ITYP.EQ.6 .OR. ITYP.EQ.7
  158. & .OR. ITYP.EQ.100 .OR. ITYP.EQ.101 .OR. ITYP.EQ.102) THEN
  159. *
  160. CALL DEVFB1(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  161. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  162. & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul)
  163. *
  164. * ------ choc ..._POINT
  165. *
  166. ELSE IF (ITYP.EQ.11 .or. ITYP.EQ.111
  167. & .or. (abs(ITYP)).EQ.13 .OR. ITYP.EQ.113) THEN
  168. CALL DEVFB2(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  169. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  170. & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul)
  171. *
  172. * ------ choc POINT_POINT_ ... _PLASTIQUE
  173. *
  174. ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17 .OR.
  175. & ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  176. *
  177. CALL DEVFB5(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,NPLB,
  178. & IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,FEXPSM,NPC1,
  179. & I,XABSCI,XORDON,NIP,iannul)
  180. *
  181. * ------ choc ..._CERCLE(sauf ligne_cercle)
  182. *
  183. ELSE IF (ITYP.EQ.21 .OR. ITYP.EQ.22 .OR. ITYP.EQ.23 .OR.
  184. & ITYP.EQ.24 .OR. ITYP.EQ.25 .OR. ITYP.EQ.26.OR.ITYP.EQ.33
  185. + .OR. ITYP.EQ.34 ) THEN
  186. CALL DEVFB3(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  187. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  188. & FEXPSM,NPC1,I,iannul)
  189. *
  190. * ------ choc PROFIL_PROFIL_...
  191. *
  192. ELSE IF (ITYP.EQ.31 .OR. ITYP.EQ.32) THEN
  193. CALL DEVFB4(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  194. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  195. & FEXPSM,NPC1,I,IERRD,iannul)
  196. IF (IERRD.NE.0) RETURN
  197. *
  198. * ------ choc LIGNE_LIGNE
  199. *
  200. ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN
  201. CALL DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  202. & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
  203.  
  204.  
  205.  
  206. *
  207. *---------choc LIGNE_CERCLE
  208. *
  209.  
  210.  
  211.  
  212. ELSE IF (ITYP.EQ.37 .OR. ITYP.EQ.38
  213. & .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN
  214. CALL DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  215. & NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
  216. *
  217. * ------ liaison PALIER_FLUIDE
  218.  
  219. ELSE IF (ITYP.EQ.60) THEN
  220. CALL DEVFB8 (ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  221. & NPLB,IND,IND2,PDTS2,I,iannul)
  222.  
  223.  
  224. *
  225. * ------ choc ...........
  226. *
  227. * ELSE IF (ITYP.EQ. ) THEN
  228. * CALL DEVFB (ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  229. * & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  230. * & FEXPSM,NPC1,I,iannul)
  231. ENDIF
  232.  
  233.  
  234. * la suite ne sert à rien après le passage de iannul dans les
  235. * s_p de calcul des forces de laison.
  236.  
  237.  
  238. * si la liaisn était annulée on l'annule
  239. * if ( ( icond.eq. 1 ) .and. ( iannul.eq.1)) then
  240. * on annulle l'increment de ftotb
  241.  
  242. * do 112 ik = 1,nplb
  243. * do 113 jk = 1,idimb
  244. * ftotb (ik,jk) = ftotb0(ik,jk)
  245. * 113 continue
  246. * 112 continue
  247. * end if
  248.  
  249. 10 CONTINUE
  250.  
  251.  
  252. END
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  

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