Télécharger devlb1.eso

Retour à la liste

Numérotation des lignes :

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

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